{-# LANGUAGE PatternGuards #-}
{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}

-- | This module takes the result of Capture, and deals with all the local
--   constraints.
module System.Console.CmdArgs.Implicit.Local(
    local, err,
    Prog_(..), Builtin_(..), Mode_(..), Flag_(..), Fixup(..), isFlag_,
    progHelpOutput, progVersionOutput, progNumericVersionOutput
    ) where

import System.Console.CmdArgs.Implicit.Ann
import System.Console.CmdArgs.Implicit.Type
import System.Console.CmdArgs.Implicit.Reader
import System.Console.CmdArgs.Explicit
import System.Console.CmdArgs.Annotate
import System.Console.CmdArgs.Default
import qualified Data.Generics.Any.Prelude as A

import Control.Monad
import Data.Char
import Data.Generics.Any
import Data.Maybe
import Data.List


data Prog_ = Prog_
    {Prog_ -> [Mode_]
progModes :: [Mode_]
    ,Prog_ -> Maybe [String]
progSummary :: Maybe [String]
    ,Prog_ -> String
progProgram :: String
    ,Prog_ -> String
progHelp :: String -- only for multiple mode programs
    ,Prog_ -> (Maybe Builtin_, Maybe Builtin_)
progVerbosityArgs :: (Maybe Builtin_, Maybe Builtin_) -- (verbose, quiet)
    ,Prog_ -> Maybe Builtin_
progHelpArg :: Maybe Builtin_
    ,Prog_ -> Maybe Builtin_
progVersionArg :: Maybe Builtin_
    ,Prog_ -> Bool
progNoAtExpand :: Bool
    } deriving Int -> Prog_ -> ShowS
[Prog_] -> ShowS
Prog_ -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prog_] -> ShowS
$cshowList :: [Prog_] -> ShowS
show :: Prog_ -> String
$cshow :: Prog_ -> String
showsPrec :: Int -> Prog_ -> ShowS
$cshowsPrec :: Int -> Prog_ -> ShowS
Show
instance Default Prog_ where
    def :: Prog_
def = [Mode_]
-> Maybe [String]
-> String
-> String
-> (Maybe Builtin_, Maybe Builtin_)
-> Maybe Builtin_
-> Maybe Builtin_
-> Bool
-> Prog_
Prog_ forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def (forall a. a -> Maybe a
Just forall a. Default a => a
def) (forall a. a -> Maybe a
Just forall a. Default a => a
def) forall a. Default a => a
def

progOutput :: (Prog_ -> Maybe Builtin_) -> Prog_ -> [String]
progOutput Prog_ -> Maybe Builtin_
f Prog_
x = forall a. a -> Maybe a -> a
fromMaybe [String
"The " forall a. [a] -> [a] -> [a]
++ Prog_ -> String
progProgram Prog_
x forall a. [a] -> [a] -> [a]
++ String
" program"] forall a b. (a -> b) -> a -> b
$
    (Builtin_ -> Maybe [String]
builtinSummary forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Prog_ -> Maybe Builtin_
f Prog_
x) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Prog_ -> Maybe [String]
progSummary Prog_
x

progHelpOutput :: Prog_ -> [String]
progHelpOutput = (Prog_ -> Maybe Builtin_) -> Prog_ -> [String]
progOutput Prog_ -> Maybe Builtin_
progHelpArg
progVersionOutput :: Prog_ -> [String]
progVersionOutput = (Prog_ -> Maybe Builtin_) -> Prog_ -> [String]
progOutput Prog_ -> Maybe Builtin_
progVersionArg
progNumericVersionOutput :: Prog_ -> Maybe (m String)
progNumericVersionOutput Prog_
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Maybe String
parseVersion forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. [a] -> Maybe a
listToMaybe (Prog_ -> [String]
progVersionOutput Prog_
x)

-- | Find numbers starting after space/comma, v
parseVersion :: String -> Maybe String
parseVersion :: String -> Maybe String
parseVersion String
xs = forall a. [a] -> Maybe a
listToMaybe
    [String
y | String
x <- String -> [String]
words forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
",;" then Char
' ' else Char
x) String
xs
       , let y :: String
