{-# LANGUAGE CPP, Rank2Types, ExistentialQuantification #-}
module Options.Applicative.Types (
  ParseError(..),
  ParserInfo(..),
  ParserPrefs(..),

  Option(..),
  OptName(..),
  isShortName,
  isLongName,

  OptReader(..),
  OptProperties(..),
  OptVisibility(..),
  Backtracking(..),
  ReadM(..),
  readerAsk,
  readerAbort,
  readerError,
  CReader(..),
  Parser(..),
  ParserM(..),
  Completer(..),
  mkCompleter,
  CompletionResult(..),
  ParserFailure(..),
  ParserResult(..),
  overFailure,
  Args,
  ArgPolicy(..),
  ArgumentReachability(..),
  AltNodeType(..),
  OptTree(..),
  ParserHelp(..),
  SomeParser(..),
  Context(..),
  IsCmdStart(..),

  fromM,
  oneM,
  manyM,
  someM,

  filterOptional,
  optVisibility,
  optMetaVar,
  optHelp,
  optShowDefault,
  optDescMod
  ) where

import Control.Applicative
import Control.Monad (ap, liftM, MonadPlus, mzero, mplus)
import Control.Monad.Trans.Except (Except, throwE)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ReaderT, ask)
import qualified Control.Monad.Fail as Fail
import Data.Semigroup hiding (Option)
import Prelude

import System.Exit (ExitCode(..))

import Options.Applicative.Help.Types
import Options.Applicative.Help.Pretty
import Options.Applicative.Help.Chunk


data ParseError
  = ErrorMsg String
  | InfoMsg String
  | ShowHelpText (Maybe String)
  | UnknownError
  | MissingError IsCmdStart SomeParser
  | ExpectsArgError String
  | UnexpectedError String SomeParser

data IsCmdStart = CmdStart | CmdCont
  deriving Int -> IsCmdStart -> ShowS
[IsCmdStart] -> ShowS
IsCmdStart -> String
(Int -> IsCmdStart -> ShowS)
-> (IsCmdStart -> String)
-> ([IsCmdStart] -> ShowS)
-> Show IsCmdStart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsCmdStart] -> ShowS
$cshowList :: [IsCmdStart] -> ShowS
show :: IsCmdStart -> String
$cshow :: IsCmdStart -> String
showsPrec :: Int -> IsCmdStart -> ShowS
$cshowsPrec :: Int -> IsCmdStart -> ShowS
Show

instance Monoid ParseError where
  mempty :: ParseError
mempty = ParseError
UnknownError
  mappend :: ParseError -> ParseError -> ParseError
mappend = ParseError -> ParseError -> ParseError
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup ParseError where
  ParseError
m <> :: ParseError -> ParseError -> ParseError
<> ParseError
UnknownError = ParseError
m
  ParseError
_ <> ParseError
m = ParseError
m

-- | A full description for a runnable 'Parser' for a program.
data ParserInfo a = ParserInfo
  { ParserInfo a -> Parser a
infoParser :: Parser a    -- ^ the option parser for the program
  , ParserInfo a -> Bool
infoFullDesc :: Bool      -- ^ whether the help text should contain full
                              -- documentation
  , ParserInfo a -> Chunk Doc
infoProgDesc :: Chunk Doc -- ^ brief parser description
  , ParserInfo a -> Chunk Doc
infoHeader :: Chunk Doc   -- ^ header of the full parser description
  , ParserInfo a -> Chunk Doc
infoFooter :: Chunk Doc   -- ^ footer of the full parser description
  , ParserInfo a -> Int
infoFailureCode :: Int    -- ^ exit code for a parser failure
  , ParserInfo a -> ArgPolicy
infoPolicy :: ArgPolicy   -- ^ allow regular options and flags to occur
                              -- after arguments (default: InterspersePolicy)
  }

instance Functor ParserInfo where
  fmap :: (a -> b) -> ParserInfo a -> ParserInfo b
fmap a -> b
f ParserInfo a
i = ParserInfo a
i { infoParser :: Parser b
infoParser = (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ParserInfo a -> Parser a
forall a. ParserInfo a -> Parser a
infoParser ParserInfo a
i) }

data Backtracking
  = Backtrack
  | NoBacktrack
  | SubparserInline
  deriving (Backtracking -> Backtracking -> Bool
(Backtracking -> Backtracking -> Bool)
-> (Backtracking -> Backtracking -> Bool) -> Eq Backtracking
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Backtracking -> Backtracking -> Bool
$c/= :: Backtracking -> Backtracking -> Bool
== :: Backtracking -> Backtracking -> Bool
$c== :: Backtracking -> Backtracking -> Bool
Eq, Int -> Backtracking -> ShowS
[Backtracking] -> ShowS
Backtracking -> String
(Int -> Backtracking -> ShowS)
-> (Backtracking -> String)
-> ([Backtracking] -> ShowS)
-> Show Backtracking
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Backtracking] -> ShowS
$cshowList :: [Backtracking] -> ShowS
show :: Backtracking -> String
$cshow :: Backtracking -> String
showsPrec :: Int -> Backtracking -> ShowS
$cshowsPrec :: Int -> Backtracking -> ShowS
Show)

