{-# LANGUAGE RecordWildCards #-}
module System.Console.CmdArgs.Explicit.Process(process) where
import System.Console.CmdArgs.Explicit.Type
import Control.Arrow
import Data.List
import Data.Maybe
process :: Mode a -> [String] -> Either String a
process :: Mode a -> [String] -> Either String a
process = Mode a -> [String] -> Either String a
forall a. Mode a -> [String] -> Either String a
processMode
processMode :: Mode a -> [String] -> Either String a
processMode :: Mode a -> [String] -> Either String a
processMode m :: Mode a
m args :: [String]
args =
case LookupName (Mode a)
find of
Ambiguous xs :: [String]
xs -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String -> String -> [String] -> String
ambiguous "mode" String
a [String]
xs
Found x :: Mode a
x -> Mode a -> [String] -> Either String a
forall a. Mode a -> [String] -> Either String a
processMode Mode a
x [String]
as
NotFound
| [Arg a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (([Arg a], Maybe (Arg a)) -> [Arg a]
forall a b. (a, b) -> a
fst (([Arg a], Maybe (Arg a)) -> [Arg a])
-> ([Arg a], Maybe (Arg a)) -> [Arg a]
forall a b. (a -> b) -> a -> b
$ Mode a -> ([Arg a], Maybe (Arg a))
forall a. Mode a -> ([Arg a], Maybe (Arg a))
modeArgs Mode a
m) Bool -> Bool -> Bool
&& Maybe (Arg a) -> Bool
forall a. Maybe a -> Bool
isNothing (([Arg a], Maybe (Arg a)) -> Maybe (Arg a)
forall a b. (a, b) -> b
snd (([Arg a], Maybe (Arg a)) -> Maybe (Arg a))
-> ([Arg a], Maybe (Arg a)) -> Maybe (Arg a)
forall a b. (a -> b) -> a -> b
$ Mode a -> ([Arg a], Maybe (Arg a))
forall a. Mode a -> ([Arg a], Maybe (Arg a))
modeArgs Mode a
m) Bool -> Bool -> Bool
&& [String]
args [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] Bool -> Bool -> Bool
&&
Bool -> Bool
not ([Mode a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Mode a] -> Bool) -> [Mode a] -> Bool
forall a b. (a -> b) -> a -> b
$ Mode a -> [Mode a]
forall a. Mode a -> [Mode a]
modeModes Mode a
m) Bool -> Bool -> Bool
&& Bool -> Bool
not ("-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
args)
-> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
missing "mode" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Mode a -> [String]) -> [Mode a] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Mode a -> [String]
forall a. Mode a -> [String]
modeNames ([Mode a] -> [String]) -> [Mode a] -> [String]
forall a b. (a -> b) -> a -> b
$ Mode a -> [Mode a]
forall a. Mode a -> [Mode a]
modeModes Mode a
m
| Bool
otherwise -> (String -> Either String a)
-> (a -> Either String a) -> Either String a -> Either String a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String a
forall a b. a -> Either a b
Left (Mode a -> a -> Either String a
forall a. Mode a -> a -> Either String a
modeCheck Mode a
m) (Either String a -> Either String a)
-> Either String a -> Either String a
forall a b. (a -> b) -> a -> b
$ Mode a -> a -> [String] -> Either String a
forall a. Mode a -> a -> [String] -> Either String a
processFlags Mode a
m (Mode a -> a
forall a. Mode a -> a
modeValue Mode a
m) [String]
args
where
(find :: LookupName (Mode a)
find,a :: String
a,as :: [String]
as) = case [String]
args of
[] -> (LookupName (Mode a)
forall a. LookupName a
NotFound,"",[])
x :: String
x:xs :: [String]
xs -> ([([String], Mode a)] -> String -> LookupName (Mode a)
forall a. [([String], a)] -> String -> LookupName a
lookupName ((Mode a -> ([String], Mode a)) -> [Mode a] -> [([String], Mode a)]
forall a b. (a -> b) -> [a] -> [b]
map (Mode a -> [String]
forall a. Mode a -> [String]
modeNames (Mode a -> [String])
-> (Mode a -> Mode a) -> Mode a -> ([String], Mode a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Mode a -> Mode a
forall a. a -> a
id) ([Mode a] -> [([String], Mode a)])
-> [Mode a] -> [([String], Mode a)]
forall a b. (a -> b) -> a -> b
$ Mode a -> [Mode a]
forall a. Mode a -> [Mode a]
modeModes Mode a
m) String
x, String
x, [String]
xs)
data S a = S
{S a -> a
val :: a
,S a -> [String]
args :: [String]
,S a -> Int
argsCount :: Int
,S a -> [String]
errs :: [String]
}
stop :: Mode a -> S a -> Maybe (Either String a)
stop :: Mode a -> S a -> Maybe (Either String a)
stop mode :: Mode a
mode S{..}
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs = Either String a -> Maybe (Either String a)
forall a. a -> Maybe a
Just (Either String a -> Maybe (Either String a))
-> Either String a -> Maybe (Either String a)
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
last [String]
errs
| [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args = Either String a -> Maybe (Either String a)
forall a. a -> Maybe a
Just (Either String a -> Maybe (Either String a))
-> Either String a -> Maybe (Either String a)
forall a b. (a -> b) -> a -> b
$ if Int
argsCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mn then a -> Either String a
forall a b. b -> Either a b
Right a
val else
String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ "Expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Int -> Maybe Int
forall a. a -> Maybe a
Just Int
mn Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
mx then "exactly" else "at least") String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
mn String -> String -> String
forall a. [a] -> [a] -> [a]
++ " unnamed arguments, but got only " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
argsCount
| Bool
otherwise = Maybe (Either String a)
forall a. Maybe a
Nothing
where (mn :: Int
mn, mx :: Maybe Int
mx) = Mode a -> (Int, Maybe Int)
forall a. Mode a -> (Int, Maybe Int)
argsRange Mode a
mode
err :: S a -> String -> S a
err :: S a -> String -> S a
err s :: S a
s x :: String
x = S a
s{errs :: [String]
errs=String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:S a -> [String]
forall a. S a -> [String]
errs S a
s}
upd :: S a -> (a -> Either String a) -> S a
upd :: S a -> (a -> Either String a) -> S a
upd s :: S a
s f :: a -> Either String a
f = case a -> Either String a
f (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ S a -> a
forall a. S a -> a
val S a
s of
Left x :: String
x -> S a -> String -> S a
forall a. S a -> String -> S a
err S a
s String
x
Right x :: a
x -> S a
s{val :: a
val=a
x}
processFlags :: Mode a -> a -> [String] -> Either String a
processFlags :: Mode a -> a -> [String] -> Either String a
processFlags mode :: Mode a
mode val_ :: a
val_ args_ :: [String]
args_ = S a -> Either String a
f (S a -> Either String a) -> S a -> Either String a
forall a b. (a -> b) -> a -> b
$ a -> [String] -> Int -> [String] -> S a
forall a. a -> [String] -> Int -> [String] -> S a
S a
val_ [String]
args_ 0 []
where f :: S a -> Either String a
f s :: S a
s = Either String a -> Maybe (Either String a) -> Either String a
forall a. a -> Maybe a -> a
fromMaybe (S a -> Either String a
f (S a -> Either String a) -> S a -> Either String a
forall a b. (a -> b) -> a -> b
$ Mode a -> S a -> S a
forall a. Mode a -> S a -> S a
processFlag Mode a
mode S a
s) (Maybe (Either String a) -> Either String a)
-> Maybe (Either String a) -> Either String a
forall a b. (a -> b) -> a -> b
$ Mode a -> S a -> Maybe (Either String a)
forall a. Mode a -> S a -> Maybe (Either String a)
stop Mode a
mode S a
s
pickFlags :: Bool -> Mode a -> [([String], (FlagInfo, Flag a))]
pickFlags long :: Bool
long mode :: Mode a
mode = [((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\x :: String
x -> (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
long) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Flag a -> [String]
forall a. Flag a -> [String]
flagNames Flag a
flag,(Flag a -> FlagInfo
forall a. Flag a -> FlagInfo
flagInfo Flag a
flag,Flag a
flag)) | Flag a
flag <- Mode a -> [Flag a]
forall a. Mode a -> [Flag a]
modeFlags Mode a
mode]
processFlag :: Mode a -> S a -> S a
processFlag :: Mode a -> S a -> S a
processFlag mode :: Mode a
mode s_ :: S a
s_@S{args :: forall a. S a -> [String]
args=('-':'-':xs :: String
xs):ys :: [String]
ys} | String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "" =
case [([String], (FlagInfo, Flag a))]
-> String -> LookupName (FlagInfo, Flag a)
forall a. [([String], a)] -> String -> LookupName a
lookupName (Bool -> Mode a -> [([String], (FlagInfo, Flag a))]
forall a. Bool -> Mode a -> [([String], (FlagInfo, Flag a))]
pickFlags Bool
True Mode a
mode) String
a of
Ambiguous poss :: [String]
poss -> S a -> String -> S a
forall a. S a -> String -> S a
err S a
s (String -> S a) -> String -> S a
forall a b. (a -> b) -> a -> b
$ String -> String -> [String] -> String
ambiguous "flag" ("--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a) [String]
poss
NotFound -> S a -> String -> S a
forall a. S a -> String -> S a
err S a
s (String -> S a) -> String -> S a
forall a b. (a -> b) -> a -> b
$ "Unknown flag: --" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a
Found (arg :: FlagInfo
arg,flag :: Flag a
flag) -> case FlagInfo
arg of
FlagNone | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
b -> S a -> (a -> Either String a) -> S a
forall a. S a -> (a -> Either String a) -> S a
upd S a
s ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
forall a b. (a -> b) -> a -> b
$ Flag a -> Update a
forall a. Flag a -> Update a
flagValue Flag a
flag ""
| Bool
otherwise -> S a -> String -> S a
forall a. S a -> String -> S a
err S a
s (String -> S a) -> String -> S a
forall a b. (a -> b) -> a -> b
$ "Unhandled argument to flag, none expected: --" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
xs
FlagReq | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
b Bool -> Bool -> Bool
&& [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ys -> S a -> String -> S a
forall a. S a -> String -> S a
err S a
s (String -> S a) -> String -> S a
forall a b. (a -> b) -> a -> b
$ "Flag requires argument: --" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
xs
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
b -> S a -> (a -> Either String a) -> S a
forall a. S a -> (a -> Either String a) -> S a
upd S a
s{args :: [String]
args=[String] -> [String]
forall a. [a] -> [a]
tail [String]
ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
forall a b. (a -> b) -> a -> b
$ Flag a -> Update a
forall a. Flag a -> Update a
flagValue Flag a
flag Update a -> Update a
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head [String]
ys
| Bool
otherwise -> S a -> (a -> Either String a) -> S a
forall a. S a -> (a -> Either String a) -> S a
upd S a
s ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
forall a b. (a -> b) -> a -> b
$ Flag a -> Update a
forall a. Flag a -> Update a
flagValue Flag a
flag Update a -> Update a
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
tail String
b
_ | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
b -> S a -> (a -> Either String a) -> S a
forall a. S a -> (a -> Either String a) -> S a
upd S a
s ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
forall a b. (a -> b) -> a -> b
$ Flag a -> Update a
forall a. Flag a -> Update a
flagValue Flag a
flag Update a -> Update a
forall a b. (a -> b) -> a -> b
$ FlagInfo -> String
fromFlagOpt FlagInfo
arg
| Bool
otherwise -> S a -> (a -> Either String a) -> S a
forall a. S a -> (a -> Either String a) -> S a
upd S a
s ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
forall a b. (a -> b) -> a -> b
$ Flag a -> Update a
forall a. Flag a -> Update a
flagValue Flag a
flag Update a -> Update a
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
tail String
b
where
s :: S a
s = S a
s_{args :: [String]
args=[String]
ys}
(a :: String
a,b :: String
b) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '=') String
xs
processFlag mode :: Mode a
mode s_ :: S a
s_@S{args :: forall a. S a -> [String]
args=('-':x :: Char
x:xs :: String
xs):ys :: [String]
ys} | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '-' =
case [([String], (FlagInfo, Flag a))]
-> String -> LookupName (FlagInfo, Flag a)
forall a. [([String], a)] -> String -> LookupName a
lookupName (Bool -> Mode a -> [([String], (FlagInfo, Flag a))]
forall a. Bool -> Mode a -> [([String], (FlagInfo, Flag a))]
pickFlags Bool
False Mode a
mode) [Char
x] of
Ambiguous poss :: [String]
poss -> S a -> String -> S a
forall a. S a -> String -> S a
err S a
s (String -> S a) -> String -> S a
forall a b. (a -> b) -> a -> b
$ String -> String -> [String] -> String
ambiguous "flag" ['-',Char
x] [String]
poss
NotFound -> S a -> String -> S a
forall a. S a -> String -> S a
err S a
s (String -> S a) -> String -> S a
forall a b. (a -> b) -> a -> b
$ "Unknown flag: -" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
x]
Found (arg :: FlagInfo
arg,flag :: Flag a
flag) -> case FlagInfo
arg of
FlagNone | "=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs -> S a -> String -> S a
forall a. S a -> String -> S a
err S a
s (String -> S a) -> String -> S a
forall a b. (a -> b) -> a -> b
$ "Unhandled argument to flag, none expected: -" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
x]
| Bool
otherwise -> S a -> (a -> Either String a) -> S a
forall a. S a -> (a -> Either String a) -> S a
upd S a
s_{args :: [String]
args=['-'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs|String
xsString -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=""] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
forall a b. (a -> b) -> a -> b
$ Flag a -> Update a
forall a. Flag a -> Update a
flagValue Flag a
flag ""
FlagReq | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs Bool -> Bool -> Bool
&& [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ys -> S a -> String -> S a
forall a. S a -> String -> S a
err S a
s (String -> S a) -> String -> S a
forall a b. (a -> b) -> a -> b
$ "Flag requires argument: -" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
x]
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs -> S a -> (a -> Either String a) -> S a
forall a. S a -> (a -> Either String a) -> S a
upd S a
s_{args :: [String]
args=[String] -> [String]
forall a. [a] -> [a]
tail [String]
ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
forall a b. (a -> b) -> a -> b
$ Flag a -> Update a
forall a. Flag a -> Update a
flagValue Flag a
flag Update a -> Update a
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head [String]
ys
| Bool
otherwise -> S a -> (a -> Either String a) -> S a
forall a. S a -> (a -> Either String a) -> S a
upd S a
s_{args :: [String]
args=[String]
ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
forall a b. (a -> b) -> a -> b
$ Flag a -> Update a
forall a. Flag a -> Update a
flagValue Flag a
flag Update a -> Update a
forall a b. (a -> b) -> a -> b
$ if "=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs then String -> String
forall a. [a] -> [a]
tail String
xs else String
xs
FlagOpt x :: String
x | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs -> S a -> (a -> Either String a) -> S a
forall a. S a -> (a -> Either String a) -> S a
upd S a
s_{args :: [String]
args=[String]
ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
forall a b. (a -> b) -> a -> b
$ Flag a -> Update a
forall a. Flag a -> Update a
flagValue Flag a
flag String
x
| Bool
otherwise -> S a -> (a -> Either String a) -> S a
forall a. S a -> (a -> Either String a) -> S a
upd S a
s_{args :: [String]
args=[String]
ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
forall a b. (a -> b) -> a -> b
$ Flag a -> Update a
forall a. Flag a -> Update a
flagValue Flag a
flag Update a -> Update a
forall a b. (a -> b) -> a -> b
$ if "=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs then String -> String
forall a. [a] -> [a]
tail String
xs else String
xs
FlagOptRare x :: String
x | "=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs -> S a -> (a -> Either String a) -> S a
forall a. S a -> (a -> Either String a) -> S a
upd S a
s_{args :: [String]
args=[String]
ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
forall a b. (a -> b) -> a -> b
$ Flag a -> Update a
forall a. Flag a -> Update a
flagValue Flag a
flag Update a -> Update a
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
tail String
xs
| Bool
otherwise -> S a -> (a -> Either String a) -> S a
forall a. S a -> (a -> Either String a) -> S a
upd S a
s_{args :: [String]
args=['-'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs|String
xsString -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=""] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ys} ((a -> Either String a) -> S a) -> (a -> Either String a) -> S a
forall a b. (a -> b) -> a -> b
$ Flag a -> Update a
forall a. Flag a -> Update a
flagValue Flag a
flag String
x
where
s :: S a
s = S a
s_{args :: [String]
args=[String]
ys}
processFlag mode :: Mode a
mode s_ :: S a
s_@S{args :: forall a. S a -> [String]
args="--":ys :: [String]
ys} = S a -> S a
f S a
s_{args :: [String]
args=[String]
ys}
where f :: S a -> S a
f s :: S a
s | Maybe (Either String a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Either String a) -> Bool)
-> Maybe (Either String a) -> Bool
forall a b. (a -> b) -> a -> b
$ Mode a -> S a -> Maybe (Either String a)
forall a. Mode a -> S a -> Maybe (Either String a)
stop Mode a
mode S a
s = S a
s
| Bool
otherwise = S a -> S a
f (S a -> S a) -> S a -> S a
forall a b. (a -> b) -> a -> b
$ Mode a -> S a -> S a
forall a. Mode a -> S a -> S a
processArg Mode a
mode S a
s
processFlag mode :: Mode a
mode s :: S a
s = Mode a -> S a -> S a
forall a. Mode a -> S a -> S a
processArg Mode a
mode S a
s
processArg :: Mode a -> S a -> S a
processArg mode :: Mode a
mode s_ :: S a
s_@S{args :: forall a. S a -> [String]
args=x :: String
x:ys :: [String]
ys, argsCount :: forall a. S a -> Int
argsCount=Int
count} = case Mode a -> Int -> Maybe (Arg a)
forall a. Mode a -> Int -> Maybe (Arg a)
argsPick Mode a
mode Int
count of
Nothing -> S a -> String -> S a
forall a. S a -> String -> S a
err S a
s (String -> S a) -> String -> S a
forall a b. (a -> b) -> a -> b
$ "Unhandled argument, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ " expected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
where str :: String
str = if Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then "none" else "at most " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count
Just arg :: Arg a
arg -> case Arg a -> Update a
forall a. Arg a -> Update a
argValue Arg a
arg String
x (S a -> a
forall a. S a -> a
val S a
s) of
Left e :: String
e -> S a -> String -> S a
forall a. S a -> String -> S a
err S a
s (String -> S a) -> String -> S a
forall a b. (a -> b) -> a -> b
$ "Unhandled argument, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
Right v :: a
v -> S a
s{val :: a
val=a
v}
where
s :: S a
s = S a
s_{args :: [String]
args=[String]
ys, argsCount :: Int
argsCount=Int
countInt -> Int -> Int
forall a. Num a => a -> a -> a
+1}
argsRange :: Mode a -> (Int, Maybe Int)
argsRange :: Mode a -> (Int, Maybe Int)
argsRange Mode{modeArgs :: forall a. Mode a -> ([Arg a], Maybe (Arg a))
modeArgs=(lst :: [Arg a]
lst,end :: Maybe (Arg a)
end)} = (Int
mn,Maybe Int
mx)
where mn :: Int
mn = [Arg a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Arg a] -> Int) -> [Arg a] -> Int
forall a b. (a -> b) -> a -> b
$ (Arg a -> Bool) -> [Arg a] -> [Arg a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Arg a -> Bool) -> Arg a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg a -> Bool
forall a. Arg a -> Bool
argRequire) ([Arg a] -> [Arg a]) -> [Arg a] -> [Arg a]
forall a b. (a -> b) -> a -> b
$ [Arg a] -> [Arg a]
forall a. [a] -> [a]
reverse ([Arg a] -> [Arg a]) -> [Arg a] -> [Arg a]
forall a b. (a -> b) -> a -> b
$ [Arg a]
lst [Arg a] -> [Arg a] -> [Arg a]
forall a. [a] -> [a] -> [a]
++ Maybe (Arg a) -> [Arg a]
forall a. Maybe a -> [a]
maybeToList Maybe (Arg a)
end
mx :: Maybe Int
mx = if Maybe (Arg a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Arg a)
end then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [Arg a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Arg a]
lst
argsPick :: Mode a -> Int -> Maybe (Arg a)
argsPick :: Mode a -> Int -> Maybe (Arg a)
argsPick Mode{modeArgs :: forall a. Mode a -> ([Arg a], Maybe (Arg a))
modeArgs=(lst :: [Arg a]
lst,end :: Maybe (Arg a)
end)} i :: Int
i = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Arg a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Arg a]
lst then Arg a -> Maybe (Arg a)
forall a. a -> Maybe a
Just (Arg a -> Maybe (Arg a)) -> Arg a -> Maybe (Arg a)
forall a b. (a -> b) -> a -> b
$ [Arg a]
lst [Arg a] -> Int -> Arg a
forall a. [a] -> Int -> a
!! Int
i else Maybe (Arg a)
end
ambiguous :: String -> String -> [String] -> String
ambiguous typ :: String
typ got :: String
got xs :: [String]
xs = "Ambiguous " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++ " '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
got String -> String -> String
forall a. [a] -> [a] -> [a]
++ "', could be any of: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
xs
missing :: String -> [String] -> String
missing typ :: String
typ xs :: [String]
xs = "Missing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", wanted any of: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
xs
data LookupName a = NotFound
| Ambiguous [Name]
| Found a
lookupName :: [([Name],a)] -> Name -> LookupName a
lookupName :: [([String], a)] -> String -> LookupName a
lookupName names :: [([String], a)]
names value :: String
value =
case ((String -> String -> Bool) -> [(String, a)]
match String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==), (String -> String -> Bool) -> [(String, a)]
match String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf) of
([],[]) -> LookupName a
forall a. LookupName a
NotFound
([],[x :: (String, a)
x]) -> a -> LookupName a
forall a. a -> LookupName a
Found (a -> LookupName a) -> a -> LookupName a
forall a b. (a -> b) -> a -> b
$ (String, a) -> a
forall a b. (a, b) -> b
snd (String, a)
x
([],xs :: [(String, a)]
xs) -> [String] -> LookupName a
forall a. [String] -> LookupName a
Ambiguous ([String] -> LookupName a) -> [String] -> LookupName a
forall a b. (a -> b) -> a -> b
$ ((String, a) -> String) -> [(String, a)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, a) -> String
forall a b. (a, b) -> a
fst [(String, a)]
xs
([x :: (String, a)
x],_) -> a -> LookupName a
forall a. a -> LookupName a
Found (a -> LookupName a) -> a -> LookupName a
forall a b. (a -> b) -> a -> b
$ (String, a) -> a
forall a b. (a, b) -> b
snd (String, a)
x
(xs :: [(String, a)]
xs,_) -> [String] -> LookupName a
forall a. [String] -> LookupName a
Ambiguous ([String] -> LookupName a) -> [String] -> LookupName a
forall a b. (a -> b) -> a -> b
$ ((String, a) -> String) -> [(String, a)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, a) -> String
forall a b. (a, b) -> a
fst [(String, a)]
xs
where
match :: (String -> String -> Bool) -> [(String, a)]
match op :: String -> String -> Bool
op = [([String] -> String
forall a. [a] -> a
head [String]
ys,a
v) | (xs :: [String]
xs,v :: a
v) <- [([String], a)]
names, let ys :: [String]
ys = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
op String
value) [String]
xs, [String]
ys [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= []]