module Options.Applicative.Types (
ParserInfo(..),
ParserPrefs(..),
Context(..),
P,
Option(..),
OptName(..),
OptReader(..),
OptProperties(..),
OptVisibility(..),
Parser(..),
ParserFailure(..),
OptHelpInfo(..),
optVisibility,
optMetaVar,
optHelp,
optShowDefault
) where
import Control.Applicative
import Control.Category
import Control.Monad
import Control.Monad.Trans.Error
import Control.Monad.Trans.Writer
import Data.Monoid
import Prelude hiding ((.), id)
import System.Exit
data ParserInfo a = ParserInfo
{ infoParser :: Parser a
, infoFullDesc :: Bool
, infoProgDesc :: String
, infoHeader :: String
, infoFooter :: String
, infoFailureCode :: Int
} deriving Functor
data ParserPrefs = ParserPrefs
{ prefMultiSuffix :: String
}
data Context where
Context :: Maybe String -> ParserInfo a -> Context
NullContext :: Context
instance Monoid Context where
mempty = NullContext
mappend _ c@(Context _ _) = c
mappend c _ = c
type P = ErrorT String (Writer Context)
data OptName = OptShort !Char
| OptLong !String
deriving (Eq, Ord)
data OptVisibility
= Internal
| Hidden
| Visible
deriving (Eq, Ord)
data OptProperties = OptProperties
{ propVisibility :: OptVisibility
, propHelp :: String
, propMetaVar :: String
, propShowDefault :: Maybe String
}
data Option a = Option
{ optMain :: OptReader a
, optProps :: OptProperties
} deriving Functor
data OptReader a
= OptReader [OptName] (String -> Maybe a)
| FlagReader [OptName] !a
| ArgReader (String -> Maybe a)
| CmdReader [String] (String -> Maybe (ParserInfo a))
deriving Functor
data Parser a where
NilP :: Maybe a -> Parser a
OptP :: Option a -> Parser a
MultP :: Parser (a -> b) -> Parser a -> Parser b
AltP :: Parser a -> Parser a -> Parser a
BindP :: Parser a -> (a -> Parser b) -> Parser b
instance Functor Parser where
fmap f (NilP x) = NilP (fmap f x)
fmap f (OptP opt) = OptP (fmap f opt)
fmap f (MultP p1 p2) = MultP (fmap (f.) p1) p2
fmap f (AltP p1 p2) = AltP (fmap f p1) (fmap f p2)
fmap f (BindP p k) = BindP p (fmap f . k)
instance Applicative Parser where
pure = NilP . Just
(<*>) = MultP
instance Alternative Parser where
empty = NilP Nothing
(<|>) = AltP
many p = some p <|> pure []
some p = p `BindP` (\r -> (r:) <$> many p)
data ParserFailure = ParserFailure
{ errMessage :: String -> String
, errExitCode :: ExitCode
}
instance Error ParserFailure where
strMsg msg = ParserFailure
{ errMessage = \_ -> msg
, errExitCode = ExitFailure 1 }
data OptHelpInfo = OptHelpInfo
{ hinfoMulti :: Bool
, hinfoDefault :: Bool }
optVisibility :: Option a -> OptVisibility
optVisibility = propVisibility . optProps
optHelp :: Option a -> String
optHelp = propHelp . optProps
optMetaVar :: Option a -> String
optMetaVar = propMetaVar . optProps
optShowDefault :: Option a -> Maybe String
optShowDefault = propShowDefault . optProps