-- | Global preferences for a top-level 'Parser'.
data ParserPrefs = ParserPrefs
  { ParserPrefs -> String
prefMultiSuffix :: String     -- ^ metavar suffix for multiple options
  , ParserPrefs -> Bool
prefDisambiguate :: Bool      -- ^ automatically disambiguate abbreviations
                                  -- (default: False)
  , ParserPrefs -> Bool
prefShowHelpOnError :: Bool   -- ^ always show help text on parse errors
                                  -- (default: False)
  , ParserPrefs -> Bool
prefShowHelpOnEmpty :: Bool   -- ^ show the help text for a command or subcommand
                                  -- if it fails with no input (default: False)
  , ParserPrefs -> Backtracking
prefBacktrack :: Backtracking -- ^ backtrack to parent parser when a
                                  -- subcommand fails (default: Backtrack)
  , ParserPrefs -> Int
prefColumns :: Int            -- ^ number of columns in the terminal, used to
                                  -- format the help page (default: 80)
  , ParserPrefs -> Bool
prefHelpLongEquals :: Bool    -- ^ when displaying long names in usage and help,
                                  -- use an '=' sign for long names, rather than a
                                  -- single space (default: False)
  , ParserPrefs -> Bool
prefHelpShowGlobal :: Bool    -- ^ when displaying subparsers' usage help,
                                  -- show parent options under a "global options"
                                  -- section (default: True)
  } deriving (ParserPrefs -> ParserPrefs -> Bool
(ParserPrefs -> ParserPrefs -> Bool)
-> (ParserPrefs -> ParserPrefs -> Bool) -> Eq ParserPrefs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParserPrefs -> ParserPrefs -> Bool
$c/= :: ParserPrefs -> ParserPrefs -> Bool
== :: ParserPrefs -> ParserPrefs -> Bool
$c== :: ParserPrefs -> ParserPrefs -> Bool
Eq, Int -> ParserPrefs -> ShowS
[ParserPrefs] -> ShowS
ParserPrefs -> String
(Int -> ParserPrefs -> ShowS)
-> (ParserPrefs -> String)
-> ([ParserPrefs] -> ShowS)
-> Show ParserPrefs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserPrefs] -> ShowS
$cshowList :: [ParserPrefs] -> ShowS
show :: ParserPrefs -> String
$cshow :: ParserPrefs -> String
showsPrec :: Int -> ParserPrefs -> ShowS
$cshowsPrec :: Int -> ParserPrefs -> ShowS
Show)

data OptName = OptShort !Char
             | OptLong !String
  deriving (OptName -> OptName -> Bool
(OptName -> OptName -> Bool)
-> (OptName -> OptName -> Bool) -> Eq OptName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptName -> OptName -> Bool
$c/= :: OptName -> OptName -> Bool
== :: OptName -> OptName -> Bool
$c== :: OptName -> OptName -> Bool
Eq, Eq OptName
Eq OptName
-> (OptName -> OptName -> Ordering)
-> (OptName -> OptName -> Bool)
-> (OptName -> OptName -> Bool)
-> (OptName -> OptName -> Bool)
-> (OptName -> OptName -> Bool)
-> (OptName -> OptName -> OptName)
-> (OptName -> OptName -> OptName)
-> Ord OptName
OptName -> OptName -> Bool
OptName -> OptName -> Ordering
OptName -> OptName -> OptName
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 :: OptName -> OptName -> OptName
$cmin :: OptName -> OptName -> OptName
max :: OptName -> OptName -> OptName
$cmax :: OptName -> OptName -> OptName
>= :: OptName -> OptName -> Bool
$c>= :: OptName -> OptName -> Bool
> :: OptName -> OptName -> Bool
$c> :: OptName -> OptName -> Bool
<= :: OptName -> OptName -> Bool
$c<= :: OptName -> OptName -> Bool
< :: OptName -> OptName -> Bool
$c< :: OptName -> OptName -> Bool
compare :: OptName -> OptName -> Ordering
$ccompare :: OptName -> OptName -> Ordering
$cp1Ord :: Eq OptName
Ord, Int -> OptName -> ShowS
[OptName] -> ShowS
OptName -> String
(Int -> OptName -> ShowS)
-> (OptName -> String) -> ([OptName] -> ShowS) -> Show OptName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptName] -> ShowS
$cshowList :: [OptName] -> ShowS
show :: OptName -> String
$cshow :: OptName -> String
showsPrec :: Int -> OptName -> ShowS
$cshowsPrec :: Int -> OptName -> ShowS
Show)

isShortName :: OptName -> Bool
isShortName :: OptName -> Bool
isShortName (OptShort Char
_) = Bool
True
isShortName (OptLong String
_)  = Bool
False

isLongName :: OptName -> Bool
isLongName :: OptName -> Bool
isLongName = Bool -> Bool
not (Bool -> Bool) -> (OptName -> Bool) -> OptName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptName -> Bool
isShortName

-- | Visibility of an option in the help text.
data OptVisibility
  = Internal          -- ^ does not appear in the help text at all
  | Hidden            -- ^ only visible in the full description
  | Visible           -- ^ visible both in the full and brief descriptions
  deriving (OptVisibility -> OptVisibility -> Bool
(OptVisibility -> OptVisibility -> Bool)
-> (OptVisibility -> OptVisibility -> Bool) -> Eq OptVisibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptVisibility -> OptVisibility -> Bool
$c/= :: OptVisibility -> OptVisibility -> Bool
== :: OptVisibility -> OptVisibility -> Bool
$c== :: OptVisibility -> OptVisibility -> Bool
Eq, Eq OptVisibility
Eq OptVisibility
-> (OptVisibility -> OptVisibility -> Ordering)
-> (OptVisibility -> OptVisibility -> Bool)
-> (OptVisibility -> OptVisibility -> Bool)
-> (OptVisibility -> OptVisibility -> Bool)
-> (OptVisibility -> OptVisibility -> Bool)
-> (OptVisibility -> OptVisibility -> OptVisibility)
-> (OptVisibility -> OptVisibility -> OptVisibility)
-> Ord OptVisibility
OptVisibility -> OptVisibility -> Bool
OptVisibility -> OptVisibility -> Ordering
OptVisibility -> OptVisibility -> OptVisibility
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 :: OptVisibility -> OptVisibility -> OptVisibility
$cmin :: OptVisibility -> OptVisibility -> OptVisibility
max :: OptVisibility -> OptVisibility -> OptVisibility
$cmax :: OptVisibility -> OptVisibility -> OptVisibility
>= :: OptVisibility -> OptVisibility -> Bool
$c>= :: OptVisibility -> OptVisibility -> Bool
> :: OptVisibility -> OptVisibility -> Bool
$c> :: OptVisibility -> OptVisibility -> Bool
<= :: OptVisibility -> OptVisibility -> Bool
$c<= :: OptVisibility -> OptVisibility -> Bool
< :: OptVisibility -> OptVisibility -> Bool
$c< :: OptVisibility -> OptVisibility -> Bool
compare :: OptVisibility -> OptVisibility -> Ordering
$ccompare :: OptVisibility -> OptVisibility -> Ordering
$cp1Ord :: Eq OptVisibility
Ord, Int -> OptVisibility -> ShowS
[OptVisibility] -> ShowS
OptVisibility -> String
(Int -> OptVisibility -> ShowS)
-> (OptVisibility -> String)
-> ([OptVisibility] -> ShowS)
-> Show OptVisibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptVisibility] -> ShowS
$cshowList :: [OptVisibility] -> ShowS
show :: OptVisibility -> String
$cshow :: OptVisibility -> String
showsPrec :: Int -> OptVisibility -> ShowS
$cshowsPrec :: Int -> OptVisibility -> ShowS
Show)

