{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Description : Command-line interface.
--
-- This module performs the command-line interface for the formatter, and
-- plumbs formatting actions through a streaming interface.
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

-- | Main entry point.
run :: IO ()
run :: IO ()
run = do
  -- parse command-line arguments
  Args
args <- IO Args
parseArgs

  -- set the default logger
  let lg :: Log
lg = Log
Log.defaultLog

  -- fetch number of capabilities; to decide the number of threads
  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

  -- fetch the current directory to use as the parent directory
  Path Abs Dir
dir <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
Path.IO.getCurrentDir

  -- tell the user what we're doing
  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)

  -- streamly action
  [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

  -- report on the overall outcome if necessary
  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

-- | Default path filter.
pathFilter :: PathFilter
pathFilter :: PathFilter
pathFilter =
  PathFilter
PathFilter.pfNoHidden
    PathFilter -> PathFilter -> PathFilter
forall a. Semigroup a => a -> a -> a
<> PathFilter
PathFilter.pfNoDistNewstyle

-- | Default formatter.
formatter :: Formatter
formatter :: Formatter
formatter =
  Formatter
Formatters.Ormolu.formatter
    Formatter -> Formatter -> Formatter
forall a. Semigroup a => a -> a -> a
<> Formatter
Formatters.CabalFmt.formatter

-- | fromJust.
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!"

-- | List a directory recursively for streaming.
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

-- | Command-line arguments.
newtype Args = Args
  { -- Run mode.
    Args -> RunMode
runMode :: RunMode
  }

-- | Parse command-line arguments.
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 for command-line arguments.
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)")
            )
      )