{-# LANGUAGE CPP #-}

-- | Most of client interface.
module HaskellCI.Cli where

import HaskellCI.Prelude

import System.Exit           (exitFailure)
import System.FilePath.Posix (takeFileName)
import System.IO             (hPutStrLn, stderr)

import qualified Options.Applicative as O

import HaskellCI.Config
import HaskellCI.OptparseGrammar
import HaskellCI.VersionInfo

-------------------------------------------------------------------------------
-- Command
-------------------------------------------------------------------------------

data Command
    = CommandTravis FilePath
    | CommandBash FilePath
    | CommandGitHub FilePath
    | CommandRegenerate
    | CommandListGHC
    | CommandDumpConfig
    | CommandVersionInfo
  deriving Int -> Command -> ShowS
[Command] -> ShowS
Command -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> FilePath
$cshow :: Command -> FilePath
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show

-------------------------------------------------------------------------------
-- Options
-------------------------------------------------------------------------------

data Options = Options
    { Options -> Maybe Output
optOutput         :: Maybe Output
    , Options -> ConfigOpt
optConfig         :: ConfigOpt
    , Options -> Maybe FilePath
optCwd            :: Maybe FilePath
    , Options -> Maybe InputType
optInputType      :: Maybe InputType
    , Options -> Config -> Config
optConfigMorphism :: Config -> Config
    }

instance Semigroup Options where
    Options Maybe Output
b ConfigOpt
d Maybe FilePath
c Maybe InputType
e Config -> Config
f <> :: Options -> Options -> Options
<> Options Maybe Output
b' ConfigOpt
d' Maybe FilePath
c' Maybe InputType
e' Config -> Config
f' =
        Maybe Output
-> ConfigOpt
-> Maybe FilePath
-> Maybe InputType
-> (Config -> Config)
-> Options
Options (Maybe Output
b forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Output
b') (ConfigOpt
d forall a. Semigroup a => a -> a -> a
<> ConfigOpt
d') (Maybe FilePath
c forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe FilePath
c') (Maybe InputType
e forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe InputType
e') (Config -> Config
f' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Config
f)

defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options
    { optOutput :: Maybe Output
optOutput         = forall a. Maybe a
Nothing
    , optConfig :: ConfigOpt
optConfig         = ConfigOpt
ConfigOptAuto
    , optCwd :: Maybe FilePath
optCwd            = forall a. Maybe a
Nothing
    , optInputType :: Maybe InputType
optInputType      = forall a. Maybe a
Nothing
    , optConfigMorphism :: Config -> Config
optConfigMorphism = forall a. a -> a
id
    }

optionsWithOutputFile :: FilePath -> Options
optionsWithOutputFile :: FilePath -> Options
optionsWithOutputFile FilePath
fp = Options
defaultOptions
    { optOutput :: Maybe Output
optOutput = forall a. a -> Maybe a
Just (FilePath -> Output
OutputFile FilePath
fp)
    }

data Output = OutputStdout | OutputFile FilePath

data ConfigOpt
    = ConfigOptAuto
    | ConfigOpt FilePath
    | ConfigOptNo
  deriving (ConfigOpt -> ConfigOpt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigOpt -> ConfigOpt -> Bool
$c/= :: ConfigOpt -> ConfigOpt -> Bool
== :: ConfigOpt -> ConfigOpt -> Bool
$c== :: ConfigOpt -> ConfigOpt -> Bool
Eq, Int -> ConfigOpt -> ShowS
[ConfigOpt] -> ShowS
ConfigOpt -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConfigOpt] -> ShowS
$cshowList :: [ConfigOpt] -> ShowS
show :: ConfigOpt -> FilePath
$cshow :: ConfigOpt -> FilePath
showsPrec :: Int -> ConfigOpt -> ShowS
$cshowsPrec :: Int -> ConfigOpt -> ShowS
Show)

instance Semigroup ConfigOpt where
    ConfigOpt
a <> :: ConfigOpt -> ConfigOpt -> ConfigOpt
<> ConfigOpt
ConfigOptAuto = ConfigOpt
a
    ConfigOpt
_ <> ConfigOpt
b             = ConfigOpt
b

-------------------------------------------------------------------------------
-- InputType
-------------------------------------------------------------------------------

data InputType
    = InputTypePackage -- ^ @.cabal@
    | InputTypeProject -- ^ @cabal.project
  deriving Int -> InputType -> ShowS
[InputType] -> ShowS
InputType -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InputType] -> ShowS
$cshowList :: [InputType] -> ShowS
show :: InputType -> FilePath
$cshow :: InputType -> FilePath
showsPrec :: Int -> InputType -> ShowS
$cshowsPrec :: Int -> InputType -> ShowS
Show