-- | Specification for an individual parser option.
data OptProperties = OptProperties
  { OptProperties -> OptVisibility
propVisibility :: OptVisibility       -- ^ whether this flag is shown in the brief description
  , OptProperties -> Chunk Doc
propHelp :: Chunk Doc                 -- ^ help text for this option
  , OptProperties -> String
propMetaVar :: String                 -- ^ metavariable for this option
  , OptProperties -> Maybe String
propShowDefault :: Maybe String       -- ^ what to show in the help text as the default
  , OptProperties -> Bool
propShowGlobal :: Bool                -- ^ whether the option is presented in global options text
  , OptProperties -> Maybe (Doc -> Doc)
propDescMod :: Maybe ( Doc -> Doc )   -- ^ a function to run over the brief description
  }

instance Show OptProperties where
  showsPrec :: Int -> OptProperties -> ShowS
showsPrec Int
p (OptProperties OptVisibility
pV Chunk Doc
pH String
pMV Maybe String
pSD Bool
pSG Maybe (Doc -> Doc)
_)
    = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"OptProperties { propVisibility = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptVisibility -> ShowS
forall a. Show a => a -> ShowS
shows OptVisibility
pV
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", propHelp = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk Doc -> ShowS
forall a. Show a => a -> ShowS
shows Chunk Doc
pH
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", propMetaVar = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows String
pMV
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", propShowDefault = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> ShowS
forall a. Show a => a -> ShowS
shows Maybe String
pSD
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", propShowGlobal = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ShowS
forall a. Show a => a -> ShowS
shows Bool
pSG
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", propDescMod = _ }"

-- | A single option of a parser.
data Option a = Option
  { Option a -> OptReader a
optMain :: OptReader a               -- ^ reader for this option
  , Option a -> OptProperties
optProps :: OptProperties            -- ^ properties of this option
  }

data SomeParser = forall a . SomeParser (Parser a)

-- | Subparser context, containing the 'name' of the subparser and its parser info.
--   Used by parserFailure to display relevant usage information when parsing inside a subparser fails.
data Context = forall a. Context String (ParserInfo a)

instance Show (Option a) where
    show :: Option a -> String
show Option a
opt = String
"Option {optProps = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ OptProperties -> String
forall a. Show a => a -> String
show (Option a -> OptProperties
forall a. Option a -> OptProperties
optProps Option a
opt) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"

instance Functor Option where
  fmap :: (a -> b) -> Option a -> Option b
fmap a -> b
f (Option OptReader a
m OptProperties
p) = OptReader b -> OptProperties -> Option b
forall a. OptReader a -> OptProperties -> Option a
Option ((a -> b) -> OptReader a -> OptReader b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f OptReader a
m) OptProperties
p

-- | A newtype over 'ReaderT String Except', used by option readers.
newtype ReadM a = ReadM
  { ReadM a -> ReaderT String (Except ParseError) a
unReadM :: ReaderT String (Except ParseError) a }

instance Functor ReadM where
  fmap :: (a -> b) -> ReadM a -> ReadM b
fmap a -> b
f (ReadM ReaderT String (Except ParseError) a
r) = ReaderT String (Except ParseError) b -> ReadM b
forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM ((a -> b)
-> ReaderT String (Except ParseError) a
-> ReaderT String (Except ParseError) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ReaderT String (Except ParseError) a
r)

instance Applicative ReadM where
  pure :: a -> ReadM a
