diff options
Diffstat (limited to 'lib/Language/Haskell/Stylish.hs')
| -rw-r--r-- | lib/Language/Haskell/Stylish.hs | 62 |
1 files changed, 58 insertions, 4 deletions
diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs index 46543ec..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,12 +11,15 @@ module Language.Haskell.Stylish , trailingWhitespace , unicodeSyntax -- ** Helpers + , findHaskellFiles , stepName -- * Config , module Language.Haskell.Stylish.Config -- * Misc , module Language.Haskell.Stylish.Verbose , version + , format + , ConfigPath(..) , Lines , Step ) where @@ -23,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 @@ -40,24 +48,25 @@ import Paths_stylish_haskell (version) -------------------------------------------------------------------------------- -simpleAlign :: Int -- ^ Columns +simpleAlign :: Maybe Int -- ^ Columns -> SimpleAlign.Config -> Step simpleAlign = SimpleAlign.step -------------------------------------------------------------------------------- -imports :: Int -- ^ columns +imports :: Maybe Int -- ^ columns -> Imports.Options -> Step imports = Imports.step -------------------------------------------------------------------------------- -languagePragmas :: Int -- ^ columns +languagePragmas :: Maybe Int -- ^ columns -> LanguagePragmas.Style -> Bool -- ^ Pad to same length in vertical mode? -> Bool -- ^ remove redundant? + -> String -- ^ language prefix -> Step languagePragmas = LanguagePragmas.step @@ -75,6 +84,7 @@ trailingWhitespace = TrailingWhitespace.step -------------------------------------------------------------------------------- unicodeSyntax :: Bool -- ^ add language pragma? + -> String -- ^ language prefix -> Step unicodeSyntax = UnicodeSyntax.step @@ -89,3 +99,47 @@ runStep exts mfp ls step = runSteps :: Extensions -> Maybe FilePath -> [Step] -> Lines -> Either String Lines runSteps exts mfp steps ls = foldM (runStep exts mfp) ls steps + +newtype ConfigPath = ConfigPath { unConfigPath :: FilePath } + +-- |Formats given contents optionally using the config provided as first param. +-- The second file path is the location from which the contents were read. +-- If provided, it's going to be printed out in the error message. +format :: Maybe ConfigPath -> Maybe FilePath -> String -> IO (Either String Lines) +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 |