Add -r flag to recursively find Haskell files

Author: mmzx

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

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)
 
 
@@ -44,6 +45,11 @@ parseStylishArgs = StylishArgs
             OA.long    "config"              <>
             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"             <>
@@ -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.
 
 
 --------------------------------------------------------------------------------

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