pure = ReaderT String (Except ParseError) a -> ReadM a
forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM (ReaderT String (Except ParseError) a -> ReadM a)
-> (a -> ReaderT String (Except ParseError) a) -> a -> ReadM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT String (Except ParseError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ReadM ReaderT String (Except ParseError) (a -> b)
x <*> :: ReadM (a -> b) -> ReadM a -> ReadM b
<*> ReadM ReaderT String (Except ParseError) a
y = ReaderT String (Except ParseError) b -> ReadM b
forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM (ReaderT String (Except ParseError) b -> ReadM b)
-> ReaderT String (Except ParseError) b -> ReadM b
forall a b. (a -> b) -> a -> b
$ ReaderT String (Except ParseError) (a -> b)
x ReaderT String (Except ParseError) (a -> b)
-> ReaderT String (Except ParseError) a
-> ReaderT String (Except ParseError) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT String (Except ParseError) a
y

instance Alternative ReadM where
  empty :: ReadM a
empty = ReadM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  <|> :: ReadM a -> ReadM a -> ReadM a
(<|>) = ReadM a -> ReadM a -> ReadM a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance Monad ReadM where
  return :: a -> ReadM a
return = a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ReadM ReaderT String (Except ParseError) a
r >>= :: ReadM a -> (a -> ReadM b) -> ReadM b
>>= a -> ReadM b
f = ReaderT String (Except ParseError) b -> ReadM b
forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM (ReaderT String (Except ParseError) b -> ReadM b)
-> ReaderT String (Except ParseError) b -> ReadM b
forall a b. (a -> b) -> a -> b
$ ReaderT String (Except ParseError) a
r ReaderT String (Except ParseError) a
-> (a -> ReaderT String (Except ParseError) b)
-> ReaderT String (Except ParseError) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReadM b -> ReaderT String (Except ParseError) b
forall a. ReadM a -> ReaderT String (Except ParseError) a
unReadM (ReadM b -> ReaderT String (Except ParseError) b)
-> (a -> ReadM b) -> a -> ReaderT String (Except ParseError) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReadM b
f

#if !(MIN_VERSION_base(4,13,0))
  fail = Fail.fail
#endif

instance Fail.MonadFail ReadM where
  fail :: String -> ReadM a
fail = String -> ReadM a
forall a. String -> ReadM a
readerError

instance MonadPlus ReadM where
  mzero :: ReadM a
mzero = ReaderT String (Except ParseError) a -> ReadM a
forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM ReaderT String (Except ParseError) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  mplus :: ReadM a -> ReadM a -> ReadM a
mplus (ReadM ReaderT String (Except ParseError) a
x) (ReadM ReaderT String (Except ParseError) a
y) = ReaderT String (Except ParseError) a -> ReadM a
forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM (ReaderT String (Except ParseError) a -> ReadM a)
-> ReaderT String (Except ParseError) a -> ReadM a
forall a b. (a -> b) -> a -> b
$ ReaderT String (Except ParseError) a
-> ReaderT String (Except ParseError) a
-> ReaderT String (Except ParseError) a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus ReaderT String (Except ParseError) a
x ReaderT String (Except ParseError) a
y

-- | Return the value being read.
readerAsk :: ReadM String
readerAsk :: ReadM String
readerAsk = ReaderT String (Except ParseError) String -> ReadM String
forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM ReaderT String (Except ParseError) String
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask

-- | Abort option reader by exiting with a 'ParseError'.
readerAbort :: ParseError -> ReadM a
readerAbort :: ParseError -> ReadM a
readerAbort = ReaderT String (Except ParseError) a -> ReadM a
forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM (ReaderT String (Except ParseError) a -> ReadM a)
-> (ParseError -> ReaderT String (Except ParseError) a)
-> ParseError
-> ReadM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT ParseError Identity a
-> ReaderT String (Except ParseError) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT ParseError Identity a
 -> ReaderT String (Except ParseError) a)
-> (ParseError -> ExceptT ParseError Identity a)
-> ParseError
-> ReaderT String (Except ParseError) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> ExceptT ParseError Identity a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE

-- | Abort option reader by exiting with an error message.
readerError :: String -> ReadM a
readerError :: String -> ReadM a
readerError = ParseError -> ReadM a
forall a. ParseError -> ReadM a
readerAbort (ParseError -> ReadM a)
-> (String -> ParseError) -> String -> ReadM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseError
ErrorMsg

data CReader a = CReader
  { CReader a -> Completer
crCompleter :: Completer
  , CReader a -> ReadM a
crReader :: ReadM a }

instance Functor CReader where
  fmap :: (a -> b) -> CReader a -> CReader b
fmap a -> b
f (CReader Completer
c ReadM a
r) = Completer -> ReadM b -> CReader b
forall a. Completer -> ReadM a -> CReader a
CReader Completer
c ((a -> b) -> ReadM a -> ReadM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ReadM a
r)

-- | An 'OptReader' defines whether an option matches an command line argument.
data OptReader a
  = OptReader [OptName] (CReader a) (String -> ParseError)
  -- ^ option reader
  | FlagReader [OptName] !a
  -- ^ flag reader
  | ArgReader (CReader a)
  -- ^ argument reader
  | CmdReader (Maybe String) [String] (String -> Maybe (ParserInfo a))
  -- ^ command reader

instance Functor OptReader where
  fmap :: (a -> b) -> OptReader a -> OptReader b
fmap a -> b
f (OptReader [OptName]
ns CReader a
cr String -> ParseError
e) = [OptName] -> CReader b -> (String -> ParseError) -> OptReader b
forall a.
[OptName] -> CReader a -> (String -> ParseError) -> OptReader a
OptReader [OptName]
ns ((a -> b) -> CReader a -> CReader b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f CReader a
cr) String -> ParseError
e
  fmap a -> b
f (FlagReader [OptName]
ns a
x) = [OptName] -> b -> OptReader b
forall a. [OptName] -> a -> OptReader a
FlagReader [OptName]
ns (a -> b
f a
x)
  fmap a -> b
f (ArgReader CReader a
cr) = CReader b -> OptReader b
forall a. CReader a -> OptReader a
ArgReader ((a -> b) -> CReader a -> CReader b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f CReader a
cr)
  fmap a -> b
