module Options
(
Options (..),
defaultOptions,
simpleOption,
DefineOptions,
SimpleOptionType (..),
Subcommand,
subcommand,
runCommand,
runSubcommand,
Parsed,
parsedError,
parsedHelp,
ParsedOptions,
parsedOptions,
parsedArguments,
parseOptions,
ParsedSubcommand,
parsedSubcommand,
parseSubcommand,
OptionType,
defineOption,
Option,
optionShortFlags,
optionLongFlags,
optionDefault,
optionDescription,
optionGroup,
Group,
group,
groupName,
groupTitle,
groupDescription,
optionType_bool,
optionType_string,
optionType_int,
optionType_int8,
optionType_int16,
optionType_int32,
optionType_int64,
optionType_word,
optionType_word8,
optionType_word16,
optionType_word32,
optionType_word64,
optionType_integer,
optionType_float,
optionType_double,
optionType_maybe,
optionType_list,
optionType_set,
optionType_map,
optionType_enum,
optionType,
optionTypeName,
optionTypeDefault,
optionTypeParse,
optionTypeShow,
optionTypeUnary,
optionTypeMerge,
)
where
import Control.Monad (forM_)
import Control.Monad.Except (ExceptT, runExceptT, throwError)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Functor.Identity
import Data.Int
import Data.List (intercalate)
import Data.Map qualified as Map
import Data.Maybe (isJust)
import Data.Set qualified as Set
import Data.Word
import Options.Help
import Options.Tokenize
import Options.Types
import Options.Util (mapEither)
import System.Environment qualified
import System.Exit (exitFailure, exitSuccess)
import System.IO (hPutStr, hPutStrLn, stderr, stdout)
class Options opts where
defineOptions :: DefineOptions opts
data DefineOptions a
= DefineOptions
a
(Integer -> (Integer, [OptionInfo]))
(Integer -> Map.Map OptionKey [Token] -> Either String (Integer, a))
instance Functor DefineOptions where
fmap :: forall a b. (a -> b) -> DefineOptions a -> DefineOptions b
fmap a -> b
fn (DefineOptions a
defaultValue Integer -> (Integer, [OptionInfo])
getInfo Integer -> Map OptionKey [Token] -> Either String (Integer, a)
parse) =
forall a.
a
-> (Integer -> (Integer, [OptionInfo]))
-> (Integer -> Map OptionKey [Token] -> Either String (Integer, a))
-> DefineOptions a
DefineOptions
(a -> b
fn a
defaultValue)
Integer -> (Integer, [OptionInfo])
getInfo
( \Integer
key Map OptionKey [Token]
tokens -> case Integer -> Map OptionKey [Token] -> Either String (Integer, a)
parse Integer
key Map OptionKey [Token]
tokens of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right (Integer
key', a
a) -> forall a b. b -> Either a b
Right (Integer
key', a -> b
fn a
a)
)
instance Applicative DefineOptions where
pure :: forall a. a -> DefineOptions a
pure a
a = forall a.
a
-> (Integer -> (Integer, [OptionInfo]))
-> (Integer -> Map OptionKey [Token] -> Either String (Integer, a))
-> DefineOptions a
DefineOptions a
a (\Integer
key -> (Integer
key, [])) (\Integer
key Map OptionKey [Token]
_ -> forall a b. b -> Either a b
Right (Integer
key, a
a))
(DefineOptions a -> b
acc_default Integer -> (Integer, [OptionInfo])
acc_getInfo Integer -> Map OptionKey [Token] -> Either String (Integer, a -> b)
acc_parse) <*> :: forall a b.
DefineOptions (a -> b) -> DefineOptions a -> DefineOptions b
<*> (DefineOptions a
defaultValue Integer -> (Integer, [OptionInfo])
getInfo Integer -> Map OptionKey [Token] -> Either String (Integer, a)
parse) =
forall a.
a
-> (Integer -> (Integer, [OptionInfo]))
-> (Integer -> Map OptionKey [Token] -> Either String (Integer, a))
-> DefineOptions a
DefineOptions
(a -> b
acc_default a
defaultValue)
( \Integer
key -> case Integer -> (Integer, [OptionInfo])
acc_getInfo Integer
key of
(Integer
key', [OptionInfo]
infos) -> case Integer -> (Integer, [OptionInfo])
getInfo Integer
key' of
(Integer
key'', [OptionInfo]
infos') -> (Integer
key'', [OptionInfo]
infos forall a. [a] -> [a] -> [a]
++ [OptionInfo]
infos')
)
( \Integer
key Map OptionKey [Token]
tokens -> case Integer -> Map OptionKey [Token] -> Either String (Integer, a -> b)
acc_parse Integer
key Map OptionKey [Token]
tokens of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right (Integer
key', a -> b
fn) -> case Integer -> Map OptionKey [Token] -> Either String (Integer, a)
parse Integer
key' Map OptionKey [Token]
tokens of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right (Integer
key'', a
a) -> forall a b. b -> Either a b
Right (Integer
key'', a -> b
fn a
a)
)
defaultOptions :: Options opts => opts
defaultOptions :: forall opts. Options opts => opts
defaultOptions = case forall opts. Options opts => DefineOptions opts
defineOptions of
(DefineOptions opts
def Integer -> (Integer, [OptionInfo])
_ Integer -> Map OptionKey [Token] -> Either String (Integer, opts)
_) -> opts
def
data OptionType val = OptionType
{
forall val. OptionType val -> String
optionTypeName :: String,
forall val. OptionType val -> val
optionTypeDefault :: val,
forall val. OptionType val -> String -> Either String val
optionTypeParse :: String -> Either String val,
forall val. OptionType val -> val -> String
optionTypeShow :: val -> String,
forall val. OptionType val -> Maybe val
optionTypeUnary :: Maybe val,
forall val. OptionType val -> Maybe ([val] -> val)
optionTypeMerge :: Maybe ([val] -> val)
}
group ::
String ->
String ->
String ->
Group
group :: String -> String -> String -> Group
group = String -> String -> String -> Group
Group
optionType ::
String ->
val ->
(String -> Either String val) ->
(val -> String) ->
OptionType val
optionType :: forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType String
name val
def String -> Either String val
parse val -> String
show' = forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> Maybe val
-> Maybe ([val] -> val)
-> OptionType val
OptionType String
name val
def String -> Either String val
parse val -> String
show' forall a. Maybe a
Nothing forall a. Maybe a
Nothing
class SimpleOptionType a where
simpleOptionType :: OptionType a
instance SimpleOptionType Bool where
simpleOptionType :: OptionType Bool
simpleOptionType = OptionType Bool
optionType_bool
optionType_bool :: OptionType Bool
optionType_bool :: OptionType Bool
optionType_bool =
(forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType String
"bool" Bool
False String -> Either String Bool
parseBool (\Bool
x -> if Bool
x then String
"true" else String
"false"))
{ optionTypeUnary :: Maybe Bool
optionTypeUnary = forall a. a -> Maybe a
Just Bool
True
}
parseBool :: String -> Either String Bool
parseBool :: String -> Either String Bool
parseBool String
s = case String
s of
String
"true" -> forall a b. b -> Either a b
Right Bool
True
String
"false" -> forall a b. b -> Either a b
Right Bool
False
String
_ -> forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show String
s forall a. [a] -> [a] -> [a]
++ String
" is not in {\"true\", \"false\"}.")
instance SimpleOptionType String where
simpleOptionType :: OptionType String
simpleOptionType = OptionType String
optionType_string
optionType_string :: OptionType String
optionType_string :: OptionType String
optionType_string = forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType String
"text" String
"" forall a b. b -> Either a b
Right forall a. Show a => a -> String
show
instance SimpleOptionType Integer where
simpleOptionType :: OptionType Integer
simpleOptionType = OptionType Integer
optionType_integer
optionType_integer :: OptionType Integer
optionType_integer :: OptionType Integer
optionType_integer = forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType String
"integer" Integer
0 String -> Either String Integer
parseInteger forall a. Show a => a -> String
show
parseInteger :: String -> Either String Integer
parseInteger :: String -> Either String Integer
parseInteger String
s = Either String Integer
parsed
where
parsed :: Either String Integer
parsed =
if Bool
valid
then forall a b. b -> Either a b
Right (forall a. Read a => String -> a
read String
s)
else forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show String
s forall a. [a] -> [a] -> [a]
++ String
" is not an integer.")
valid :: Bool
valid = case String
s of
[] -> Bool
False
Char
'-' : String
s' -> String -> Bool
allDigits String
s'
String
_ -> String -> Bool
allDigits String
s
allDigits :: String -> Bool
allDigits = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
c -> Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9')
parseBoundedIntegral :: (Bounded a, Integral a) => String -> String -> Either String a
parseBoundedIntegral :: forall a.
(Bounded a, Integral a) =>
String -> String -> Either String a
parseBoundedIntegral String
label = String -> Either String a
parse
where
getBounds ::
(Bounded a, Integral a) =>
(String -> Either String a) ->
a ->
a ->
(Integer, Integer)
getBounds :: forall a.
(Bounded a, Integral a) =>
(String -> Either String a) -> a -> a -> (Integer, Integer)
getBounds String -> Either String a
_ a
min' a
max' = (forall a. Integral a => a -> Integer
toInteger a
min', forall a. Integral a => a -> Integer
toInteger a
max')
(Integer
minInt, Integer
maxInt) = forall a.
(Bounded a, Integral a) =>
(String -> Either String a) -> a -> a -> (Integer, Integer)
getBounds String -> Either String a
parse forall a. Bounded a => a
minBound forall a. Bounded a => a
maxBound
parse :: String -> Either String a
parse String
s = case String -> Either String Integer
parseInteger String
s of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right Integer
int ->
if Integer
int forall a. Ord a => a -> a -> Bool
< Integer
minInt Bool -> Bool -> Bool
|| Integer
int forall a. Ord a => a -> a -> Bool
> Integer
maxInt
then forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show Integer
int forall a. [a] -> [a] -> [a]
++ String
" is not within bounds [" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
minInt forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
maxInt forall a. [a] -> [a] -> [a]
++ String
"] of type " forall a. [a] -> [a] -> [a]
++ String
label forall a. [a] -> [a] -> [a]
++ String
".")
else forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
int)
optionTypeBoundedInt :: (Bounded a, Integral a, Show a) => String -> OptionType a
optionTypeBoundedInt :: forall a. (Bounded a, Integral a, Show a) => String -> OptionType a
optionTypeBoundedInt String
tName = forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType String
tName a
0 (forall a.
(Bounded a, Integral a) =>
String -> String -> Either String a
parseBoundedIntegral String
tName) forall a. Show a => a -> String
show
instance SimpleOptionType Int where
simpleOptionType :: OptionType Int
simpleOptionType = OptionType Int
optionType_int
optionType_int :: OptionType Int
optionType_int :: OptionType Int
optionType_int = forall a. (Bounded a, Integral a, Show a) => String -> OptionType a
optionTypeBoundedInt String
"int"
instance SimpleOptionType Int8 where
simpleOptionType :: OptionType Int8
simpleOptionType = OptionType Int8
optionType_int8
optionType_int8 :: OptionType Int8
optionType_int8 :: OptionType Int8
optionType_int8 = forall a. (Bounded a, Integral a, Show a) => String -> OptionType a
optionTypeBoundedInt String
"int8"
instance SimpleOptionType Int16 where
simpleOptionType :: OptionType Int16
simpleOptionType = OptionType Int16
optionType_int16
optionType_int16 :: OptionType Int16
optionType_int16 :: OptionType Int16
optionType_int16 = forall a. (Bounded a, Integral a, Show a) => String -> OptionType a
optionTypeBoundedInt String
"int16"
instance SimpleOptionType Int32 where
simpleOptionType :: OptionType Int32
simpleOptionType = OptionType Int32
optionType_int32
optionType_int32 :: OptionType Int32
optionType_int32 :: OptionType Int32
optionType_int32 = forall a. (Bounded a, Integral a, Show a) => String -> OptionType a
optionTypeBoundedInt String
"int32"
instance SimpleOptionType Int64 where
simpleOptionType :: OptionType Int64
simpleOptionType = OptionType Int64
optionType_int64
optionType_int64 :: OptionType Int64
optionType_int64 :: OptionType Int64
optionType_int64 = forall a. (Bounded a, Integral a, Show a) => String -> OptionType a
optionTypeBoundedInt String
"int64"
instance SimpleOptionType Word where
simpleOptionType :: OptionType Word
simpleOptionType = OptionType Word
optionType_word
optionType_word :: OptionType Word
optionType_word :: OptionType Word
optionType_word = forall a. (Bounded a, Integral a, Show a) => String -> OptionType a
optionTypeBoundedInt String
"uint"
instance SimpleOptionType Word8 where
simpleOptionType :: OptionType Word8
simpleOptionType = OptionType Word8
optionType_word8
optionType_word8 :: OptionType Word8
optionType_word8 :: OptionType Word8
optionType_word8 = forall a. (Bounded a, Integral a, Show a) => String -> OptionType a
optionTypeBoundedInt String
"uint8"
instance SimpleOptionType Word16 where
simpleOptionType :: OptionType Word16
simpleOptionType = OptionType Word16
optionType_word16
optionType_word16 :: OptionType Word16
optionType_word16 :: OptionType Word16
optionType_word16 = forall a. (Bounded a, Integral a, Show a) => String -> OptionType a
optionTypeBoundedInt String
"uint16"
instance SimpleOptionType Word32 where
simpleOptionType :: OptionType Word32
simpleOptionType = OptionType Word32
optionType_word32
optionType_word32 :: OptionType Word32
optionType_word32 :: OptionType Word32
optionType_word32 = forall a. (Bounded a, Integral a, Show a) => String -> OptionType a
optionTypeBoundedInt String
"uint32"
instance SimpleOptionType Word64 where
simpleOptionType :: OptionType Word64
simpleOptionType = OptionType Word64
optionType_word64
optionType_word64 :: OptionType Word64
optionType_word64 :: OptionType Word64
optionType_word64 = forall a. (Bounded a, Integral a, Show a) => String -> OptionType a
optionTypeBoundedInt String
"uint64"
instance SimpleOptionType Float where
simpleOptionType :: OptionType Float
simpleOptionType = OptionType Float
optionType_float
optionType_float :: OptionType Float
optionType_float :: OptionType Float
optionType_float = forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType String
"float32" Float
0 forall a. Read a => String -> Either String a
parseFloat forall a. Show a => a -> String
show
instance SimpleOptionType Double where
simpleOptionType :: OptionType Double
simpleOptionType = OptionType Double
optionType_double
optionType_double :: OptionType Double
optionType_double :: OptionType Double
optionType_double = forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType String
"float64" Double
0 forall a. Read a => String -> Either String a
parseFloat forall a. Show a => a -> String
show
parseFloat :: Read a => String -> Either String a
parseFloat :: forall a. Read a => String -> Either String a
parseFloat String
s = case forall a. Read a => ReadS a
reads String
s of
[(a
x, String
"")] -> forall a b. b -> Either a b
Right a
x
[(a, String)]
_ -> forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show String
s forall a. [a] -> [a] -> [a]
++ String
" is not a number.")
instance SimpleOptionType a => SimpleOptionType (Maybe a) where
simpleOptionType :: OptionType (Maybe a)
simpleOptionType = forall a. OptionType a -> OptionType (Maybe a)
optionType_maybe forall a. SimpleOptionType a => OptionType a
simpleOptionType
optionType_maybe :: OptionType a -> OptionType (Maybe a)
optionType_maybe :: forall a. OptionType a -> OptionType (Maybe a)
optionType_maybe OptionType a
t = OptionType (Maybe a)
maybeT {optionTypeUnary :: Maybe (Maybe a)
optionTypeUnary = Maybe (Maybe a)
unary}
where
maybeT :: OptionType (Maybe a)
maybeT = forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType String
name forall a. Maybe a
Nothing (forall val. OptionType val -> String -> Either String (Maybe val)
parseMaybe OptionType a
t) (forall val. OptionType val -> Maybe val -> String
showMaybe OptionType a
t)
name :: String
name = String
"maybe<" forall a. [a] -> [a] -> [a]
++ forall val. OptionType val -> String
optionTypeName OptionType a
t forall a. [a] -> [a] -> [a]
++ String
">"
unary :: Maybe (Maybe a)
unary = case forall val. OptionType val -> Maybe val
optionTypeUnary OptionType a
t of
Maybe a
Nothing -> forall a. Maybe a
Nothing
Just a
val -> forall a. a -> Maybe a
Just (forall a. a -> Maybe a
Just a
val)
parseMaybe :: OptionType val -> String -> Either String (Maybe val)
parseMaybe :: forall val. OptionType val -> String -> Either String (Maybe val)
parseMaybe OptionType val
t String
s = case String
s of
String
"" -> forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
String
_ -> case forall val. OptionType val -> String -> Either String val
optionTypeParse OptionType val
t String
s of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right val
a -> forall a b. b -> Either a b
Right (forall a. a -> Maybe a
Just val
a)
showMaybe :: OptionType val -> Maybe val -> String
showMaybe :: forall val. OptionType val -> Maybe val -> String
showMaybe OptionType val
_ Maybe val
Nothing = String
""
showMaybe OptionType val
t (Just val
x) = forall val. OptionType val -> val -> String
optionTypeShow OptionType val
t val
x
optionType_set ::
Ord a =>
Char ->
OptionType a ->
OptionType (Set.Set a)
optionType_set :: forall a. Ord a => Char -> OptionType a -> OptionType (Set a)
optionType_set Char
sep OptionType a
t = forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType String
name forall a. Set a
Set.empty String -> Either String (Set a)
parseSet Set a -> String
showSet
where
name :: String
name = String
"set<" forall a. [a] -> [a] -> [a]
++ forall val. OptionType val -> String
optionTypeName OptionType a
t forall a. [a] -> [a] -> [a]
++ String
">"
parseSet :: String -> Either String (Set a)
parseSet String
s = case forall a.
(String -> Either String a) -> [String] -> Either String [a]
parseList (forall val. OptionType val -> String -> Either String val
optionTypeParse OptionType a
t) (Char -> String -> [String]
split Char
sep String
s) of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right [a]
xs -> forall a b. b -> Either a b
Right (forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs)
showSet :: Set a -> String
showSet Set a
xs = forall a. [a] -> [[a]] -> [a]
intercalate [Char
sep] (forall a b. (a -> b) -> [a] -> [b]
map (forall val. OptionType val -> val -> String
optionTypeShow OptionType a
t) (forall a. Set a -> [a]
Set.toList Set a
xs))
optionType_map ::
Ord k =>
Char ->
Char ->
OptionType k ->
OptionType v ->
OptionType (Map.Map k v)
optionType_map :: forall k v.
Ord k =>
Char
-> Char -> OptionType k -> OptionType v -> OptionType (Map k v)
optionType_map Char
itemSep Char
keySep OptionType k
kt OptionType v
vt = forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType String
name forall k a. Map k a
Map.empty String -> Either String (Map k v)
parser Map k v -> String
showMap
where
name :: String
name = String
"map<" forall a. [a] -> [a] -> [a]
++ forall val. OptionType val -> String
optionTypeName OptionType k
kt forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall val. OptionType val -> String
optionTypeName OptionType v
vt forall a. [a] -> [a] -> [a]
++ String
">"
parser :: String -> Either String (Map k v)
parser String
s = forall k v.
Ord k =>
Char
-> (String -> Either String k)
-> (String -> Either String v)
-> [String]
-> Either String (Map k v)
parseMap Char
keySep (forall val. OptionType val -> String -> Either String val
optionTypeParse OptionType k
kt) (forall val. OptionType val -> String -> Either String val
optionTypeParse OptionType v
vt) (Char -> String -> [String]
split Char
itemSep String
s)
showMap :: Map k v -> String
showMap Map k v
m = forall a. [a] -> [[a]] -> [a]
intercalate [Char
itemSep] (forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> String
showItem (forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m))
showItem :: (k, v) -> String
showItem (k
k, v
v) = forall val. OptionType val -> val -> String
optionTypeShow OptionType k
kt k
k forall a. [a] -> [a] -> [a]
++ [Char
keySep] forall a. [a] -> [a] -> [a]
++ forall val. OptionType val -> val -> String
optionTypeShow OptionType v
vt v
v
parseList :: (String -> Either String a) -> [String] -> Either String [a]
parseList :: forall a.
(String -> Either String a) -> [String] -> Either String [a]
parseList String -> Either String a
p = [String] -> Either String [a]
loop
where
loop :: [String] -> Either String [a]
loop [] = forall a b. b -> Either a b
Right []
loop (String
x : [String]
xs) = case String -> Either String a
p String
x of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right a
v -> case [String] -> Either String [a]
loop [String]
xs of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right [a]
vs -> forall a b. b -> Either a b
Right (a
v forall a. a -> [a] -> [a]
: [a]
vs)
parseMap ::
Ord k =>
Char ->
(String -> Either String k) ->
(String -> Either String v) ->
[String] ->
Either String (Map.Map k v)
parseMap :: forall k v.
Ord k =>
Char
-> (String -> Either String k)
-> (String -> Either String v)
-> [String]
-> Either String (Map k v)
parseMap Char
keySep String -> Either String k
pKey String -> Either String v
pVal = [String] -> Either String (Map k v)
parsed
where
parsed :: [String] -> Either String (Map k v)
parsed [String]
strs = case forall a.
(String -> Either String a) -> [String] -> Either String [a]
parseList String -> Either String (k, v)
pItem [String]
strs of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right [(k, v)]
xs -> forall a b. b -> Either a b
Right (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(k, v)]
xs)
pItem :: String -> Either String (k, v)
pItem String
s = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
keySep) String
s of
(String
sKey, String
valAndSep) -> case String
valAndSep of
[] -> forall a b. a -> Either a b
Left (String
"Map item " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s forall a. [a] -> [a] -> [a]
++ String
" has no value.")
Char
_ : String
sVal -> case String -> Either String k
pKey String
sKey of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right k
key -> case String -> Either String v
pVal String
sVal of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right v
val -> forall a b. b -> Either a b
Right (k
key, v
val)
split :: Char -> String -> [String]
split :: Char -> String -> [String]
split Char
_ [] = []
split Char
sep String
s0 = String -> [String]
loop String
s0
where
loop :: String -> [String]
loop String
s =
let (String
chunk, String
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
sep) String
s
cont :: [String]
cont = String
chunk forall a. a -> [a] -> [a]
: String -> [String]
loop (forall a. [a] -> [a]
tail String
rest)
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest then [String
chunk] else [String]
cont
optionType_list ::
Char ->
OptionType a ->
OptionType [a]
optionType_list :: forall a. Char -> OptionType a -> OptionType [a]
optionType_list Char
sep OptionType a
t = forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType String
name [] String -> Either String [a]
parser [a] -> String
shower
where
name :: String
name = String
"list<" forall a. [a] -> [a] -> [a]
++ forall val. OptionType val -> String
optionTypeName OptionType a
t forall a. [a] -> [a] -> [a]
++ String
">"
parser :: String -> Either String [a]
parser String
s = forall a.
(String -> Either String a) -> [String] -> Either String [a]
parseList (forall val. OptionType val -> String -> Either String val
optionTypeParse OptionType a
t) (Char -> String -> [String]
split Char
sep String
s)
shower :: [a] -> String
shower [a]
xs = forall a. [a] -> [[a]] -> [a]
intercalate [Char
sep] (forall a b. (a -> b) -> [a] -> [b]
map (forall val. OptionType val -> val -> String
optionTypeShow OptionType a
t) [a]
xs)
optionType_enum ::
(Bounded a, Enum a, Show a) =>
String ->
OptionType a
optionType_enum :: forall a. (Bounded a, Enum a, Show a) => String -> OptionType a
optionType_enum String
tName = forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType String
tName forall a. Bounded a => a
minBound String -> Either String a
parseEnum forall a. Show a => a -> String
show
where
values :: Map String a
values = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(forall a. Show a => a -> String
show a
x, a
x) | a
x <- forall a. Enum a => a -> [a]
enumFrom forall a. Bounded a => a
minBound]
setString :: String
setString = String
"{" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show (forall k a. Map k a -> [k]
Map.keys Map String a
values)) forall a. [a] -> [a] -> [a]
++ String
"}"
parseEnum :: String -> Either String a
parseEnum String
s = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
s Map String a
values of
Maybe a
Nothing -> forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show String
s forall a. [a] -> [a] -> [a]
++ String
" is not in " forall a. [a] -> [a] -> [a]
++ String
setString forall a. [a] -> [a] -> [a]
++ String
".")
Just a
x -> forall a b. b -> Either a b
Right a
x
simpleOption ::
SimpleOptionType a =>
String ->
a ->
String ->
DefineOptions a
simpleOption :: forall a.
SimpleOptionType a =>
String -> a -> String -> DefineOptions a
simpleOption String
flag a
def String
desc =
forall a. OptionType a -> (Option a -> Option a) -> DefineOptions a
defineOption
forall a. SimpleOptionType a => OptionType a
simpleOptionType
( \Option a
o ->
Option a
o
{ optionLongFlags :: [String]
optionLongFlags = [String
flag],
optionDefault :: a
optionDefault = a
def,
optionDescription :: String
optionDescription = String
desc
}
)
defineOption :: OptionType a -> (Option a -> Option a) -> DefineOptions a
defineOption :: forall a. OptionType a -> (Option a -> Option a) -> DefineOptions a
defineOption OptionType a
t Option a -> Option a
fn = forall a.
a
-> (Integer -> (Integer, [OptionInfo]))
-> (Integer -> Map OptionKey [Token] -> Either String (Integer, a))
-> DefineOptions a
DefineOptions (forall a. Option a -> a
optionDefault Option a
opt) Integer -> (Integer, [OptionInfo])
getInfo Integer -> Map OptionKey [Token] -> Either String (Integer, a)
parser
where
opt :: Option a
opt =
Option a -> Option a
fn
( Option
{ optionShortFlags :: String
optionShortFlags = [],
optionLongFlags :: [String]
optionLongFlags = [],
optionDefault :: a
optionDefault = forall val. OptionType val -> val
optionTypeDefault OptionType a
t,
optionDescription :: String
optionDescription = String
"",
optionGroup :: Maybe Group
optionGroup = forall a. Maybe a
Nothing,
optionLocation :: Maybe Location
optionLocation = forall a. Maybe a
Nothing
}
)
getInfo :: Integer -> (Integer, [OptionInfo])
getInfo Integer
key =
( Integer
key forall a. Num a => a -> a -> a
+ Integer
1,
[ OptionInfo
{ optionInfoKey :: OptionKey
optionInfoKey = Integer -> OptionKey
OptionKeyGenerated Integer
key,
optionInfoShortFlags :: String
optionInfoShortFlags = forall a. Option a -> String
optionShortFlags Option a
opt,
optionInfoLongFlags :: [String]
optionInfoLongFlags = forall a. Option a -> [String]
optionLongFlags Option a
opt,
optionInfoDefault :: String
optionInfoDefault = forall val. OptionType val -> val -> String
optionTypeShow OptionType a
t (forall a. Option a -> a
optionDefault Option a
opt),
optionInfoDescription :: String
optionInfoDescription = forall a. Option a -> String
optionDescription Option a
opt,
optionInfoGroup :: Maybe Group
optionInfoGroup = forall a. Option a -> Maybe Group
optionGroup Option a
opt,
optionInfoLocation :: Maybe Location
optionInfoLocation = forall a. Option a -> Maybe Location
optionLocation Option a
opt,
optionInfoTypeName :: String
optionInfoTypeName = forall val. OptionType val -> String
optionTypeName OptionType a
t,
optionInfoUnary :: Bool
optionInfoUnary = forall a. Maybe a -> Bool
isJust (forall val. OptionType val -> Maybe val
optionTypeUnary OptionType a
t),
optionInfoUnaryOnly :: Bool
optionInfoUnaryOnly = Bool
False
}
]
)
parseToken :: Token -> Either String a
parseToken Token
tok = case Token
tok of
TokenUnary String
flagName -> case forall val. OptionType val -> Maybe val
optionTypeUnary OptionType a
t of
Maybe a
Nothing -> forall a b. a -> Either a b
Left (String
"The flag " forall a. [a] -> [a] -> [a]
++ String
flagName forall a. [a] -> [a] -> [a]
++ String
" requires an argument.")
Just a
val -> forall a b. b -> Either a b
Right a
val
Token String
flagName String
rawValue -> case forall val. OptionType val -> String -> Either String val
optionTypeParse OptionType a
t String
rawValue of
Left String
err -> forall a b. a -> Either a b
Left (String
"Value for flag " forall a. [a] -> [a] -> [a]
++ String
flagName forall a. [a] -> [a] -> [a]
++ String
" is invalid: " forall a. [a] -> [a] -> [a]
++ String
err)
Right a
val -> forall a b. b -> Either a b
Right a
val
parser :: Integer -> Map OptionKey [Token] -> Either String (Integer, a)
parser Integer
key Map OptionKey [Token]
tokens = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Integer -> OptionKey
OptionKeyGenerated Integer
key) Map OptionKey [Token]
tokens of
Maybe [Token]
Nothing -> forall a b. b -> Either a b
Right (Integer
key forall a. Num a => a -> a -> a
+ Integer
1, forall a. Option a -> a
optionDefault Option a
opt)
Just [Token]
toks -> case [Token]
toks of
[] -> forall a b. b -> Either a b
Right (Integer
key forall a. Num a => a -> a -> a
+ Integer
1, forall a. Option a -> a
optionDefault Option a
opt)
[Token
tok] -> case Token -> Either String a
parseToken Token
tok of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right a
val -> forall a b. b -> Either a b
Right (Integer
key forall a. Num a => a -> a -> a
+ Integer
1, a
val)
[Token]
_ -> case forall val. OptionType val -> Maybe ([val] -> val)
optionTypeMerge OptionType a
t of
Maybe ([a] -> a)
Nothing -> forall a b. a -> Either a b
Left (String
"Multiple values for flag: " forall a. [a] -> [a] -> [a]
++ [Token] -> String
showMultipleFlagValues [Token]
toks)
Just [a] -> a
appendFn -> case forall a err b. (a -> Either err b) -> [a] -> Either err [b]
mapEither Token -> Either String a
parseToken [Token]
toks of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right [a]
vals -> forall a b. b -> Either a b
Right (Integer
key forall a. Num a => a -> a -> a
+ Integer
1, [a] -> a
appendFn [a]
vals)
showMultipleFlagValues :: [Token] -> String
showMultipleFlagValues :: [Token] -> String
showMultipleFlagValues = forall a. [a] -> [[a]] -> [a]
intercalate String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Token -> String
showToken
where
showToken :: Token -> String
showToken (TokenUnary String
flagName) = String
flagName
showToken (Token String
flagName String
rawValue) = forall a. Show a => a -> String
show (String
flagName forall a. [a] -> [a] -> [a]
++ String
"=" forall a. [a] -> [a] -> [a]
++ String
rawValue)
data Option a = Option
{
forall a. Option a -> String
optionShortFlags :: [Char],
forall a. Option a -> [String]
optionLongFlags :: [String],
forall a. Option a -> a
optionDefault :: a,
forall a. Option a -> String
optionDescription :: String,
forall a. Option a -> Maybe Group
optionGroup :: Maybe Group,
forall a. Option a -> Maybe Location
optionLocation :: Maybe Location
}
validateOptionDefs :: [OptionInfo] -> [(String, [OptionInfo])] -> Either String OptionDefinitions
validateOptionDefs :: [OptionInfo]
-> [(String, [OptionInfo])] -> Either String OptionDefinitions
validateOptionDefs [OptionInfo]
cmdInfos [(String, [OptionInfo])]
subInfos = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
let subcmdNames :: [String]
subcmdNames = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, [OptionInfo])]
subInfos
if forall a. Set a -> Int
Set.size (forall a. Ord a => [a] -> Set a
Set.fromList [String]
subcmdNames) forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
subcmdNames
then
forall (m :: * -> *) a. MonadError m => ErrorType m -> m a
throwError String
"Multiple subcommands exist with the same name."
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
let allOptInfos :: [OptionInfo]
allOptInfos = [OptionInfo]
cmdInfos forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[OptionInfo]
infos | (String
_, [OptionInfo]
infos) <- [(String, [OptionInfo])]
subInfos]
case forall a err b. (a -> Either err b) -> [a] -> Either err [b]
mapEither OptionInfo -> Either String ()
optValidFlags [OptionInfo]
allOptInfos of
Left String
err -> forall (m :: * -> *) a. MonadError m => ErrorType m -> m a
throwError String
err
Right [()]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Map DeDupFlag OptionInfo
cmdDeDupedFlags <- Map DeDupFlag OptionInfo
-> [OptionInfo]
-> ExceptT String Identity (Map DeDupFlag OptionInfo)
checkNoDuplicateFlags forall k a. Map k a
Map.empty [OptionInfo]
cmdInfos
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, [OptionInfo])]
subInfos (\(String, [OptionInfo])
subInfo -> Map DeDupFlag OptionInfo
-> [OptionInfo]
-> ExceptT String Identity (Map DeDupFlag OptionInfo)
checkNoDuplicateFlags Map DeDupFlag OptionInfo
cmdDeDupedFlags (forall a b. (a, b) -> b
snd (String, [OptionInfo])
subInfo))
forall (m :: * -> *) a. Monad m => a -> m a
return (OptionDefinitions -> OptionDefinitions
addHelpFlags ([OptionInfo] -> [(String, [OptionInfo])] -> OptionDefinitions
OptionDefinitions [OptionInfo]
cmdInfos [(String, [OptionInfo])]
subInfos))
optValidFlags :: OptionInfo -> Either String ()
optValidFlags :: OptionInfo -> Either String ()
optValidFlags OptionInfo
info =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (OptionInfo -> String
optionInfoShortFlags OptionInfo
info) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (OptionInfo -> [String]
optionInfoLongFlags OptionInfo
info)
then case OptionInfo -> Maybe Location
optionInfoLocation OptionInfo
info of
Maybe Location
Nothing -> forall a b. a -> Either a b
Left (String
"Option with description " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (OptionInfo -> String
optionInfoDescription OptionInfo
info) forall a. [a] -> [a] -> [a]
++ String
" has no flags.")
Just Location
loc -> forall a b. a -> Either a b
Left (String
"Option with description " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (OptionInfo -> String
optionInfoDescription OptionInfo
info) forall a. [a] -> [a] -> [a]
++ String
" at " forall a. [a] -> [a] -> [a]
++ Location -> String
locationFilename Location
loc forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Location -> Integer
locationLine Location
loc) forall a. [a] -> [a] -> [a]
++ String
" has no flags.")
else
forall a b. b -> Either a b
Right ()
data DeDupFlag = DeDupShort Char | DeDupLong String
deriving (DeDupFlag -> DeDupFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeDupFlag -> DeDupFlag -> Bool
$c/= :: DeDupFlag -> DeDupFlag -> Bool
== :: DeDupFlag -> DeDupFlag -> Bool
$c== :: DeDupFlag -> DeDupFlag -> Bool
Eq, Eq DeDupFlag
DeDupFlag -> DeDupFlag -> Bool
DeDupFlag -> DeDupFlag -> Ordering
DeDupFlag -> DeDupFlag -> DeDupFlag
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 :: DeDupFlag -> DeDupFlag -> DeDupFlag
$cmin :: DeDupFlag -> DeDupFlag -> DeDupFlag
max :: DeDupFlag -> DeDupFlag -> DeDupFlag
$cmax :: DeDupFlag -> DeDupFlag -> DeDupFlag
>= :: DeDupFlag -> DeDupFlag -> Bool
$c>= :: DeDupFlag -> DeDupFlag -> Bool
> :: DeDupFlag -> DeDupFlag -> Bool
$c> :: DeDupFlag -> DeDupFlag -> Bool
<= :: DeDupFlag -> DeDupFlag -> Bool
$c<= :: DeDupFlag -> DeDupFlag -> Bool
< :: DeDupFlag -> DeDupFlag -> Bool
$c< :: DeDupFlag -> DeDupFlag -> Bool
compare :: DeDupFlag -> DeDupFlag -> Ordering
$ccompare :: DeDupFlag -> DeDupFlag -> Ordering
Ord, Int -> DeDupFlag -> ShowS
[DeDupFlag] -> ShowS
DeDupFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeDupFlag] -> ShowS
$cshowList :: [DeDupFlag] -> ShowS
show :: DeDupFlag -> String
$cshow :: DeDupFlag -> String
showsPrec :: Int -> DeDupFlag -> ShowS
$cshowsPrec :: Int -> DeDupFlag -> ShowS
Show)
checkNoDuplicateFlags :: Map.Map DeDupFlag OptionInfo -> [OptionInfo] -> ExceptT String Identity (Map.Map DeDupFlag OptionInfo)
checkNoDuplicateFlags :: Map DeDupFlag OptionInfo
-> [OptionInfo]
-> ExceptT String Identity (Map DeDupFlag OptionInfo)
checkNoDuplicateFlags Map DeDupFlag OptionInfo
checked [] = forall (m :: * -> *) a. Monad m => a -> m a
return Map DeDupFlag OptionInfo
checked
checkNoDuplicateFlags Map DeDupFlag OptionInfo
checked (OptionInfo
info : [OptionInfo]
infos) = do
let mappedShort :: [DeDupFlag]
mappedShort = forall a b. (a -> b) -> [a] -> [b]
map Char -> DeDupFlag
DeDupShort (OptionInfo -> String
optionInfoShortFlags OptionInfo
info)
let mappedLong :: [DeDupFlag]
mappedLong = forall a b. (a -> b) -> [a] -> [b]
map String -> DeDupFlag
DeDupLong (OptionInfo -> [String]
optionInfoLongFlags OptionInfo
info)
let mappedFlags :: [DeDupFlag]
mappedFlags = [DeDupFlag]
mappedShort forall a. [a] -> [a] -> [a]
++ [DeDupFlag]
mappedLong
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DeDupFlag]
mappedFlags \DeDupFlag
mapKey -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DeDupFlag
mapKey Map DeDupFlag OptionInfo
checked of
Maybe OptionInfo
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just OptionInfo
prevInfo ->
if OptionInfo -> OptionInfo -> Bool
eqIgnoringKey OptionInfo
info OptionInfo
prevInfo
then forall (m :: * -> *) a. Monad m => a -> m a
return ()
else
let flagName :: String
flagName = case DeDupFlag
mapKey of
DeDupShort Char
flag -> Char
'-' forall a. a -> [a] -> [a]
: Char
flag forall a. a -> [a] -> [a]
: []
DeDupLong String
long -> String
"--" forall a. [a] -> [a] -> [a]
++ String
long
in forall (m :: * -> *) a. MonadError m => ErrorType m -> m a
throwError (String
"Duplicate option flag " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
flagName forall a. [a] -> [a] -> [a]
++ String
".")
let infoMap :: Map DeDupFlag OptionInfo
infoMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(DeDupFlag
f, OptionInfo
info) | DeDupFlag
f <- [DeDupFlag]
mappedFlags]
Map DeDupFlag OptionInfo
-> [OptionInfo]
-> ExceptT String Identity (Map DeDupFlag OptionInfo)
checkNoDuplicateFlags (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map DeDupFlag OptionInfo
checked Map DeDupFlag OptionInfo
infoMap) [OptionInfo]
infos
eqIgnoringKey :: OptionInfo -> OptionInfo -> Bool
eqIgnoringKey :: OptionInfo -> OptionInfo -> Bool
eqIgnoringKey OptionInfo
x OptionInfo
y = OptionInfo -> OptionInfo
normKey OptionInfo
x forall a. Eq a => a -> a -> Bool
== OptionInfo -> OptionInfo
normKey OptionInfo
y
where
normKey :: OptionInfo -> OptionInfo
normKey OptionInfo
info = OptionInfo
info {optionInfoKey :: OptionKey
optionInfoKey = OptionKey
OptionKeyIgnored}
class Parsed a where
parsedError_ :: a -> Maybe String
parsedHelp_ :: a -> String
data ParsedOptions opts = ParsedOptions (Maybe opts) (Maybe String) String [String]
data ParsedSubcommand action = ParsedSubcommand (Maybe action) (Maybe String) String
instance Parsed (ParsedOptions a) where
parsedError_ :: ParsedOptions a -> Maybe String
parsedError_ (ParsedOptions Maybe a
_ Maybe String
x String
_ [String]
_) = Maybe String
x
parsedHelp_ :: ParsedOptions a -> String
parsedHelp_ (ParsedOptions Maybe a
_ Maybe String
_ String
x [String]
_) = String
x
instance Parsed (ParsedSubcommand a) where
parsedError_ :: ParsedSubcommand a -> Maybe String
parsedError_ (ParsedSubcommand Maybe a
_ Maybe String
x String
_) = Maybe String
x
parsedHelp_ :: ParsedSubcommand a -> String
parsedHelp_ (ParsedSubcommand Maybe a
_ Maybe String
_ String
x) = String
x
parsedOptions :: ParsedOptions opts -> Maybe opts
parsedOptions :: forall opts. ParsedOptions opts -> Maybe opts
parsedOptions (ParsedOptions Maybe opts
x Maybe String
_ String
_ [String]
_) = Maybe opts
x
parsedArguments :: ParsedOptions opts -> [String]
parsedArguments :: forall opts. ParsedOptions opts -> [String]
parsedArguments (ParsedOptions Maybe opts
_ Maybe String
_ String
_ [String]
x) = [String]
x
parsedSubcommand :: ParsedSubcommand action -> Maybe action
parsedSubcommand :: forall action. ParsedSubcommand action -> Maybe action
parsedSubcommand (ParsedSubcommand Maybe action
x Maybe String
_ String
_) = Maybe action
x
parsedError :: Parsed a => a -> Maybe String
parsedError :: forall a. Parsed a => a -> Maybe String
parsedError = forall a. Parsed a => a -> Maybe String
parsedError_
parsedHelp :: Parsed a => a -> String
parsedHelp :: forall a. Parsed a => a -> String
parsedHelp = forall a. Parsed a => a -> String
parsedHelp_
parseOptions :: Options opts => [String] -> ParsedOptions opts
parseOptions :: forall opts. Options opts => [String] -> ParsedOptions opts
parseOptions [String]
argv = ParsedOptions opts
parsed
where
(DefineOptions opts
_ Integer -> (Integer, [OptionInfo])
getInfos Integer -> Map OptionKey [Token] -> Either String (Integer, opts)
parser) = forall opts. Options opts => DefineOptions opts
defineOptions
(Integer
_, [OptionInfo]
optionInfos) = Integer -> (Integer, [OptionInfo])
getInfos Integer
0
parseTokens :: Map OptionKey [Token] -> Either String (Integer, opts)
parseTokens = Integer -> Map OptionKey [Token] -> Either String (Integer, opts)
parser Integer
0
parsed :: ParsedOptions opts
parsed = case [OptionInfo]
-> [(String, [OptionInfo])] -> Either String OptionDefinitions
validateOptionDefs [OptionInfo]
optionInfos [] of
Left String
err -> forall opts.
Maybe opts
-> Maybe String -> String -> [String] -> ParsedOptions opts
ParsedOptions forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
err) String
"" []
Right OptionDefinitions
optionDefs -> case OptionDefinitions
-> [String] -> (Maybe String, Either String Tokens)
tokenize (OptionDefinitions -> OptionDefinitions
addHelpFlags OptionDefinitions
optionDefs) [String]
argv of
(Maybe String
_, Left String
err) -> forall opts.
Maybe opts
-> Maybe String -> String -> [String] -> ParsedOptions opts
ParsedOptions forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
err) (HelpFlag -> OptionDefinitions -> Maybe String -> String
helpFor HelpFlag
HelpSummary OptionDefinitions
optionDefs forall a. Maybe a
Nothing) []
(Maybe String
_, Right Tokens
tokens) -> case Tokens -> Maybe HelpFlag
checkHelpFlag Tokens
tokens of
Just HelpFlag
helpFlag -> forall opts.
Maybe opts
-> Maybe String -> String -> [String] -> ParsedOptions opts
ParsedOptions forall a. Maybe a
Nothing forall a. Maybe a
Nothing (HelpFlag -> OptionDefinitions -> Maybe String -> String
helpFor HelpFlag
helpFlag OptionDefinitions
optionDefs forall a. Maybe a
Nothing) []
Maybe HelpFlag
Nothing -> case Map OptionKey [Token] -> Either String (Integer, opts)
parseTokens (Tokens -> Map OptionKey [Token]
tokensMap Tokens
tokens) of
Left String
err -> forall opts.
Maybe opts
-> Maybe String -> String -> [String] -> ParsedOptions opts
ParsedOptions forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
err) (HelpFlag -> OptionDefinitions -> Maybe String -> String
helpFor HelpFlag
HelpSummary OptionDefinitions
optionDefs forall a. Maybe a
Nothing) []
Right (Integer
_, opts
opts) -> forall opts.
Maybe opts
-> Maybe String -> String -> [String] -> ParsedOptions opts
ParsedOptions (forall a. a -> Maybe a
Just opts
opts) forall a. Maybe a
Nothing (HelpFlag -> OptionDefinitions -> Maybe String -> String
helpFor HelpFlag
HelpSummary OptionDefinitions
optionDefs forall a. Maybe a
Nothing) (Tokens -> [String]
tokensArgv Tokens
tokens)
runCommand :: (MonadIO m, Options opts) => (opts -> [String] -> m a) -> m a
runCommand :: forall (m :: * -> *) opts a.
(MonadIO m, Options opts) =>
(opts -> [String] -> m a) -> m a
runCommand opts -> [String] -> m a
io = do
[String]
argv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
System.Environment.getArgs
let parsed :: ParsedOptions opts
parsed = forall opts. Options opts => [String] -> ParsedOptions opts
parseOptions [String]
argv
case forall opts. ParsedOptions opts -> Maybe opts
parsedOptions ParsedOptions opts
parsed of
Just opts
opts -> opts -> [String] -> m a
io opts
opts (forall opts. ParsedOptions opts -> [String]
parsedArguments ParsedOptions opts
parsed)
Maybe opts
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO case forall a. Parsed a => a -> Maybe String
parsedError ParsedOptions opts
parsed of
Just String
err -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (forall a. Parsed a => a -> String
parsedHelp ParsedOptions opts
parsed)
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
err
forall a. IO a
exitFailure
Maybe String
Nothing -> do
Handle -> String -> IO ()
hPutStr Handle
stdout (forall a. Parsed a => a -> String
parsedHelp ParsedOptions opts
parsed)
forall a. IO a
exitSuccess
data Subcommand cmdOpts action
= Subcommand
String
(Integer -> ([OptionInfo], (cmdOpts -> Tokens -> Either String action), Integer))
subcommand ::
(Options cmdOpts, Options subcmdOpts) =>
String ->
(cmdOpts -> subcmdOpts -> [String] -> action) ->
Subcommand cmdOpts action
subcommand :: forall cmdOpts subcmdOpts action.
(Options cmdOpts, Options subcmdOpts) =>
String
-> (cmdOpts -> subcmdOpts -> [String] -> action)
-> Subcommand cmdOpts action
subcommand String
name cmdOpts -> subcmdOpts -> [String] -> action
fn =
forall cmdOpts action.
String
-> (Integer
-> ([OptionInfo], cmdOpts -> Tokens -> Either String action,
Integer))
-> Subcommand cmdOpts action
Subcommand
String
name
( \Integer
initialKey ->
let (DefineOptions subcmdOpts
_ Integer -> (Integer, [OptionInfo])
getInfos Integer
-> Map OptionKey [Token] -> Either String (Integer, subcmdOpts)
parser) = forall opts. Options opts => DefineOptions opts
defineOptions
(Integer
nextKey, [OptionInfo]
optionInfos) = Integer -> (Integer, [OptionInfo])
getInfos Integer
initialKey
parseTokens :: Map OptionKey [Token] -> Either String (Integer, subcmdOpts)
parseTokens = Integer
-> Map OptionKey [Token] -> Either String (Integer, subcmdOpts)
parser Integer
initialKey
runAction :: cmdOpts -> Tokens -> Either String action
runAction cmdOpts
cmdOpts Tokens
tokens = case Map OptionKey [Token] -> Either String (Integer, subcmdOpts)
parseTokens (Tokens -> Map OptionKey [Token]
tokensMap Tokens
tokens) of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right (Integer
_, subcmdOpts
subOpts) -> forall a b. b -> Either a b
Right (cmdOpts -> subcmdOpts -> [String] -> action
fn cmdOpts
cmdOpts subcmdOpts
subOpts (Tokens -> [String]
tokensArgv Tokens
tokens))
in ([OptionInfo]
optionInfos, cmdOpts -> Tokens -> Either String action
runAction, Integer
nextKey)
)
parseSubcommand :: Options cmdOpts => [Subcommand cmdOpts action] -> [String] -> ParsedSubcommand action
parseSubcommand :: forall cmdOpts action.
Options cmdOpts =>
[Subcommand cmdOpts action] -> [String] -> ParsedSubcommand action
parseSubcommand [Subcommand cmdOpts action]
subcommands [String]
argv = ParsedSubcommand action
parsed
where
(DefineOptions cmdOpts
_ Integer -> (Integer, [OptionInfo])
getInfos Integer
-> Map OptionKey [Token] -> Either String (Integer, cmdOpts)
parser) = forall opts. Options opts => DefineOptions opts
defineOptions
(Integer
cmdNextKey, [OptionInfo]
cmdInfos) = Integer -> (Integer, [OptionInfo])
getInfos Integer
0
cmdParseTokens :: Map OptionKey [Token] -> Either String (Integer, cmdOpts)
cmdParseTokens = Integer
-> Map OptionKey [Token] -> Either String (Integer, cmdOpts)
parser Integer
0
subcmdInfos :: [(String, [OptionInfo])]
subcmdInfos = do
Subcommand String
name Integer
-> ([OptionInfo], cmdOpts -> Tokens -> Either String action,
Integer)
fn <- [Subcommand cmdOpts action]
subcommands
let ([OptionInfo]
infos, cmdOpts -> Tokens -> Either String action
_, Integer
_) = Integer
-> ([OptionInfo], cmdOpts -> Tokens -> Either String action,
Integer)
fn Integer
cmdNextKey
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, [OptionInfo]
infos)
subcmdRunners :: Map String (cmdOpts -> Tokens -> Either String action)
subcmdRunners = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList do
Subcommand String
name Integer
-> ([OptionInfo], cmdOpts -> Tokens -> Either String action,
Integer)
fn <- [Subcommand cmdOpts action]
subcommands
let ([OptionInfo]
_, cmdOpts -> Tokens -> Either String action
runner, Integer
_) = Integer
-> ([OptionInfo], cmdOpts -> Tokens -> Either String action,
Integer)
fn Integer
cmdNextKey
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, cmdOpts -> Tokens -> Either String action
runner)
parsed :: ParsedSubcommand action
parsed = case [OptionInfo]
-> [(String, [OptionInfo])] -> Either String OptionDefinitions
validateOptionDefs [OptionInfo]
cmdInfos [(String, [OptionInfo])]
subcmdInfos of
Left String
err -> forall action.
Maybe action -> Maybe String -> String -> ParsedSubcommand action
ParsedSubcommand forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
err) String
""
Right OptionDefinitions
optionDefs -> case OptionDefinitions
-> [String] -> (Maybe String, Either String Tokens)
tokenize (OptionDefinitions -> OptionDefinitions
addHelpFlags OptionDefinitions
optionDefs) [String]
argv of
(Maybe String
subcmd, Left String
err) -> forall action.
Maybe action -> Maybe String -> String -> ParsedSubcommand action
ParsedSubcommand forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
err) (HelpFlag -> OptionDefinitions -> Maybe String -> String
helpFor HelpFlag
HelpSummary OptionDefinitions
optionDefs Maybe String
subcmd)
(Maybe String
subcmd, Right Tokens
tokens) -> case Tokens -> Maybe HelpFlag
checkHelpFlag Tokens
tokens of
Just HelpFlag
helpFlag -> forall action.
Maybe action -> Maybe String -> String -> ParsedSubcommand action
ParsedSubcommand forall a. Maybe a
Nothing forall a. Maybe a
Nothing (HelpFlag -> OptionDefinitions -> Maybe String -> String
helpFor HelpFlag
helpFlag OptionDefinitions
optionDefs Maybe String
subcmd)
Maybe HelpFlag
Nothing -> case Tokens -> Maybe String -> Either String action
findAction Tokens
tokens Maybe String
subcmd of
Left String
err -> forall action.
Maybe action -> Maybe String -> String -> ParsedSubcommand action
ParsedSubcommand forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
err) (HelpFlag -> OptionDefinitions -> Maybe String -> String
helpFor HelpFlag
HelpSummary OptionDefinitions
optionDefs Maybe String
subcmd)
Right action
action -> forall action.
Maybe action -> Maybe String -> String -> ParsedSubcommand action
ParsedSubcommand (forall a. a -> Maybe a
Just action
action) forall a. Maybe a
Nothing (HelpFlag -> OptionDefinitions -> Maybe String -> String
helpFor HelpFlag
HelpSummary OptionDefinitions
optionDefs Maybe String
subcmd)
findAction :: Tokens -> Maybe String -> Either String action
findAction Tokens
_ Maybe String
Nothing = forall a b. a -> Either a b
Left String
"No subcommand specified"
findAction Tokens
tokens (Just String
subcmdName) = case Map OptionKey [Token] -> Either String (Integer, cmdOpts)
cmdParseTokens (Tokens -> Map OptionKey [Token]
tokensMap Tokens
tokens) of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right (Integer
_, cmdOpts
cmdOpts) -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
subcmdName Map String (cmdOpts -> Tokens -> Either String action)
subcmdRunners of
Maybe (cmdOpts -> Tokens -> Either String action)
Nothing -> forall a b. a -> Either a b
Left (String
"Unknown subcommand " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
subcmdName forall a. [a] -> [a] -> [a]
++ String
".")
Just cmdOpts -> Tokens -> Either String action
getRunner -> case cmdOpts -> Tokens -> Either String action
getRunner cmdOpts
cmdOpts Tokens
tokens of
Left String
err -> forall a b. a -> Either a b
Left String
err
Right action
action -> forall a b. b -> Either a b
Right action
action
runSubcommand :: (Options opts, MonadIO m) => [Subcommand opts (m a)] -> m a
runSubcommand :: forall opts (m :: * -> *) a.
(Options opts, MonadIO m) =>
[Subcommand opts (m a)] -> m a
runSubcommand [Subcommand opts (m a)]
subcommands = do
[String]
argv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
System.Environment.getArgs
let parsed :: ParsedSubcommand (m a)
parsed = forall cmdOpts action.
Options cmdOpts =>
[Subcommand cmdOpts action] -> [String] -> ParsedSubcommand action
parseSubcommand [Subcommand opts (m a)]
subcommands [String]
argv
case forall action. ParsedSubcommand action -> Maybe action
parsedSubcommand ParsedSubcommand (m a)
parsed of
Just m a
cmd -> m a
cmd
Maybe (m a)
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ case forall a. Parsed a => a -> Maybe String
parsedError ParsedSubcommand (m a)
parsed of
Just String
err -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (forall a. Parsed a => a -> String
parsedHelp ParsedSubcommand (m a)
parsed)
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
err
forall a. IO a
exitFailure
Maybe String
Nothing -> do
Handle -> String -> IO ()
hPutStr Handle
stdout (forall a. Parsed a => a -> String
parsedHelp ParsedSubcommand (m a)
parsed)
forall a. IO a
exitSuccess