From a18e171446d62491c7c41db0a50af520c18833ba Mon Sep 17 00:00:00 2001 From: 1computer1 Date: Tue, 20 Oct 2020 20:02:29 -0400 Subject: [PATCH 1/2] add support for .hsc files --- examples/Cpp.hsc | 15 ++++++++++++++ lib/Language/Haskell/Stylish.hs | 22 +++++++++++++++----- src/Main.hs | 14 ++++++++----- tests/Language/Haskell/Stylish/Tests.hs | 27 +++++++++++++++++++++---- 4 files changed, 64 insertions(+), 14 deletions(-) create mode 100644 examples/Cpp.hsc diff --git a/examples/Cpp.hsc b/examples/Cpp.hsc new file mode 100644 index 00000000..0a4ae160 --- /dev/null +++ b/examples/Cpp.hsc @@ -0,0 +1,15 @@ +module Cpp where + +#include + +data Foo = Foo + { bar :: Int +#if 0 + , bazquux :: Int8 +#else + , bazquux :: Int16 +#endif + } + +main :: IO () +main = pure () diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs index a767889e..4665affa 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -12,6 +12,8 @@ module Language.Haskell.Stylish , unicodeSyntax -- ** Helpers , findHaskellFiles + , considerFiles + , considerFile , stepName -- * Config , module Language.Haskell.Stylish.Config @@ -45,6 +47,7 @@ import qualified Language.Haskell.Stylish.Step.TrailingWhitespace as TrailingWhi import qualified Language.Haskell.Stylish.Step.UnicodeSyntax as UnicodeSyntax import Language.Haskell.Stylish.Verbose import Paths_stylish_haskell (version) +import Data.Maybe (maybeToList, mapMaybe) -------------------------------------------------------------------------------- @@ -118,19 +121,18 @@ format maybeConfigPath maybeFilePath contents = do -------------------------------------------------------------------------------- -- | Searches Haskell source files in any given folder recursively. -findHaskellFiles :: Bool -> [FilePath] -> IO [FilePath] +findHaskellFiles :: Bool -> [FilePath] -> IO [(FilePath, [String])] findHaskellFiles v fs = mapM (findFilesR v) fs >>= return . concat -------------------------------------------------------------------------------- -findFilesR :: Bool -> FilePath -> IO [FilePath] +findFilesR :: Bool -> FilePath -> IO [(FilePath, [String])] findFilesR _ [] = return [] findFilesR v path = do doesFileExist path >>= \case - True -> return [path] + True -> return . maybeToList $ considerFile path _ -> doesDirectoryExist path >>= \case - True -> findFilesRecursive path >>= - return . filter (\x -> takeExtension x == ".hs") + True -> mapMaybe considerFile <$> findFilesRecursive path False -> do makeVerbose v ("Input folder does not exists: " <> path) findFilesR v [] @@ -148,3 +150,13 @@ findFilesR v path = do True -> go dir False -> return [dir]) return $ concat ps + +considerFiles :: [FilePath] -> [(FilePath, [String])] +considerFiles = mapMaybe considerFile + +considerFile :: FilePath -> Maybe (FilePath, [String]) +considerFile x = + case takeExtension x of + ".hs" -> Just (x, []) + ".hsc" -> Just (x, ["CPP"]) + _ -> Nothing diff --git a/src/Main.hs b/src/Main.hs index a41c1d86..eaeedf3e 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -8,6 +8,7 @@ module Main -------------------------------------------------------------------------------- import Control.Monad (forM_, unless, when) import qualified Data.ByteString.Char8 as BC8 +import Data.List (nub) import Data.Version (showVersion) import qualified Options.Applicative as OA import System.Exit (exitFailure) @@ -111,21 +112,24 @@ stylishHaskell sa = do conf <- loadConfig verbose' (saConfig sa) filesR <- case (saRecursive sa) of True -> findHaskellFiles (saVerbose sa) (saFiles sa) - _ -> return $ saFiles sa + _ -> return $ considerFiles $ saFiles sa let steps = configSteps conf forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step" verbose' $ "Extra language extensions: " ++ show (configLanguageExtensions conf) - res <- foldMap (file sa conf) (files' filesR) + res <- case files' filesR of + Nothing -> file sa conf Nothing + Just xs -> foldMap (\(fp, exts) -> file sa (extend conf exts) (Just fp)) xs verbose' $ "Exit code behavior: " ++ show (configExitCode conf) when (configExitCode conf == ErrorOnFormatExitBehavior && res == DidFormat) exitFailure where verbose' = makeVerbose (saVerbose sa) + extend conf exts = conf { configLanguageExtensions = nub $ exts <> configLanguageExtensions conf } files' x = case (saRecursive sa, null x) of - (True,True) -> [] -- No file to format and recursive enabled. - (_,True) -> [Nothing] -- Involving IO.stdin. - (_,False) -> map Just x -- Process available files. + (True,True) -> Just [] -- No file to format and recursive enabled. + (_,True) -> Nothing -- Involving IO.stdin. + (_,False) -> Just x -- Process available files. data FormattingResult = DidFormat diff --git a/tests/Language/Haskell/Stylish/Tests.hs b/tests/Language/Haskell/Stylish/Tests.hs index b99e620a..2ad0ea20 100644 --- a/tests/Language/Haskell/Stylish/Tests.hs +++ b/tests/Language/Haskell/Stylish/Tests.hs @@ -5,6 +5,7 @@ module Language.Haskell.Stylish.Tests -------------------------------------------------------------------------------- +import Data.Bifunctor (first) import Data.List (sort) import System.Directory (createDirectory) import System.FilePath (normalise, ()) @@ -28,6 +29,7 @@ tests = testGroup "Language.Haskell.Stylish.Tests" , testCase "case 05" case05 , testCase "case 06" case06 , testCase "case 07" case07 + , testCase "case 08" case08 ] @@ -100,7 +102,7 @@ case04 = (@?= result) =<< format Nothing (Just fileLocation) input fileLocation = "directory/File.hs" input = "module Herp" result = Left $ - fileLocation <> ": RealSrcSpan SrcSpanPoint \"directory/File.hs\" 2 1:" + fileLocation <> ": RealSrcSpan SrcSpanPoint \"directory/File.hs\" 2 1:" <> " parse error (possibly incorrect indentation or mismatched brackets)\n" -------------------------------------------------------------------------------- @@ -109,7 +111,7 @@ case05 :: Assertion case05 = withTestDirTree $ do createDirectory aDir >> writeFile c fileCont mapM_ (flip writeFile fileCont) fs - result <- findHaskellFiles False input + result <- map fst <$> findHaskellFiles False input sort result @?= (sort $ map normalise expected) where input = c : fs @@ -125,7 +127,7 @@ case05 = withTestDirTree $ do case06 :: Assertion case06 = withTestDirTree $ do mapM_ (flip writeFile "") input - result <- findHaskellFiles False input + result <- map fst <$> findHaskellFiles False input result @?= expected where input = ["b.hs"] @@ -137,8 +139,25 @@ case06 = withTestDirTree $ do case07 :: Assertion case07 = withTestDirTree $ do mapM_ (flip writeFile "") input - result <- findHaskellFiles False input + result <- map fst <$> findHaskellFiles False input result @?= expected where input = [] expected = input + + +-------------------------------------------------------------------------------- +-- | Should work for .hsc files. +case08 :: Assertion +case08 = withTestDirTree $ do + createDirectory aDir >> writeFile c fileCont + mapM_ (flip writeFile fileCont) fs + result <- findHaskellFiles False input + sort result @?= (sort $ map (first normalise) expected) + where + input = c : fs + fs = ["b.hsc", "a.hsc", "d.hs"] + c = aDir "c.hsc" + aDir = "aDir" + expected = [("a.hsc", ["CPP"]), ("b.hsc", ["CPP"]), (c, ["CPP"]), ("d.hs", [])] + fileCont = "" From b4508d0e3539bae22964328d321cd59edd80e54f Mon Sep 17 00:00:00 2001 From: 1computer1 Date: Tue, 20 Oct 2020 20:05:21 -0400 Subject: [PATCH 2/2] add some documentation --- lib/Language/Haskell/Stylish.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs index 4665affa..e06d808f 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -29,6 +29,8 @@ module Language.Haskell.Stylish -------------------------------------------------------------------------------- import Control.Monad (foldM) +import Data.Maybe (maybeToList, + mapMaybe) import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) @@ -47,7 +49,6 @@ import qualified Language.Haskell.Stylish.Step.TrailingWhitespace as TrailingWhi import qualified Language.Haskell.Stylish.Step.UnicodeSyntax as UnicodeSyntax import Language.Haskell.Stylish.Verbose import Paths_stylish_haskell (version) -import Data.Maybe (maybeToList, mapMaybe) -------------------------------------------------------------------------------- @@ -121,6 +122,7 @@ format maybeConfigPath maybeFilePath contents = do -------------------------------------------------------------------------------- -- | Searches Haskell source files in any given folder recursively. +-- Includes any extra extensions to add on top of the config. findHaskellFiles :: Bool -> [FilePath] -> IO [(FilePath, [String])] findHaskellFiles v fs = mapM (findFilesR v) fs >>= return . concat @@ -151,6 +153,8 @@ findFilesR v path = do False -> return [dir]) return $ concat ps +-- | Filter out files that can be formatted and also any extra extensions they may use. +-- Currently supported: .hs .hsc considerFiles :: [FilePath] -> [(FilePath, [String])] considerFiles = mapMaybe considerFile