{-# LANGUAGE CPP #-}
--------------------------------------------------------------------------------
module Main
( main
) where
--------------------------------------------------------------------------------
import Control.Monad (forM_, unless, when)
import qualified Data.ByteString.Char8 as BC8
import Data.Version (showVersion)
import qualified Options.Applicative as OA
import System.Exit (exitFailure)
import qualified System.IO as IO
import qualified System.IO.Strict as IO.Strict
--------------------------------------------------------------------------------
#if __GLASGOW_HASKELL__ < 808
import Data.Monoid ((<>))
#endif
--------------------------------------------------------------------------------
import Language.Haskell.Stylish
--------------------------------------------------------------------------------
data StylishArgs = StylishArgs
{ saVersion :: Bool
, saConfig :: Maybe FilePath
, saRecursive :: Bool
, saVerbose :: Bool
, saDefaults :: Bool
, saInPlace :: Bool
, saNoUtf8 :: Bool
, saFiles :: [FilePath]
} deriving (Show)
--------------------------------------------------------------------------------
parseStylishArgs :: OA.Parser StylishArgs
parseStylishArgs = StylishArgs
<$> OA.switch (
OA.help "Show version information" <>
OA.long "version" <>
OA.hidden)
<*> OA.optional (OA.strOption $
OA.metavar "CONFIG" <>
OA.help "Configuration file" <>
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" <>
OA.short 'v' <>
OA.hidden)
<*> OA.switch (
OA.help "Dump default config and exit" <>
OA.long "defaults" <>
OA.short 'd' <>
OA.hidden)
<*> OA.switch (
OA.help "Overwrite the given files in place" <>
OA.long "inplace" <>
OA.short 'i' <>
OA.hidden)
<*> OA.switch (
OA.help "Don't force UTF-8 stdin/stdout" <>
OA.long "no-utf8" <>
OA.hidden)
<*> OA.many (OA.strArgument $
OA.metavar "FILENAME" <>
OA.help "Input file(s)")
--------------------------------------------------------------------------------
stylishHaskellVersion :: String
stylishHaskellVersion = "stylish-haskell " <> showVersion version
--------------------------------------------------------------------------------
parserInfo :: OA.ParserInfo StylishArgs
parserInfo = OA.info (OA.helper <*> parseStylishArgs) $
OA.fullDesc <>
OA.header stylishHaskellVersion
--------------------------------------------------------------------------------
main :: IO ()
main = OA.execParser parserInfo >>= stylishHaskell
--------------------------------------------------------------------------------
stylishHaskell :: StylishArgs -> IO ()
stylishHaskell sa = do
unless (saNoUtf8 sa) $
mapM_ (`IO.hSetEncoding` IO.utf8) [IO.stdin, IO.stdout]
if saVersion sa then
putStrLn stylishHaskellVersion
else if saDefaults sa then do
verbose' "Dumping embedded config..."
BC8.putStr defaultConfigBytes
else do
conf <- loadConfig verbose' $ case saConfig sa of
Nothing -> SearchFromCurrentDirectory
Just fp -> UseConfig fp
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)
res <- foldMap (file sa conf) (files' filesR)
verbose' $ "Exit code behavior: " ++ show (configExitCode conf)
when (configExitCode conf == ErrorOnFormatExitBehavior && res == DidFormat) exitFailure
where
verbose' = makeVerbose (saVerbose 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.
data FormattingResult
= DidFormat
| NoChange
deriving (Eq)
instance Semigroup FormattingResult where
_ <> DidFormat = DidFormat
DidFormat <> _ = DidFormat
_ <> _ = NoChange
instance Monoid FormattingResult where
mempty = NoChange
--------------------------------------------------------------------------------
-- | Processes a single file, or stdin if no filepath is given
file :: StylishArgs -> Config -> Maybe FilePath -> IO FormattingResult
file sa conf mfp = do
contents <- maybe getContents readUTF8File mfp
let
inputLines =
lines contents
result =
runSteps (configLanguageExtensions conf) mfp (configSteps conf) inputLines
case result of
Right ok -> do
write contents (unlines ok)
pure $ if ok /= inputLines then DidFormat else NoChange
Left err -> do
IO.hPutStrLn IO.stderr err
exitFailure
where
write old new = case mfp of
Nothing -> putStrNewline new
Just _ | not (saInPlace sa) -> putStrNewline new
Just path | not (null new) && old /= new ->
IO.withFile path IO.WriteMode $ \h -> do
setNewlineMode h
IO.hPutStr h new
_ -> return ()
setNewlineMode h = do
let nl = configNewline conf
let mode = IO.NewlineMode IO.nativeNewline nl
IO.hSetNewlineMode h mode
putStrNewline txt = setNewlineMode IO.stdout >> putStr txt
readUTF8File :: FilePath -> IO String
readUTF8File fp =
IO.withFile fp IO.ReadMode $ \h -> do
IO.hSetEncoding h IO.utf8
IO.Strict.hGetContents h