module Zifter.OptParse
( module Zifter.OptParse
, Instructions
, Dispatch(..)
, Settings(..)
, OutputMode(..)
) where
import Data.Maybe
import Data.Monoid
import Options.Applicative
import System.Environment (getArgs)
import Zifter.OptParse.Types
getInstructions :: IO Instructions
getInstructions = do
(cmd, flags) <- getArguments
config <- getConfiguration cmd flags
combineToInstructions cmd flags config
combineToInstructions :: Command -> Flags -> Configuration -> IO Instructions
combineToInstructions cmd Flags {..} Configuration = pure (d, sets)
where
sets =
Settings
{ setsOutputColor = flagsOutputColor
, setsOutputMode = fromMaybe OutputLinear flagsOutputMode
}
d =
case cmd of
CommandRun -> DispatchRun
CommandInstall r -> DispatchInstall r
CommandPreProcess -> DispatchPreProcess
CommandPreCheck -> DispatchPreCheck
CommandCheck -> DispatchCheck
getConfiguration :: Command -> Flags -> IO Configuration
getConfiguration _ _ = pure Configuration
getArguments :: IO Arguments
getArguments = do
args <- getArgs
let result = runArgumentsParser args
handleParseResult result
runArgumentsParser :: [String] -> ParserResult Arguments
runArgumentsParser = execParserPure pfs argParser
where
pfs =
ParserPrefs
{ prefMultiSuffix = ""
, prefDisambiguate = True
, prefShowHelpOnError = True
, prefShowHelpOnEmpty = True
, prefBacktrack = True
, prefColumns = 80
}
argParser :: ParserInfo Arguments
argParser = info (helper <*> parseArgs) hlp
where
hlp = fullDesc <> progDesc description
description = "Zifter"
parseArgs :: Parser Arguments
parseArgs = (,) <$> parseCommand <*> parseFlags
parseCommand :: Parser Command
parseCommand =
hsubparser $
mconcat
[ command "run" parseCommandRun
, command "preprocess" parseCommandPreProcess
, command "precheck" parseCommandPreCheck
, command "check" parseCommandCheck
, command "install" parseCommandInstall
]
parseCommandRun :: ParserInfo Command
parseCommandRun = info parser modifier
where
parser = pure CommandRun
modifier = fullDesc <> progDesc "Run the zift script."
parseCommandPreProcess :: ParserInfo Command
parseCommandPreProcess = info parser modifier
where
parser = pure CommandPreProcess
modifier = fullDesc <> progDesc "PreProcess according to the zift script."
parseCommandPreCheck :: ParserInfo Command
parseCommandPreCheck = info parser modifier
where
parser = pure CommandPreCheck
modifier = fullDesc <> progDesc "PreCheck according to the zift script."
parseCommandCheck :: ParserInfo Command
parseCommandCheck = info parser modifier
where
parser = pure CommandCheck
modifier = fullDesc <> progDesc "Check according to the zift script."
parseCommandInstall :: ParserInfo Command
parseCommandInstall = info parser modifier
where
parser =
CommandInstall <$> doubleSwitch "recursive" "Install recursively" mempty
modifier = fullDesc <> progDesc "Install the zift script."
parseFlags :: Parser Flags
parseFlags =
Flags <$> doubleSwitch "color" "color in output." mempty <*> outputModeFlag
doubleSwitch :: String -> String -> Mod FlagFields Bool -> Parser Bool
doubleSwitch name helpText mods =
let enabledValue = True
disabledValue = False
defaultValue = True
in (last <$>
some
((flag'
enabledValue
(hidden <> internal <> long name <> help helpText <> mods) <|>
flag'
disabledValue
(hidden <> internal <> long ("no-" ++ name) <> help helpText <>
mods)) <|>
flag'
disabledValue
(long ("[no-]" ++ name) <>
help
("Enable/disable " ++
helpText ++ " (default: " ++ show defaultValue ++ ")") <>
mods))) <|>
pure defaultValue
outputModeFlag :: Parser (Maybe OutputMode)
outputModeFlag =
(flag'
(Just OutputLinear)
(mconcat [long "linear", help "output linearly, reorder as necessary."]) <|>
flag'
(Just OutputFast)
(mconcat
[ long "fast"
, help "output as soon as possible, this is likely faster"
])) <|>
pure Nothing