optInputType' :: Options -> FilePath -> InputType
optInputType' :: Options -> FilePath -> InputType
optInputType' Options
opts FilePath
path =
    forall a. a -> Maybe a -> a
fromMaybe InputType
def (Options -> Maybe InputType
optInputType Options
opts)
  where
    def :: InputType
def | FilePath
"cabal.project" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ShowS
takeFileName FilePath
path = InputType
InputTypeProject
        | Bool
otherwise                                      = InputType
InputTypePackage

-------------------------------------------------------------------------------
-- Parsers
-------------------------------------------------------------------------------

optionsP :: O.Parser Options
optionsP :: Parser Options
optionsP = Maybe Output
-> ConfigOpt
-> Maybe FilePath
-> Maybe InputType
-> (Config -> Config)
-> Options
Options
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
O.optional Parser Output
outputP
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfigOpt
configOptP
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
O.optional (forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
O.long FilePath
"cwd" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
O.metavar FilePath
"Dir" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
O.action FilePath
"directory" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
O.help FilePath
"Directory to change to"))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
O.optional Parser InputType
inputTypeP
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s a. OptparseGrammar s a -> Parser (s -> s)
runOptparseGrammar forall (c :: * -> Constraint) (g :: * -> * -> *).
(OptionsGrammar c g, Applicative (g Config), c (Identity HLintJob),
 c (Identity PackageScope), c (Identity TestedWithJobs),
 c (Identity Ubuntu), c (Identity Jobs), c (Identity CopyFields),
 c (Identity Version), c (Identity Natural),
 c (Identity Components), c Env, c Folds, c CopyFields,
 c HeadVersion, c (List FSep (Identity Installed) Installed),
 Applicative (g DoctestConfig), Applicative (g DocspecConfig),
 Applicative (g HLintConfig)) =>
g Config Config
configGrammar

configOptP :: O.Parser ConfigOpt
configOptP :: Parser ConfigOpt
configOptP = Parser ConfigOpt
file forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ConfigOpt
noconfig forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigOpt
ConfigOptAuto
  where
    file :: Parser ConfigOpt
file = FilePath -> ConfigOpt
ConfigOpt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
O.long FilePath
"config" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
O.metavar FilePath
"CONFIGFILE" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
O.action FilePath
"file" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
O.help FilePath
"Configuration file")
    noconfig :: Parser ConfigOpt
noconfig = forall a. a -> Mod FlagFields a -> Parser a
O.flag' ConfigOpt
ConfigOptNo (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
O.long FilePath
"no-config" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
O.help FilePath
"Don't read configuration file")

outputP :: O.Parser Output
outputP :: Parser Output
outputP =
    FilePath -> Output
OutputFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
O.long FilePath
"output" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'o' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
O.metavar FilePath
"FILE" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
O.action FilePath
"file" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
O.help FilePath
"Output file") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    forall a. a -> Mod FlagFields a -> Parser a
O.flag' Output
OutputStdout (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
O.long FilePath
"stdout" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
O.help FilePath
"Use stdout output")

versionP :: O.Parser (a -> a)
versionP :: forall a. Parser (a -> a)
versionP = forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
O.infoOption FilePath
haskellCIVerStr forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
O.long FilePath
"version"
    , forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'V'
    , forall (f :: * -> *) a. FilePath -> Mod f a
O.help FilePath
"Print version information"
    ]

inputTypeP :: O.Parser InputType
inputTypeP :: Parser InputType
inputTypeP = Parser InputType
pkg forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser InputType
prj where
    pkg :: Parser InputType
pkg = forall a. a -> Mod FlagFields a -> Parser a
O.flag' InputType
InputTypePackage forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
O.long FilePath
"package"
    prj :: Parser InputType
prj = forall a. a -> Mod FlagFields a -> Parser a
O.flag' InputType
InputTypeProject forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
O.long FilePath
"project"

cliParserInfo :: O.ParserInfo (Command, Options)
cliParserInfo :: ParserInfo (Command, Options)
cliParserInfo = forall a. Parser a -> InfoMod a -> ParserInfo a
O.info ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Command
cmdP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Options
optionsP forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
O.<**> forall a. Parser (a -> a)
versionP forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
O.<**> forall a. Parser (a -> a)
O.helper) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ forall a. InfoMod a
O.fullDesc
    , forall a. FilePath -> InfoMod a
O.header FilePath
"haskell-ci - generate CI scripts for Haskell projects"
    ]
  where
    cmdP :: Parser Command