y = forall a. a -> Maybe a -> a
fromMaybe String
x forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"v" String
x
       , forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit String
y) forall a. Ord a => a -> a -> Bool
>= Int
1]


data Builtin_ = Builtin_
    {Builtin_ -> [String]
builtinNames :: [String]
    ,Builtin_ -> Bool
builtinExplicit :: Bool
    ,Builtin_ -> Maybe String
builtinHelp :: Maybe String
    ,Builtin_ -> Maybe String
builtinGroup :: Maybe String
    ,Builtin_ -> Maybe [String]
builtinSummary :: Maybe [String]
    } deriving Int -> Builtin_ -> ShowS
[Builtin_] -> ShowS
Builtin_ -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Builtin_] -> ShowS
$cshowList :: [Builtin_] -> ShowS
show :: Builtin_ -> String
$cshow :: Builtin_ -> String
showsPrec :: Int -> Builtin_ -> ShowS
$cshowsPrec :: Int -> Builtin_ -> ShowS
Show
instance Default Builtin_ where
    def :: Builtin_
def = [String]
-> Bool
-> Maybe String
-> Maybe String
-> Maybe [String]
-> Builtin_
Builtin_ forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def

data Mode_ = Mode_
    {Mode_ -> [Flag_]
modeFlags_ :: [Flag_]
    ,Mode_ -> Mode (CmdArgs Any)
modeMode :: Mode (CmdArgs Any)
    ,Mode_ -> Bool
modeDefault :: Bool
    ,Mode_ -> Maybe String
modeGroup :: Maybe String
    ,Mode_ -> Bool
modeExplicit :: Bool
    } deriving Int -> Mode_ -> ShowS
[Mode_] -> ShowS
Mode_ -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode_] -> ShowS
$cshowList :: [Mode_] -> ShowS
show :: Mode_ -> String
$cshow :: Mode_ -> String
showsPrec :: Int -> Mode_ -> ShowS
$cshowsPrec :: Int -> Mode_ -> ShowS
Show
instance Default Mode_ where
    def :: Mode_
def = [Flag_]
-> Mode (CmdArgs Any) -> Bool -> Maybe String -> Bool -> Mode_
Mode_ [] (forall a. a -> Mode a
modeEmpty forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"Mode_ undefined") forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def

data Flag_
    = Flag_
        {Flag_ -> String
flagField :: String
        ,Flag_ -> Flag (CmdArgs Any)
flagFlag :: Flag (CmdArgs Any)
        ,Flag_ -> Bool
flagExplicit :: Bool
        ,Flag_ -> Maybe String
flagGroup :: Maybe String
        ,Flag_ -> Maybe String
flagEnum :: Maybe String -- if you are an enum, what is your string value
        ,Flag_ -> Fixup
flagFixup :: Fixup
        }
    | Arg_
        {Flag_ -> Arg (CmdArgs Any)
flagArg_ :: Arg (CmdArgs Any)
        ,Flag_ -> Maybe Int
flagArgPos :: Maybe Int
        ,Flag_ -> Maybe String
flagArgOpt :: Maybe String
        ,flagFixup :: Fixup
        }
      deriving Int -> Flag_ -> ShowS
[Flag_] -> ShowS
Flag_ -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flag_] -> ShowS
$cshowList :: [Flag_] -> ShowS
show :: Flag_ -> String
$cshow :: Flag_ -> String
showsPrec :: Int -> Flag_ -> ShowS
$cshowsPrec :: Int -> Flag_ -> ShowS
Show
instance Default Flag_ where
    def :: Flag_
def = String
-> Flag (CmdArgs Any)
-> Bool
-> Maybe String
-> Maybe String
-> Fixup
-> Flag_
Flag_ String
"" (forall a. HasCallStack => String -> a
error String
"Flag_ undefined") forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def

newtype Fixup = Fixup (Any -> Any)

