{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module CLI where
import Data.Function ((&))
import qualified Data.Text.Short as ShortText
import Formatter (Formatter, runFormatIO)
import qualified Formatter
import qualified Formatters.CabalFmt (formatter)
import qualified Formatters.Ormolu (formatter)
import qualified GHC.Conc
import qualified Log
import Options.Applicative (Parser)
import qualified Options.Applicative as OA
import Path (Abs, Dir, File, Path)
import qualified Path
import qualified Path.IO
import PathFilter (PathFilter)
import qualified PathFilter
import RunMode (RunMode)
import qualified RunMode
import Streamly.Prelude (AsyncT, fromAsync, fromSerial, maxThreads)
import qualified Streamly.Prelude as S
import qualified System.Exit
run :: IO ()
run :: IO ()
run = do
Args
args <- IO Args
parseArgs
let lg :: Log
lg = Log
Log.defaultLog
Int
numCap <- IO Int
GHC.Conc.getNumCapabilities
let nThreads :: Int
nThreads = Int
numCap Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
Path Abs Dir
dir <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
Path.IO.getCurrentDir
let txtMode :: ShortText
txtMode =
case Args -> RunMode
runMode Args
args of
RunMode
RunMode.Format -> ShortText
"file formatting"
RunMode
RunMode.CheckOnly -> ShortText
"checking only"
Log -> ShortText -> IO ()
Log.info Log
lg ShortText
"# Formatter Utility"
Log -> ShortText -> IO ()
Log.info Log
lg (ShortText -> IO ()) -> ShortText -> IO ()
forall a b. (a -> b) -> a -> b
$ ShortText
"Mode : " ShortText -> ShortText -> ShortText
forall a. Semigroup a => a -> a -> a
<> ShortText
txtMode
Log -> ShortText -> IO ()
Log.info Log
lg (ShortText -> IO ()) -> ShortText -> IO ()
forall a b. (a -> b) -> a -> b
$
ShortText
"Threadpool size : "
ShortText -> ShortText -> ShortText
forall a. Semigroup a => a -> a -> a
<> ([Char] -> ShortText
ShortText.pack ([Char] -> ShortText) -> (Int -> [Char]) -> Int -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> ShortText) -> Int -> ShortText
forall a b. (a -> b) -> a -> b
$ Int
nThreads)
Log -> ShortText -> IO ()
Log.info Log
lg (ShortText -> IO ()) -> ShortText -> IO ()
forall a b. (a -> b) -> a -> b
$
ShortText
"Parent directory : "
ShortText -> ShortText -> ShortText
forall a. Semigroup a => a -> a -> a
<> ([Char] -> ShortText
ShortText.pack ([Char] -> ShortText)
-> (Path Abs Dir -> [Char]) -> Path Abs Dir -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> [Char]
Path.fromAbsDir (Path Abs Dir -> ShortText) -> Path Abs Dir -> ShortText
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
dir)
[Bool]
changed :: [Bool] <-
SerialT IO Bool -> IO [Bool]
forall (m :: * -> *) a. Monad m => SerialT m a -> m [a]
S.toList (SerialT IO Bool -> IO [Bool]) -> SerialT IO Bool -> IO [Bool]
forall a b. (a -> b) -> a -> b
$
((Path Rel File, FormattingResult ()) -> Bool)
-> SerialT IO (Path Rel File, FormattingResult ())
-> SerialT IO Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
(a -> b) -> t m a -> t m b
S.map (FormattingResult () -> Bool
forall a. FormattingResult a -> Bool
Formatter.isUnchanged (FormattingResult () -> Bool)
-> ((Path Rel File, FormattingResult ()) -> FormattingResult ())
-> (Path Rel File, FormattingResult ())
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Rel File, FormattingResult ()) -> FormattingResult ()
forall a b. (a, b) -> b
snd) (SerialT IO (Path Rel File, FormattingResult ())
-> SerialT IO Bool)
-> SerialT IO (Path Rel File, FormattingResult ())
-> SerialT IO Bool
forall a b. (a -> b) -> a -> b
$
SerialT IO (Path Rel File, FormattingResult ())
-> SerialT IO (Path Rel File, FormattingResult ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
IsStream t =>
SerialT m a -> t m a
fromSerial
( AsyncT IO (Path Rel File, FormattingResult ())
-> SerialT IO (Path Rel File, FormattingResult ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
IsStream t =>
AsyncT m a -> t m a
fromAsync (AsyncT IO (Path Rel File, FormattingResult ())
-> SerialT IO (Path Rel File, FormattingResult ()))
-> (AsyncT IO (Path Rel File, FormattingResult ())
-> AsyncT IO (Path Rel File, FormattingResult ()))
-> AsyncT IO (Path Rel File, FormattingResult ())
-> SerialT IO (Path Rel File, FormattingResult ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> AsyncT IO (Path Rel File, FormattingResult ())
-> AsyncT IO (Path Rel File, FormattingResult ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
IsStream t =>
Int -> t m a -> t m a
maxThreads Int
nThreads (AsyncT IO (Path Rel File, FormattingResult ())
-> SerialT IO (Path Rel File, FormattingResult ()))
-> AsyncT IO (Path Rel File, FormattingResult ())
-> SerialT IO (Path Rel File, FormattingResult ())
forall a b. (a -> b) -> a -> b
$
( Path Abs Dir -> AsyncT IO (Path Abs File)
listDirRecursive Path Abs Dir
dir
AsyncT IO (Path Abs File)
-> (AsyncT IO (Path Abs File) -> AsyncT IO (Path Rel File))
-> AsyncT IO (Path Rel File)
forall a b. a -> (a -> b) -> b
& (Path Abs File -> Path Rel File)
-> AsyncT IO (Path Abs File) -> AsyncT IO (Path Rel File)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
(a -> b) -> t m a -> t m b
S.map (Maybe (Path Rel File) -> Path Rel File
forall a. Maybe a -> a
fromJustUnsafe (Maybe (Path Rel File) -> Path Rel File)
-> (Path Abs File -> Maybe (Path Rel File))
-> Path Abs File
-> Path Rel File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Abs File -> Maybe (Path Rel File)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
Path.stripProperPrefix Path Abs Dir
dir)
AsyncT IO (Path Rel File)
-> (AsyncT IO (Path Rel File) -> AsyncT IO (Path Rel File))
-> AsyncT IO (Path Rel File)
forall a b. a -> (a -> b) -> b
& (Path Rel File -> Bool)
-> AsyncT IO (Path Rel File) -> AsyncT IO (Path Rel File)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
(a -> Bool) -> t m a -> t m a
S.filter
( PathAccept -> Bool
PathFilter.toBool
(PathAccept -> Bool)
-> (Path Rel File -> PathAccept) -> Path Rel File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathFilter -> Path Rel File -> PathAccept
PathFilter.unPathFilter PathFilter
pathFilter
)
AsyncT IO (Path Rel File)
-> (AsyncT IO (Path Rel File)
-> AsyncT IO (Path Rel File, FormattingResult ()))
-> AsyncT IO (Path Rel File, FormattingResult ())
forall a b. a -> (a -> b) -> b
& (Path Rel File -> IO (Path Rel File, FormattingResult ()))
-> AsyncT IO (Path Rel File)
-> AsyncT IO (Path Rel File, FormattingResult ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, MonadAsync m) =>
(a -> m b) -> t m a -> t m b
S.mapM
( \Path Rel File
relFile -> do
FormattingResult ()
result <-
RunMode
-> Formatter
-> Path Abs Dir
-> Path Rel File
-> IO (FormattingResult ())
Formatter.runFormatIO
(Args -> RunMode
runMode Args
args)
Formatter
formatter
Path Abs Dir
dir
Path Rel File
relFile
(Path Rel File, FormattingResult ())
-> IO (Path Rel File, FormattingResult ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Rel File
relFile, FormattingResult ()
result)
)
)
)
SerialT IO (Path Rel File, FormattingResult ())
-> (SerialT IO (Path Rel File, FormattingResult ())
-> SerialT IO (Path Rel File, FormattingResult ()))
-> SerialT IO (Path Rel File, FormattingResult ())
forall a b. a -> (a -> b) -> b
& ((Path Rel File, FormattingResult ()) -> IO ())
-> SerialT IO (Path Rel File, FormattingResult ())
-> SerialT IO (Path Rel File, FormattingResult ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, MonadAsync m) =>
(a -> m b) -> t m a -> t m a
S.trace ((Path Rel File -> FormattingResult () -> IO ())
-> (Path Rel File, FormattingResult ()) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Log -> Path Rel File -> FormattingResult () -> IO ()
Log.report Log
lg))
let noChange :: Bool
noChange = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
changed
case Args -> RunMode
runMode Args
args of
RunMode
RunMode.Format -> IO ()
forall a. IO a
System.Exit.exitSuccess
RunMode
RunMode.CheckOnly -> do
if Bool
noChange
then do
Log -> ShortText -> IO ()
Log.info Log
lg ShortText
"Done: All files passed formatting checks."
IO ()
forall a. IO a
System.Exit.exitSuccess
else do
Log -> ShortText -> IO ()
Log.info Log
lg ShortText
"Done: File(s) failed formatting checks."
IO ()
forall a. IO a
System.Exit.exitFailure
pathFilter :: PathFilter
pathFilter :: PathFilter
pathFilter =
PathFilter
PathFilter.pfNoHidden
PathFilter -> PathFilter -> PathFilter
forall a. Semigroup a => a -> a -> a
<> PathFilter
PathFilter.pfNoDistNewstyle
formatter :: Formatter
formatter :: Formatter
formatter =
Formatter
Formatters.Ormolu.formatter
Formatter -> Formatter -> Formatter
forall a. Semigroup a => a -> a -> a
<> Formatter
Formatters.CabalFmt.formatter
fromJustUnsafe :: Maybe a -> a
fromJustUnsafe :: Maybe a -> a
fromJustUnsafe (Just a
x) = a
x
fromJustUnsafe Maybe a
Nothing = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"fromJustUnsafe: not Just!"
listDirRecursive :: Path Abs Dir -> AsyncT IO (Path Abs File)
listDirRecursive :: Path Abs Dir -> AsyncT IO (Path Abs File)
listDirRecursive Path Abs Dir
dir = do
([Path Abs Dir]
subdirs, [Path Abs File]
files) <- Path Abs Dir -> AsyncT IO ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
Path.IO.listDir Path Abs Dir
dir
[Path Abs File] -> AsyncT IO (Path Abs File)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, IsStream t) =>
[a] -> t m a
S.fromList [Path Abs File]
files AsyncT IO (Path Abs File)
-> AsyncT IO (Path Abs File) -> AsyncT IO (Path Abs File)
forall a. Semigroup a => a -> a -> a
<> (Path Abs Dir -> AsyncT IO (Path Abs File))
-> [Path Abs Dir] -> AsyncT IO (Path Abs File)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Path Abs Dir -> AsyncT IO (Path Abs File)
listDirRecursive [Path Abs Dir]
subdirs
newtype Args = Args
{
Args -> RunMode
runMode :: RunMode
}
parseArgs :: IO Args
parseArgs :: IO Args
parseArgs = ParserInfo Args -> IO Args
forall a. ParserInfo a -> IO a
OA.execParser ParserInfo Args
opts
where
opts :: ParserInfo Args
opts =
Parser Args -> InfoMod Args -> ParserInfo Args
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
(Parser Args
parser Parser Args -> Parser (Args -> Args) -> Parser Args
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
OA.<**> Parser (Args -> Args)
forall a. Parser (a -> a)
OA.helper)
( InfoMod Args
forall a. InfoMod a
OA.fullDesc
InfoMod Args -> InfoMod Args -> InfoMod Args
forall a. Semigroup a => a -> a -> a
<> [Char] -> InfoMod Args
forall a. [Char] -> InfoMod a
OA.progDesc [Char]
"Formatting Utility"
InfoMod Args -> InfoMod Args -> InfoMod Args
forall a. Semigroup a => a -> a -> a
<> [Char] -> InfoMod Args
forall a. [Char] -> InfoMod a
OA.header [Char]
"format - formatting stuff for Haskell projects"
)
parser :: Parser Args
parser :: Parser Args
parser =
RunMode -> Args
Args
(RunMode -> Args) -> Parser RunMode -> Parser Args
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod CommandFields RunMode -> Parser RunMode
forall a. Mod CommandFields a -> Parser a
OA.subparser
( [Char] -> ParserInfo RunMode -> Mod CommandFields RunMode
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
OA.command
[Char]
"check"
( Parser RunMode -> InfoMod RunMode -> ParserInfo RunMode
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
(RunMode -> Parser RunMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunMode
RunMode.CheckOnly)
([Char] -> InfoMod RunMode
forall a. [Char] -> InfoMod a
OA.progDesc [Char]
"Only check file formatting (do not over-write)")
)
Mod CommandFields RunMode
-> Mod CommandFields RunMode -> Mod CommandFields RunMode
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo RunMode -> Mod CommandFields RunMode
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
OA.command
[Char]
"format"
( Parser RunMode -> InfoMod RunMode -> ParserInfo RunMode
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
(RunMode -> Parser RunMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunMode
RunMode.Format)
([Char] -> InfoMod RunMode
forall a. [Char] -> InfoMod a
OA.progDesc [Char]
"Format files (over-write if required)")
)
)