Add support for .hsc files

examples/Cpp.hsc

@@ -0,0 +1,15 @@
+module Cpp where
+
+#include <something.h>
+
+data Foo = Foo
+    { bar :: Int
+#if 0
+    , bazquux :: Int8
+#else
+    , bazquux :: Int16
+#endif
+    }
+
+main :: IO ()
+main = pure ()

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
@@ -27,6 +29,8 @@ module Language.Haskell.Stylish
 
 --------------------------------------------------------------------------------
 import           Control.Monad                                    (foldM)
+import           Data.Maybe                                       (maybeToList,
+                                                                   mapMaybe)
 import           System.Directory                                 (doesDirectoryExist,
                                                                    doesFileExist,
                                                                    listDirectory)
@@ -118,19 +122,19 @@ format maybeConfigPath maybeFilePath contents = do
 
 --------------------------------------------------------------------------------
 -- | Searches Haskell source files in any given folder recursively.
-findHaskellFiles :: Bool -> [FilePath] -> IO [FilePath]
+-- 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
 
 
 --------------------------------------------------------------------------------
-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 +152,15 @@ findFilesR v path = do
                    True  -> go dir
                    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
+
+considerFile :: FilePath -> Maybe (FilePath, [String])
+considerFile x =
+  case takeExtension x of
+    ".hs"  -> Just (x, [])
+    ".hsc" -> Just (x, ["CPP"])
+    _      -> Nothing

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

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 = ""