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

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

data Backtracking
  = Backtrack
  | NoBacktrack
  | SubparserInline
  deriving (Backtracking -> Backtracking -> Bool
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
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: False)
  , ParserPrefs -> Int
prefTabulateFill ::Int       -- ^ Indentation width for tables
  } deriving (ParserPrefs -> ParserPrefs -> Bool
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
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
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
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
Ord, Int -> OptName -> ShowS
[OptName] -> ShowS
OptName -> String
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 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
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
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
Ord, Int -> OptVisibility -> ShowS
[OptVisibility] -> ShowS
OptVisibility -> String
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 forall a. Ord a => a -> a -> Bool
>= Int
11)
    forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"OptProperties { propVisibility = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows OptVisibility
pV
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", propHelp = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Chunk Doc
pH
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", propMetaVar = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
pMV
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", propShowDefault = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Maybe String
pSD
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", propShowGlobal = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Bool
pSG
    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
  { forall a. Option a -> OptReader a
optMain :: OptReader a               -- ^ reader for this option
  , forall a. 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 = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Option a -> OptProperties
optProps Option a
opt) forall a. [a] -> [a] -> [a]
++ String
"}"

instance Functor Option where
  fmap :: forall a b. (a -> b) -> Option a -> Option b
fmap a -> b
f (Option OptReader a
m OptProperties
p) = forall a. OptReader a -> OptProperties -> Option a
Option (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
  { forall a. ReadM a -> ReaderT String (Except ParseError) a
unReadM :: ReaderT String (Except ParseError) a }

instance Functor ReadM where
  fmap :: forall a b. (a -> b) -> ReadM a -> ReadM b
fmap a -> b
f (ReadM ReaderT String (Except ParseError) a
r) = forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM (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 :: forall a. a -> ReadM a
pure = forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ReadM ReaderT String (Except ParseError) (a -> b)
x <*> :: forall a b. ReadM (a -> b) -> ReadM a -> ReadM b
<*> ReadM ReaderT String (Except ParseError) a
y = forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM forall a b. (a -> b) -> a -> b
$ ReaderT String (Except ParseError) (a -> b)
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT String (Except ParseError) a
y

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

instance Monad ReadM where
  return :: forall a. a -> ReadM a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ReadM ReaderT String (Except ParseError) a
r >>= :: forall a b. ReadM a -> (a -> ReadM b) -> ReadM b
>>= a -> ReadM b
f = forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM forall a b. (a -> b) -> a -> b
$ ReaderT String (Except ParseError) a
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. ReadM a -> ReaderT String (Except ParseError) a
unReadM 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 :: forall a. String -> ReadM a
fail = forall a. String -> ReadM a
readerError

instance MonadPlus ReadM where
  mzero :: forall a. ReadM a
mzero = forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM forall (m :: * -> *) a. MonadPlus m => m a
mzero
  mplus :: forall a. ReadM a -> ReadM a -> ReadM a
mplus (ReadM ReaderT String (Except ParseError) a
x) (ReadM ReaderT String (Except ParseError) a
y) = forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM forall a b. (a -> b) -> a -> b
$ 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 = forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM forall (m :: * -> *) r. Monad m => ReaderT r m r
ask

-- | Abort option reader by exiting with a 'ParseError'.
readerAbort :: ParseError -> ReadM a
readerAbort :: forall a. ParseError -> ReadM a
readerAbort = forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. String -> ReadM a
readerError = forall a. ParseError -> ReadM a
readerAbort forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseError
ErrorMsg

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

instance Functor CReader where
  fmap :: forall a b. (a -> b) -> CReader a -> CReader b
fmap a -> b
f (CReader Completer
c ReadM a
r) = forall a. Completer -> ReadM a -> CReader a
CReader Completer
c (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 :: forall a b. (a -> b) -> OptReader a -> OptReader b
fmap a -> b
f (OptReader [OptName]
ns CReader a
cr String -> ParseError
e) = forall a.
[OptName] -> CReader a -> (String -> ParseError) -> OptReader a
OptReader [OptName]
ns (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) = forall a. [OptName] -> a -> OptReader a
FlagReader [OptName]
ns (a -> b
f a
x)
  fmap a -> b
f (ArgReader CReader a
cr) = forall a. CReader a -> OptReader a
ArgReader (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) = forall a.
Maybe String
-> [String] -> (String -> Maybe (ParserInfo a)) -> OptReader a
CmdReader Maybe String
n [String]
cs ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f 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 :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f (NilP Maybe a
x) = forall a. Maybe a -> Parser a
NilP (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) = forall a. Option a -> Parser a
OptP (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) = forall a x. Parser (x -> a) -> Parser x -> Parser a
MultP (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
fforall 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) = forall a. Parser a -> Parser a -> Parser a
AltP (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Parser a
p1) (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) = forall a x. Parser x -> (x -> Parser a) -> Parser a
BindP Parser x
p (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Parser a
k)

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

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

instance Monad ParserM where
  return :: forall a. a -> ParserM a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ParserM forall x. (a -> Parser x) -> Parser x
f >>= :: forall a b. ParserM a -> (a -> ParserM b) -> ParserM b
>>= a -> ParserM b
g = forall r. (forall x. (r -> Parser x) -> Parser x) -> ParserM r
ParserM forall a b. (a -> b) -> a -> b
$ \b -> Parser x
k -> forall x. (a -> Parser x) -> Parser x
f (\a
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 :: forall a b. (a -> b) -> ParserM a -> ParserM b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative ParserM where
  pure :: forall a. a -> ParserM a
pure a
x = forall r. (forall x. (r -> Parser x) -> Parser x) -> ParserM r
ParserM forall a b. (a -> b) -> a -> b
$ \a -> Parser x
k -> a -> Parser x
k a
x
  <*> :: forall a 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 :: forall a. ParserM a -> Parser a
fromM (ParserM forall x. (a -> Parser x) -> Parser x
f) = forall x. (a -> Parser x) -> Parser x
f forall (f :: * -> *) a. Applicative f => a -> f a
pure

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

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

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

instance Alternative Parser where
  empty :: forall a. Parser a
empty = forall a. Maybe a -> Parser a
NilP forall a. Maybe a
Nothing
  <|> :: forall a. Parser a -> Parser a -> Parser a
(<|>) = forall a. Parser a -> Parser a -> Parser a
AltP
  many :: forall a. Parser a -> Parser [a]
many = forall a. ParserM a -> Parser a
fromM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ParserM [a]
manyM
  some :: forall a. Parser a -> Parser [a]
some = forall a. ParserM a -> Parser a
fromM forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ \String
s -> forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
c1 String
s 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 forall a b. (a -> b) -> a -> b
$ \String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
  mappend :: Completer -> Completer -> Completer
mappend = 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"CompletionResult _"

newtype ParserFailure h = ParserFailure
  { forall h. 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 forall a. Ord a => a -> a -> Bool
> Int
10)
    forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ParserFailure"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (String -> (h, ExitCode, Int)
f String
"<program>")

instance Functor ParserFailure where
  fmap :: forall a b. (a -> b) -> ParserFailure a -> ParserFailure b
fmap a -> b
f (ParserFailure String -> (a, ExitCode, Int)
err) = forall h. (String -> (h, ExitCode, Int)) -> ParserFailure h
ParserFailure 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
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 :: forall a b. (a -> b) -> ParserResult a -> ParserResult b
fmap a -> b
f (Success a
a) = forall a. a -> ParserResult a
Success (a -> b
f a
a)
  fmap a -> b
_ (Failure ParserFailure ParserHelp
f) = forall a. ParserFailure ParserHelp -> ParserResult a
Failure ParserFailure ParserHelp
f
  fmap a -> b
_ (CompletionInvoked CompletionResult
c) = forall a. CompletionResult -> ParserResult a
CompletionInvoked CompletionResult
c

overFailure :: (ParserHelp -> ParserHelp)
            -> ParserResult a -> ParserResult a
overFailure :: forall a.
(ParserHelp -> ParserHelp) -> ParserResult a -> ParserResult a
overFailure ParserHelp -> ParserHelp
f (Failure ParserFailure ParserHelp
failure) = forall a. ParserFailure ParserHelp -> ParserResult a
Failure forall a b. (a -> b) -> a -> b
$ 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 :: forall a. a -> ParserResult a
pure = forall a. a -> ParserResult a
Success
  Success a -> b
f <*> :: forall a b.
ParserResult (a -> b) -> ParserResult a -> ParserResult b
<*> ParserResult a
r = 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
_ = forall a. ParserFailure ParserHelp -> ParserResult a
Failure ParserFailure ParserHelp
f
  CompletionInvoked CompletionResult
c <*> ParserResult a
_ = forall a. CompletionResult -> ParserResult a
CompletionInvoked CompletionResult
c

instance Monad ParserResult where
  return :: forall a. a -> ParserResult a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Success a
x >>= :: forall a b.
ParserResult a -> (a -> ParserResult b) -> ParserResult b
>>= a -> ParserResult b
f = a -> ParserResult b
f a
x
  Failure ParserFailure ParserHelp
f >>= a -> ParserResult b
_ = forall a. ParserFailure ParserHelp -> ParserResult a
Failure ParserFailure ParserHelp
f
  CompletionInvoked CompletionResult
c >>= a -> 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
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
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
Ord, Int -> ArgPolicy -> ShowS
[ArgPolicy] -> ShowS
ArgPolicy -> String
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
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
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
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
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
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 :: forall a. OptTree a -> OptTree a
filterOptional OptTree a
t = case OptTree a
t of
  Leaf a
a
    -> forall a. a -> OptTree a
Leaf a
a
  MultNode [OptTree a]
xs
    -> forall a. [OptTree a] -> OptTree a
MultNode (forall a b. (a -> b) -> [a] -> [b]
map forall a. OptTree a -> OptTree a
filterOptional [OptTree a]
xs)
  AltNode AltNodeType
MarkDefault [OptTree a]
_
    -> forall a. AltNodeType -> [OptTree a] -> OptTree a
AltNode AltNodeType
MarkDefault []
  AltNode AltNodeType
NoDefault [OptTree a]
xs
    -> forall a. AltNodeType -> [OptTree a] -> OptTree a
AltNode AltNodeType
NoDefault (forall a b. (a -> b) -> [a] -> [b]
map forall a. OptTree a -> OptTree a
filterOptional [OptTree a]
xs)
  BindNode OptTree a
xs
    -> forall a. OptTree a -> OptTree a
BindNode (forall a. OptTree a -> OptTree a
filterOptional OptTree a
xs)

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

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

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

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

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