cmdP = forall a. Mod CommandFields a -> Parser a
O.subparser (forall a. Monoid a => [a] -> a
mconcat
        [ forall a. FilePath -> ParserInfo a -> Mod CommandFields a
O.command FilePath
"regenerate"   forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> InfoMod a -> ParserInfo a
O.info (forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
CommandRegenerate)  forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> InfoMod a
O.progDesc FilePath
"Regenerate outputs"
        , forall a. FilePath -> ParserInfo a -> Mod CommandFields a
O.command FilePath
"travis"       forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> InfoMod a -> ParserInfo a
O.info Parser Command
travisP                   forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> InfoMod a
O.progDesc FilePath
"Generate travis-ci config"
        , forall a. FilePath -> ParserInfo a -> Mod CommandFields a
O.command FilePath
"bash"         forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> InfoMod a -> ParserInfo a
O.info Parser Command
bashP                     forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> InfoMod a
O.progDesc FilePath
"Generate local-bash-docker script"
        , forall a. FilePath -> ParserInfo a -> Mod CommandFields a
O.command FilePath
"github"       forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> InfoMod a -> ParserInfo a
O.info Parser Command
githubP                   forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> InfoMod a
O.progDesc FilePath
"Generate GitHub Actions config"
        , forall a. FilePath -> ParserInfo a -> Mod CommandFields a
O.command FilePath
"list-ghc"     forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> InfoMod a -> ParserInfo a
O.info (forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
CommandListGHC)     forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> InfoMod a
O.progDesc FilePath
"List known GHC versions"
        , forall a. FilePath -> ParserInfo a -> Mod CommandFields a
O.command FilePath
"dump-config"  forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> InfoMod a -> ParserInfo a
O.info (forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
CommandDumpConfig)  forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> InfoMod a
O.progDesc FilePath
"Dump cabal.haskell-ci config with default values"
        , forall a. FilePath -> ParserInfo a -> Mod CommandFields a
O.command FilePath
"version-info" forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> InfoMod a -> ParserInfo a
O.info (forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
CommandVersionInfo) forall a b. (a -> b) -> a -> b
$ forall a. FilePath -> InfoMod a
O.progDesc FilePath
"Print versions info haskell-ci was compiled with"
        ]) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Command
travisP

    travisP :: Parser Command
travisP = FilePath -> Command
CommandTravis
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod ArgumentFields s -> Parser s
O.strArgument (forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
O.metavar FilePath
"CABAL.FILE" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
O.action FilePath
"file" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
O.help FilePath
"Either <pkg.cabal> or cabal.project")

    bashP :: Parser Command
bashP = FilePath -> Command
CommandBash
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod ArgumentFields s -> Parser s
O.strArgument (forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
O.metavar FilePath
"CABAL.FILE" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
O.action FilePath
"file" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
O.help FilePath
"Either <pkg.cabal> or cabal.project")

    githubP :: Parser Command
githubP = FilePath -> Command
CommandGitHub
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod ArgumentFields s -> Parser s
O.strArgument (forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
O.metavar FilePath
"CABAL.FILE" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
O.action FilePath
"file" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
O.help FilePath
"Either <pkg.cabal> or cabal.project")

-------------------------------------------------------------------------------
-- Parsing helpers
-------------------------------------------------------------------------------

parseOptions :: [String] -> IO (FilePath, Options)
parseOptions :: [FilePath] -> IO (FilePath, Options)
parseOptions [FilePath]
argv = case ParserResult (Command, Options)
res of
    O.Success (Command
cmd, Options
opts) -> do
        FilePath
path <- Command -> IO FilePath
fromCmd Command
cmd
        forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
path, Options
opts)
    O.Failure ParserFailure ParserHelp
f -> case ParserFailure ParserHelp -> FilePath -> (FilePath, ExitCode)
O.renderFailure ParserFailure ParserHelp
f FilePath
"haskell-ci" of
        (FilePath
help, ExitCode
_) -> Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
help forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitFailure
    O.CompletionInvoked CompletionResult
_ -> forall a. IO a
exitFailure -- unexpected
  where
    res :: ParserResult (Command, Options)
res = forall a.
ParserPrefs -> ParserInfo a -> [FilePath] -> ParserResult a
O.execParserPure (PrefsMod -> ParserPrefs
O.prefs PrefsMod
O.subparserInline) ParserInfo (Command, Options)
cliParserInfo [FilePath]
argv

    fromCmd :: Command -> IO FilePath
    fromCmd :: Command -> IO FilePath
fromCmd (CommandTravis FilePath
fp) = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp
    fromCmd (CommandBash FilePath
fp)   = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp
    fromCmd (CommandGitHub FilePath
fp) = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp
    fromCmd Command
cmd                = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Command without filepath: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Command
cmd