{-# LANGUAGE ApplicativeDo   #-}
{-# LANGUAGE QuasiQuotes     #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections   #-}

{- |
Copyright: (c) 2017-2019 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

This module contains functions and data types to parse CLI inputs.
-}

module Summoner.CLI
       ( -- * CLI data types
         Command (..)
       , NewOpts (..)
       , ShowOpts (..)

         -- * Functions to parse CLI arguments and run @summoner@
       , summon
       , summonCli

         -- * Runners
       , runConfig
       , runScript

         -- * Common helper functions
       , getFinalConfig
       , getCustomLicenseText
       ) where

import Colourista (blue, bold, errorMessage, formatWith, infoMessage, successMessage,
                   warningMessage)
import Data.Version (Version, showVersion)
import Development.GitRev (gitCommitDate, gitHash)
import NeatInterpolation (text)
import Options.Applicative (Parser, ParserInfo, ParserPrefs, argument, command, customExecParser,
                            flag, fullDesc, help, helpLongEquals, helper, info, infoFooter,
                            infoHeader, infoOption, long, maybeReader, metavar, option, prefs,
                            progDesc, short, showDefault, showHelpOnEmpty, strArgument, strOption,
                            subparser, subparserInline, switch, value)
import Options.Applicative.Help.Chunk (stringChunk)
import Relude.Extra.Enum (universe)
import System.Directory (doesFileExist)
import System.Info (os)
import Validation (Validation (..))

import Summoner.Config (Config, ConfigP (..), PartialConfig, defaultConfig, finalise,
                        guessConfigFromGit, loadFileConfig)
import Summoner.CustomPrelude (CustomPrelude (..))
import Summoner.Decision (Decision (..))
import Summoner.Default (currentYear, defaultConfigFile, defaultConfigFileContent, defaultGHC)
import Summoner.GhcVer (GhcVer, ghcTable, parseGhcVer)
import Summoner.License (License (..), LicenseName (..), fetchLicenseCustom, parseLicenseName,
                         showLicenseWithDesc)
import Summoner.Mode (ConnectMode (..), Interactivity (..), isOffline)
import Summoner.Project (generateProject)
import Summoner.Settings (Tool, parseTool)
import Summoner.Template.Script (scriptFile)
import Summoner.Text (endLine)

import qualified Data.Text as T
import qualified Paths_summoner as Meta (version)


-- | Main function that parses @CLI@ commands and runs them using given
-- 'Command' handler.
summon :: Version -> (Command -> IO ()) -> IO ()
summon :: Version -> (Command -> IO ()) -> IO ()
summon version :: Version
version performCommand :: Command -> IO ()
performCommand =
    ParserPrefs -> ParserInfo Command -> IO Command
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
summonerParserPrefs (Version -> ParserInfo Command
cliParser Version
version) IO Command -> (Command -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Command -> IO ()
performCommand
  where
    -- To turn on some special options.
    summonerParserPrefs :: ParserPrefs
    summonerParserPrefs :: ParserPrefs
summonerParserPrefs = PrefsMod -> ParserPrefs
prefs
        (PrefsMod -> ParserPrefs) -> PrefsMod -> ParserPrefs
forall a b. (a -> b) -> a -> b
$ PrefsMod
helpLongEquals
       PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> PrefsMod
showHelpOnEmpty
       PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> PrefsMod
subparserInline

-- | Runs @summoner@ in CLI mode.
summonCli :: IO ()
summonCli :: IO ()
summonCli = Version -> (Command -> IO ()) -> IO ()
summon Version
Meta.version Command -> IO ()
runCliCommand

-- | Run 'summoner' with @CLI@ command
runCliCommand :: Command -> IO ()
runCliCommand :: Command -> IO ()
runCliCommand = \case
    New opts :: NewOpts
opts -> NewOpts -> IO ()
runNew NewOpts
opts
    Script opts :: ScriptOpts
opts -> ScriptOpts -> IO ()
runScript ScriptOpts
opts
    ShowInfo opts :: ShowOpts
opts -> ShowOpts -> IO ()
runShow ShowOpts
opts
    Config opts :: ConfigOpts
opts -> ConfigOpts -> IO ()
runConfig ConfigOpts
opts


{- | Runs @config@ command

@
Usage: summon config [-f|--file=FILENAME]
  Create a default TOML configuration file for summoner

Available options:
  -h,--help                Show this help text
  -f,--file=FILENAME       Path to the toml file with configurations. If not
                           specified '~/.summoner.toml' will be used by default
@
-}
runConfig :: ConfigOpts -> IO ()
runConfig :: ConfigOpts -> IO ()
runConfig ConfigOpts{..} = do
    FilePath
configFile <- Maybe FilePath -> IO FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => Maybe a -> f a -> f a
whenNothing Maybe FilePath
configOptsName IO FilePath
defaultConfigFile
    let configFileTxt :: Text
configFileTxt = FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
configFile
    Bool
alreadyExist <- FilePath -> IO Bool
doesFileExist FilePath
configFile
    if Bool
alreadyExist
    then do
        Text -> IO ()
warningMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "File '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
configFileTxt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' already exits."
        Text -> IO ()
infoMessage "Use 'summon config --file <path>' to specify another path."
        IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
    else do
        FilePath -> Text -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileText FilePath
configFile Text
defaultConfigFileContent
        Text -> IO ()
infoMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Created default configuration file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
configFileTxt
        Text -> IO ()
infoMessage "Open the file using the editor of your choice."

{- | Runs @show@ command.

@
Usage:
  summon show COMMAND
      Show supported licenses or ghc versions

Available commands:
  ghc                      Show available ghc versions
  license                  Show available licenses
  license [LICENSE_NAME]   Show specific license text
@

-}
runShow :: ShowOpts -> IO ()
runShow :: ShowOpts -> IO ()
runShow = \case
    -- show list of all available GHC versions
    GhcList -> (Text -> Text) -> [Text] -> IO ()
forall a. (a -> Text) -> [a] -> IO ()
showBulletList Text -> Text
forall a. a -> a
id [Text]
ghcTable
    -- show a list of all available licenses
    LicenseList Nothing -> (LicenseName -> Text) -> [LicenseName] -> IO ()
forall a. (a -> Text) -> [a] -> IO ()
showBulletList @LicenseName LicenseName -> Text
showLicenseWithDesc [LicenseName]
forall a. (Bounded a, Enum a) => [a]
universe
    -- show a specific license
    LicenseList (Just name :: FilePath
name) ->
        case Text -> Maybe LicenseName
parseLicenseName (FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
name) of
            Nothing -> do
                Text -> IO ()
errorMessage "This wasn't a valid choice."
                Text -> IO ()
infoMessage "Here is the list of supported licenses:"
                (LicenseName -> Text) -> [LicenseName] -> IO ()
forall a. (a -> Text) -> [a] -> IO ()
showBulletList @LicenseName LicenseName -> Text
forall b a. (Show a, IsString b) => a -> b
show [LicenseName]
forall a. (Bounded a, Enum a) => [a]
universe
                -- get and show a license`s text
            Just licenseName :: LicenseName
licenseName -> do
                License
licenseCustomText <- LicenseName -> IO License
getCustomLicenseText LicenseName
licenseName
                Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ License -> Text
unLicense License
licenseCustomText
  where
    showBulletList :: (a -> Text) -> [a] -> IO ()
    showBulletList :: (a -> Text) -> [a] -> IO ()
showBulletList showT :: a -> Text
showT = (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> IO ()
infoMessage (Text -> IO ()) -> (a -> Text) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append "➤ " (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
showT)

-- | Get the customized License text for @summon show license NAME@ command.
getCustomLicenseText :: LicenseName -> IO License
getCustomLicenseText :: LicenseName -> IO License
getCustomLicenseText licenseName :: LicenseName
licenseName = do
    Text
year <- IO Text
currentYear
    PartialConfig
guessConfig <- IO PartialConfig
guessConfigFromGit
    LicenseName -> Text -> Text -> IO License
fetchLicenseCustom
        LicenseName
licenseName
        (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "YOUR NAME" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Last Text -> Maybe Text
forall a. Last a -> Maybe a
getLast (Last Text -> Maybe Text) -> Last Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ PartialConfig -> 'Partial :- Text
forall (p :: Phase). ConfigP p -> p :- Text
cFullName PartialConfig
guessConfig)
        Text
year

{- | Runs @script@ command.

@
Usage: summon script BUILD_TOOL (-g|--ghc GHC_VERSION) (-n|--name FILE_NAME)
  Create a new Haskell script

Available options:
  -h,--help                Show this help text
  -g,--ghc GHC_VERSION     Version of the compiler to be used for script
  -n,--name FILE_NAME      Name of the script file
@
-}
runScript :: ScriptOpts -> IO ()
runScript :: ScriptOpts -> IO ()
runScript ScriptOpts{..} = do
    let pathTxt :: Text
pathTxt = FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
scriptOptsName
    IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> IO Bool
doesFileExist FilePath
scriptOptsName) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> IO ()
errorMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "File already exists: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pathTxt
        IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure

    let script :: Text
script = GhcVer -> Tool -> Text
scriptFile GhcVer
scriptOptsGhc Tool
scriptOptsTool
    FilePath -> Text -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileText FilePath
scriptOptsName Text
script
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath
os FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "mingw32") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        "chmod" ["+x", Text
pathTxt]
    Text -> IO ()
successMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Successfully created script: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pathTxt

{- | Runs @new@ command.

@
Usage:
  summon new PROJECT_NAME [--ignore-config] [--no-upload] [--offline]
             [-f|--file FILENAME]
             [--cabal]
             [--stack]
             [--prelude-package PACKAGE_NAME]
             [--prelude-module MODULE_NAME]
             [with [OPTIONS]]
             [without [OPTIONS]]
@

-}
runNew :: NewOpts -> IO ()
runNew :: NewOpts -> IO ()
runNew newOpts :: NewOpts
newOpts@NewOpts{..} = do
    -- get the final config
    Config
finalConfig <- NewOpts -> IO Config
getFinalConfig NewOpts
newOpts
    -- Generate the project.
    Interactivity -> ConnectMode -> Text -> Config -> IO ()
generateProject Interactivity
newOptsInteractivity ConnectMode
newOptsConnectMode Text
newOptsProjectName Config
finalConfig

-- | By the given 'NewOpts' return the final configurations.
getFinalConfig :: NewOpts -> IO Config
getFinalConfig :: NewOpts -> IO Config
getFinalConfig NewOpts{..} = do
    -- read config from file
    PartialConfig
fileConfig <- Bool -> Maybe FilePath -> IO PartialConfig
readFileConfig Bool
newOptsIgnoreFile Maybe FilePath
newOptsConfigFile

    -- guess config from the global ~/.gitconfig file
    PartialConfig
gitConfig <- IO PartialConfig
guessConfigFromGit

    -- union all possible configs
    let unionConfig :: PartialConfig
unionConfig = PartialConfig
defaultConfig PartialConfig -> PartialConfig -> PartialConfig
forall a. Semigroup a => a -> a -> a
<> PartialConfig
gitConfig PartialConfig -> PartialConfig -> PartialConfig
forall a. Semigroup a => a -> a -> a
<> PartialConfig
fileConfig PartialConfig -> PartialConfig -> PartialConfig
forall a. Semigroup a => a -> a -> a
<> PartialConfig
newOptsCliConfig

    -- get the final config
    case PartialConfig -> Validation [Text] Config
finalise PartialConfig
unionConfig of
        Success c :: Config
c    -> Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
c
        Failure msgs :: [Text]
msgs -> [Text] -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Text]
msgs Text -> IO ()
errorMessage IO () -> IO Config -> IO Config
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Config
forall (m :: * -> *) a. MonadIO m => m a
exitFailure

-- | Reads and parses the given config file. If no file is provided the default
-- configuration returned.
readFileConfig :: Bool -> Maybe FilePath -> IO PartialConfig
readFileConfig :: Bool -> Maybe FilePath -> IO PartialConfig
readFileConfig ignoreFile :: Bool
ignoreFile maybeFile :: Maybe FilePath
maybeFile = if Bool
ignoreFile then PartialConfig -> IO PartialConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure PartialConfig
forall a. Monoid a => a
mempty else do
    (isDefault :: Bool
isDefault, file :: FilePath
file) <- case Maybe FilePath
maybeFile of
        Nothing -> (Bool
True,) (FilePath -> (Bool, FilePath))
-> IO FilePath -> IO (Bool, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
defaultConfigFile
        Just x :: FilePath
x  -> (Bool, FilePath) -> IO (Bool, FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, FilePath
x)

    Bool
isFile <- FilePath -> IO Bool
doesFileExist FilePath
file

    if Bool
isFile then do
        Text -> IO ()
infoMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Configurations from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " will be used."
        FilePath -> IO PartialConfig
forall (m :: * -> *). MonadIO m => FilePath -> m PartialConfig
loadFileConfig FilePath
file
    else if Bool
isDefault then do
        Text
fp <- FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> IO FilePath -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
defaultConfigFile
        Text -> IO ()
warningMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Default config " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " file is missing."
        pure PartialConfig
forall a. Monoid a => a
mempty
    else do
        Text -> IO ()
errorMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Specified configuration file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " is not found."
        IO PartialConfig
forall (m :: * -> *) a. MonadIO m => m a
exitFailure

----------------------------------------------------------------------------
-- Command data types
----------------------------------------------------------------------------

-- | Represent all available commands
data Command
    -- | @new@ command creates a new project
    = New NewOpts
    -- | @script@ command creates Haskell script
    | Script ScriptOpts
    -- | @show@ command shows supported licenses or GHC versions
    | ShowInfo ShowOpts
    -- | @config@ command creates the TOML configuration file
    | Config ConfigOpts

-- | Options parsed with the @new@ command
data NewOpts = NewOpts
    { NewOpts -> Text
newOptsProjectName   :: !Text             -- ^ Project name
    , NewOpts -> Bool
newOptsIgnoreFile    :: !Bool             -- ^ Ignore all config files if 'True'
    , NewOpts -> ConnectMode
newOptsConnectMode   :: !ConnectMode      -- ^ 'Online'/'Offline' mode
    , NewOpts -> Interactivity
newOptsInteractivity :: !Interactivity    -- ^ Interactive or non-interactive mode is on?
    , NewOpts -> Maybe FilePath
newOptsConfigFile    :: !(Maybe FilePath) -- ^ File with custom configuration
    , NewOpts -> PartialConfig
newOptsCliConfig     :: !PartialConfig    -- ^ Config gathered via command-line
    }

-- | Options parsed with the @script@ command
data ScriptOpts = ScriptOpts
    { ScriptOpts -> Tool
scriptOptsTool :: !Tool      -- ^ Build tool: `cabal` or `stack`
    , ScriptOpts -> FilePath
scriptOptsName :: !FilePath  -- ^ File path to the script
    , ScriptOpts -> GhcVer
scriptOptsGhc  :: !GhcVer    -- ^ GHC version for this script
    }

-- | Commands parsed with @show@ command
data ShowOpts
    = GhcList
    | LicenseList (Maybe String)

-- | Options parsed with the @config@ command
newtype ConfigOpts = ConfigOpts
    { ConfigOpts -> Maybe FilePath
configOptsName :: Maybe FilePath
    }

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

-- | Main parser of the app.
cliParser :: Version -> ParserInfo Command
cliParser :: Version -> ParserInfo Command
cliParser version :: Version
version = ParserInfo Command -> ParserInfo Command
forall a. ParserInfo a -> ParserInfo a
modifyHeader
     (ParserInfo Command -> ParserInfo Command)
-> ParserInfo Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ ParserInfo Command -> ParserInfo Command
forall a. ParserInfo a -> ParserInfo a
modifyFooter
     (ParserInfo Command -> ParserInfo Command)
-> ParserInfo Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ( Parser ((Command -> Command) -> Command -> Command)
forall a. Parser (a -> a)
helper Parser ((Command -> Command) -> Command -> Command)
-> Parser (Command -> Command) -> Parser (Command -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Version -> Parser (Command -> Command)
forall a. Version -> Parser (a -> a)
versionP Version
version Parser (Command -> Command) -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
summonerP )
            (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ InfoMod Command
forall a. InfoMod a
fullDesc
           InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc "Set up your own Haskell project"

versionP :: Version -> Parser (a -> a)
versionP :: Version -> Parser (a -> a)
versionP version :: Version
version = FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption (Version -> FilePath
summonerVersion Version
version)
    (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$ FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "version"
   Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'v'
   Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. FilePath -> Mod f a
help "Show summoner's version"

summonerVersion :: Version -> String
summonerVersion :: Version -> FilePath
summonerVersion version :: Version
version = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "\n" [FilePath
sVersion, FilePath
sHash, FilePath
sDate]
  where
    sVersion, sHash, sDate :: String
    sVersion :: FilePath
sVersion = [FilePath] -> FilePath -> FilePath
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [FilePath
forall str. IsString str => str
blue, FilePath
forall str. IsString str => str
bold] (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ "Summoner " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> "v" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>  Version -> FilePath
showVersion Version
version
    sHash :: FilePath
sHash = " ➤ " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath -> FilePath
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [FilePath
forall str. IsString str => str
blue, FilePath
forall str. IsString str => str
bold] "Git revision: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> $(gitHash)
    sDate :: FilePath
sDate = " ➤ " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath -> FilePath
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [FilePath
forall str. IsString str => str
blue, FilePath
forall str. IsString str => str
bold] "Commit date:  " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> $(gitCommitDate)

-- | All possible commands.
summonerP :: Parser Command
summonerP :: Parser Command
summonerP = Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
subparser
    (Mod CommandFields Command -> Parser Command)
-> Mod CommandFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$ FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "new" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (Command -> Command)
forall a. Parser (a -> a)
helper Parser (Command -> Command) -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
newP) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc "Create a new Haskell project")
   Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "script" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (Command -> Command)
forall a. Parser (a -> a)
helper Parser (Command -> Command) -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
scriptP) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc "Create a new Haskell script")
   Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "show" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (Command -> Command)
forall a. Parser (a -> a)
helper Parser (Command -> Command) -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
showP) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc "Show supported licenses or ghc versions")
   Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "config" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (Command -> Command)
forall a. Parser (a -> a)
helper Parser (Command -> Command) -> Parser Command -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
configP) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc "Create a default TOML configuration file for summoner")

----------------------------------------------------------------------------
-- @config@ command parsers
----------------------------------------------------------------------------

-- | Parses options of the @config@ command.
configP :: Parser Command
configP :: Parser Command
configP = do
    Maybe FilePath
configOptsName <- Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FilePath
configFileP
    pure $ ConfigOpts -> Command
Config ConfigOpts :: Maybe FilePath -> ConfigOpts
ConfigOpts{..}

----------------------------------------------------------------------------
-- @show@ command parsers
----------------------------------------------------------------------------

-- | Parses options of the @show@ command.
showP :: Parser Command
showP :: Parser Command
showP = ShowOpts -> Command
ShowInfo (ShowOpts -> Command) -> Parser ShowOpts -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod CommandFields ShowOpts -> Parser ShowOpts
forall a. Mod CommandFields a -> Parser a
subparser
    ( FilePath -> ParserInfo ShowOpts -> Mod CommandFields ShowOpts
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "ghc" (Parser ShowOpts -> InfoMod ShowOpts -> ParserInfo ShowOpts
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (ShowOpts -> ShowOpts)
forall a. Parser (a -> a)
helper Parser (ShowOpts -> ShowOpts) -> Parser ShowOpts -> Parser ShowOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ShowOpts -> Parser ShowOpts
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShowOpts
GhcList) (InfoMod ShowOpts -> ParserInfo ShowOpts)
-> InfoMod ShowOpts -> ParserInfo ShowOpts
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod ShowOpts
forall a. FilePath -> InfoMod a
progDesc "Show supported ghc versions")
   Mod CommandFields ShowOpts
-> Mod CommandFields ShowOpts -> Mod CommandFields ShowOpts
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo ShowOpts -> Mod CommandFields ShowOpts
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "license" (Parser ShowOpts -> InfoMod ShowOpts -> ParserInfo ShowOpts
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (ShowOpts -> ShowOpts)
forall a. Parser (a -> a)
helper Parser (ShowOpts -> ShowOpts) -> Parser ShowOpts -> Parser ShowOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ShowOpts
licenseText) (InfoMod ShowOpts -> ParserInfo ShowOpts)
-> InfoMod ShowOpts -> ParserInfo ShowOpts
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod ShowOpts
forall a. FilePath -> InfoMod a
progDesc "Show supported licenses")
    )

licenseText :: Parser ShowOpts
licenseText :: Parser ShowOpts
licenseText = Maybe FilePath -> ShowOpts
LicenseList (Maybe FilePath -> ShowOpts)
-> Parser (Maybe FilePath) -> Parser ShowOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
    (Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "LICENSE_NAME" Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help "Show specific license text"))

----------------------------------------------------------------------------
-- @script@ command parsers
----------------------------------------------------------------------------

-- | Parses options of the @script@ command.
scriptP :: Parser Command
scriptP :: Parser Command
scriptP = do
    Tool
scriptOptsTool <- Parser Tool
toolArgP
    GhcVer
scriptOptsGhc  <- Parser GhcVer
ghcVerP
    FilePath
scriptOptsName <- Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
         (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "name"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'n'
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value "my_script"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "FILE_NAME"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help "Name of the script file"

    pure $ ScriptOpts -> Command
Script $WScriptOpts :: Tool -> FilePath -> GhcVer -> ScriptOpts
ScriptOpts{..}

-- | Argument parser for 'Tool'.
toolArgP :: Parser Tool
toolArgP :: Parser Tool
toolArgP = ReadM Tool -> Mod ArgumentFields Tool -> Parser Tool
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument
    ((FilePath -> Maybe Tool) -> ReadM Tool
forall a. (FilePath -> Maybe a) -> ReadM a
maybeReader ((FilePath -> Maybe Tool) -> ReadM Tool)
-> (FilePath -> Maybe Tool) -> ReadM Tool
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Tool
parseTool (Text -> Maybe Tool)
-> (FilePath -> Text) -> FilePath -> Maybe Tool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a. ToText a => a -> Text
toText)
    (FilePath -> Mod ArgumentFields Tool
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "BUILD_TOOL")

ghcVerP :: Parser GhcVer
ghcVerP :: Parser GhcVer
ghcVerP = ReadM GhcVer -> Mod OptionFields GhcVer -> Parser GhcVer
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((FilePath -> Maybe GhcVer) -> ReadM GhcVer
forall a. (FilePath -> Maybe a) -> ReadM a
maybeReader ((FilePath -> Maybe GhcVer) -> ReadM GhcVer)
-> (FilePath -> Maybe GhcVer) -> ReadM GhcVer
forall a b. (a -> b) -> a -> b
$ Text -> Maybe GhcVer
parseGhcVer (Text -> Maybe GhcVer)
-> (FilePath -> Text) -> FilePath -> Maybe GhcVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a. ToText a => a -> Text
toText)
    (  FilePath -> Mod OptionFields GhcVer
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "ghc"
    Mod OptionFields GhcVer
-> Mod OptionFields GhcVer -> Mod OptionFields GhcVer
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields GhcVer
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'g'
    Mod OptionFields GhcVer
-> Mod OptionFields GhcVer -> Mod OptionFields GhcVer
forall a. Semigroup a => a -> a -> a
<> GhcVer -> Mod OptionFields GhcVer
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value GhcVer
defaultGHC
    Mod OptionFields GhcVer
-> Mod OptionFields GhcVer -> Mod OptionFields GhcVer
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields GhcVer
forall a (f :: * -> *). Show a => Mod f a
showDefault
    Mod OptionFields GhcVer
-> Mod OptionFields GhcVer -> Mod OptionFields GhcVer
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields GhcVer
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "GHC_VERSION"
    Mod OptionFields GhcVer
-> Mod OptionFields GhcVer -> Mod OptionFields GhcVer
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields GhcVer
forall (f :: * -> *) a. FilePath -> Mod f a
help "Version of the compiler to be used for script"
    )

----------------------------------------------------------------------------
-- @new@ command parsers
----------------------------------------------------------------------------

-- | Parses options of the @new@ command.
newP :: Parser Command
newP :: Parser Command
newP = do
    Text
newOptsProjectName   <- Mod ArgumentFields Text -> Parser Text
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "PROJECT_NAME")
    Bool
newOptsIgnoreFile    <- Parser Bool
ignoreFileP
    Bool
noUpload             <- Parser Bool
noUploadP
    ConnectMode
newOptsConnectMode   <- Parser ConnectMode
connectModeP
    Interactivity
newOptsInteractivity <- Parser Interactivity
interactivityP
    Maybe FilePath
newOptsConfigFile    <- Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FilePath
configFileP
    Decision
cabal <- Parser Decision
cabalP
    Decision
stack <- Parser Decision
stackP
    Maybe Text
preludePack <- Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text
preludePackP
    Maybe Text
preludeMod  <- Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text
preludeModP
    Maybe PartialConfig
with    <- Parser PartialConfig -> Parser (Maybe PartialConfig)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser PartialConfig
withP
    Maybe PartialConfig
without <- Parser PartialConfig -> Parser (Maybe PartialConfig)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser PartialConfig
withoutP

    pure $ NewOpts -> Command
New (NewOpts -> Command) -> NewOpts -> Command
forall a b. (a -> b) -> a -> b
$ $WNewOpts :: Text
-> Bool
-> ConnectMode
-> Interactivity
-> Maybe FilePath
-> PartialConfig
-> NewOpts
NewOpts
        { newOptsCliConfig :: PartialConfig
newOptsCliConfig = (Maybe PartialConfig -> PartialConfig
forall m. Monoid m => Maybe m -> m
maybeToMonoid (Maybe PartialConfig -> PartialConfig)
-> Maybe PartialConfig -> PartialConfig
forall a b. (a -> b) -> a -> b
$ Maybe PartialConfig
with Maybe PartialConfig -> Maybe PartialConfig -> Maybe PartialConfig
forall a. Semigroup a => a -> a -> a
<> Maybe PartialConfig
without)
            { cPrelude :: Last CustomPrelude
cPrelude = Maybe CustomPrelude -> Last CustomPrelude
forall a. Maybe a -> Last a
Last (Maybe CustomPrelude -> Last CustomPrelude)
-> Maybe CustomPrelude -> Last CustomPrelude
forall a b. (a -> b) -> a -> b
$ Text -> Text -> CustomPrelude
CustomPrelude (Text -> Text -> CustomPrelude)
-> Maybe Text -> Maybe (Text -> CustomPrelude)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
preludePack Maybe (Text -> CustomPrelude) -> Maybe Text -> Maybe CustomPrelude
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text
preludeMod
            , cCabal :: Decision
cCabal = Decision
cabal
            , cStack :: Decision
cStack = Decision
stack
            , cNoUpload :: Any
cNoUpload = Bool -> Any
Any (Bool -> Any) -> Bool -> Any
forall a b. (a -> b) -> a -> b
$ Bool
noUpload Bool -> Bool -> Bool
|| ConnectMode -> Bool
isOffline ConnectMode
newOptsConnectMode
            }
        , ..
        }

targetsP ::  Decision -> Parser PartialConfig
targetsP :: Decision -> Parser PartialConfig
targetsP d :: Decision
d = do
    Decision
cGitHub    <- Decision -> Parser Decision
githubP    Decision
d
    Decision
cGhActions <- Decision -> Parser Decision
ghActionsP Decision
d
    Decision
cTravis    <- Decision -> Parser Decision
travisP    Decision
d
    Decision
cAppVey    <- Decision -> Parser Decision
appVeyorP  Decision
d
    Decision
cPrivate   <- Decision -> Parser Decision
privateP   Decision
d
    Decision
cLib       <- Decision -> Parser Decision
libraryP   Decision
d
    Decision
cExe       <- Decision -> Parser Decision
execP      Decision
d
    Decision
cTest      <- Decision -> Parser Decision
testP      Decision
d
    Decision
cBench     <- Decision -> Parser Decision
benchmarkP Decision
d
    pure PartialConfig
forall a. Monoid a => a
mempty
        { cGitHub :: Decision
cGitHub    = Decision
cGitHub
        , cGhActions :: Decision
cGhActions = Decision
cGhActions
        , cTravis :: Decision
cTravis    = Decision
cTravis
        , cAppVey :: Decision
cAppVey    = Decision
cAppVey
        , cPrivate :: Decision
cPrivate   = Decision
cPrivate
        , cLib :: Decision
cLib       = Decision
cLib
        , cExe :: Decision
cExe       = Decision
cExe
        , cTest :: Decision
cTest      = Decision
cTest
        , cBench :: Decision
cBench     = Decision
cBench
        }

githubP :: Decision -> Parser Decision
githubP :: Decision -> Parser Decision
githubP d :: Decision
d = Decision -> Decision -> Mod FlagFields Decision -> Parser Decision
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Decision
Idk Decision
d (Mod FlagFields Decision -> Parser Decision)
-> Mod FlagFields Decision -> Parser Decision
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Decision] -> Mod FlagFields Decision
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "github"
    , Char -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'g'
    , FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. FilePath -> Mod f a
help "GitHub integration"
    ]

ghActionsP :: Decision -> Parser Decision
ghActionsP :: Decision -> Parser Decision
ghActionsP d :: Decision
d = Decision -> Decision -> Mod FlagFields Decision -> Parser Decision
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Decision
Idk Decision
d (Mod FlagFields Decision -> Parser Decision)
-> Mod FlagFields Decision -> Parser Decision
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Decision] -> Mod FlagFields Decision
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "actions"
    , Char -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'a'
    , FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. FilePath -> Mod f a
help "GitHub Actions CI"
    ]

travisP :: Decision -> Parser Decision
travisP :: Decision -> Parser Decision
travisP d :: Decision
d = Decision -> Decision -> Mod FlagFields Decision -> Parser Decision
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Decision
Idk Decision
d (Mod FlagFields Decision -> Parser Decision)
-> Mod FlagFields Decision -> Parser Decision
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Decision] -> Mod FlagFields Decision
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "travis"
    , Char -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'c'
    , FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. FilePath -> Mod f a
help "Travis CI integration"
    ]

appVeyorP :: Decision -> Parser Decision
appVeyorP :: Decision -> Parser Decision
appVeyorP d :: Decision
d = Decision -> Decision -> Mod FlagFields Decision -> Parser Decision
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Decision
Idk Decision
d (Mod FlagFields Decision -> Parser Decision)
-> Mod FlagFields Decision -> Parser Decision
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Decision] -> Mod FlagFields Decision
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "app-veyor"
    , Char -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'w'
    , FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. FilePath -> Mod f a
help "AppVeyor CI integration"
    ]

privateP :: Decision -> Parser Decision
privateP :: Decision -> Parser Decision
privateP d :: Decision
d = Decision -> Decision -> Mod FlagFields Decision -> Parser Decision
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Decision
Idk Decision
d (Mod FlagFields Decision -> Parser Decision)
-> Mod FlagFields Decision -> Parser Decision
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Decision] -> Mod FlagFields Decision
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "private"
    , Char -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'p'
    , FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. FilePath -> Mod f a
help "Private repository"
    ]

libraryP :: Decision -> Parser Decision
libraryP :: Decision -> Parser Decision
libraryP d :: Decision
d = Decision -> Decision -> Mod FlagFields Decision -> Parser Decision
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Decision
Idk Decision
d (Mod FlagFields Decision -> Parser Decision)
-> Mod FlagFields Decision -> Parser Decision
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Decision] -> Mod FlagFields Decision
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "library"
    , Char -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'l'
    , FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. FilePath -> Mod f a
help "Library folder"
    ]

execP :: Decision -> Parser Decision
execP :: Decision -> Parser Decision
execP d :: Decision
d = Decision -> Decision -> Mod FlagFields Decision -> Parser Decision
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Decision
Idk Decision
d (Mod FlagFields Decision -> Parser Decision)
-> Mod FlagFields Decision -> Parser Decision
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Decision] -> Mod FlagFields Decision
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "exec"
    , Char -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'e'
    , FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. FilePath -> Mod f a
help "Executable target"
    ]

testP :: Decision -> Parser Decision
testP :: Decision -> Parser Decision
testP d :: Decision
d = Decision -> Decision -> Mod FlagFields Decision -> Parser Decision
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Decision
Idk Decision
d (Mod FlagFields Decision -> Parser Decision)
-> Mod FlagFields Decision -> Parser Decision
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Decision] -> Mod FlagFields Decision
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "test"
    , Char -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 't'
    , FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. FilePath -> Mod f a
help "Test target"
    ]

benchmarkP :: Decision -> Parser Decision
benchmarkP :: Decision -> Parser Decision
benchmarkP d :: Decision
d = Decision -> Decision -> Mod FlagFields Decision -> Parser Decision
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Decision
Idk Decision
d (Mod FlagFields Decision -> Parser Decision)
-> Mod FlagFields Decision -> Parser Decision
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Decision] -> Mod FlagFields Decision
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "benchmark"
    , Char -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'b'
    , FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. FilePath -> Mod f a
help "Benchmarks"
    ]

withP :: Parser PartialConfig
withP :: Parser PartialConfig
withP = Mod CommandFields PartialConfig -> Parser PartialConfig
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields PartialConfig -> Parser PartialConfig)
-> Mod CommandFields PartialConfig -> Parser PartialConfig
forall a b. (a -> b) -> a -> b
$ [Mod CommandFields PartialConfig]
-> Mod CommandFields PartialConfig
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod CommandFields PartialConfig
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "with [OPTIONS]"
    , FilePath
-> ParserInfo PartialConfig -> Mod CommandFields PartialConfig
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "with" (ParserInfo PartialConfig -> Mod CommandFields PartialConfig)
-> ParserInfo PartialConfig -> Mod CommandFields PartialConfig
forall a b. (a -> b) -> a -> b
$ Parser PartialConfig
-> InfoMod PartialConfig -> ParserInfo PartialConfig
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (PartialConfig -> PartialConfig)
forall a. Parser (a -> a)
helper Parser (PartialConfig -> PartialConfig)
-> Parser PartialConfig -> Parser PartialConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decision -> Parser PartialConfig
targetsP Decision
Yes) (FilePath -> InfoMod PartialConfig
forall a. FilePath -> InfoMod a
progDesc "Specify options to enable")
    ]

withoutP :: Parser PartialConfig
withoutP :: Parser PartialConfig
withoutP = Mod CommandFields PartialConfig -> Parser PartialConfig
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields PartialConfig -> Parser PartialConfig)
-> Mod CommandFields PartialConfig -> Parser PartialConfig
forall a b. (a -> b) -> a -> b
$ [Mod CommandFields PartialConfig]
-> Mod CommandFields PartialConfig
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod CommandFields PartialConfig
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "without [OPTIONS]"
    , FilePath
-> ParserInfo PartialConfig -> Mod CommandFields PartialConfig
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "without" (ParserInfo PartialConfig -> Mod CommandFields PartialConfig)
-> ParserInfo PartialConfig -> Mod CommandFields PartialConfig
forall a b. (a -> b) -> a -> b
$ Parser PartialConfig
-> InfoMod PartialConfig -> ParserInfo PartialConfig
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (PartialConfig -> PartialConfig)
forall a. Parser (a -> a)
helper Parser (PartialConfig -> PartialConfig)
-> Parser PartialConfig -> Parser PartialConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decision -> Parser PartialConfig
targetsP Decision
Nop) (FilePath -> InfoMod PartialConfig
forall a. FilePath -> InfoMod a
progDesc "Specify options to disable")
    ]

ignoreFileP :: Parser Bool
ignoreFileP :: Parser Bool
ignoreFileP = Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "ignore-config"
    , FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help "Ignore configuration file"
    ]

noUploadP :: Parser Bool
noUploadP :: Parser Bool
noUploadP = Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "no-upload"
    , FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help "Do not upload to GitHub. Special case of the '--offline' flag."
    ]

connectModeP :: Parser ConnectMode
connectModeP :: Parser ConnectMode
connectModeP = ConnectMode
-> ConnectMode -> Mod FlagFields ConnectMode -> Parser ConnectMode
forall a. a -> a -> Mod FlagFields a -> Parser a
flag ConnectMode
Online ConnectMode
Offline (Mod FlagFields ConnectMode -> Parser ConnectMode)
-> Mod FlagFields ConnectMode -> Parser ConnectMode
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields ConnectMode] -> Mod FlagFields ConnectMode
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields ConnectMode
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "offline"
    , FilePath -> Mod FlagFields ConnectMode
forall (f :: * -> *) a. FilePath -> Mod f a
help "Offline mode: create a project with 'All Rights Reserved' license and without uploading to GitHub."
    ]

interactivityP :: Parser Interactivity
interactivityP :: Parser Interactivity
interactivityP = Interactivity
-> Interactivity
-> Mod FlagFields Interactivity
-> Parser Interactivity
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Interactivity
Interactive Interactivity
NonInteractive (Mod FlagFields Interactivity -> Parser Interactivity)
-> Mod FlagFields Interactivity -> Parser Interactivity
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Interactivity] -> Mod FlagFields Interactivity
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Interactivity
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "non-interactive"
    , Char -> Mod FlagFields Interactivity
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'n'
    , FilePath -> Mod FlagFields Interactivity
forall (f :: * -> *) a. FilePath -> Mod f a
help "Non-interactive mode: create a project without interactive questions."
    ]

configFileP :: Parser FilePath
configFileP :: Parser FilePath
configFileP = Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "file"
    , Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'f'
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "FILENAME"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help "Path to the toml file with configurations. If not specified '~/.summoner.toml' will be used by default"
    ]

preludePackP :: Parser Text
preludePackP :: Parser Text
preludePackP = Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields Text] -> Mod OptionFields Text
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "prelude-package"
    , FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "PACKAGE_NAME"
    , FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help "Name for the package of the custom prelude to use in the project"
    ]

preludeModP :: Parser Text
preludeModP :: Parser Text
preludeModP = Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields Text] -> Mod OptionFields Text
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "prelude-module"
    , FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "MODULE_NAME"
    , FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help "Name for the module of the custom prelude to use in the project"
    ]

cabalP :: Parser Decision
cabalP :: Parser Decision
cabalP = Decision -> Decision -> Mod FlagFields Decision -> Parser Decision
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Decision
Idk Decision
Yes (Mod FlagFields Decision -> Parser Decision)
-> Mod FlagFields Decision -> Parser Decision
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Decision] -> Mod FlagFields Decision
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "cabal"
    , FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. FilePath -> Mod f a
help "Cabal support for the project"
    ]

stackP :: Parser Decision
stackP :: Parser Decision
stackP = Decision -> Decision -> Mod FlagFields Decision -> Parser Decision
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Decision
Idk Decision
Yes (Mod FlagFields Decision -> Parser Decision)
-> Mod FlagFields Decision -> Parser Decision
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Decision] -> Mod FlagFields Decision
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "stack"
    , FilePath -> Mod FlagFields Decision
forall (f :: * -> *) a. FilePath -> Mod f a
help "Stack support for the project"
    ]

----------------------------------------------------------------------------
-- Beauty util
----------------------------------------------------------------------------

-- to put custom header which doesn't cut all spaces
modifyHeader :: ParserInfo a -> ParserInfo a
modifyHeader :: ParserInfo a -> ParserInfo a
modifyHeader p :: ParserInfo a
p = ParserInfo a
p {infoHeader :: Chunk Doc
infoHeader = FilePath -> Chunk Doc
stringChunk (FilePath -> Chunk Doc) -> FilePath -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
artHeader}

-- to put custom footer which doesn't cut all spaces
modifyFooter :: ParserInfo a -> ParserInfo a
modifyFooter :: ParserInfo a -> ParserInfo a
modifyFooter p :: ParserInfo a
p = ParserInfo a
p {infoFooter :: Chunk Doc
infoFooter = FilePath -> Chunk Doc
stringChunk (FilePath -> Chunk Doc) -> FilePath -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
artFooter}

artHeader :: Text
artHeader :: Text
artHeader = [text|
$endLine
                                                   ___
                                                 ╱  .  ╲
                                                │╲_/│   │
                                                │   │  ╱│
  ___________________________________________________-' │
 ╱                                                      │
╱   .-.                                                 │
│  ╱   ╲                                                │
│ │\_.  │ Summoner — tool for creating Haskell projects │
│\│  │ ╱│                                               │
│ `-_-' │                                              ╱
│       │_____________________________________________╱
│       │
 ╲     ╱
  `-_-'
|]

artFooter :: Text
artFooter :: Text
artFooter = [text|
$endLine
              , *   +
           +      o   *             ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
            * @ ╭─╮  .      ________┃                                 ┃_______
           ╱| . │λ│ @   '   ╲       ┃   λ Haskell's summon scroll λ   ┃      ╱
         _╱ ╰─  ╰╥╯    O     ╲      ┃                                 ┃     ╱
        .─╲"╱. * ║  +        ╱      ┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛     ╲
       ╱  ( ) ╲_ ║          ╱__________)                           (_________╲
       ╲ ╲(')╲__(╱
       ╱╱`)╱ `╮  ║
 `╲.  ╱╱  (   │  ║
  ╲.╲╱        │  ║
  `╰══════════╯
$endLine
|]