Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- newtype Parser e d f k = Parser {}
- parser :: ShowErrorComponent e => Router (Parser e d) handlers (Response (Router (Parser e d))) -> handlers -> [Arg] -> IO ()
- parseErrorTextPretty :: forall s e. (Stream s, ShowErrorComponent e) => ParseError s e -> String
- messageItemsPretty :: String -> [String] -> String
- orList :: NonEmpty String -> String
- showErrorItem :: Stream s => Proxy s -> ErrorItem (Token s) -> String
- concatCont :: [(a -> k) -> k] -> ([a] -> k) -> k
- consCont :: (a -> b -> c) -> ((a -> k) -> k) -> ((b -> k) -> k) -> (c -> k) -> k
- mapCont :: (a -> b) -> ((a -> k) -> k) -> (b -> k) -> k
- newtype ParserResponse = ParserResponse {
- unResponseParser :: IO ()
- type ParserResponseArgs = IO
- class IOType a => Outputable a where
- data OnHandle a = OnHandle Handle a
- class IOType a where
- class FromSegment a where
- fromSegment :: Segment -> IO (Either String a)
- newtype ParserSeq e d k a = ParserSeq {
- unParserSeq :: Parser e d (a -> k) k
- data ParserPerm e d repr k a = ParserPerm {
- permutation_result :: !(Maybe ((a -> k) -> k))
- permutation_parser :: repr () (ParserPerm e d repr k a)
- noTransParserPerm :: Trans repr => Functor (UnTrans repr ()) => ParserPerm e d (UnTrans repr) k a -> ParserPerm e d repr k a
- unTransParserPerm :: Trans repr => Functor (UnTrans repr ()) => ParserPerm e d repr k a -> ParserPerm e d (UnTrans repr) k a
- hoistParserPerm :: Functor (repr ()) => (forall a b. repr a b -> repr a b) -> ParserPerm e d repr k c -> ParserPerm e d repr k c
- class CLI_Routing repr where
- data Router repr a b where
- Router_Any :: repr a b -> Router repr a b
- Router_Commands :: Map Name (Router repr a k) -> Map Name (Router repr a k) -> Router repr a k
- Router_Tag :: Tag -> Router repr f k -> Router repr f k
- Router_App :: Router repr a b -> Router repr b c -> Router repr a c
- Router_Alt :: Router repr a k -> Router repr b k -> Router repr (a :!: b) k
- Router_Union :: (b -> a) -> Router repr a k -> Router repr b k
- router :: repr ~ Parser e d => Router repr a b -> Router repr a b
- router_Alt :: repr ~ Parser e d => Router repr a k -> Router repr b k -> Router repr (a :!: b) k
- router_Commands :: repr ~ Parser e d => Bool -> Map Segment (Router repr a k) -> Map Segment (Router repr b k) -> Map Segment (Router repr (a :!: b) k)
- newtype RouterParserSeq repr k a = RouterParserSeq {
- unRouterParserSeq :: repr k a
- data Arg
- lexer :: [String] -> [Arg]
- showArg :: Arg -> String
- showArgs :: [Arg] -> String
Type Parser
newtype Parser e d f k Source #
Instances
parser :: ShowErrorComponent e => Router (Parser e d) handlers (Response (Router (Parser e d))) -> handlers -> [Arg] -> IO () Source #
parseErrorTextPretty :: forall s e. (Stream s, ShowErrorComponent e) => ParseError s e -> String Source #
Rewrite parseErrorTextPretty
to keep Ord
of Arg
.
concatCont :: [(a -> k) -> k] -> ([a] -> k) -> k Source #
Type ParserResponse
newtype ParserResponse Source #
ParserResponse | |
|
Type ParserResponseArgs
type ParserResponseArgs = IO Source #
Class Outputable
class IOType a => Outputable a where Source #
Output of a CLI.
Nothing
Instances
Type OnHandle
Instances
IOType a => IOType (OnHandle a) Source # | |
Defined in Symantic.CLI.Parser | |
Outputable (OnHandle Bool) Source # | |
Outputable (OnHandle Char) Source # | |
Outputable (OnHandle Int) Source # | |
Outputable (OnHandle Integer) Source # | |
Outputable (OnHandle Natural) Source # | |
Outputable (OnHandle ()) Source # | |
Outputable (OnHandle String) Source # | |
Outputable (OnHandle ByteString) Source # | |
Defined in Symantic.CLI.Parser | |
Outputable (OnHandle ByteString) Source # | |
Defined in Symantic.CLI.Parser | |
Outputable (OnHandle Text) Source # | |
Outputable (OnHandle (Plain Builder)) Source # | |
Outputable (OnHandle Text) Source # | |
Class IOType
Like a MIME type but for input/output of a CLI.
Nothing
Instances
IOType Bool Source # | |
Defined in Symantic.CLI.Parser | |
IOType Char Source # | |
Defined in Symantic.CLI.Parser | |
IOType Int Source # | |
Defined in Symantic.CLI.Parser | |
IOType Integer Source # | |
Defined in Symantic.CLI.Parser | |
IOType Natural Source # | |
Defined in Symantic.CLI.Parser | |
IOType () Source # | |
Defined in Symantic.CLI.Parser | |
IOType String Source # | |
Defined in Symantic.CLI.Parser | |
IOType ByteString Source # | |
Defined in Symantic.CLI.Parser | |
IOType ByteString Source # | |
Defined in Symantic.CLI.Parser | |
IOType Text Source # | |
Defined in Symantic.CLI.Parser | |
IOType Text Source # | |
Defined in Symantic.CLI.Parser | |
Typeable a => IOType (Maybe a) Source # | |
Defined in Symantic.CLI.Parser | |
IOType (Plain Builder) Source # | |
Defined in Symantic.CLI.Parser | |
IOType a => IOType (OnHandle a) Source # | |
Defined in Symantic.CLI.Parser | |
(Typeable e, Typeable a) => IOType (Either e a) Source # | |
Defined in Symantic.CLI.Parser |
Class FromSegment
class FromSegment a where Source #
Nothing
fromSegment :: Segment -> IO (Either String a) Source #
fromSegment :: Read a => Segment -> IO (Either String a) Source #
Instances
FromSegment Bool Source # | |
Defined in Symantic.CLI.Parser | |
FromSegment Int Source # | |
Defined in Symantic.CLI.Parser | |
FromSegment Integer Source # | |
Defined in Symantic.CLI.Parser | |
FromSegment Natural Source # | |
Defined in Symantic.CLI.Parser | |
FromSegment String Source # | |
Defined in Symantic.CLI.Parser | |
FromSegment Text Source # | |
Defined in Symantic.CLI.Parser | |
FromSegment Text Source # | |
Defined in Symantic.CLI.Parser |
Type ParserSeq
newtype ParserSeq e d k a Source #
Lift a Parser
to something working with Functor
and Applicative
.
Used to gather collected values into a single one,
which is for instance needed for using many0
on multiple var
s.
ParserSeq | |
|
Instances
Functor (ParserSeq e d k) Source # | |
Applicative (ParserSeq e d k) Source # | |
Defined in Symantic.CLI.Parser pure :: a -> ParserSeq e d k a # (<*>) :: ParserSeq e d k (a -> b) -> ParserSeq e d k a -> ParserSeq e d k b # liftA2 :: (a -> b -> c) -> ParserSeq e d k a -> ParserSeq e d k b -> ParserSeq e d k c # (*>) :: ParserSeq e d k a -> ParserSeq e d k b -> ParserSeq e d k b # (<*) :: ParserSeq e d k a -> ParserSeq e d k b -> ParserSeq e d k a # |
Type ParserPerm
data ParserPerm e d repr k a Source #
ParserPerm | |
|
Instances
CLI_Help repr => CLI_Help (ParserPerm e d repr) Source # | |
Defined in Symantic.CLI.Parser type HelpConstraint (ParserPerm e d repr) d :: Constraint Source # help :: HelpConstraint (ParserPerm e d repr) d0 => d0 -> ParserPerm e d repr f k -> ParserPerm e d repr f k Source # program :: Name -> ParserPerm e d repr f k -> ParserPerm e d repr f k Source # rule :: Name -> ParserPerm e d repr f k -> ParserPerm e d repr f k Source # | |
(App repr, Functor (repr ())) => Functor (ParserPerm e d repr k) Source # | |
Defined in Symantic.CLI.Parser fmap :: (a -> b) -> ParserPerm e d repr k a -> ParserPerm e d repr k b # (<$) :: a -> ParserPerm e d repr k b -> ParserPerm e d repr k a # | |
(App repr, Functor (repr ()), Alternative (repr ())) => Applicative (ParserPerm e d repr k) Source # | |
Defined in Symantic.CLI.Parser pure :: a -> ParserPerm e d repr k a # (<*>) :: ParserPerm e d repr k (a -> b) -> ParserPerm e d repr k a -> ParserPerm e d repr k b # liftA2 :: (a -> b -> c) -> ParserPerm e d repr k a -> ParserPerm e d repr k b -> ParserPerm e d repr k c # (*>) :: ParserPerm e d repr k a -> ParserPerm e d repr k b -> ParserPerm e d repr k b # (<*) :: ParserPerm e d repr k a -> ParserPerm e d repr k b -> ParserPerm e d repr k a # | |
type HelpConstraint (ParserPerm e d repr) d' Source # | |
Defined in Symantic.CLI.Parser |
noTransParserPerm :: Trans repr => Functor (UnTrans repr ()) => ParserPerm e d (UnTrans repr) k a -> ParserPerm e d repr k a Source #
unTransParserPerm :: Trans repr => Functor (UnTrans repr ()) => ParserPerm e d repr k a -> ParserPerm e d (UnTrans repr) k a Source #
hoistParserPerm :: Functor (repr ()) => (forall a b. repr a b -> repr a b) -> ParserPerm e d repr k c -> ParserPerm e d repr k c Source #
Class CLI_Routing
class CLI_Routing repr where Source #
Type Router
data Router repr a b where Source #
Router_Any :: repr a b -> Router repr a b | Lift any |
Router_Commands :: Map Name (Router repr a k) -> Map Name (Router repr a k) -> Router repr a k | Represent |
Router_Tag :: Tag -> Router repr f k -> Router repr f k | Represent |
Router_App :: Router repr a b -> Router repr b c -> Router repr a c | Represent ( |
Router_Alt :: Router repr a k -> Router repr b k -> Router repr (a :!: b) k | Represent ( |
Router_Union :: (b -> a) -> Router repr a k -> Router repr b k | Unify |
Instances
router_Alt :: repr ~ Parser e d => Router repr a k -> Router repr b k -> Router repr (a :!: b) k Source #
Merge/reorder alternatives if possible or default to a Router_Alt
.
router_Commands :: repr ~ Parser e d => Bool -> Map Segment (Router repr a k) -> Map Segment (Router repr b k) -> Map Segment (Router repr (a :!: b) k) Source #
Type RouterParserSeq
newtype RouterParserSeq repr k a Source #
RouterParserSeq | |
|
Instances
Functor (repr k) => Functor (RouterParserSeq repr k) Source # | |
Defined in Symantic.CLI.Parser fmap :: (a -> b) -> RouterParserSeq repr k a -> RouterParserSeq repr k b # (<$) :: a -> RouterParserSeq repr k b -> RouterParserSeq repr k a # | |
Applicative (repr k) => Applicative (RouterParserSeq repr k) Source # | |
Defined in Symantic.CLI.Parser pure :: a -> RouterParserSeq repr k a # (<*>) :: RouterParserSeq repr k (a -> b) -> RouterParserSeq repr k a -> RouterParserSeq repr k b # liftA2 :: (a -> b -> c) -> RouterParserSeq repr k a -> RouterParserSeq repr k b -> RouterParserSeq repr k c # (*>) :: RouterParserSeq repr k a -> RouterParserSeq repr k b -> RouterParserSeq repr k b # (<*) :: RouterParserSeq repr k a -> RouterParserSeq repr k b -> RouterParserSeq repr k a # |
Type Arg
ArgSegment Segment | |
ArgTagLong Name | |
ArgTagShort Char | |
ArgEnv Name String | Here only for error reporting. |
Instances
Eq Arg Source # | |
Ord Arg Source # | |
Show Arg Source # | |
Stream [Arg] Source # | |
Defined in Symantic.CLI.Parser tokenToChunk :: Proxy [Arg] -> Token [Arg] -> Tokens [Arg] # tokensToChunk :: Proxy [Arg] -> [Token [Arg]] -> Tokens [Arg] # chunkToTokens :: Proxy [Arg] -> Tokens [Arg] -> [Token [Arg]] # chunkLength :: Proxy [Arg] -> Tokens [Arg] -> Int # chunkEmpty :: Proxy [Arg] -> Tokens [Arg] -> Bool # take1_ :: [Arg] -> Maybe (Token [Arg], [Arg]) # takeN_ :: Int -> [Arg] -> Maybe (Tokens [Arg], [Arg]) # takeWhile_ :: (Token [Arg] -> Bool) -> [Arg] -> (Tokens [Arg], [Arg]) # showTokens :: Proxy [Arg] -> NonEmpty (Token [Arg]) -> String # reachOffset :: Int -> PosState [Arg] -> (SourcePos, String, PosState [Arg]) # reachOffsetNoLine :: Int -> PosState [Arg] -> (SourcePos, PosState [Arg]) # | |
type Tokens [Arg] Source # | |
Defined in Symantic.CLI.Parser | |
type Token [Arg] Source # | |
Defined in Symantic.CLI.Parser |