instance Default Fixup where def :: Fixup
def = (Any -> Any) -> Fixup
Fixup forall a. a -> a
id
instance Show Fixup where show :: Fixup -> String
show Fixup
_ = String
"Fixup"

isFlag_ :: Flag_ -> Bool
isFlag_ Flag_{} = Bool
True
isFlag_ Flag_
_ = Bool
False

withMode :: Mode_ -> (Mode (CmdArgs Any) -> Mode (CmdArgs Any)) -> Mode_
withMode Mode_
x Mode (CmdArgs Any) -> Mode (CmdArgs Any)
f = Mode_
x{modeMode :: Mode (CmdArgs Any)
modeMode = Mode (CmdArgs Any) -> Mode (CmdArgs Any)
f forall a b. (a -> b) -> a -> b
$ Mode_ -> Mode (CmdArgs Any)
modeMode Mode_
x}
withFlagArg :: Flag_ -> (Arg (CmdArgs Any) -> Arg (CmdArgs Any)) -> Flag_
withFlagArg Flag_
x Arg (CmdArgs Any) -> Arg (CmdArgs Any)
f = Flag_
x{flagArg_ :: Arg (CmdArgs Any)
flagArg_ = Arg (CmdArgs Any) -> Arg (CmdArgs Any)
f forall a b. (a -> b) -> a -> b
$ Flag_ -> Arg (CmdArgs Any)
flagArg_ Flag_
x}
withFlagFlag :: Flag_ -> (Flag (CmdArgs Any) -> Flag (CmdArgs Any)) -> Flag_
withFlagFlag Flag_
x Flag (CmdArgs Any) -> Flag (CmdArgs Any)
f = Flag_
x{flagFlag :: Flag (CmdArgs Any)
flagFlag = Flag (CmdArgs Any) -> Flag (CmdArgs Any)
f forall a b. (a -> b) -> a -> b
$ Flag_ -> Flag (CmdArgs Any)
flagFlag Flag_
x}

err :: String -> String -> a
err String
x String
y = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"System.Console.CmdArgs.Implicit, unexpected " forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
y
errFlag :: String -> String -> a
errFlag String
x String
y = forall {a}. String -> String -> a
err (String
"flag (" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
")") String
y


local :: Capture Ann -> Prog_
local :: Capture Ann -> Prog_
local = Capture Ann -> Prog_
prog_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Capture ann -> Capture ann
defaultMissing


---------------------------------------------------------------------
-- CAPTURE THE STRUCTURE

prog_ :: Capture Ann -> Prog_
prog_ :: Capture Ann -> Prog_
prog_ (Ann Ann
a Capture Ann
b) = Ann -> Prog_ -> Prog_
progAnn Ann
a forall a b. (a -> b) -> a -> b
$ Capture Ann -> Prog_
prog_ Capture Ann
b
prog_ (Many [Capture Ann]
xs) = forall a. Default a => a
def{progModes :: [Mode_]
progModes=forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Capture Ann -> [Mode_]
mode_ [Capture Ann]
xs, progProgram :: String
progProgram=String
prog}
    where prog :: String
prog = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall a b. (a -> b) -> a -> b
$ Any -> String
typeShell forall a b. (a -> b) -> a -> b
$ forall ann. Capture ann -> Any
fromCapture forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [Capture Ann]
xs
prog_ x :: Capture Ann
x@Ctor{} = Capture Ann -> Prog_
prog_ forall a b. (a -> b) -> a -> b
$ forall ann. [Capture ann] -> Capture ann
Many [Capture Ann
x]
prog_ Capture Ann
x = forall {a}. String -> String -> a
err String
"program" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Capture Ann
x


mode_ :: Capture Ann -> [Mode_]
mode_ :: Capture Ann -> [Mode_]
mode_ (Ann Ann
Ignore Capture Ann
_) = []
mode_ (Ann Ann
a Capture Ann
b) = forall a b. (a -> b) -> [a] -> [b]
map (Ann -> Mode_ -> Mode_
modeAnn Ann
a) forall a b. (a -> b) -> a -> b
$ Capture Ann -> [Mode_]
mode_ Capture Ann
b
mode_ o :: Capture Ann
o@(Ctor Any
x [Capture Ann]
ys) = [Mode_ -> (Mode (CmdArgs Any) -> Mode (CmdArgs Any)) -> Mode_
withMode forall a. Default a => a
def{modeFlags_ :: [Flag_]
modeFlags_=[Flag_]
flgs} forall a b. (a -> b) -> a -> b
$ \Mode (CmdArgs Any)
x -> Mode (CmdArgs Any)
x{modeValue :: CmdArgs Any
modeValue=forall a. a -> CmdArgs a
embed forall a b. (a -> b) -> a -> b
$ Any -> Any
fixup forall a b. (a -> b) -> a -> b
$ forall ann. Capture ann -> Any
fromCapture Capture Ann
o}]
    where flgs :: [Flag_]
flgs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> Capture Ann -> [Flag_]
flag_ (Any -> [String]
fields Any
x) [Capture Ann]
ys
          fixup :: Any -> Any
fixup Any
x = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Any
x (Fixup Any -> Any
f) -> Any -> Any
f Any
x) Any
x forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Flag_ -> Fixup
flagFixup [Flag_]
flgs
mode_ Capture Ann
x = forall {a}. String -> String -> a
err String
"mode" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Capture Ann
x


flag_ :: String -> Capture Ann -> [Flag_]
flag_ :: String -> Capture Ann -> [Flag_]
flag_ String
name (Ann Ann
Ignore Capture Ann
_) = []
flag_ String
name (Ann Ann
a Capture Ann
b) = forall a b. (a -> b) -> [a] -> [b]
map (Ann -> Flag_ -> Flag_
flagAnn Ann
a) forall a b. (a -> b) -> a -> b
$ String -> Capture Ann -> [Flag_]
flag_ String
name Capture Ann
b
flag_ String
name (Value Any
x) = let (Fixup
fix,Flag Any
flg) = String -> Any -> (Fixup, Flag Any)
value_ String
name Any
x in [forall a. Default a => a
def{flagField :: String
flagField=String
name, flagFlag :: Flag (CmdArgs Any)
flagFlag=forall (m :: * -> *) a b.
Remap m =>
(a -> b) -> (b -> (a, a -> b)) -> m a -> m b
remap forall a. a -> CmdArgs a
embed forall a. CmdArgs a -> (a, a -> CmdArgs a)
reembed Flag Any
flg, flagFixup :: Fixup
flagFixup=Fixup
fix}]
flag_ String
name x :: Capture Ann
x@Ctor{} = String -> Capture Ann -> [Flag_]
flag_ String
name forall a b. (a -> b) -> a -> b
$ forall ann. Any -> Capture ann
Value forall a b. (a -> b) -> a -> b
$ forall ann. Capture ann -> Any
fromCapture Capture Ann
x
flag_ String
name (Many [Capture Ann]
xs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Capture Ann -> [Flag_]
enum_ String
name) [Capture Ann]
xs
flag_ String
name Capture Ann
x = forall {a}. String -> String -> a
errFlag String
name forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Capture Ann
x


enum_ :: String -> Capture Ann -> [Flag_]
enum_ :: String -> Capture Ann -> [Flag_]
enum_ String
name (Ann Ann
Ignore Capture Ann
_) = []
enum_ String
name (Ann Ann
a Capture Ann
b) = forall a b. (a -> b) -> [a] -> [b]
map (Ann -> Flag_ -> Flag_
flagAnn Ann
a) forall a b. (a -> b) -> a -> b
$ String -> Capture Ann -> [Flag_]
enum_ String
name Capture Ann
b
enum_ String
name (Value Any
x) = [forall a. Default a => a
def{flagField :: String
flagField=String
name, flagFlag :: Flag (CmdArgs Any)
flagFlag = forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [] (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Any -> Any
upd) String
"", flagEnum :: Maybe String
flagEnum=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Any -> String
ctor Any
x}]
    where upd :: Any -> Any
upd Any
v | Bool -> Bool
not (Any -> Bool
A.isString Any
x) Bool -> Bool -> Bool
&& Any -> Bool
A.isList Any
x = (String, Any) -> Any -> Any
setField (String
name, String -> Any -> Any
getField String
name Any
v forall a. Any -> Any -> Any
`A.append` Any
x) Any
v
                | Bool
otherwise = (String, Any) -> Any -> Any
setField (String
name,Any
x) Any
v
enum_ String
name x :: Capture Ann
x@Ctor{} = String -> Capture Ann -> [Flag_]
enum_ String
name forall a b. (a -> b) -> a -> b
$ forall ann. Any -> Capture ann
Value forall a b. (a -> b) -> a -> b
$ forall ann. Capture ann -> Any
fromCapture Capture Ann
x
enum_ String
name Capture Ann
x = forall {a}. String -> String -> a
errFlag String
name forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Capture Ann
x


-- Fixup (ends up in modeCheck) and the flag itself
value_ :: String -> Any -> (Fixup, Flag Any)
value_ :: String -> Any -> (Fixup, Flag Any)
value_ String
name Any
x
    | forall a. Maybe a -> Bool
isNothing Maybe Reader
mty = forall {a}. String -> String -> a
errFlag String
name forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Any
x
    | Reader -> Bool
readerBool Reader
ty =
        let f :: Either a b -> b
f (Right b
x) = b
x
            upd :: a -> Any -> Any
upd a
b Any
x = (String, Any) -> Any -> Any
setField (String
name, forall {a} {b}. Either a b -> b
f forall a b. (a -> b) -> a -> b
$ Reader -> Any -> String -> Either String Any
readerRead Reader
ty (String -> Any -> Any
getField String
name Any
x) forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
b) Any
x
        in (Fixup
fixup, forall a. [String] -> (Bool -> a -> a) -> String -> Flag a
flagBool [] forall {a}. Show a => a -> Any -> Any
upd String
"")
    | Bool
otherwise =
        let upd :: String -> Any -> Either String Any
upd String
s Any
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Any
c -> (String, Any) -> Any -> Any
setField (String
name,Any
c) Any
x) forall a b. (a -> b) -> a -> b
$ Reader -> Any -> String -> Either String Any
readerRead Reader
ty (String -> Any -> Any
getField String
name Any
x) String
s
        in (Fixup
fixup, forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [] String -> Any -> Either String Any
upd (Reader -> String
readerHelp Reader
ty) String
"")
    where
        mty :: Maybe Reader
mty = Any -> Maybe Reader
reader Any
x
        ty :: Reader
ty = forall a. HasCallStack => Maybe a -> a
fromJust Maybe Reader
mty
        fixup :: Fixup
fixup = (Any -> Any) -> Fixup
Fixup forall a b. (a -> b) -> a -> b
$ \Any
x -> (String, Any) -> Any -> Any
setField (String
name,Reader -> Any -> Any
readerFixup Reader
ty forall a b. (a -> b) -> a -> b
$ String -> Any -> Any
getField String
name Any
x) Any
x


---------------------------------------------------------------------
-- CAPTURE THE ANNOTATIONS

progAnn :: Ann -> Prog_ -> Prog_
progAnn :: Ann -> Prog_ -> Prog_
progAnn (ProgSummary String
a) Prog_
x = Prog_
x{progSummary :: Maybe [String]
progSummary=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
a}
progAnn (ProgProgram String
a) Prog_
x = Prog_
x{progProgram :: String
progProgram=String
a}
progAnn Ann
ProgVerbosity Prog_
x = Prog_
x{progVerbosityArgs :: (Maybe Builtin_, Maybe Builtin_)
progVerbosityArgs=let f :: ((Maybe Builtin_, Maybe Builtin_) -> Maybe a) -> Maybe a
f (Maybe Builtin_, Maybe Builtin_) -> Maybe a
sel = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ (Maybe Builtin_, Maybe Builtin_) -> Maybe a
sel forall a b. (a -> b) -> a -> b
$ Prog_ -> (Maybe Builtin_, Maybe Builtin_)
progVerbosityArgs Prog_
x in (forall {a}.
Default a =>
((Maybe Builtin_, Maybe Builtin_) -> Maybe a) -> Maybe a
f forall a b. (a, b) -> a
fst, forall {a}.
Default a =>
((Maybe Builtin_, Maybe Builtin_) -> Maybe a) -> Maybe a
f forall a b. (a, b) -> b
snd)}
progAnn (Help String
a) Prog_
x | forall (t :: * -> *) a. Foldable t => t a -> Int
length (Prog_ -> [Mode_]
progModes Prog_
x) forall a. Ord a => a -> a -> Bool
> Int
1 = Prog_
x{progHelp :: String
progHelp=String
a}
progAnn (ProgHelpArg [Ann]
a) Prog_
x = Prog_
x{progHelpArg :: Maybe Builtin_
progHelpArg = Maybe Builtin_ -> [Ann] -> Maybe Builtin_
builtinAnns (Prog_ -> Maybe Builtin_
progHelpArg Prog_
x) [Ann]
a}
progAnn (ProgVersionArg [Ann]
a) Prog_
x = Prog_
x{progVersionArg :: Maybe Builtin_
progVersionArg = Maybe Builtin_ -> [Ann] -> Maybe Builtin_
builtinAnns (Prog_ -> Maybe Builtin_
progVersionArg Prog_
x) [Ann]
a}
progAnn (ProgVerbosityArgs [Ann]
a [Ann]
b) Prog_
x = Prog_
x{progVerbosityArgs :: (Maybe Builtin_, Maybe Builtin_)
progVerbosityArgs=(Maybe Builtin_ -> [Ann] -> Maybe Builtin_
builtinAnns (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Prog_ -> (Maybe Builtin_, Maybe Builtin_)
progVerbosityArgs Prog_
x) [Ann]
a, Maybe Builtin_ -> [Ann] -> Maybe Builtin_
builtinAnns (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Prog_ -> (Maybe Builtin_, Maybe Builtin_)
progVerbosityArgs Prog_
x) [Ann]
b)}
progAnn Ann
ProgNoAtExpand Prog_
x = Prog_
x{progNoAtExpand :: Bool
progNoAtExpand=Bool
True}
progAnn Ann
a Prog_
x | forall (t :: * -> *) a. Foldable t => t a -> Int
length (Prog_ -> [Mode_]
progModes Prog_
x) forall a. Eq a => a -> a -> Bool
== Int
1 = Prog_
x{progModes :: [Mode_]
progModes = forall a b. (a -> b) -> [a] -> [b]
map (Ann -> Mode_ -> Mode_
modeAnn Ann
a) forall a b. (a -> b) -> a -> b
$ Prog_ -> [Mode_]
progModes Prog_
x}
progAnn Ann
a Prog_
x = forall {a}. String -> String -> a
err String
"program" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Ann
a


builtinAnns :: Maybe Builtin_ -> [Ann] -> Maybe Builtin_
builtinAnns = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip Ann -> Maybe Builtin_ -> Maybe Builtin_
builtinAnn)

builtinAnn :: Ann -> Maybe Builtin_ -> Maybe Builtin_
builtinAnn :: Ann -> Maybe Builtin_ -> Maybe Builtin_
builtinAnn Ann
_ Maybe Builtin_
Nothing = forall a. Maybe a
Nothing
builtinAnn Ann
Ignore Maybe Builtin_
_ = forall a. Maybe a
Nothing
builtinAnn Ann
Explicit (Just Builtin_
x) = forall a. a -> Maybe a
Just Builtin_
x{builtinExplicit :: Bool
builtinExplicit=Bool
True}
builtinAnn (Name String
a) (Just Builtin_
x) = forall a. a -> Maybe a
Just Builtin_
x{builtinNames :: [String]
builtinNames=String
a forall a. a -> [a] -> [a]
: Builtin_ -> [String]
builtinNames Builtin_
x}
builtinAnn (Help String
a) (Just Builtin_
x) = forall a. a -> Maybe a
Just Builtin_
x{builtinHelp :: Maybe String
builtinHelp=forall a. a -> Maybe a
Just String
a}
builtinAnn (GroupName String
a) (Just Builtin_
x) = forall a. a -> Maybe a
Just Builtin_
x{builtinGroup :: Maybe String
builtinGroup=forall a. a -> Maybe a
Just String
a}
builtinAnn (ProgSummary String
a) (Just Builtin_
x) = forall a. a -> Maybe a
Just Builtin_
x{builtinSummary :: Maybe [String]
builtinSummary=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
a}
builtinAnn Ann
a Maybe Builtin_
x = forall {a}. String -> String -> a
err String
"builtin" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Ann
a


modeAnn :: Ann -> Mode_ -> Mode_
modeAnn :: Ann -> Mode_ -> Mode_
modeAnn (Help String
a) Mode_
x = Mode_ -> (Mode (CmdArgs Any) -> Mode (CmdArgs Any)) -> Mode_
withMode Mode_
x forall a b. (a -> b) -> a -> b
$ \Mode (CmdArgs Any)
x -> Mode (CmdArgs Any)
x{modeHelp :: String
modeHelp=String
a}
modeAnn (ModeHelpSuffix [String]
a) Mode_
x = Mode_ -> (Mode (CmdArgs Any) -> Mode (CmdArgs Any)) -> Mode_
withMode Mode_
x forall a b. (a -> b) -> a -> b
$ \Mode (CmdArgs Any)
x -> Mode (CmdArgs Any)
x{modeHelpSuffix :: [String]
modeHelpSuffix=[String]
a}
modeAnn Ann
ModeDefault Mode_
x = Mode_
x{modeDefault :: Bool
modeDefault=Bool
True}
modeAnn (GroupName String
a) Mode_
x = Mode_
x{modeGroup :: Maybe String
modeGroup=forall a. a -> Maybe a
Just String
a}
modeAnn Ann
Explicit Mode_
x = Mode_
x{modeExplicit :: Bool
modeExplicit=Bool
True}
modeAnn (Name String
a) Mode_
x = Mode_ -> (Mode (CmdArgs Any) -> Mode (CmdArgs Any)) -> Mode_
withMode Mode_
x forall a b. (a -> b) -> a -> b
$ \Mode (CmdArgs Any)
x -> Mode (CmdArgs Any)
x{modeNames :: [String]
modeNames=String
aforall a. a -> [a] -> [a]
:forall a. Mode a -> [String]
modeNames Mode (CmdArgs Any)
x}
modeAnn Ann
a Mode_
x = forall {a}. String -> String -> a
err String
"mode" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Ann
a


flagAnn :: Ann -> Flag_ -> Flag_
flagAnn :: Ann -> Flag_ -> Flag_
flagAnn (FlagType String
a) x :: Flag_
x@Arg_{} = Flag_ -> (Arg (CmdArgs Any) -> Arg (CmdArgs Any)) -> Flag_
withFlagArg Flag_
x forall a b. (a -> b) -> a -> b
$ \Arg (CmdArgs Any)
x -> Arg (CmdArgs Any)
x{argType :: String
argType=String
a}
flagAnn (FlagType String
a) x :: Flag_
x@Flag_{} = Flag_ -> (Flag (CmdArgs Any) -> Flag (CmdArgs Any)) -> Flag_
withFlagFlag Flag_
x forall a b. (a -> b) -> a -> b
$ \Flag (CmdArgs Any)
x -> Flag (CmdArgs Any)
x{flagType :: String
flagType=String
a}
flagAnn (Help String
a) x :: Flag_
x@Flag_{} = Flag_ -> (Flag (CmdArgs Any) -> Flag (CmdArgs Any)) -> Flag_
withFlagFlag Flag_
x forall a b. (a -> b) -> a -> b
$ \Flag (CmdArgs Any)
x -> Flag (CmdArgs Any)
x{flagHelp :: String
flagHelp=String
a}
flagAnn (FlagArgPos Int
a) Flag_
x = Flag_ -> Maybe Int -> Flag_
toArg Flag_
x forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int
a
flagAnn Ann
FlagArgs Flag_
x = Flag_ -> Maybe Int -> Flag_
toArg Flag_
x forall a. Maybe a
Nothing
flagAnn Ann
Explicit x :: Flag_
x@Flag_{} = Flag_
x{flagExplicit :: Bool
flagExplicit=Bool
True}
flagAnn (FlagOptional String
a) x :: Flag_
x@Flag_{flagEnum :: Flag_ -> Maybe String
flagEnum=Maybe String
Nothing,flagFlag :: Flag_ -> Flag (CmdArgs Any)
flagFlag=Flag{flagInfo :: forall a. Flag a -> FlagInfo
flagInfo=FlagInfo
FlagReq}} = Flag_ -> (Flag (CmdArgs Any) -> Flag (CmdArgs Any)) -> Flag_
withFlagFlag Flag_
x forall a b. (a -> b) -> a -> b
$ \Flag (CmdArgs Any)
x -> Flag (CmdArgs Any)
x{flagInfo :: FlagInfo
flagInfo=String -> FlagInfo
FlagOpt String
a}
flagAnn (FlagOptional String
a) x :: Flag_
x@Arg_{} = Flag_
x{flagArgOpt :: Maybe String
flagArgOpt=forall a. a -> Maybe a
Just String
a}
flagAnn (Name String
a) x :: Flag_
x@Flag_{} = Flag_ -> (Flag (CmdArgs Any) -> Flag (CmdArgs Any)) -> Flag_
withFlagFlag Flag_
x forall a b. (a -> b) -> a -> b
$ \Flag (CmdArgs Any)
x -> Flag (CmdArgs Any)
x{flagNames :: [String]
flagNames = String
a forall a. a -> [a] -> [a]
: forall a. Flag a -> [String]
flagNames Flag (CmdArgs Any)
x}
flagAnn (GroupName String
a) x :: Flag_
x@Flag_{} = Flag_
x{flagGroup :: Maybe String
flagGroup=forall a. a -> Maybe a
Just String
a}
flagAnn Ann
a Flag_
x = forall {a}. String -> String -> a
errFlag (forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ String -> [String]
words forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Flag_
x) forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Ann
a

toArg :: Flag_ -> Maybe Int -> Flag_
toArg :: Flag_ -> Maybe Int -> Flag_
toArg (Flag_ String
fld Flag (CmdArgs Any)
x Bool
False Maybe String
Nothing Maybe String
Nothing Fixup
fix) Maybe Int
pos
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. Flag a -> [String]
flagNames Flag (CmdArgs Any)
x), forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. Flag a -> String
flagHelp Flag (CmdArgs Any)
x), Just Maybe String
y <- FlagInfo -> Maybe (Maybe String)
opt forall a b. (a -> b) -> a -> b
$ forall a. Flag a -> FlagInfo
flagInfo Flag (CmdArgs Any)
x
    = Arg (CmdArgs Any) -> Maybe Int -> Maybe String -> Fixup -> Flag_
Arg_ (forall a. Update a -> String -> Bool -> Arg a
Arg (forall a. Flag a -> Update a
flagValue Flag (CmdArgs Any)
x) (forall a. Flag a -> String
flagType Flag (CmdArgs Any)
x) (forall a. Maybe a -> Bool
isNothing Maybe String
y)) Maybe Int
pos Maybe String
y Fixup
fix
    where
        opt :: FlagInfo -> Maybe (Maybe String)
opt FlagInfo
FlagReq = forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
        opt (FlagOpt String
x) = forall a. a -> Maybe a
Just (forall a. a -> Maybe a
Just String
x)
        opt (FlagOptRare String
x) = forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
        opt FlagInfo
_ = forall a. Maybe a
Nothing
toArg Flag_
a Maybe Int
_ = forall {a}. String -> String -> a
errFlag String
"args/argPos" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Flag_
a