{-# LANGUAGE ApplicativeDo #-}

{- |
Module                  : DrCabal.Cli
Copyright               : (c) 2022 Dmitrii Kovanikov
SPDX-License-Identifier : MPL-2.0
Maintainer              : Dmitrii Kovanikov <kovanikov@gmail.com>
Stability               : Experimental
Portability             : Portable

CLI parser for @dr-cabal@.
-}

module DrCabal.Cli
    ( Command (..)
    , readCommand

    , ProfileArgs (..)
    , FileMode (..)
    ) where

import DrCabal.Model (Style (..))

import qualified Options.Applicative as Opt

data Command
    = Profile ProfileArgs

data ProfileArgs = ProfileArgs
    { ProfileArgs -> Style
profileArgsStyle    :: Style
    , ProfileArgs -> FileMode
profileArgsFileMode :: FileMode
    }

data FileMode
    -- | Don't read from the file and don't store the results in the file
    = None

    -- | Store current results in the file
    | Output FilePath

    -- | Read previously saved results from the file
    | Input FilePath

readCommand :: IO Command
readCommand :: IO Command
readCommand = forall a. ParserInfo a -> IO a
Opt.execParser ParserInfo Command
opts
  where
    opts :: ParserInfo Command
opts = forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (forall a. Parser (a -> a)
Opt.helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
commandP) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ forall a. InfoMod a
Opt.fullDesc
      , forall a. FilePath -> InfoMod a
Opt.progDesc FilePath
"Profile cabal dependency build output"
      , forall a. FilePath -> InfoMod a
Opt.header FilePath
"dr-cabal - a CLI tool to treat cabal output"
      ]

-- | All possible commands.
commandP :: Opt.Parser Command
commandP :: Parser Command
commandP = forall a. Mod CommandFields a -> Parser a
Opt.subparser forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ forall a. FilePath -> ParserInfo a -> Mod CommandFields a
Opt.command FilePath
"profile"
        forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (forall a. Parser (a -> a)
Opt.helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
profileP)
        forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> InfoMod a
Opt.progDesc FilePath
"Build profiling report"
    ]

profileP :: Opt.Parser Command
profileP :: Parser Command
profileP = do
    Style
profileArgsStyle <- Parser Style
styleP
    FileMode
profileArgsFileMode <- Parser FileMode
fileModeP

    pure $ ProfileArgs -> Command
Profile ProfileArgs{Style
FileMode
profileArgsFileMode :: FileMode
profileArgsStyle :: Style
profileArgsFileMode :: FileMode
profileArgsStyle :: Style
..}

styleP :: Opt.Parser Style
styleP :: Parser Style
styleP = Parser Style
stackedP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Style
Stacked
  where
    stackedP :: Opt.Parser Style
    stackedP :: Parser Style
stackedP = forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' Style
Stacked forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
        [ forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"stacked"
        , forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
's'
        , forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Format as stacked"
        ]

fileModeP :: Opt.Parser FileMode
fileModeP :: Parser FileMode
fileModeP = Parser FileMode
inputP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser FileMode
outputP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure FileMode
None
  where
    inputP :: Opt.Parser FileMode
    inputP :: Parser FileMode
inputP = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FileMode
Input forall a b. (a -> b) -> a -> b
$ forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
        [ forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"input"
        , forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'i'
        , forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"FILE_PATH"
        , forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Read profile input from a JSON file, created by 'dr-cabal profile --output=<some-file>'"
        ]

    outputP :: Opt.Parser FileMode
    outputP :: Parser FileMode
outputP = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FileMode
Output forall a b. (a -> b) -> a -> b
$ forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
        [ forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"output"
        , forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'o'
        , forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"FILE_PATH"
        , forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Save cabal output to a file in a JSON format"
        ]