{-# LANGUAGE LambdaCase #-}
module Language.Haskell.Stylish
(
runSteps
, simpleAlign
, imports
, languagePragmas
, tabs
, trailingWhitespace
, unicodeSyntax
, findHaskellFiles
, stepName
, module Language.Haskell.Stylish.Config
, module Language.Haskell.Stylish.Verbose
, version
, format
, ConfigPath(..)
, Lines
, Step
) where
import Control.Monad (foldM)
import System.Directory (doesDirectoryExist,
doesFileExist,
listDirectory)
import System.FilePath (takeExtension,
(</>))
import Language.Haskell.Stylish.Config
import Language.Haskell.Stylish.Parse
import Language.Haskell.Stylish.Step
import qualified Language.Haskell.Stylish.Step.Imports as Imports
import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas
import qualified Language.Haskell.Stylish.Step.SimpleAlign as SimpleAlign
import qualified Language.Haskell.Stylish.Step.Tabs as Tabs
import qualified Language.Haskell.Stylish.Step.TrailingWhitespace as TrailingWhitespace
import qualified Language.Haskell.Stylish.Step.UnicodeSyntax as UnicodeSyntax
import Language.Haskell.Stylish.Verbose
import Paths_stylish_haskell (version)
simpleAlign :: Maybe Int
-> SimpleAlign.Config
-> Step
simpleAlign :: Maybe Int -> Config -> Step
simpleAlign = Maybe Int -> Config -> Step
SimpleAlign.step
imports :: Maybe Int
-> Imports.Options
-> Step
imports :: Maybe Int -> Options -> Step
imports = Maybe Int -> Options -> Step
Imports.step
languagePragmas :: Maybe Int
-> LanguagePragmas.Style
-> Bool
-> Bool
-> String
-> Step
languagePragmas :: Maybe Int -> Style -> Bool -> Bool -> String -> Step
languagePragmas = Maybe Int -> Style -> Bool -> Bool -> String -> Step
LanguagePragmas.step
tabs :: Int
-> Step
tabs :: Int -> Step
tabs = Int -> Step
Tabs.step
trailingWhitespace :: Step
trailingWhitespace :: Step
trailingWhitespace = Step
TrailingWhitespace.step
unicodeSyntax :: Bool
-> String
-> Step
unicodeSyntax :: Bool -> String -> Step
unicodeSyntax = Bool -> String -> Step
UnicodeSyntax.step
runStep :: Extensions -> Maybe FilePath -> Lines -> Step -> Either String Lines
runStep :: Extensions
-> Maybe String -> Extensions -> Step -> Either String Extensions
runStep Extensions
exts Maybe String
mfp Extensions
ls = \case
Step String
_name Extensions -> Module -> Extensions
step ->
Extensions -> Module -> Extensions
step Extensions
ls (Module -> Extensions)
-> Either String Module -> Either String Extensions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extensions -> Maybe String -> String -> Either String Module
parseModule Extensions
exts Maybe String
mfp (Extensions -> String
unlines Extensions
ls)
runSteps ::
Extensions
-> Maybe FilePath
-> [Step]
-> Lines
-> Either String Lines
runSteps :: Extensions
-> Maybe String -> [Step] -> Extensions -> Either String Extensions
runSteps Extensions
exts Maybe String
mfp [Step]
steps Extensions
ls =
(Extensions -> Step -> Either String Extensions)
-> Extensions -> [Step] -> Either String Extensions
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Extensions
-> Maybe String -> Extensions -> Step -> Either String Extensions
runStep Extensions
exts Maybe String
mfp) Extensions
ls [Step]
steps
newtype ConfigPath = ConfigPath { ConfigPath -> String
unConfigPath :: FilePath }
format :: Maybe ConfigPath -> Maybe FilePath -> String -> IO (Either String Lines)
format :: Maybe ConfigPath
-> Maybe String -> String -> IO (Either String Extensions)
format Maybe ConfigPath
maybeConfigPath Maybe String
maybeFilePath String
contents = do
Config
conf <- Verbose -> Maybe String -> IO Config
loadConfig (Bool -> Verbose
makeVerbose Bool
True) ((ConfigPath -> String) -> Maybe ConfigPath -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConfigPath -> String
unConfigPath Maybe ConfigPath
maybeConfigPath)
Either String Extensions -> IO (Either String Extensions)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Extensions -> IO (Either String Extensions))
-> Either String Extensions -> IO (Either String Extensions)
forall a b. (a -> b) -> a -> b
$ Extensions
-> Maybe String -> [Step] -> Extensions -> Either String Extensions
runSteps (Config -> Extensions
configLanguageExtensions Config
conf) Maybe String
maybeFilePath (Config -> [Step]
configSteps Config
conf) (Extensions -> Either String Extensions)
-> Extensions -> Either String Extensions
forall a b. (a -> b) -> a -> b
$ String -> Extensions
lines String
contents
findHaskellFiles :: Bool -> [FilePath] -> IO [FilePath]
findHaskellFiles :: Bool -> Extensions -> IO Extensions
findHaskellFiles Bool
v Extensions
fs = (String -> IO Extensions) -> Extensions -> IO [Extensions]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> String -> IO Extensions
findFilesR Bool
v) Extensions
fs IO [Extensions] -> ([Extensions] -> IO Extensions) -> IO Extensions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Extensions -> IO Extensions
forall (m :: * -> *) a. Monad m => a -> m a
return (Extensions -> IO Extensions)
-> ([Extensions] -> Extensions) -> [Extensions] -> IO Extensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Extensions] -> Extensions
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
findFilesR :: Bool -> FilePath -> IO [FilePath]
findFilesR :: Bool -> String -> IO Extensions
findFilesR Bool
_ [] = Extensions -> IO Extensions
forall (m :: * -> *) a. Monad m => a -> m a
return []
findFilesR Bool
v String
path = do
String -> IO Bool
doesFileExist String
path IO Bool -> (Bool -> IO Extensions) -> IO Extensions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> Extensions -> IO Extensions
forall (m :: * -> *) a. Monad m => a -> m a
return [String
path]
Bool
_ -> String -> IO Bool
doesDirectoryExist String
path IO Bool -> (Bool -> IO Extensions) -> IO Extensions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> String -> IO Extensions
findFilesRecursive String
path IO Extensions -> (Extensions -> IO Extensions) -> IO Extensions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Extensions -> IO Extensions
forall (m :: * -> *) a. Monad m => a -> m a
return (Extensions -> IO Extensions)
-> (Extensions -> Extensions) -> Extensions -> IO Extensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> Extensions -> Extensions
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
x -> String -> String
takeExtension String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".hs")
Bool
False -> do
Bool -> Verbose
makeVerbose Bool
v (String
"Input folder does not exists: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path)
Bool -> String -> IO Extensions
findFilesR Bool
v []
where
findFilesRecursive :: FilePath -> IO [FilePath]
findFilesRecursive :: String -> IO Extensions
findFilesRecursive = (String -> IO Extensions) -> String -> IO Extensions
listDirectoryFiles String -> IO Extensions
findFilesRecursive
listDirectoryFiles :: (FilePath -> IO [FilePath])
-> FilePath -> IO [FilePath]
listDirectoryFiles :: (String -> IO Extensions) -> String -> IO Extensions
listDirectoryFiles String -> IO Extensions
go String
topdir = do
[Extensions]
ps <- String -> IO Extensions
listDirectory String
topdir IO Extensions -> (Extensions -> IO [Extensions]) -> IO [Extensions]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(String -> IO Extensions) -> Extensions -> IO [Extensions]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\String
x -> do
let dir :: String
dir = String
topdir String -> String -> String
</> String
x
String -> IO Bool
doesDirectoryExist String
dir IO Bool -> (Bool -> IO Extensions) -> IO Extensions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> String -> IO Extensions
go String
dir
Bool
False -> Extensions -> IO Extensions
forall (m :: * -> *) a. Monad m => a -> m a
return [String
dir])
Extensions -> IO Extensions
forall (m :: * -> *) a. Monad m => a -> m a
return (Extensions -> IO Extensions) -> Extensions -> IO Extensions
forall a b. (a -> b) -> a -> b
$ [Extensions] -> Extensions
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Extensions]
ps