diff options
author | Akos Marton <makos999@protonmail.ch> | 2020-02-15 12:24:11 +0100 |
---|---|---|
committer | GitHub <noreply@github.com> | 2020-02-15 12:24:11 +0100 |
commit | ab85690eb35dec46c8eb80a930337249f34b9f80 (patch) | |
tree | 59a73cef8a09bcd28269a58a50642bd8ca533382 | |
parent | 41dcda2a34b5f12f3fa91480bfe2aaeb4afa90e5 (diff) | |
download | stylish-haskell-ab85690eb35dec46c8eb80a930337249f34b9f80.tar.gz |
Add -r flag to recursively find Haskell files
-rw-r--r-- | lib/Language/Haskell/Stylish.hs | 42 | ||||
-rw-r--r-- | src/Main.hs | 30 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Tests.hs | 47 |
3 files changed, 109 insertions, 10 deletions
diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs index 4f6aa1f..c50db4d 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} -------------------------------------------------------------------------------- module Language.Haskell.Stylish ( -- * Run @@ -10,6 +11,7 @@ module Language.Haskell.Stylish , trailingWhitespace , unicodeSyntax -- ** Helpers + , findHaskellFiles , stepName -- * Config , module Language.Haskell.Stylish.Config @@ -25,7 +27,11 @@ module Language.Haskell.Stylish -------------------------------------------------------------------------------- import Control.Monad (foldM) - +import System.Directory (doesDirectoryExist, + doesFileExist, + listDirectory) +import System.FilePath (takeExtension, + (</>)) -------------------------------------------------------------------------------- import Language.Haskell.Stylish.Config @@ -103,3 +109,37 @@ format :: Maybe ConfigPath -> Maybe FilePath -> String -> IO (Either String Line format maybeConfigPath maybeFilePath contents = do conf <- loadConfig (makeVerbose True) (fmap unConfigPath maybeConfigPath) pure $ runSteps (configLanguageExtensions conf) maybeFilePath (configSteps conf) $ lines contents + + +-------------------------------------------------------------------------------- +-- | Searches Haskell source files in any given folder recursively. +findHaskellFiles :: Bool -> [FilePath] -> IO [FilePath] +findHaskellFiles v fs = mapM (findFilesR v) fs >>= return . concat + + +-------------------------------------------------------------------------------- +findFilesR :: Bool -> FilePath -> IO [FilePath] +findFilesR _ [] = return [] +findFilesR v path = do + doesFileExist path >>= \case + True -> return [path] + _ -> doesDirectoryExist path >>= \case + True -> findFilesRecursive path >>= + return . filter (\x -> takeExtension x == ".hs") + False -> do + makeVerbose v ("Input folder does not exists: " <> path) + findFilesR v [] + where + findFilesRecursive :: FilePath -> IO [FilePath] + findFilesRecursive = listDirectoryFiles findFilesRecursive + + listDirectoryFiles :: (FilePath -> IO [FilePath]) + -> FilePath -> IO [FilePath] + listDirectoryFiles go topdir = do + ps <- listDirectory topdir >>= + mapM (\x -> do + let dir = topdir </> x + doesDirectoryExist dir >>= \case + True -> go dir + False -> return [dir]) + return $ concat ps diff --git a/src/Main.hs b/src/Main.hs index e71c795..b1ca2d5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -21,13 +21,14 @@ import Language.Haskell.Stylish -------------------------------------------------------------------------------- data StylishArgs = StylishArgs - { saVersion :: Bool - , saConfig :: Maybe FilePath - , saVerbose :: Bool - , saDefaults :: Bool - , saInPlace :: Bool - , saNoUtf8 :: Bool - , saFiles :: [FilePath] + { saVersion :: Bool + , saConfig :: Maybe FilePath + , saRecursive :: Bool + , saVerbose :: Bool + , saDefaults :: Bool + , saInPlace :: Bool + , saNoUtf8 :: Bool + , saFiles :: [FilePath] } deriving (Show) @@ -45,6 +46,11 @@ parseStylishArgs = StylishArgs OA.short 'c' <> OA.hidden) <*> OA.switch ( + OA.help "Recursive file search" <> + OA.long "recursive" <> + OA.short 'r' <> + OA.hidden) + <*> OA.switch ( OA.help "Run in verbose mode" <> OA.long "verbose" <> OA.short 'v' <> @@ -99,14 +105,20 @@ stylishHaskell sa = do else do conf <- loadConfig verbose' (saConfig sa) + filesR <- case (saRecursive sa) of + True -> findHaskellFiles (saVerbose sa) (saFiles sa) + _ -> return $ saFiles sa let steps = configSteps conf forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step" verbose' $ "Extra language extensions: " ++ show (configLanguageExtensions conf) - mapM_ (file sa conf) files' + mapM_ (file sa conf) $ files' filesR where verbose' = makeVerbose (saVerbose sa) - files' = if null (saFiles sa) then [Nothing] else map Just (saFiles sa) + 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. -------------------------------------------------------------------------------- diff --git a/tests/Language/Haskell/Stylish/Tests.hs b/tests/Language/Haskell/Stylish/Tests.hs index 59ca92b..e7faa9b 100644 --- a/tests/Language/Haskell/Stylish/Tests.hs +++ b/tests/Language/Haskell/Stylish/Tests.hs @@ -5,6 +5,9 @@ module Language.Haskell.Stylish.Tests -------------------------------------------------------------------------------- +import Data.List (sort) +import System.Directory (createDirectory) +import System.FilePath (normalise, (</>)) import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (Assertion, (@?=)) @@ -21,6 +24,9 @@ tests = testGroup "Language.Haskell.Stylish.Step.Tabs.Tests" [ testCase "case 01" case01 , testCase "case 02" case02 , testCase "case 03" case03 + , testCase "case 04" case04 + , testCase "case 05" case05 + , testCase "case 06" case06 ] @@ -68,3 +74,44 @@ case03 = (@?= result) =<< format Nothing (Just fileLocation) input "Language.Haskell.Stylish.Parse.parseModule: could not parse " <> fileLocation <> ": ParseFailed (SrcLoc \"<unknown>.hs\" 2 1) \"Parse error: EOF\"" + + +-------------------------------------------------------------------------------- +-- | When providing current dir including folders and files. +case04 :: Assertion +case04 = withTestDirTree $ do + createDirectory aDir >> writeFile c fileCont + mapM_ (flip writeFile fileCont) fs + result <- findHaskellFiles False input + sort result @?= (sort $ map normalise expected) + where + input = c : fs + fs = ["b.hs", "a.hs"] + c = aDir </> "c.hs" + aDir = "aDir" + expected = ["a.hs", "b.hs", c] + fileCont = "" + + +-------------------------------------------------------------------------------- +-- | When the input item is not file, do not recurse it. +case05 :: Assertion +case05 = withTestDirTree $ do + mapM_ (flip writeFile "") input + result <- findHaskellFiles False input + result @?= expected + where + input = ["b.hs"] + expected = map normalise input + + +-------------------------------------------------------------------------------- +-- | Empty input should result in empty output. +case06 :: Assertion +case06 = withTestDirTree $ do + mapM_ (flip writeFile "") input + result <- findHaskellFiles False input + result @?= expected + where + input = [] + expected = input |