{-# 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 a list of flags (usually obtained from @getArgs@/@expandArgsAt@) with a mode. Returns
--   @Left@ and an error message if the command line fails to parse, or @Right@ and
--   the associated value.
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 Mode a
m [String]
args =
    case LookupName (Mode a)
find of
        Ambiguous [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 String
"mode" String
a [String]
xs
        Found Mode a
x -> Mode a -> [String] -> Either String a
forall a. Mode a -> [String] -> Either String a
processMode Mode a
x [String]
as
        LookupName (Mode a)
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 -> 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 String
"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
        (LookupName (Mode a)
find,String
a,[String]
as) = case [String]
args of
            [] -> (LookupName (Mode a)
forall a. LookupName a
NotFound,String
"",[])
            String
x:[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 -- The value you are accumulating
    ,S a -> [String]
args :: [String] -- The arguments you are processing through
    ,S a -> Int
argsCount :: Int -- The number of unnamed arguments you have seen
    ,S a -> [String]
errs :: [String] -- The errors you have seen
    }

stop :: Mode a -> S a -> Maybe (Either String a)
stop :: Mode a -> S a -> Maybe (Either String a)
stop Mode a
mode S{a
Int
[String]
errs :: [String]
argsCount :: Int
args :: [String]
val :: a
errs :: forall a. S a -> [String]
argsCount :: forall a. S a -> Int
args :: forall a. S a -> [String]
val :: forall a. S a -> a
..}
    | 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
$ String
"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 String
"exactly" else String
"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]
++ String
" 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 (Int
mn, 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 a
s 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 a
s 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 String
x -> S a -> String -> S a
forall a. S a -> String -> S a
err S a
s String
x
    Right 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 a
mode a
val_ [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_ Int
0 []
    where f :: S a -> Either String a
f 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 Bool
long Mode a
mode = [((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\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
> Int
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 a
mode s_ :: S a
s_@S{args :: forall a. S a -> [String]
args=(Char
'-':Char
'-':String
xs):[String]
ys} | String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" =
    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 [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 String
"flag" (String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a) [String]
poss
        LookupName (FlagInfo, Flag a)
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
$ String
"Unknown flag: --" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a
        Found (FlagInfo
arg,Flag a
flag) -> case FlagInfo
arg of
            FlagInfo
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 String
""
                     | 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
$ String
"Unhandled argument to flag, none expected: --" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
xs
            FlagInfo
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
$ String
"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
            FlagInfo
_ | 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}
        (String
a,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
== Char
'=') String
xs


processFlag Mode a
mode s_ :: S a
s_@S{args :: forall a. S a -> [String]
args=(Char
'-':Char
x:String
xs):[String]
ys} | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-' =
    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 [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 String
"flag" [Char
'-',Char
x] [String]
poss
        LookupName (FlagInfo, Flag a)
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
$ String
"Unknown flag: -" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
x]
        Found (FlagInfo
arg,Flag a
flag) -> case FlagInfo
arg of
            FlagInfo
FlagNone | String
"=" 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
$ String
"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
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs|String
xsString -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
""] [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
""
            FlagInfo
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
$ String
"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 -> 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 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 -> 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 String
x | String
"=" 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
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs|String
xsString -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
""] [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 a
mode s_ :: S a
s_@S{args :: forall a. S a -> [String]
args=String
"--":[String]
ys} = S a -> S a
f S a
s_{args :: [String]
args=[String]
ys}
    where f :: S a -> S a
f 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 a
mode 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 a
mode s_ :: S a
s_@S{args :: forall a. S a -> [String]
args=String
x:[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
    Maybe (Arg a)
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
$ String
"Unhandled argument, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" 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
== Int
0 then String
"none" else String
"at most " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count
    Just 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 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
$ String
"Unhandled argument, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
            Right 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
+Int
1}


-- find the minimum and maximum allowed number of arguments (Nothing=infinite)
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=([Arg a]
lst,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=([Arg a]
lst,Maybe (Arg a)
end)} 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


---------------------------------------------------------------------
-- UTILITIES

ambiguous :: String -> String -> [String] -> String
ambiguous String
typ String
got [String]
xs = String
"Ambiguous " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
got String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"', could be any of: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
xs
missing :: String -> [String] -> String
missing String
typ [String]
xs = String
"Missing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", wanted any of: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
xs


data LookupName a = NotFound
                  | Ambiguous [Name]
                  | Found a

-- different order to lookup so can potentially partially-apply it
lookupName :: [([Name],a)] -> Name -> LookupName a
lookupName :: [([String], a)] -> String -> LookupName a
lookupName [([String], a)]
names 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
        ([],[(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
        ([],[(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
        ([(String, a)
x],[(String, a)]
_) -> 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
        ([(String, a)]
xs,[(String, a)]
_) -> [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 String -> String -> Bool
op = [([String] -> String
forall a. [a] -> a
head [String]
ys,a
v) | ([String]
xs,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
/= []]