{-# LANGUAGE LambdaCase #-}
--------------------------------------------------------------------------------
module Language.Haskell.Stylish
    ( -- * Run
      runSteps
      -- * Steps
    , simpleAlign
    , imports
    , languagePragmas
    , tabs
    , trailingWhitespace
    , unicodeSyntax
      -- ** Helpers
    , findHaskellFiles
    , stepName
      -- * Config
    , module Language.Haskell.Stylish.Config
      -- * Misc
    , 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  -- ^ Columns
            -> SimpleAlign.Config
            -> Step
simpleAlign :: Maybe Int -> Config -> Step
simpleAlign = Maybe Int -> Config -> Step
SimpleAlign.step


--------------------------------------------------------------------------------
imports :: Maybe Int -- ^ columns
        -> Imports.Options
        -> Step
imports :: Maybe Int -> Options -> Step
imports = Maybe Int -> Options -> Step
Imports.step


--------------------------------------------------------------------------------
languagePragmas :: Maybe Int -- ^ columns
                -> LanguagePragmas.Style
                -> Bool -- ^ Pad to same length in vertical mode?
                -> Bool -- ^ remove redundant?
                -> String -- ^ language prefix
                -> Step
languagePragmas :: Maybe Int -> Style -> Bool -> Bool -> String -> Step
languagePragmas = Maybe Int -> Style -> Bool -> Bool -> String -> Step
LanguagePragmas.step


--------------------------------------------------------------------------------
tabs :: Int -- ^ number of spaces
     -> Step
tabs :: Int -> Step
tabs = Int -> Step
Tabs.step


--------------------------------------------------------------------------------
trailingWhitespace :: Step
trailingWhitespace :: Step
trailingWhitespace = Step
TrailingWhitespace.step


--------------------------------------------------------------------------------
unicodeSyntax :: Bool -- ^ add language pragma?
              -> String -- ^ language prefix
              -> 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 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 =
 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 }

-- |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 :: 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) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConfigPath -> String
unConfigPath Maybe ConfigPath
maybeConfigPath)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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) forall a b. (a -> b) -> a -> b
$ String -> Extensions
lines String
contents


--------------------------------------------------------------------------------
-- | Searches Haskell source files in any given folder recursively.
findHaskellFiles :: Bool -> [FilePath] -> IO [FilePath]
findHaskellFiles :: Bool -> Extensions -> IO Extensions
findHaskellFiles Bool
v Extensions
fs = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat


--------------------------------------------------------------------------------
findFilesR :: Bool -> FilePath -> IO [FilePath]
findFilesR :: Bool -> String -> IO Extensions
findFilesR Bool
_ []   = forall (m :: * -> *) a. Monad m => a -> m a
return []
findFilesR Bool
v String
path = do
  String -> IO Bool
doesFileExist String
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return [String
path]
    Bool
_    -> String -> IO Bool
doesDirectoryExist String
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
True  -> String -> IO Extensions
findFilesRecursive String
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\String
x -> String -> String
takeExtension String
x forall a. Eq a => a -> a -> Bool
== String
".hs")
      Bool
False -> do
        Bool -> Verbose
makeVerbose Bool
v (String
"Input folder does not exists: " 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                   Bool
True  -> String -> IO Extensions
go String
dir
                   Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return [String
dir])
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Extensions]
ps