f (CmdReader Maybe String
n [String]
cs String -> Maybe (ParserInfo a)
g) = Maybe String
-> [String] -> (String -> Maybe (ParserInfo b)) -> OptReader b
forall a.
Maybe String
-> [String] -> (String -> Maybe (ParserInfo a)) -> OptReader a
CmdReader Maybe String
n [String]
cs (((ParserInfo a -> ParserInfo b)
-> Maybe (ParserInfo a) -> Maybe (ParserInfo b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ParserInfo a -> ParserInfo b)
 -> Maybe (ParserInfo a) -> Maybe (ParserInfo b))
-> ((a -> b) -> ParserInfo a -> ParserInfo b)
-> (a -> b)
-> Maybe (ParserInfo a)
-> Maybe (ParserInfo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> ParserInfo a -> ParserInfo b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f (Maybe (ParserInfo a) -> Maybe (ParserInfo b))
-> (String -> Maybe (ParserInfo a))
-> String
-> Maybe (ParserInfo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (ParserInfo a)
g)

-- | A @Parser a@ is an option parser returning a value of type 'a'.
data Parser a
  = NilP (Maybe a)
  | OptP (Option a)
  | forall x . MultP (Parser (x -> a)) (Parser x)
  | AltP (Parser a) (Parser a)
  | forall x . BindP (Parser x) (x -> Parser a)

instance Functor Parser where
  fmap :: (a -> b) -> Parser a -> Parser b
fmap a -> b
f (NilP Maybe a
x) = Maybe b -> Parser b
forall a. Maybe a -> Parser a
NilP ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
x)
  fmap a -> b
f (OptP Option a
opt) = Option b -> Parser b
forall a. Option a -> Parser a
OptP ((a -> b) -> Option a -> Option b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Option a
opt)
  fmap a -> b
f (MultP Parser (x -> a)
p1 Parser x
p2) = Parser (x -> b) -> Parser x -> Parser b
forall a x. Parser (x -> a) -> Parser x -> Parser a
MultP (((x -> a) -> x -> b) -> Parser (x -> a) -> Parser (x -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f(a -> b) -> (x -> a) -> x -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) Parser (x -> a)
p1) Parser x
p2
  fmap a -> b
f (AltP Parser a
p1 Parser a
p2) = Parser b -> Parser b -> Parser b
forall a. Parser a -> Parser a -> Parser a
AltP ((a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Parser a
p1) ((a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Parser a
p2)
  fmap a -> b
f (BindP Parser x
p x -> Parser a
k) = Parser x -> (x -> Parser b) -> Parser b
forall a x. Parser x -> (x -> Parser a) -> Parser a
BindP Parser x
p ((a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Parser a -> Parser b) -> (x -> Parser a) -> x -> Parser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Parser a
k)

instance Applicative Parser where
  pure :: a -> Parser a
pure = Maybe a -> Parser a
forall a. Maybe a -> Parser a
NilP (Maybe a -> Parser a) -> (a -> Maybe a) -> a -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
  <*> :: Parser (a -> b) -> Parser a -> Parser b
(<*>) = Parser (a -> b) -> Parser a -> Parser b
forall a x. Parser (x -> a) -> Parser x -> Parser a
MultP

newtype ParserM r = ParserM
  { ParserM r -> forall x. (r -> Parser x) -> Parser x
runParserM :: forall x . (r -> Parser x) -> Parser x }

instance Monad ParserM where
  return :: a -> ParserM a
return = a -> ParserM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ParserM forall x. (a -> Parser x) -> Parser x
f >>= :: ParserM a -> (a -> ParserM b) -> ParserM b
>>= a -> ParserM b
g = (forall x. (b -> Parser x) -> Parser x) -> ParserM b
forall r. (forall x. (r -> Parser x) -> Parser x) -> ParserM r
ParserM ((forall x. (b -> Parser x) -> Parser x) -> ParserM b)
-> (forall x. (b -> Parser x) -> Parser x) -> ParserM b
forall a b. (a -> b) -> a -> b
$ \b -> Parser x
k -> (a -> Parser x) -> Parser x
forall x. (a -> Parser x) -> Parser x
f (\a
x -> ParserM b -> (b -> Parser x) -> Parser x
forall r. ParserM r -> forall x. (r -> Parser x) -> Parser x
runParserM (a -> ParserM b
g a
x) b -> Parser x
k)

instance Functor ParserM where
  fmap :: (a -> b) -> ParserM a -> ParserM b
fmap = (a -> b) -> ParserM a -> ParserM b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative ParserM where
  pure :: a -> ParserM a
pure a
x = (forall x. (a -> Parser x) -> Parser x) -> ParserM a
forall r. (forall x. (r -> Parser x) -> Parser x) -> ParserM r
ParserM ((forall x. (a -> Parser x) -> Parser x) -> ParserM a)
-> (forall x. (a -> Parser x) -> Parser x) -> ParserM a
forall a b. (a -> b) -> a -> b
$ \a -> Parser x
k -> a -> Parser x
k a
x
  <*> :: ParserM (a -> b) -> ParserM a -> ParserM b
(<*>) = ParserM (a -> b) -> ParserM a -> ParserM b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

fromM :: ParserM a -> Parser a
fromM :: ParserM a -> Parser a
fromM (ParserM forall x. (a -> Parser x) -> Parser x
f) = (a -> Parser a) -> Parser a
forall x. (a -> Parser x) -> Parser x
f a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

oneM :: Parser a -> ParserM a
oneM :: Parser a -> ParserM a
oneM Parser a
p = (forall x. (a -> Parser x) -> Parser x) -> ParserM a
forall r. (forall x. (r -> Parser x) -> Parser x) -> ParserM r
ParserM (Parser a -> (a -> Parser x) -> Parser x
forall a x. Parser x -> (x -> Parser a) -> Parser a
BindP Parser a
p)

manyM :: Parser a -> ParserM [a]
manyM :: Parser a -> ParserM [a]
manyM Parser a
p = do
  Maybe a
mx <- Parser (Maybe a) -> ParserM (Maybe a)
forall a. Parser a -> ParserM a
oneM (Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser a
p)
  case Maybe a
mx of
    Maybe a
Nothing -> [a] -> ParserM [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just a
x -> (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> ParserM [a] -> ParserM [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> ParserM [a]
forall a. Parser a -> ParserM [a]
manyM Parser a
p

someM :: Parser a -> ParserM [a]
someM :: Parser a -> ParserM [a]
someM Parser a
p = (:) (a -> [a] -> [a]) -> ParserM a -> ParserM ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> ParserM a
forall a. Parser a -> ParserM a
oneM Parser a
p ParserM ([a] -> [a]) -> ParserM [a] -> ParserM [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a -> ParserM [a]
forall a. Parser a -> ParserM [a]
manyM Parser a
p

instance Alternative Parser where
  empty :: Parser a
empty = Maybe a -> Parser a
forall a. Maybe a -> Parser a
NilP Maybe a
forall a. Maybe a
Nothing
  <|> :: Parser a -> Parser a -> Parser a
(<|>) = Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
AltP
  many :: Parser a -> Parser [a]
many = ParserM [a] -> Parser [a]
forall a. ParserM a -> Parser a
fromM (ParserM [a] -> Parser [a])
-> (Parser a -> ParserM [a]) -> Parser a -> Parser [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ParserM [a]
forall a. Parser a -> ParserM [a]
manyM
  some :: Parser a -> Parser [a]
some = ParserM [a] -> Parser [a]
forall a. ParserM a -> Parser a
fromM (ParserM [a] -> Parser [a])
-> (Parser a -> ParserM [a]) -> Parser a -> Parser [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ParserM [a]
forall a. Parser a -> ParserM [a]
someM

-- | A shell complete function.
newtype Completer = Completer
  { Completer -> String -> IO [String]
runCompleter :: String -> IO [String] }

-- | Smart constructor for a 'Completer'
mkCompleter :: (String -> IO [String]) -> Completer
mkCompleter :: (String -> IO [String]) -> Completer
mkCompleter = (String -> IO [String]) -> Completer
Completer

instance Semigroup Completer where
  (Completer String -> IO [String]
c1) <> :: Completer -> Completer -> Completer
<> (Completer String -> IO [String]
c2) =
    (String -> IO [String]) -> Completer
Completer ((String -> IO [String]) -> Completer)
-> (String -> IO [String]) -> Completer
forall a b. (a -> b) -> a -> b
$ \String
s -> [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) ([String] -> [String] -> [String])
-> IO [String] -> IO ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
c1 String
s IO ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO [String]
c2 String
s

instance Monoid Completer where
  mempty :: Completer
mempty = (String -> IO [String]) -> Completer
Completer ((String -> IO [String]) -> Completer)
-> (String -> IO [String]) -> Completer
forall a b. (a -> b) -> a -> b
$ \String
_ -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  mappend :: Completer -> Completer -> Completer
mappend = Completer -> Completer -> Completer
forall a. Semigroup a => a -> a -> a
(<>)

newtype CompletionResult = CompletionResult
  { CompletionResult -> String -> IO String
execCompletion :: String -> IO String }

instance Show CompletionResult where
  showsPrec :: Int -> CompletionResult -> ShowS
showsPrec Int
p CompletionResult
_ = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"CompletionResult _"

newtype ParserFailure h = ParserFailure
  { ParserFailure h -> String -> (h, ExitCode, Int)
execFailure :: String -> (h, ExitCode, Int) }

instance Show h => Show (ParserFailure h) where
  showsPrec :: Int -> ParserFailure h -> ShowS
showsPrec Int
p (ParserFailure String -> (h, ExitCode, Int)
f)
    = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ParserFailure"
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (h, ExitCode, Int) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (String -> (h, ExitCode, Int)
f String
"<program>")

instance Functor ParserFailure where
  fmap :: (a -> b) -> ParserFailure a -> ParserFailure b
fmap a -> b
f (ParserFailure String -> (a, ExitCode, Int)
err) = (String -> (b, ExitCode, Int)) -> ParserFailure b
forall h. (String -> (h, ExitCode, Int)) -> ParserFailure h
ParserFailure ((String -> (b, ExitCode, Int)) -> ParserFailure b)
-> (String -> (b, ExitCode, Int)) -> ParserFailure b
forall a b. (a -> b) -> a -> b
$ \String
progn ->
    let (a
h, ExitCode
exit, Int
cols) = String -> (a, ExitCode, Int)
err String
progn in (a -> b
f a
h, ExitCode
exit, Int
cols)

-- | Result of 'execParserPure'.
data ParserResult a
  = Success a
  | Failure (ParserFailure ParserHelp)
  | CompletionInvoked CompletionResult
  deriving Int -> ParserResult a -> ShowS
[ParserResult a] -> ShowS
ParserResult a -> String
(Int -> ParserResult a -> ShowS)
-> (ParserResult a -> String)
-> ([ParserResult a] -> ShowS)
-> Show (ParserResult a)
forall a. Show a => Int -> ParserResult a -> ShowS
forall a. Show a => [ParserResult a] -> ShowS
forall a. Show a => ParserResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserResult a] -> ShowS
$cshowList :: forall a. Show a => [ParserResult a] -> ShowS
show :: ParserResult a -> String
$cshow :: forall a. Show a => ParserResult a -> String
showsPrec :: Int -> ParserResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ParserResult a -> ShowS
Show

instance Functor ParserResult where
  fmap :: (a -> b) -> ParserResult a -> ParserResult b
fmap a -> b
f (Success a
a) = b -> ParserResult b
forall a. a -> ParserResult a
Success (a -> b
f a
a)
  fmap a -> b
_ (Failure ParserFailure ParserHelp
f) = ParserFailure ParserHelp -> ParserResult b
forall a. ParserFailure ParserHelp -> ParserResult a
Failure ParserFailure ParserHelp
f
  fmap a -> b
_ (CompletionInvoked CompletionResult
c) = CompletionResult -> ParserResult b
forall a. CompletionResult -> ParserResult a
CompletionInvoked CompletionResult
c

overFailure :: (ParserHelp -> ParserHelp)
            -> ParserResult a -> ParserResult a
overFailure :: (ParserHelp -> ParserHelp) -> ParserResult a -> ParserResult a
overFailure ParserHelp -> ParserHelp
f (Failure ParserFailure ParserHelp
failure) = ParserFailure ParserHelp -> ParserResult a
forall a. ParserFailure ParserHelp -> ParserResult a
Failure (ParserFailure ParserHelp -> ParserResult a)
-> ParserFailure ParserHelp -> ParserResult a
forall a b. (a -> b) -> a -> b
$ (ParserHelp -> ParserHelp)
-> ParserFailure ParserHelp -> ParserFailure ParserHelp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParserHelp -> ParserHelp
f ParserFailure ParserHelp
failure
overFailure ParserHelp -> ParserHelp
_ ParserResult a
r = ParserResult a
r

instance Applicative ParserResult where
  pure :: a -> ParserResult a
pure = a -> ParserResult a
forall a. a -> ParserResult a
Success
  Success a -> b
f <*> :: ParserResult (a -> b) -> ParserResult a -> ParserResult b
<*> ParserResult a
r = (a -> b) -> ParserResult a -> ParserResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ParserResult a
r
  Failure ParserFailure ParserHelp
f <*> ParserResult a
_ = ParserFailure ParserHelp -> ParserResult b
forall a. ParserFailure ParserHelp -> ParserResult a
Failure ParserFailure ParserHelp
f
  CompletionInvoked CompletionResult
c <*> ParserResult a
_ = CompletionResult -> ParserResult b
forall a. CompletionResult -> ParserResult a
CompletionInvoked CompletionResult
c

instance Monad ParserResult where
  return :: a -> ParserResult a
return = a -> ParserResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Success a
x >>= :: ParserResult a -> (a -> ParserResult b) -> ParserResult b
>>= a -> ParserResult b
f = a -> ParserResult b
f a
x
  Failure ParserFailure ParserHelp
f >>= a -> ParserResult b
_ = ParserFailure ParserHelp -> ParserResult b
forall a. ParserFailure ParserHelp -> ParserResult a
Failure ParserFailure ParserHelp
f
  CompletionInvoked CompletionResult
c >>= a -> ParserResult b
_ = CompletionResult -> ParserResult b
forall a. CompletionResult -> ParserResult a
CompletionInvoked CompletionResult
c

type Args = [String]

-- | Policy for how to handle options within the parse
data ArgPolicy
  = Intersperse
  -- ^ The default policy, options and arguments can
  --   be interspersed.
  --   A `--` option can be passed to ensure all following
  --   commands are treated as arguments.
  | NoIntersperse
  -- ^ Options must all come before arguments, once a
  --   single positional argument or subcommand is parsed,
  --   all remaining arguments are treated as positionals.
  --   A `--` option can be passed if the first positional
  --   one needs starts with `-`.
  | AllPositionals
  -- ^ No options are parsed at all, all arguments are
  --   treated as positionals.
  --   Is the policy used after `--` is encountered.
  | ForwardOptions
  -- ^ Options and arguments can be interspersed, but if
  --   a given option is not found, it is treated as a
  --   positional argument. This is sometimes useful if
  --   one is passing through most options to another tool,
  --   but are supplying just a few of their own options.
  deriving (ArgPolicy -> ArgPolicy -> Bool
(ArgPolicy -> ArgPolicy -> Bool)
-> (ArgPolicy -> ArgPolicy -> Bool) -> Eq ArgPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgPolicy -> ArgPolicy -> Bool
$c/= :: ArgPolicy -> ArgPolicy -> Bool
== :: ArgPolicy -> ArgPolicy -> Bool
$c== :: ArgPolicy -> ArgPolicy -> Bool
Eq, Eq ArgPolicy
Eq ArgPolicy
-> (ArgPolicy -> ArgPolicy -> Ordering)
-> (ArgPolicy -> ArgPolicy -> Bool)
-> (ArgPolicy -> ArgPolicy -> Bool)
-> (ArgPolicy -> ArgPolicy -> Bool)
-> (ArgPolicy -> ArgPolicy -> Bool)
-> (ArgPolicy -> ArgPolicy -> ArgPolicy)
-> (ArgPolicy -> ArgPolicy -> ArgPolicy)
-> Ord ArgPolicy
ArgPolicy -> ArgPolicy -> Bool
ArgPolicy -> ArgPolicy -> Ordering
ArgPolicy -> ArgPolicy -> ArgPolicy
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 :: ArgPolicy -> ArgPolicy -> ArgPolicy
$cmin :: ArgPolicy -> ArgPolicy -> ArgPolicy
max :: ArgPolicy -> ArgPolicy -> ArgPolicy
$cmax :: ArgPolicy -> ArgPolicy -> ArgPolicy
>= :: ArgPolicy -> ArgPolicy -> Bool
$c>= :: ArgPolicy -> ArgPolicy -> Bool
> :: ArgPolicy -> ArgPolicy -> Bool
$c> :: ArgPolicy -> ArgPolicy -> Bool
<= :: ArgPolicy -> ArgPolicy -> Bool
$c<= :: ArgPolicy -> ArgPolicy -> Bool
< :: ArgPolicy -> ArgPolicy -> Bool
$c< :: ArgPolicy -> ArgPolicy -> Bool
compare :: ArgPolicy -> ArgPolicy -> Ordering
$ccompare :: ArgPolicy -> ArgPolicy -> Ordering
$cp1Ord :: Eq ArgPolicy
Ord, Int -> ArgPolicy -> ShowS
[ArgPolicy] -> ShowS
ArgPolicy -> String
(Int -> ArgPolicy -> ShowS)
-> (ArgPolicy -> String)
-> ([ArgPolicy] -> ShowS)
-> Show ArgPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArgPolicy] -> ShowS
$cshowList :: [ArgPolicy] -> ShowS
show :: ArgPolicy -> String
$cshow :: ArgPolicy -> String
showsPrec :: Int -> ArgPolicy -> ShowS
$cshowsPrec :: Int -> ArgPolicy -> ShowS
Show)

newtype ArgumentReachability = ArgumentReachability
  { ArgumentReachability -> Bool
argumentIsUnreachable :: Bool -- ^ If the result is a positional, if it can't be
                                  --    accessed in the current parser position ( first arg )
  } deriving (ArgumentReachability -> ArgumentReachability -> Bool
(ArgumentReachability -> ArgumentReachability -> Bool)
-> (ArgumentReachability -> ArgumentReachability -> Bool)
-> Eq ArgumentReachability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgumentReachability -> ArgumentReachability -> Bool
$c/= :: ArgumentReachability -> ArgumentReachability -> Bool
== :: ArgumentReachability -> ArgumentReachability -> Bool
$c== :: ArgumentReachability -> ArgumentReachability -> Bool
Eq, Int -> ArgumentReachability -> ShowS
[ArgumentReachability] -> ShowS
ArgumentReachability -> String
(Int -> ArgumentReachability -> ShowS)
-> (ArgumentReachability -> String)
-> ([ArgumentReachability] -> ShowS)
-> Show ArgumentReachability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArgumentReachability] -> ShowS
$cshowList :: [ArgumentReachability] -> ShowS
show :: ArgumentReachability -> String
$cshow :: ArgumentReachability -> String
showsPrec :: Int -> ArgumentReachability -> ShowS
$cshowsPrec :: Int -> ArgumentReachability -> ShowS
Show)

-- | This type encapsulates whether an 'AltNode' of an 'OptTree' should be displayed
-- with brackets around it.
data AltNodeType = MarkDefault | NoDefault
  deriving (Int -> AltNodeType -> ShowS
[AltNodeType] -> ShowS
AltNodeType -> String
(Int -> AltNodeType -> ShowS)
-> (AltNodeType -> String)
-> ([AltNodeType] -> ShowS)
-> Show AltNodeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AltNodeType] -> ShowS
$cshowList :: [AltNodeType] -> ShowS
show :: AltNodeType -> String
$cshow :: AltNodeType -> String
showsPrec :: Int -> AltNodeType -> ShowS
$cshowsPrec :: Int -> AltNodeType -> ShowS
Show, AltNodeType -> AltNodeType -> Bool
(AltNodeType -> AltNodeType -> Bool)
-> (AltNodeType -> AltNodeType -> Bool) -> Eq AltNodeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AltNodeType -> AltNodeType -> Bool
$c/= :: AltNodeType -> AltNodeType -> Bool
== :: AltNodeType -> AltNodeType -> Bool
$c== :: AltNodeType -> AltNodeType -> Bool
Eq)

data OptTree a
  = Leaf a
  | MultNode [OptTree a]
  | AltNode AltNodeType [OptTree a]
  | BindNode (OptTree a)
  deriving Int -> OptTree a -> ShowS
[OptTree a] -> ShowS
OptTree a -> String
(Int -> OptTree a -> ShowS)
-> (OptTree a -> String)
-> ([OptTree a] -> ShowS)
-> Show (OptTree a)
forall a. Show a => Int -> OptTree a -> ShowS
forall a. Show a => [OptTree a] -> ShowS
forall a. Show a => OptTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptTree a] -> ShowS
$cshowList :: forall a. Show a => [OptTree a] -> ShowS
show :: OptTree a -> String
$cshow :: forall a. Show a => OptTree a -> String
showsPrec :: Int -> OptTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> OptTree a -> ShowS
Show

filterOptional :: OptTree a -> OptTree a
filterOptional :: OptTree a -> OptTree a
filterOptional OptTree a
t = case OptTree a
t of
  Leaf a
a
    -> a -> OptTree a
forall a. a -> OptTree a
Leaf a
a
  MultNode [OptTree a]
xs
    -> [OptTree a] -> OptTree a
forall a. [OptTree a] -> OptTree a
MultNode ((OptTree a -> OptTree a) -> [OptTree a] -> [OptTree a]
forall a b. (a -> b) -> [a] -> [b]
map OptTree a -> OptTree a
forall a. OptTree a -> OptTree a
filterOptional [OptTree a]
xs)
  AltNode AltNodeType
MarkDefault [OptTree a]
_
    -> AltNodeType -> [OptTree a] -> OptTree a
forall a. AltNodeType -> [OptTree a] -> OptTree a
AltNode AltNodeType
MarkDefault []
  AltNode AltNodeType
NoDefault [OptTree a]
xs
    -> AltNodeType -> [OptTree a] -> OptTree a
forall a. AltNodeType -> [OptTree a] -> OptTree a
AltNode AltNodeType
NoDefault ((OptTree a -> OptTree a) -> [OptTree a] -> [OptTree a]
forall a b. (a -> b) -> [a] -> [b]
map OptTree a -> OptTree a
forall a. OptTree a -> OptTree a
filterOptional [OptTree a]
xs)
  BindNode OptTree a
xs
    -> OptTree a -> OptTree a
forall a. OptTree a -> OptTree a
BindNode (OptTree a -> OptTree a
forall a. OptTree a -> OptTree a
filterOptional OptTree a
xs)

optVisibility :: Option a -> OptVisibility
optVisibility :: Option a -> OptVisibility
optVisibility = OptProperties -> OptVisibility
propVisibility (OptProperties -> OptVisibility)
-> (Option a -> OptProperties) -> Option a -> OptVisibility
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option a -> OptProperties
forall a. Option a -> OptProperties
optProps

optHelp :: Option a -> Chunk Doc
optHelp :: Option a -> Chunk Doc
optHelp  = OptProperties -> Chunk Doc
propHelp (OptProperties -> Chunk Doc)
-> (Option a -> OptProperties) -> Option a -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option a -> OptProperties
forall a. Option a -> OptProperties
optProps

optMetaVar :: Option a -> String
optMetaVar :: Option a -> String
optMetaVar = OptProperties -> String
propMetaVar (OptProperties -> String)
-> (Option a -> OptProperties) -> Option a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option a -> OptProperties
forall a. Option a -> OptProperties
optProps

optShowDefault :: Option a -> Maybe String
optShowDefault :: Option a -> Maybe String
optShowDefault = OptProperties -> Maybe String
propShowDefault (OptProperties -> Maybe String)
-> (Option a -> OptProperties) -> Option a -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option a -> OptProperties
forall a. Option a -> OptProperties
optProps

optDescMod :: Option a -> Maybe ( Doc -> Doc )
optDescMod :: Option a -> Maybe (Doc -> Doc)
optDescMod = OptProperties -> Maybe (Doc -> Doc)
propDescMod (OptProperties -> Maybe (Doc -> Doc))
-> (Option a -> OptProperties) -> Option a -> Maybe (Doc -> Doc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option a -> OptProperties
forall a. Option a -> OptProperties
optProps