{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_HADDOCK prune #-}
module Core.Program.Arguments (
Config,
blankConfig,
simpleConfig,
complexConfig,
baselineOptions,
Parameters (..),
ParameterValue (..),
LongName (..),
ShortName,
Description,
Options (..),
Commands (..),
appendOption,
parseCommandLine,
extractValidEnvironments,
InvalidCommandLine (..),
buildUsage,
buildVersion,
emptyParameters,
) where
import Data.Hashable (Hashable)
import qualified Data.List as List
import Data.Maybe (fromMaybe)
import Data.String (IsString (..))
import Prettyprinter (
Doc,
Pretty (..),
align,
emptyDoc,
fillBreak,
fillCat,
fillSep,
hardline,
indent,
nest,
softline,
(<+>),
)
import Prettyprinter.Util (reflow)
import System.Environment (getProgName)
import Core.Data.Structures
import Core.Program.Metadata
import Core.System.Base
import Core.Text.Rope
import Core.Text.Utilities
type ShortName = Char
type Description = Rope
newtype LongName = LongName String
deriving (Int -> LongName -> ShowS
[LongName] -> ShowS
LongName -> String
(Int -> LongName -> ShowS)
-> (LongName -> String) -> ([LongName] -> ShowS) -> Show LongName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LongName] -> ShowS
$cshowList :: [LongName] -> ShowS
show :: LongName -> String
$cshow :: LongName -> String
showsPrec :: Int -> LongName -> ShowS
$cshowsPrec :: Int -> LongName -> ShowS
Show, String -> LongName
(String -> LongName) -> IsString LongName
forall a. (String -> a) -> IsString a
fromString :: String -> LongName
$cfromString :: String -> LongName
IsString, LongName -> LongName -> Bool
(LongName -> LongName -> Bool)
-> (LongName -> LongName -> Bool) -> Eq LongName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LongName -> LongName -> Bool
$c/= :: LongName -> LongName -> Bool
== :: LongName -> LongName -> Bool
$c== :: LongName -> LongName -> Bool
Eq, Eq LongName
Eq LongName
-> (Int -> LongName -> Int)
-> (LongName -> Int)
-> Hashable LongName
Int -> LongName -> Int
LongName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: LongName -> Int
$chash :: LongName -> Int
hashWithSalt :: Int -> LongName -> Int
$chashWithSalt :: Int -> LongName -> Int
$cp1Hashable :: Eq LongName
Hashable, Eq LongName
Eq LongName
-> (LongName -> LongName -> Ordering)
-> (LongName -> LongName -> Bool)
-> (LongName -> LongName -> Bool)
-> (LongName -> LongName -> Bool)
-> (LongName -> LongName -> Bool)
-> (LongName -> LongName -> LongName)
-> (LongName -> LongName -> LongName)
-> Ord LongName
LongName -> LongName -> Bool
LongName -> LongName -> Ordering
LongName -> LongName -> LongName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LongName -> LongName -> LongName
$cmin :: LongName -> LongName -> LongName
max :: LongName -> LongName -> LongName
$cmax :: LongName -> LongName -> LongName
>= :: LongName -> LongName -> Bool
$c>= :: LongName -> LongName -> Bool
> :: LongName -> LongName -> Bool
$c> :: LongName -> LongName -> Bool
<= :: LongName -> LongName -> Bool
$c<= :: LongName -> LongName -> Bool
< :: LongName -> LongName -> Bool
$c< :: LongName -> LongName -> Bool
compare :: LongName -> LongName -> Ordering
$ccompare :: LongName -> LongName -> Ordering
$cp1Ord :: Eq LongName
Ord)
instance Key LongName
instance Pretty LongName where
pretty :: LongName -> Doc ann
pretty (LongName String
name) = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
instance Textual LongName where
intoRope :: LongName -> Rope
intoRope (LongName String
str) = String -> Rope
forall α. Textual α => α -> Rope
intoRope String
str
fromRope :: Rope -> LongName
fromRope = String -> LongName
LongName (String -> LongName) -> (Rope -> String) -> Rope -> LongName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> String
forall α. Textual α => Rope -> α
fromRope
data Config
= Blank
| Simple [Options]
| Complex [Commands]
blankConfig :: Config
blankConfig :: Config
blankConfig = Config
Blank
simpleConfig :: [Options] -> Config
simpleConfig :: [Options] -> Config
simpleConfig [Options]
options = [Options] -> Config
Simple ([Options]
options [Options] -> [Options] -> [Options]
forall a. [a] -> [a] -> [a]
++ [Options]
baselineOptions)
complexConfig :: [Commands] -> Config
complexConfig :: [Commands] -> Config
complexConfig [Commands]
commands = [Commands] -> Config
Complex ([Commands]
commands [Commands] -> [Commands] -> [Commands]
forall a. [a] -> [a] -> [a]
++ [[Options] -> Commands
Global [Options]
baselineOptions])
data Commands
= Global [Options]
| Command LongName Description [Options]
data Options
= Option LongName (Maybe ShortName) ParameterValue Description
| Argument LongName Description
| Remaining Description
| Variable LongName Description
deriving (Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)
appendOption :: Options -> Config -> Config
appendOption :: Options -> Config -> Config
appendOption Options
option Config
config =
case Config
config of
Config
Blank -> Config
Blank
Simple [Options]
options -> [Options] -> Config
Simple ([Options]
options [Options] -> [Options] -> [Options]
forall a. [a] -> [a] -> [a]
++ [Options
option])
Complex [Commands]
commands -> [Commands] -> Config
Complex (([Commands] -> Commands -> [Commands])
-> [Commands] -> [Commands] -> [Commands]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' [Commands] -> Commands -> [Commands]
f [] [Commands]
commands)
where
f :: [Commands] -> Commands -> [Commands]
f :: [Commands] -> Commands -> [Commands]
f [Commands]
acc Commands
command = case Commands
command of
Global [Options]
options -> [Options] -> Commands
Global ([Options]
options [Options] -> [Options] -> [Options]
forall a. [a] -> [a] -> [a]
++ [Options
option]) Commands -> [Commands] -> [Commands]
forall a. a -> [a] -> [a]
: [Commands]
acc
c :: Commands
c@(Command LongName
_ Rope
_ [Options]
_) -> Commands
c Commands -> [Commands] -> [Commands]
forall a. a -> [a] -> [a]
: [Commands]
acc
data ParameterValue
= Value String
| Empty
deriving (Int -> ParameterValue -> ShowS
[ParameterValue] -> ShowS
ParameterValue -> String
(Int -> ParameterValue -> ShowS)
-> (ParameterValue -> String)
-> ([ParameterValue] -> ShowS)
-> Show ParameterValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParameterValue] -> ShowS
$cshowList :: [ParameterValue] -> ShowS
show :: ParameterValue -> String
$cshow :: ParameterValue -> String
showsPrec :: Int -> ParameterValue -> ShowS
$cshowsPrec :: Int -> ParameterValue -> ShowS
Show, ParameterValue -> ParameterValue -> Bool
(ParameterValue -> ParameterValue -> Bool)
-> (ParameterValue -> ParameterValue -> Bool) -> Eq ParameterValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterValue -> ParameterValue -> Bool
$c/= :: ParameterValue -> ParameterValue -> Bool
== :: ParameterValue -> ParameterValue -> Bool
$c== :: ParameterValue -> ParameterValue -> Bool
Eq)
instance IsString ParameterValue where
fromString :: String -> ParameterValue
fromString String
x = String -> ParameterValue
Value String
x
data Parameters = Parameters
{ Parameters -> Maybe LongName
commandNameFrom :: Maybe LongName
, Parameters -> Map LongName ParameterValue
parameterValuesFrom :: Map LongName ParameterValue
, Parameters -> [String]
remainingArgumentsFrom :: [String]
, Parameters -> Map LongName ParameterValue
environmentValuesFrom :: Map LongName ParameterValue
}
deriving (Int -> Parameters -> ShowS
[Parameters] -> ShowS
Parameters -> String
(Int -> Parameters -> ShowS)
-> (Parameters -> String)
-> ([Parameters] -> ShowS)
-> Show Parameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parameters] -> ShowS
$cshowList :: [Parameters] -> ShowS
show :: Parameters -> String
$cshow :: Parameters -> String
showsPrec :: Int -> Parameters -> ShowS
$cshowsPrec :: Int -> Parameters -> ShowS
Show, Parameters -> Parameters -> Bool
(Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool) -> Eq Parameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parameters -> Parameters -> Bool
$c/= :: Parameters -> Parameters -> Bool
== :: Parameters -> Parameters -> Bool
$c== :: Parameters -> Parameters -> Bool
Eq)
emptyParameters :: Parameters
emptyParameters :: Parameters
emptyParameters =
Parameters :: Maybe LongName
-> Map LongName ParameterValue
-> [String]
-> Map LongName ParameterValue
-> Parameters
Parameters
{ commandNameFrom :: Maybe LongName
commandNameFrom = Maybe LongName
forall a. Maybe a
Nothing
, parameterValuesFrom :: Map LongName ParameterValue
parameterValuesFrom = Map LongName ParameterValue
forall κ ν. Map κ ν
emptyMap
, remainingArgumentsFrom :: [String]
remainingArgumentsFrom = []
, environmentValuesFrom :: Map LongName ParameterValue
environmentValuesFrom = Map LongName ParameterValue
forall κ ν. Map κ ν
emptyMap
}
baselineOptions :: [Options]
baselineOptions :: [Options]
baselineOptions =
[ LongName -> Maybe ShortName -> ParameterValue -> Rope -> Options
Option
LongName
"verbose"
(ShortName -> Maybe ShortName
forall a. a -> Maybe a
Just ShortName
'v')
ParameterValue
Empty
[quote|
Turn on informational messages. The logging stream will go
to standard output in your terminal.
|]
, LongName -> Maybe ShortName -> ParameterValue -> Rope -> Options
Option
LongName
"debug"
Maybe ShortName
forall a. Maybe a
Nothing
ParameterValue
Empty
[quote|
Turn on debug output. Implies --verbose.
|]
]
data InvalidCommandLine
=
InvalidOption String
|
UnknownOption String
|
MissingArgument LongName
|
UnexpectedArguments [String]
|
UnknownCommand String
|
NoCommandFound
|
HelpRequest (Maybe LongName)
|
VersionRequest
deriving (Int -> InvalidCommandLine -> ShowS
[InvalidCommandLine] -> ShowS
InvalidCommandLine -> String
(Int -> InvalidCommandLine -> ShowS)
-> (InvalidCommandLine -> String)
-> ([InvalidCommandLine] -> ShowS)
-> Show InvalidCommandLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidCommandLine] -> ShowS
$cshowList :: [InvalidCommandLine] -> ShowS
show :: InvalidCommandLine -> String
$cshow :: InvalidCommandLine -> String
showsPrec :: Int -> InvalidCommandLine -> ShowS
$cshowsPrec :: Int -> InvalidCommandLine -> ShowS
Show, InvalidCommandLine -> InvalidCommandLine -> Bool
(InvalidCommandLine -> InvalidCommandLine -> Bool)
-> (InvalidCommandLine -> InvalidCommandLine -> Bool)
-> Eq InvalidCommandLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidCommandLine -> InvalidCommandLine -> Bool
$c/= :: InvalidCommandLine -> InvalidCommandLine -> Bool
== :: InvalidCommandLine -> InvalidCommandLine -> Bool
$c== :: InvalidCommandLine -> InvalidCommandLine -> Bool
Eq)
instance Exception InvalidCommandLine where
displayException :: InvalidCommandLine -> String
displayException InvalidCommandLine
e = case InvalidCommandLine
e of
InvalidOption String
arg ->
let one :: String
one = String
"Option '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
arg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' illegal.\n\n"
two :: String
two =
[quote|
Options must either be long form with a double dash, for example:
--verbose
or, when available with a short version, a single dash and a single
character. They need to be listed individually:
-v -a
When an option takes a value it has to be in long form and the value
indicated with an equals sign, for example:
--tempdir=/tmp
with complex values escaped according to the rules of your shell:
--username="Ada Lovelace"
For options valid in this program, please see --help.
|]
in String
one String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
two
UnknownOption String
name -> String
"Sorry, option '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' not recognized."
MissingArgument (LongName String
name) -> String
"Mandatory argument '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' missing."
UnexpectedArguments [String]
args ->
let quoted :: String
quoted = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"', '" [String]
args
in [quote|
Unexpected trailing arguments:
|]
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
quoted
String -> ShowS
forall a. [a] -> [a] -> [a]
++ [quote|
For arguments expected by this program, please see --help.
|]
UnknownCommand String
first -> String
"Hm. Command '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
first String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' not recognized."
InvalidCommandLine
NoCommandFound ->
[quote|
No command specified.
Usage is of the form:
|]
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
programName
String -> ShowS
forall a. [a] -> [a] -> [a]
++ [quote| [GLOBAL OPTIONS] COMMAND [LOCAL OPTIONS] [ARGUMENTS]
See --help for details.
|]
HelpRequest Maybe LongName
_ -> String
""
InvalidCommandLine
VersionRequest -> String
""
programName :: String
programName :: String
programName = IO String -> String
forall a. IO a -> a
unsafePerformIO IO String
getProgName
parseCommandLine :: Config -> [String] -> Either InvalidCommandLine Parameters
parseCommandLine :: Config -> [String] -> Either InvalidCommandLine Parameters
parseCommandLine Config
config [String]
argv = case Config
config of
Config
Blank -> Parameters -> Either InvalidCommandLine Parameters
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe LongName
-> Map LongName ParameterValue
-> [String]
-> Map LongName ParameterValue
-> Parameters
Parameters Maybe LongName
forall a. Maybe a
Nothing Map LongName ParameterValue
forall κ ν. Map κ ν
emptyMap [] Map LongName ParameterValue
forall κ ν. Map κ ν
emptyMap)
Simple [Options]
options -> do
(Map LongName ParameterValue
params, [String]
remainder) <- Maybe LongName
-> [Options]
-> [String]
-> Either
InvalidCommandLine (Map LongName ParameterValue, [String])
extractor Maybe LongName
forall a. Maybe a
Nothing [Options]
options [String]
argv
[Options] -> [String] -> Either InvalidCommandLine ()
checkRemainder [Options]
options [String]
remainder
Parameters -> Either InvalidCommandLine Parameters
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe LongName
-> Map LongName ParameterValue
-> [String]
-> Map LongName ParameterValue
-> Parameters
Parameters Maybe LongName
forall a. Maybe a
Nothing Map LongName ParameterValue
params [String]
remainder Map LongName ParameterValue
forall κ ν. Map κ ν
emptyMap)
Complex [Commands]
commands ->
let globalOptions :: [Options]
globalOptions = [Commands] -> [Options]
extractGlobalOptions [Commands]
commands
modes :: Map LongName [Options]
modes = [Commands] -> Map LongName [Options]
extractValidModes [Commands]
commands
in do
([String]
possibles, [String]
argv') <- [String] -> Either InvalidCommandLine ([String], [String])
splitCommandLine1 [String]
argv
(Map LongName ParameterValue
params1, [String]
_) <- Maybe LongName
-> [Options]
-> [String]
-> Either
InvalidCommandLine (Map LongName ParameterValue, [String])
extractor Maybe LongName
forall a. Maybe a
Nothing [Options]
globalOptions [String]
possibles
(String
first, [String]
moreArgs) <- [String] -> Either InvalidCommandLine (String, [String])
splitCommandLine2 [String]
argv'
(LongName
mode, [Options]
localOptions) <- Map LongName [Options]
-> String -> Either InvalidCommandLine (LongName, [Options])
parseIndicatedCommand Map LongName [Options]
modes String
first
(Map LongName ParameterValue
params2, [String]
remainder) <- Maybe LongName
-> [Options]
-> [String]
-> Either
InvalidCommandLine (Map LongName ParameterValue, [String])
extractor (LongName -> Maybe LongName
forall a. a -> Maybe a
Just LongName
mode) [Options]
localOptions [String]
moreArgs
[Options] -> [String] -> Either InvalidCommandLine ()
checkRemainder [Options]
localOptions [String]
remainder
Parameters -> Either InvalidCommandLine Parameters
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe LongName
-> Map LongName ParameterValue
-> [String]
-> Map LongName ParameterValue
-> Parameters
Parameters (LongName -> Maybe LongName
forall a. a -> Maybe a
Just LongName
mode) (Map LongName ParameterValue
-> Map LongName ParameterValue -> Map LongName ParameterValue
forall a. Semigroup a => a -> a -> a
(<>) Map LongName ParameterValue
params1 Map LongName ParameterValue
params2) [String]
remainder Map LongName ParameterValue
forall κ ν. Map κ ν
emptyMap)
where
extractor :: Maybe LongName -> [Options] -> [String] -> Either InvalidCommandLine ((Map LongName ParameterValue), [String])
extractor :: Maybe LongName
-> [Options]
-> [String]
-> Either
InvalidCommandLine (Map LongName ParameterValue, [String])
extractor Maybe LongName
mode [Options]
options [String]
args =
let ([String]
possibles, [String]
arguments) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition String -> Bool
isOption [String]
args
valids :: Set LongName
valids = [Options] -> Set LongName
extractValidNames [Options]
options
shorts :: Map ShortName LongName
shorts = [Options] -> Map ShortName LongName
extractShortNames [Options]
options
needed :: [LongName]
needed = [Options] -> [LongName]
extractRequiredArguments [Options]
options
in do
[(LongName, ParameterValue)]
list1 <- Maybe LongName
-> Set LongName
-> Map ShortName LongName
-> [String]
-> Either InvalidCommandLine [(LongName, ParameterValue)]
parsePossibleOptions Maybe LongName
mode Set LongName
valids Map ShortName LongName
shorts [String]
possibles
([(LongName, ParameterValue)]
list2, [String]
arguments') <- [LongName]
-> [String]
-> Either
InvalidCommandLine ([(LongName, ParameterValue)], [String])
parseRequiredArguments [LongName]
needed [String]
arguments
(Map LongName ParameterValue, [String])
-> Either
InvalidCommandLine (Map LongName ParameterValue, [String])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Map LongName ParameterValue
-> Map LongName ParameterValue -> Map LongName ParameterValue
forall a. Semigroup a => a -> a -> a
(<>) ([(LongName, ParameterValue)]
-> Map
(K [(LongName, ParameterValue)]) (V [(LongName, ParameterValue)])
forall α. Dictionary α => α -> Map (K α) (V α)
intoMap [(LongName, ParameterValue)]
list1) ([(LongName, ParameterValue)]
-> Map
(K [(LongName, ParameterValue)]) (V [(LongName, ParameterValue)])
forall α. Dictionary α => α -> Map (K α) (V α)
intoMap [(LongName, ParameterValue)]
list2)), [String]
arguments')
checkRemainder :: [Options] -> [String] -> Either InvalidCommandLine ()
checkRemainder :: [Options] -> [String] -> Either InvalidCommandLine ()
checkRemainder [Options]
options [String]
remainder =
if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [String]
remainder
then () -> Either InvalidCommandLine ()
forall a b. b -> Either a b
Right ()
else
if [Options] -> Bool
hasRemaining [Options]
options
then () -> Either InvalidCommandLine ()
forall a b. b -> Either a b
Right ()
else InvalidCommandLine -> Either InvalidCommandLine ()
forall a b. a -> Either a b
Left ([String] -> InvalidCommandLine
UnexpectedArguments [String]
remainder)
hasRemaining :: [Options] -> Bool
hasRemaining :: [Options] -> Bool
hasRemaining [Options]
options =
(Bool -> Options -> Bool) -> Bool -> [Options] -> Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
( \Bool
acc Options
option -> case Options
option of
Remaining Rope
_ -> Bool
True
Options
_ -> Bool
acc
)
Bool
False
[Options]
options
isOption :: String -> Bool
isOption :: String -> Bool
isOption String
arg = case String
arg of
(ShortName
'-' : String
_) -> Bool
True
String
_ -> Bool
False
parsePossibleOptions ::
Maybe LongName ->
Set LongName ->
Map ShortName LongName ->
[String] ->
Either InvalidCommandLine [(LongName, ParameterValue)]
parsePossibleOptions :: Maybe LongName
-> Set LongName
-> Map ShortName LongName
-> [String]
-> Either InvalidCommandLine [(LongName, ParameterValue)]
parsePossibleOptions Maybe LongName
mode Set LongName
valids Map ShortName LongName
shorts [String]
args = (String -> Either InvalidCommandLine (LongName, ParameterValue))
-> [String]
-> Either InvalidCommandLine [(LongName, ParameterValue)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> Either InvalidCommandLine (LongName, ParameterValue)
f [String]
args
where
f :: String -> Either InvalidCommandLine (LongName, ParameterValue)
f String
arg = case String
arg of
String
"--help" -> InvalidCommandLine
-> Either InvalidCommandLine (LongName, ParameterValue)
forall a b. a -> Either a b
Left (Maybe LongName -> InvalidCommandLine
HelpRequest Maybe LongName
mode)
String
"-?" -> InvalidCommandLine
-> Either InvalidCommandLine (LongName, ParameterValue)
forall a b. a -> Either a b
Left (Maybe LongName -> InvalidCommandLine
HelpRequest Maybe LongName
mode)
String
"--version" -> InvalidCommandLine
-> Either InvalidCommandLine (LongName, ParameterValue)
forall a b. a -> Either a b
Left InvalidCommandLine
VersionRequest
(ShortName
'-' : ShortName
'-' : String
name) -> String -> Either InvalidCommandLine (LongName, ParameterValue)
considerLongOption String
name
(ShortName
'-' : ShortName
c : []) -> ShortName -> Either InvalidCommandLine (LongName, ParameterValue)
considerShortOption ShortName
c
String
_ -> InvalidCommandLine
-> Either InvalidCommandLine (LongName, ParameterValue)
forall a b. a -> Either a b
Left (String -> InvalidCommandLine
InvalidOption String
arg)
considerLongOption :: String -> Either InvalidCommandLine (LongName, ParameterValue)
considerLongOption :: String -> Either InvalidCommandLine (LongName, ParameterValue)
considerLongOption String
arg =
let (String
name, String
value) = (ShortName -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span (ShortName -> ShortName -> Bool
forall a. Eq a => a -> a -> Bool
/= ShortName
'=') String
arg
candidate :: LongName
candidate = String -> LongName
LongName String
name
value' :: ParameterValue
value' = case String -> Maybe (ShortName, String)
forall a. [a] -> Maybe (a, [a])
List.uncons String
value of
Just (ShortName
_, String
remainder) -> String -> ParameterValue
Value String
remainder
Maybe (ShortName, String)
Nothing -> ParameterValue
Empty
in if LongName -> Set LongName -> Bool
forall ε. Key ε => ε -> Set ε -> Bool
containsElement LongName
candidate Set LongName
valids
then (LongName, ParameterValue)
-> Either InvalidCommandLine (LongName, ParameterValue)
forall a b. b -> Either a b
Right (LongName
candidate, ParameterValue
value')
else InvalidCommandLine
-> Either InvalidCommandLine (LongName, ParameterValue)
forall a b. a -> Either a b
Left (String -> InvalidCommandLine
UnknownOption (String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name))
considerShortOption :: Char -> Either InvalidCommandLine (LongName, ParameterValue)
considerShortOption :: ShortName -> Either InvalidCommandLine (LongName, ParameterValue)
considerShortOption ShortName
c =
case ShortName -> Map ShortName LongName -> Maybe LongName
forall κ ν. Key κ => κ -> Map κ ν -> Maybe ν
lookupKeyValue ShortName
c Map ShortName LongName
shorts of
Just LongName
name -> (LongName, ParameterValue)
-> Either InvalidCommandLine (LongName, ParameterValue)
forall a b. b -> Either a b
Right (LongName
name, ParameterValue
Empty)
Maybe LongName
Nothing -> InvalidCommandLine
-> Either InvalidCommandLine (LongName, ParameterValue)
forall a b. a -> Either a b
Left (String -> InvalidCommandLine
UnknownOption [ShortName
'-', ShortName
c])
parseRequiredArguments ::
[LongName] ->
[String] ->
Either InvalidCommandLine ([(LongName, ParameterValue)], [String])
parseRequiredArguments :: [LongName]
-> [String]
-> Either
InvalidCommandLine ([(LongName, ParameterValue)], [String])
parseRequiredArguments [LongName]
needed [String]
argv = [LongName]
-> [String]
-> Either
InvalidCommandLine ([(LongName, ParameterValue)], [String])
iter [LongName]
needed [String]
argv
where
iter :: [LongName] -> [String] -> Either InvalidCommandLine ([(LongName, ParameterValue)], [String])
iter :: [LongName]
-> [String]
-> Either
InvalidCommandLine ([(LongName, ParameterValue)], [String])
iter [] [] = ([(LongName, ParameterValue)], [String])
-> Either
InvalidCommandLine ([(LongName, ParameterValue)], [String])
forall a b. b -> Either a b
Right ([], [])
iter [] [String]
args = ([(LongName, ParameterValue)], [String])
-> Either
InvalidCommandLine ([(LongName, ParameterValue)], [String])
forall a b. b -> Either a b
Right ([], [String]
args)
iter (LongName
name : [LongName]
_) [] = InvalidCommandLine
-> Either
InvalidCommandLine ([(LongName, ParameterValue)], [String])
forall a b. a -> Either a b
Left (LongName -> InvalidCommandLine
MissingArgument LongName
name)
iter (LongName
name : [LongName]
names) (String
arg : [String]
args) =
let deeper :: Either InvalidCommandLine ([(LongName, ParameterValue)], [String])
deeper = [LongName]
-> [String]
-> Either
InvalidCommandLine ([(LongName, ParameterValue)], [String])
iter [LongName]
names [String]
args
in case Either InvalidCommandLine ([(LongName, ParameterValue)], [String])
deeper of
Left InvalidCommandLine
e -> InvalidCommandLine
-> Either
InvalidCommandLine ([(LongName, ParameterValue)], [String])
forall a b. a -> Either a b
Left InvalidCommandLine
e
Right ([(LongName, ParameterValue)]
list, [String]
remainder) -> ([(LongName, ParameterValue)], [String])
-> Either
InvalidCommandLine ([(LongName, ParameterValue)], [String])
forall a b. b -> Either a b
Right (((LongName
name, String -> ParameterValue
Value String
arg) (LongName, ParameterValue)
-> [(LongName, ParameterValue)] -> [(LongName, ParameterValue)]
forall a. a -> [a] -> [a]
: [(LongName, ParameterValue)]
list), [String]
remainder)
parseIndicatedCommand ::
Map LongName [Options] ->
String ->
Either InvalidCommandLine (LongName, [Options])
parseIndicatedCommand :: Map LongName [Options]
-> String -> Either InvalidCommandLine (LongName, [Options])
parseIndicatedCommand Map LongName [Options]
modes String
first =
let candidate :: LongName
candidate = String -> LongName
LongName String
first
in case LongName -> Map LongName [Options] -> Maybe [Options]
forall κ ν. Key κ => κ -> Map κ ν -> Maybe ν
lookupKeyValue LongName
candidate Map LongName [Options]
modes of
Just [Options]
options -> (LongName, [Options])
-> Either InvalidCommandLine (LongName, [Options])
forall a b. b -> Either a b
Right (LongName
candidate, [Options]
options)
Maybe [Options]
Nothing -> InvalidCommandLine
-> Either InvalidCommandLine (LongName, [Options])
forall a b. a -> Either a b
Left (String -> InvalidCommandLine
UnknownCommand String
first)
extractValidNames :: [Options] -> Set LongName
[Options]
options =
(Options -> Set LongName -> Set LongName)
-> Set LongName -> [Options] -> Set LongName
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Options -> Set LongName -> Set LongName
f Set LongName
forall ε. Key ε => Set ε
emptySet [Options]
options
where
f :: Options -> Set LongName -> Set LongName
f :: Options -> Set LongName -> Set LongName
f (Option LongName
longname Maybe ShortName
_ ParameterValue
_ Rope
_) Set LongName
valids = LongName -> Set LongName -> Set LongName
forall ε. Key ε => ε -> Set ε -> Set ε
insertElement LongName
longname Set LongName
valids
f Options
_ Set LongName
valids = Set LongName
valids
extractShortNames :: [Options] -> Map ShortName LongName
[Options]
options =
(Options -> Map ShortName LongName -> Map ShortName LongName)
-> Map ShortName LongName -> [Options] -> Map ShortName LongName
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Options -> Map ShortName LongName -> Map ShortName LongName
g Map ShortName LongName
forall κ ν. Map κ ν
emptyMap [Options]
options
where
g :: Options -> Map ShortName LongName -> Map ShortName LongName
g :: Options -> Map ShortName LongName -> Map ShortName LongName
g (Option LongName
longname Maybe ShortName
shortname ParameterValue
_ Rope
_) Map ShortName LongName
shorts = case Maybe ShortName
shortname of
Just ShortName
shortchar -> ShortName
-> LongName -> Map ShortName LongName -> Map ShortName LongName
forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue ShortName
shortchar LongName
longname Map ShortName LongName
shorts
Maybe ShortName
Nothing -> Map ShortName LongName
shorts
g Options
_ Map ShortName LongName
shorts = Map ShortName LongName
shorts
extractRequiredArguments :: [Options] -> [LongName]
[Options]
arguments =
([LongName] -> Options -> [LongName])
-> [LongName] -> [Options] -> [LongName]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' [LongName] -> Options -> [LongName]
h [] [Options]
arguments
where
h :: [LongName] -> Options -> [LongName]
h :: [LongName] -> Options -> [LongName]
h [LongName]
needed (Argument LongName
longname Rope
_) = LongName
longname LongName -> [LongName] -> [LongName]
forall a. a -> [a] -> [a]
: [LongName]
needed
h [LongName]
needed Options
_ = [LongName]
needed
extractGlobalOptions :: [Commands] -> [Options]
[Commands]
commands =
(Commands -> [Options] -> [Options])
-> [Options] -> [Commands] -> [Options]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Commands -> [Options] -> [Options]
j [] [Commands]
commands
where
j :: Commands -> [Options] -> [Options]
j :: Commands -> [Options] -> [Options]
j (Global [Options]
options) [Options]
valids = [Options]
options [Options] -> [Options] -> [Options]
forall a. [a] -> [a] -> [a]
++ [Options]
valids
j Commands
_ [Options]
valids = [Options]
valids
extractValidModes :: [Commands] -> Map LongName [Options]
[Commands]
commands =
(Map LongName [Options] -> Commands -> Map LongName [Options])
-> Map LongName [Options] -> [Commands] -> Map LongName [Options]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Map LongName [Options] -> Commands -> Map LongName [Options]
k Map LongName [Options]
forall κ ν. Map κ ν
emptyMap [Commands]
commands
where
k :: Map LongName [Options] -> Commands -> Map LongName [Options]
k :: Map LongName [Options] -> Commands -> Map LongName [Options]
k Map LongName [Options]
modes (Command LongName
longname Rope
_ [Options]
options) = LongName
-> [Options] -> Map LongName [Options] -> Map LongName [Options]
forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue LongName
longname [Options]
options Map LongName [Options]
modes
k Map LongName [Options]
modes Commands
_ = Map LongName [Options]
modes
splitCommandLine1 :: [String] -> Either InvalidCommandLine ([String], [String])
splitCommandLine1 :: [String] -> Either InvalidCommandLine ([String], [String])
splitCommandLine1 [String]
args =
let ([String]
possibles, [String]
remainder) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span String -> Bool
isOption [String]
args
in if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
possibles Bool -> Bool -> Bool
&& [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
remainder
then InvalidCommandLine
-> Either InvalidCommandLine ([String], [String])
forall a b. a -> Either a b
Left InvalidCommandLine
NoCommandFound
else ([String], [String])
-> Either InvalidCommandLine ([String], [String])
forall a b. b -> Either a b
Right ([String]
possibles, [String]
remainder)
splitCommandLine2 :: [String] -> Either InvalidCommandLine (String, [String])
splitCommandLine2 :: [String] -> Either InvalidCommandLine (String, [String])
splitCommandLine2 [String]
argv' =
let x :: Maybe (String, [String])
x = [String] -> Maybe (String, [String])
forall a. [a] -> Maybe (a, [a])
List.uncons [String]
argv'
in case Maybe (String, [String])
x of
Just (String
mode, [String]
remainingArgs) -> (String, [String]) -> Either InvalidCommandLine (String, [String])
forall a b. b -> Either a b
Right (String
mode, [String]
remainingArgs)
Maybe (String, [String])
Nothing -> InvalidCommandLine -> Either InvalidCommandLine (String, [String])
forall a b. a -> Either a b
Left InvalidCommandLine
NoCommandFound
extractValidEnvironments :: Maybe LongName -> Config -> Set LongName
Maybe LongName
mode Config
config = case Config
config of
Config
Blank -> Set LongName
forall ε. Key ε => Set ε
emptySet
Simple [Options]
options -> [Options] -> Set LongName
extractVariableNames [Options]
options
Complex [Commands]
commands ->
let globals :: [Options]
globals = [Commands] -> [Options]
extractGlobalOptions [Commands]
commands
variables1 :: Set LongName
variables1 = [Options] -> Set LongName
extractVariableNames [Options]
globals
locals :: [Options]
locals = [Commands] -> LongName -> [Options]
extractLocalVariables [Commands]
commands (LongName -> Maybe LongName -> LongName
forall a. a -> Maybe a -> a
fromMaybe LongName
"" Maybe LongName
mode)
variables2 :: Set LongName
variables2 = [Options] -> Set LongName
extractVariableNames [Options]
locals
in Set LongName
variables1 Set LongName -> Set LongName -> Set LongName
forall a. Semigroup a => a -> a -> a
<> Set LongName
variables2
extractLocalVariables :: [Commands] -> LongName -> [Options]
[Commands]
commands LongName
mode =
(Commands -> [Options] -> [Options])
-> [Options] -> [Commands] -> [Options]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Commands -> [Options] -> [Options]
k [] [Commands]
commands
where
k :: Commands -> [Options] -> [Options]
k :: Commands -> [Options] -> [Options]
k (Command LongName
name Rope
_ [Options]
options) [Options]
acc = if LongName
name LongName -> LongName -> Bool
forall a. Eq a => a -> a -> Bool
== LongName
mode then [Options]
options else [Options]
acc
k Commands
_ [Options]
acc = [Options]
acc
extractVariableNames :: [Options] -> Set LongName
[Options]
options =
(Options -> Set LongName -> Set LongName)
-> Set LongName -> [Options] -> Set LongName
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Options -> Set LongName -> Set LongName
f Set LongName
forall ε. Key ε => Set ε
emptySet [Options]
options
where
f :: Options -> Set LongName -> Set LongName
f :: Options -> Set LongName -> Set LongName
f (Variable LongName
longname Rope
_) Set LongName
valids = LongName -> Set LongName -> Set LongName
forall ε. Key ε => ε -> Set ε -> Set ε
insertElement LongName
longname Set LongName
valids
f Options
_ Set LongName
valids = Set LongName
valids
buildUsage :: Config -> Maybe LongName -> Doc ann
buildUsage :: Config -> Maybe LongName -> Doc ann
buildUsage Config
config Maybe LongName
mode = case Config
config of
Config
Blank -> Doc ann
forall ann. Doc ann
emptyDoc
Simple [Options]
options ->
let ([Options]
o, [Options]
a, [Options]
v) = [Options] -> ([Options], [Options], [Options])
partitionParameters [Options]
options
in Doc ann
"Usage:" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent
Int
4
( Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest
Int
4
( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillCat
[ String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
programName
, [Options] -> Doc ann
forall ann. [Options] -> Doc ann
optionsSummary [Options]
o
, [Options] -> Doc ann
forall ann. [Options] -> Doc ann
argumentsSummary [Options]
a
, [Options] -> Doc ann
forall ann. [Options] -> Doc ann
remainingSummary [Options]
a
]
)
)
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
optionsHeading [Options]
o
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall ann. [Options] -> Doc ann
formatParameters [Options]
o
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
argumentsHeading [Options]
a
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall ann. [Options] -> Doc ann
formatParameters [Options]
a
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
variablesHeading [Options]
v
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall ann. [Options] -> Doc ann
formatParameters [Options]
v
Complex [Commands]
commands ->
let globalOptions :: [Options]
globalOptions = [Commands] -> [Options]
extractGlobalOptions [Commands]
commands
modes :: Map LongName [Options]
modes = [Commands] -> Map LongName [Options]
extractValidModes [Commands]
commands
([Options]
oG, [Options]
_, [Options]
vG) = [Options] -> ([Options], [Options], [Options])
partitionParameters [Options]
globalOptions
in Doc ann
"Usage:" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> case Maybe LongName
mode of
Maybe LongName
Nothing ->
Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent
Int
2
( Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest
Int
4
( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillCat
[ String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
programName
, [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
globalSummary [Options]
oG
, Map LongName [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
commandSummary Map LongName [Options]
modes
]
)
)
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
globalHeading [Options]
oG
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall ann. [Options] -> Doc ann
formatParameters [Options]
oG
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Map LongName [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
commandHeading Map LongName [Options]
modes
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Commands] -> Doc ann
forall ann. [Commands] -> Doc ann
formatCommands [Commands]
commands
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
variablesHeading [Options]
vG
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall ann. [Options] -> Doc ann
formatParameters [Options]
vG
Just LongName
longname ->
let ([Options]
oL, [Options]
aL, [Options]
vL) = case LongName -> Map LongName [Options] -> Maybe [Options]
forall κ ν. Key κ => κ -> Map κ ν -> Maybe ν
lookupKeyValue LongName
longname Map LongName [Options]
modes of
Just [Options]
localOptions -> [Options] -> ([Options], [Options], [Options])
partitionParameters [Options]
localOptions
Maybe [Options]
Nothing -> String -> ([Options], [Options], [Options])
forall a. HasCallStack => String -> a
error String
"Illegal State"
in Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent
Int
2
( Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest
Int
4
( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillCat
[ String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
programName
, [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
globalSummary [Options]
oG
, Map LongName [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
commandSummary Map LongName [Options]
modes
, [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
localSummary [Options]
oL
, [Options] -> Doc ann
forall ann. [Options] -> Doc ann
argumentsSummary [Options]
aL
, [Options] -> Doc ann
forall ann. [Options] -> Doc ann
remainingSummary [Options]
aL
]
)
)
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
localHeading [Options]
oL
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall ann. [Options] -> Doc ann
formatParameters [Options]
oL
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
argumentsHeading [Options]
aL
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall ann. [Options] -> Doc ann
formatParameters [Options]
aL
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall (t :: * -> *) a ann. Foldable t => t a -> Doc ann
variablesHeading [Options]
vL
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Options] -> Doc ann
forall ann. [Options] -> Doc ann
formatParameters [Options]
vL
where
partitionParameters :: [Options] -> ([Options], [Options], [Options])
partitionParameters :: [Options] -> ([Options], [Options], [Options])
partitionParameters [Options]
options = (([Options], [Options], [Options])
-> Options -> ([Options], [Options], [Options]))
-> ([Options], [Options], [Options])
-> [Options]
-> ([Options], [Options], [Options])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ([Options], [Options], [Options])
-> Options -> ([Options], [Options], [Options])
f ([], [], []) [Options]
options
optionsSummary :: [Options] -> Doc ann
optionsSummary :: [Options] -> Doc ann
optionsSummary [Options]
os = if [Options] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Options]
os Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Doc ann
forall ann. Doc ann
softline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"[OPTIONS]" else Doc ann
forall ann. Doc ann
emptyDoc
optionsHeading :: t a -> Doc ann
optionsHeading t a
os = if t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
os Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Available options:" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline else Doc ann
forall ann. Doc ann
emptyDoc
globalSummary :: t a -> Doc ann
globalSummary t a
os = if t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
os Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Doc ann
forall ann. Doc ann
softline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"[GLOBAL OPTIONS]" else Doc ann
forall ann. Doc ann
emptyDoc
globalHeading :: t a -> Doc ann
globalHeading t a
os =
if t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
os Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Global options:" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline
else Doc ann
forall ann. Doc ann
emptyDoc
localSummary :: t a -> Doc ann
localSummary t a
os = if t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
os Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Doc ann
forall ann. Doc ann
softline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"[LOCAL OPTIONS]" else Doc ann
forall ann. Doc ann
emptyDoc
localHeading :: t a -> Doc ann
localHeading t a
os =
if t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
os Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Options to the '" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
commandName Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"' command:" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline
else Doc ann
forall ann. Doc ann
emptyDoc
commandName :: Doc ann
commandName :: Doc ann
commandName = case Maybe LongName
mode of
Just (LongName String
name) -> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
Maybe LongName
Nothing -> Doc ann
"COMMAND..."
argumentsSummary :: [Options] -> Doc ann
argumentsSummary :: [Options] -> Doc ann
argumentsSummary [Options]
as = Doc ann
" " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep ((LongName -> Doc ann) -> [LongName] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\LongName
x -> Doc ann
"<" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> LongName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty LongName
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
">") ([Options] -> [LongName]
extractRequiredArguments [Options]
as))
argumentsHeading :: t a -> Doc ann
argumentsHeading t a
as = if t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
as Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Required arguments:" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline else Doc ann
forall ann. Doc ann
emptyDoc
variablesHeading :: t a -> Doc ann
variablesHeading t a
vs = if t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
vs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Known environment variables:" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline else Doc ann
forall ann. Doc ann
emptyDoc
remainingSummary :: [Options] -> Doc ann
remainingSummary :: [Options] -> Doc ann
remainingSummary [Options]
as = if [Options] -> Bool
hasRemaining [Options]
as then Doc ann
" ..." else Doc ann
forall ann. Doc ann
emptyDoc
commandSummary :: t a -> Doc ann
commandSummary t a
modes = if t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
modes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Doc ann
forall ann. Doc ann
softline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
commandName else Doc ann
forall ann. Doc ann
emptyDoc
commandHeading :: t a -> Doc ann
commandHeading t a
modes = if t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
modes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Available commands:" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline else Doc ann
forall ann. Doc ann
emptyDoc
f :: ([Options], [Options], [Options]) -> Options -> ([Options], [Options], [Options])
f :: ([Options], [Options], [Options])
-> Options -> ([Options], [Options], [Options])
f ([Options]
opts, [Options]
args, [Options]
vars) o :: Options
o@(Option LongName
_ Maybe ShortName
_ ParameterValue
_ Rope
_) = (Options
o Options -> [Options] -> [Options]
forall a. a -> [a] -> [a]
: [Options]
opts, [Options]
args, [Options]
vars)
f ([Options]
opts, [Options]
args, [Options]
vars) a :: Options
a@(Argument LongName
_ Rope
_) = ([Options]
opts, Options
a Options -> [Options] -> [Options]
forall a. a -> [a] -> [a]
: [Options]
args, [Options]
vars)
f ([Options]
opts, [Options]
args, [Options]
vars) a :: Options
a@(Remaining Rope
_) = ([Options]
opts, Options
a Options -> [Options] -> [Options]
forall a. a -> [a] -> [a]
: [Options]
args, [Options]
vars)
f ([Options]
opts, [Options]
args, [Options]
vars) v :: Options
v@(Variable LongName
_ Rope
_) = ([Options]
opts, [Options]
args, Options
v Options -> [Options] -> [Options]
forall a. a -> [a] -> [a]
: [Options]
vars)
formatParameters :: [Options] -> Doc ann
formatParameters :: [Options] -> Doc ann
formatParameters [] = Doc ann
forall ann. Doc ann
emptyDoc
formatParameters [Options]
options = Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (Doc ann -> Options -> Doc ann) -> Doc ann -> [Options] -> Doc ann
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Doc ann -> Options -> Doc ann
forall ann. Doc ann -> Options -> Doc ann
g Doc ann
forall ann. Doc ann
emptyDoc [Options]
options
g :: Doc ann -> Options -> Doc ann
g :: Doc ann -> Options -> Doc ann
g Doc ann
acc (Option LongName
longname Maybe ShortName
shortname ParameterValue
valued Rope
description) =
let s :: Doc ann
s = case Maybe ShortName
shortname of
Just ShortName
shortchar -> Doc ann
" -" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ShortName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ShortName
shortchar Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", --"
Maybe ShortName
Nothing -> Doc ann
" --"
l :: Doc ann
l = LongName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty LongName
longname
d :: Text
d = Rope -> Text
forall α. Textual α => Rope -> α
fromRope Rope
description
in case ParameterValue
valued of
ParameterValue
Empty ->
Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
fillBreak Int
16 (Doc ann
forall ann. Doc ann
s Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" ") Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Text -> Doc ann
forall ann. Text -> Doc ann
reflow Text
d) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
acc
Value String
label ->
Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
fillBreak Int
16 (Doc ann
forall ann. Doc ann
s Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"=<" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
label Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"> ") Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Text -> Doc ann
forall ann. Text -> Doc ann
reflow Text
d) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
acc
g Doc ann
acc (Argument LongName
longname Rope
description) =
let l :: Doc ann
l = LongName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty LongName
longname
d :: Text
d = Rope -> Text
forall α. Textual α => Rope -> α
fromRope Rope
description
in Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
fillBreak Int
16 (Doc ann
" <" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"> ") Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Text -> Doc ann
forall ann. Text -> Doc ann
reflow Text
d) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
acc
g Doc ann
acc (Remaining Rope
description) =
let d :: Text
d = Rope -> Text
forall α. Textual α => Rope -> α
fromRope Rope
description
in Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
fillBreak Int
16 (Doc ann
" " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"... ") Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Text -> Doc ann
forall ann. Text -> Doc ann
reflow Text
d) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
acc
g Doc ann
acc (Variable LongName
longname Rope
description) =
let l :: Doc ann
l = LongName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty LongName
longname
d :: Text
d = Rope -> Text
forall α. Textual α => Rope -> α
fromRope Rope
description
in Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
fillBreak Int
16 (Doc ann
" " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" ") Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Text -> Doc ann
forall ann. Text -> Doc ann
reflow Text
d) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
acc
formatCommands :: [Commands] -> Doc ann
formatCommands :: [Commands] -> Doc ann
formatCommands [Commands]
commands = Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (Doc ann -> Commands -> Doc ann)
-> Doc ann -> [Commands] -> Doc ann
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Doc ann -> Commands -> Doc ann
forall ann. Doc ann -> Commands -> Doc ann
h Doc ann
forall ann. Doc ann
emptyDoc [Commands]
commands
h :: Doc ann -> Commands -> Doc ann
h :: Doc ann -> Commands -> Doc ann
h Doc ann
acc (Command LongName
longname Rope
description [Options]
_) =
let l :: Doc ann
l = LongName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty LongName
longname
d :: Text
d = Rope -> Text
forall α. Textual α => Rope -> α
fromRope Rope
description
in Doc ann
acc Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
fillBreak Int
16 (Doc ann
" " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" ") Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Text -> Doc ann
forall ann. Text -> Doc ann
reflow Text
d) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline
h Doc ann
acc Commands
_ = Doc ann
acc
buildVersion :: Version -> Doc ann
buildVersion :: Version -> Doc ann
buildVersion Version
version =
String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Version -> String
projectNameFrom Version
version)
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"v"
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Version -> String
versionNumberFrom Version
version)
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline