diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,37 @@ ## Unreleased +## 0.3.0.0 - 2026-08-27 + +### Added + +- Request options that trigger a request when matched +- Literate Haskell mkuser tutorial that demonstrates how to build + parsers for options and parameters +- Literate Haskell pkgtool tutorial that demonstrates how to build + command parsers +- Individual text parsers for common data types + +### Changed + +- Generalize help requests to help or version requests +- Rewrite mkuser tutorial as a Literate Haskell program +- Add version information to ProgramInfo +- Move tutorials from the inside the README to dedicated pages on the + GitHub wiki which are built from Literate Haskell files in the `doc` + directory + +### Fixed + +- Include commands with no options in help output +- Factor out duplicate code in Mangrove.Unix.optionPure + +### Removed + +- Separable module and Separable typeclass +- Exhibit type +- Modal type + ## 0.2.0.0 - 2026-08-14 ### Added diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -10,6 +10,17 @@ `--mount src=/webroot,dst=/var/www,rw`). It is also extensible, so you can define alternative command line syntaxes. +## Documentation + +The API documentation is available on Hackage: + + +There is a tutorial to help with getting started: + + +Commands are covered in a separate tutorial: + + ## Obtaining Mangrove is available on Hackage as `mangrove-cli`: @@ -45,429 +56,3 @@ - Profiling & optimization Once these are addressed, a 1.0.0 release will be appropriate. - -# Tutorial - -## A Metaphor - -Imagine the roots of a plant branching out like a tree as they -descend. Eventually, they dip into a stream. The roots collect water -and nutrients from the flowing stream. These resources travel back up -the structure toward the plant, combining along the way. - -This is kind of like how the Mangrove library works. We build a -tree-shaped parser from simple applicative combinators, then feed it a -sequence of CLI arguments. Simple parsers stationed at the bottom of -the tree consume these arguments and produce values which are then -passed back up the tree and combined with the results of other parsers -until a final result is reached. - -## Example - -__NOTE__: See the full example file in `doc/MkUser.hs`. - -Suppose we are writing a simple program that creates new user -accounts - we'll call it "mkuser". The goal will be to provide a -command line interface with the following syntax: - -``` -mkuser [--uid=INT] [--system] [--groups={GROUP...}] USERNAME -``` - -First, let's create a new record that captures the program's runtime -configuration. - -```haskell -data Settings = Settings - { userId :: Maybe Int -- ^ An optional target user ID - , userSystem :: Bool -- ^ Is this a system user? - , userGroups :: [Text] -- ^ Groups the new user will be in - , userName :: Text -- ^ Username for the new user - } deriving (Show) -``` - -Let's also pretend that our program's logic lives inside a function -`run :: Settings -> IO ()`. We pass it the settings we want, and it -runs the program accordingly. However, since this is just an example -program, we won't actually create any user accounts; instead we'll -just have the program print its settings to `stdout`. - -```haskell -run :: Settings -> IO () -run = print -``` - -Now we need to construct a parser that reads a list of arguments and -yields a `Settings`. Our parser will have the type `UnixParser -Settings`. - -__NOTE__: This example uses the language extensions `OverloadedLists` -and `OverloadedStrings` since we need to write lots of `NonEmpty` list -and `Text` literals. - -__NOTE__: `UnixParser` is just a convenient type synonym for -`ParseTree UnixScheme`. This tells us that we will build a `ParseTree` -by combining parsers from the UNIX scheme. - -## Positional Parameters - -A "positional parameter" is a positional input that accepts the first -non-flag argument it encounters. In Mangrove, positional parameters -are usually just referred to as "parameters" since other kinds of -parameters have their own names. Consider an example program called -`substring` whose command line syntax is `substring START END STRING`. -`START`, `END`, and `STRING` would be parameters. If we invoke -`substring 1 3 "example"`, we know that `START` is `1`, `END` is `3`, -and `STRING` is `"example"` because of the order in which they appear. - -Our program will have just one parameter: a username. Here is how we -define a parser for it: - -```haskell -prm_name :: UnixParser Text -prm_name = parameter defaultParser -``` - -The `parameter` function creates a parameter parser out of a -`TextParser`. - -### TextParsers - -A `TextParser r` is just a wrapper around a function that parses -`Text` into a value of type `r`. It also contains a "hint" string used -for displaying usage information. - -Many common data types have a reasonable default `TextParser` -implementation. Types that are instances of the `DefaultParser` class -implement `defaultParser :: DefaultParser a => TextParser a`, letting -us automatically select the correct parser based on the required type. - -In the example above, `Text` has a very simple `DefaultParser` -instance that just returns its input unchanged. - -## Options - -An "option" is a construct representing a named input. Options begin -with a flag followed by an optional subargument string. - -A "flag" is special symbol that signals the beginning of a particular -option. Per UNIX tradition there are long flags (e.g. `--foo`) and -short flags (e.g `-f`). - -To prevent ambiguity, sometimes an equals sign is used to separate a -long flag from its subargument string (instead of a space). For -example, `--uid=1000` is an option that begins with the `--uid` flag -and is followed by the subargument string `1000`. Similarly, an -option's short flag can be directly concatenated with its argument, -e.g. `-u 1000` can be written `-u1000`. - -Let's define a parser for the `--uid` option: - -```haskell -opt_uid :: UnixParser Int -opt_uid = option ["--uid", "-u"] - "Specify a user ID" - $ subparameter defaultParser -``` - -The `option` function creates a parser for CLI options. It takes three -arguments: - -1. A `NonEmpty` list of `Flag`s that trigger the option, in this case - "--uid" and "-u". `Flag` is an instance of `IsString`, so we can - just write the string representation instead of `LongFlag "uid"` - and `ShortFlag 'u'`. -2. A human readable description. This will be displayed when help - output is triggered. -3. A subparser tree (`SubParser r`) that will parse any subparameters or - suboptions. In this case, we declare a single subparameter (an - integer). - -The `subparameter` function behaves just like `parameter` from -earlier, except it creates a `SubParser` instead of a `UnixParser`. We -also use `defaultParser` to automatically select an appropriate -`TextParser` for `Int`. - -__NOTE__: `SubParser` is a type synonym for `ParseTree SubScheme`. -That means we build a `SubParser` by combining `SubScheme` parsers. -`SubScheme` provides parsers for handling subarguments to options. - -You might notice that our `Settings` record requires a `Maybe Int`, -not an `Int`. However, since `UnixParser` is an instance of -`Alternative`, we can use `optional` from `Control.Applicative`. -`optional opt_uid :: UnixParser (Maybe Int)` describes an option that -is not required and might be absent (which should give us `Nothing`). - -### Switches - -The `--system` option is simpler because because it doesn't accept any -subarguments - it is either present (`True`) or absent (`False`). This -special type of option is a "switch", and we can use the `switch` -function to create a parser: - -```haskell -opt_system :: UnixParser Bool -opt_system = switch ["--system", "-s"] "Create a system user" - --- If we defined this without 'switch' it would look like this: --- opt_system = option ["--system", "-s"] --- "Create a system user" --- (pure True) --- <|> pure False - -``` - -### Options with Multiple Subparameters - -Let's deal with the `--groups` option. This option is a bit different -from the `--uid` option because we want the user to be able to specify -a list of groups for the new user to join. Thus, we want to create an -option that accepts one or more subarguments. - -Thankfully, `SubParser` is also an `Alternative` instance. We can use -`some` (from `Control.Applicative`) to convert a `SubParser r` into a -`SubParser [r]` that will expect to parse one or more `r` values. - -```haskell -opt_groups :: UnixParser [Text] -opt_groups = - option ["--groups", "-g"] - "Specify what groups the user is part of" - $ some $ subparameter defaultParser -``` - -Mangrove recognizes that the subparser `some $ subparameter -defaultParser :: SubParser [Text]` can consume multiple subarguments, -so it splits those subarguments apart by comma. This allows us to pass -a list of group names like so: `--groups=wheel,audio,input`, and the -parser will yield `["wheel","audio","input"]`. - -By using `some` instead of the similar function `many`, we have -created a subparser that will fail if no subarguments are provided -(e.g. `mkuser alice --groups`). - -What if the `--groups` option isn't present at all? We still need a -`[Text]` value for our `Settings` record. In that case, an empty list -makes sense. Just like with our `--uid` option, we use `Alternative` -to define what happens if our parser never finds applicable input. - -``` -opt_groups <|> pure [] :: UnixParser [Text] -``` - -__NOTE__: There is an important distinction between a parser that -never finds relevant input and a parser that fails. In an expression -like `opt_groups <|> pure []`, if `opt_groups` never finds relevant -input, the alternative provides a default value. However, if -`opt_groups` *does* find applicable input, but parsing it fails, an -error will be thrown instead. - -More generally, if `p` and `q` are parsers, then `p <|> q` is a parser -that yields the result from whichever parser finds applicable input -first. If neither parser finds input, we first try resolving `p` and -then `q` with no input and yield the first result we get. If neither -succeeds, we throw an error. - -## Applicative - -We are now ready to construct our `Settings` parser using `<$>` and -`<*>`: - -```haskell -parseSettings :: UnixParser Settings -parseSettings = - Settings - <$> optional opt_uid - <*> opt_system - <*> (opt_groups <|> pure []) - <*> prm_name -``` - -Now we can inspect the automatically generated usage information for -our parser in GHCi using `render` from `Mangrove.Text`: - -``` -ghci> render parseSettings -"[--uid=INT] [--system] [--groups={STRING...}] STRING" -``` - -This output indicates that our parser accepts (but does not require) a -`--uid` option with an integer subargument, a `--system` option, and a -`--groups` option with a list of string subarguments. Finally, it -requires a single parameter, which is a string. We'll see how to -improve those type hints later. - -## Program Metadata - -The last thing we need to define before running our parser is a -structure with some metadata about the program: - -```haskell -programInfo :: ProgramInfo -programInfo = ProgramInfo - { programName = "mkuser" -- The name of the program - , programDesc = "Create user accounts" -- A short description of the program - } -``` - -This information is used to display nice, human-readable help and -usage information, which will is discussed in more detail in the [Help -Options](#help-options) section. - -## Running the Parser - -The `parseArguments` function will run our parser with the arguments -passed to our program by the operating system. - -```haskell -main :: IO () -main = parseArguments programInfo parseSettings run -``` - -`parseArguments` takes three arguments: the program metadata (for help -output), a `UnixParser r`, and a function of type `r -> IO a`. When -the parser completes successfully, this function will be called with -the result. Otherwise, `parseArguments` will print error messages or -help information as appropriate, and then exit. - -If you want to run an argument parser without using `IO`, or you want -to pass your own argument list, check out `runHelpfulParser` from -`Mangrove`. - -Now we have a complete program we can build and run to show the -argument parser in action! - -``` -$ ghc -o mkuser MkUser.hs -[1 of 2] Compiling Main ( MkUser.hs, MkUser.o ) -[2 of 2] Linking mkuser - -$ ./mkuser --system --groups audio,input bilbo -Settings {userId = Nothing, userSystem = True, userGroups = ["audio","input"], userName = "bilbo"} - -$ ./mkuser --badinput -unexpected --badinput - -$ ./mkuser --system -expected: STRING - -$ ./mkuser --uid=InvalidNumber bilbo ---uid=InvalidNumber: InvalidNumber: input does not start with a digit -``` - -## Help Options - -Currently, our CLI interface is missing something important: an option -for displaying help and usage information. Let's create a new -`Settings` parser that recognizes `--help` as a request for help -information. - -```haskell -parseSettings' :: UnixParser Settings -parseSettings' = addHelpOptions ["--help"] - "Display help and usage information" - parseSettings - -main :: IO () -main = parseArguments programInfo parseSettings' run -``` - -Now if we invoke our program with the `--help` option, it will display -a nice summary of how to use it: - -``` -./mkuser --help -Usage: -mkuser [--uid=INT] [--system] [--groups={STRING...}] STRING -mkuser --help - -Create user accounts - - --help Display help and usage information --g --groups {STRING...} Specify what groups the user is part of --s --system Create a system user --u --uid INT Specify a user ID -``` - -__NOTE__: If an interface defines any commands (see below), -`addHelpOptions` will add a help option at the root of the parse tree -as well as the root of every command subtree. This is so that you can -invoke `myprogram --help` to get general help or `myprogram -somecommand --help` to get help information specifically for -`somecommand`. - -## Hints - -Type hints are displayed as placeholders for parameters in help and -usage information. They are a hint to the user about what kind of -information is expected by that input. For example, `--uid=INT` -indicates the `--uid` option expects an integer as a subargument. -Hints stored inside the `parserHint` field of a `TextParser`. - -Our program uses the generic hints defined in the `DefaultParser` -instances for `Int` and `Text`. These defaults are often reasonable, -but we can also tailor hints more specifically for our use case. All -we need to do is alter the value of `parserHint` for the relevant -`TextParser`. - -``` -opt_groups :: UnixParser [Text] -opt_groups = - option ["--groups", "-g"] - "Specify what groups the user is part of" - $ some $ subparameter defaultParser {parserHint = "GROUP"} - -prm_name :: UnixParser Text -prm_name = parameter defaultParser {parserHint = "USERNAME"} -``` - -Now our help output looks like this: - -``` -$ ./mkuser --help -Usage: -mkuser [--uid=INT] [--system] [--groups={GROUP...}] USERNAME -mkuser --help - -Create user accounts - - --help Display help and usage information --g --groups {GROUP...} Specify what groups the user is part of --s --system Create a system user --u --uid INT Specify a user ID -``` - -## Commands - -A "command" is a special argument changes the context of a parser. -When a command is encountered, the parser begins using the parse tree -associated with that command as a new context until it completes. -Commands are usually used as a way to invoke different modes of -functionality for a single program. For example, `git` supports -various commands like `commit` or `pull`. - -Suppose we are creating a basic version control system similar to -`git`. Our program will have several runtime modes for doing -operations like `commit` or `pull`. Here is how we might define a -parser that recognizes the corresponding commands (for the full code, -see `doc/VersionControl.hs`): - -```haskell -data Mode - = CommitMode CommitSettings - | PullMode PullSettings - -- ... and probably other modes too - deriving (Show) - -parseMode :: UnixParser Mode -parseMode = cmd_commit <|> cmd_pull - where - cmd_commit = - command ["commit"] - "Make a new commit" - $ CommitMode <$> parseCommitSettings - cmd_pull = - command ["pull"] - "Download remote changes" - $ PullMode <$> parsePullSettings -``` diff --git a/mangrove-cli.cabal b/mangrove-cli.cabal --- a/mangrove-cli.cabal +++ b/mangrove-cli.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: mangrove-cli -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Build CLI argument parsers using Applicative. description: Please see the README on GitHub at category: CLI, Options, Parsing @@ -32,7 +32,6 @@ Mangrove.Resolve Mangrove.Scheme.Sub Mangrove.Scheme.Unix - Mangrove.Separable Mangrove.Text Mangrove.TextParser Mangrove.Unix diff --git a/src/Mangrove.hs b/src/Mangrove.hs --- a/src/Mangrove.hs +++ b/src/Mangrove.hs @@ -10,7 +10,8 @@ Copyright : (c) Quytelda Kahja, 2026 License : BSD-3-Clause -This module contains an API (types and functions) for running argument parsers. +This module contains types and functions necessary for running +argument parsers. -} module Mangrove ( -- * Standard Interface @@ -21,10 +22,11 @@ , ParseTree , Scheme , Result(..) - , SupportsHelp + , SupportsResponse , StreamState - , HelpHandler - , HelpContinuation(..) + , RequestType(..) + , RequestHandler + , ReqContinuation(..) -- * Pure Interface -- ** Helpful Parsers @@ -52,25 +54,19 @@ import Mangrove.Resolve import Mangrove.Text --- | Program metadata for displaying help output. -data ProgramInfo = ProgramInfo - { programName :: !Text -- ^ The program name - , programDesc :: !Text -- ^ A description of the program - } deriving (Show) - -- | The results of a parsing operation. -- --- Only parsing schemes that support generating help output will yield --- 'Help' values. +-- Only parsing schemes that support generating responses can use the +-- 'Response' constructor. data Result s r where -- | A successful parsing operation yields a list of leftover -- arguments and a result value. Success :: ![Text] -> !r -> Result s r -- | A failed parsing operation yields an error message. Failure :: !Text -> Result s r - -- | A request for help yields human-readable help output (for + -- | A request for information yields a human-readable response (for -- parsers that support it). - Help :: SupportsHelp s => !Text -> Result s r + Response :: SupportsResponse s => !Text -> Result s r deriving instance Show r => Show (Result s r) deriving instance Eq r => Eq (Result s r) @@ -80,9 +76,9 @@ argsToState args = StreamState args [] False -- | Attempt to parse a value of type @r@ from a list of arguments, --- where the parser @ParseTree s r@ doesn't support help output. +-- where the parser @ParseTree s r@ doesn't support requests. runSilentParser - :: (Scheme s, HelpSupport s ~ 'Silent) + :: (Scheme s, RequestSupport s ~ 'False) => ParseTree s r -- ^ Argument parser -> [Text] -- ^ Input arguments -> Result s r @@ -91,18 +87,18 @@ -- | A more general form of 'runSilentParser' that accepts a custom -- stream starting state. runSilentParser' - :: (Scheme s, HelpSupport s ~ 'Silent) + :: (Scheme s, RequestSupport s ~ 'False) => ParseTree s r -- ^ Argument parser -> StreamState s -- ^ Initial stream state -> Result s r runSilentParser' tree state = - runArgumentParser' tree state Success Failure NoHelp + runArgumentParser' tree state Success Failure NoRequests -- | Attempt to parse a value of type @r@ from a list of arguments, --- where the parser @ParseTree s r@ supports help output. +-- where the parser @ParseTree s r@ supports requests. runHelpfulParser - :: SupportsHelp s - => ProgramInfo -- ^ Program metadata + :: SupportsResponse s + => ProgramInfo s -- ^ Program metadata -> ParseTree s r -- ^ Argument parser -> [Text] -- ^ Input arguments -> Result s r @@ -111,39 +107,42 @@ -- | A more general form of 'runHelpfulParser' that accepts a custom -- stream starting state. runHelpfulParser' - :: SupportsHelp s - => ProgramInfo -- ^ Program metadata + :: SupportsResponse s + => ProgramInfo s -- ^ Program metadata -> ParseTree s r -- ^ Argument parser -> StreamState s -- ^ Initial stream state -> Result s r runHelpfulParser' info tree state = - runArgumentParser' tree state Success Failure (OnHelp _onHelpRequest) + runArgumentParser' tree state Success Failure (OnRequest _onRequest) where - _onHelpRequest state' = - Help $ makeHelpInfo tree (streamContext state') (programName info) (programDesc info) + _onRequest state' HelpRequest = + Response $ makeHelpInfo tree (streamContext state') info + _onRequest _ VersionRequest = + Response $ makeVersionInfo info --- | A variant of 'runHelpfulParser' that treats help requests as --- failures. +-- | A variant of 'runHelpfulParser' that treats requests as failures. +-- +-- This is useful if you know that no requests will ever be made. runHelpfulParser_ - :: SupportsHelp s + :: SupportsResponse s => ParseTree s r -- ^ Argument parser -> [Text] -- ^ Input arguments -> Result s r runHelpfulParser_ tree args = - runArgumentParser' tree (argsToState args) Success Failure (OnHelp _onHelpRequest) + runArgumentParser' tree (argsToState args) Success Failure (OnRequest _onRequest) where - _onHelpRequest state' = Failure $ + _onRequest state' _ = Failure $ formatError (streamContext state') "help requested" -- | Parse the command line arguments passed to the program, then -- invoke the program's entrypoint with the results of the parsing. If -- parsing fails, we instead display an error to stderr and exit. --- Alternatively, if help was requested, we abandon parsing and print --- the relevant help output to stdout, then exit without indicating an --- error. +-- Alternatively, if information was requested, we abandon parsing and +-- print the relevant response to stdout, then exit without indicating +-- an error. parseArguments - :: SupportsHelp s - => ProgramInfo -- ^ Program metadata + :: SupportsResponse s + => ProgramInfo s -- ^ Program metadata -> ParseTree s r -- ^ Argument parser -> (r -> IO a) -- ^ Program Entrypoint -> IO a @@ -157,7 +156,7 @@ Failure err -> do TIO.hPutStrLn stderr err exitFailure - Help output -> do + Response output -> do TIO.putStr output exitSuccess @@ -169,7 +168,7 @@ -> [Text] -- ^ Input arguments -> ([Text] -> r -> a) -- ^ Success handler -> (Text -> a) -- ^ Failure handler - -> HelpHandler s a -- ^ Help request handler + -> RequestHandler s a -- ^ Request handler -> a runArgumentParser tree = runArgumentParser' tree . argsToState @@ -181,7 +180,7 @@ -> StreamState s -- ^ Initial stream state -> ([Text] -> r -> a) -- ^ Success handler -> (Text -> a) -- ^ Failure handler - -> HelpHandler s a -- ^ Help request handler + -> RequestHandler s a -- ^ Request handler -> a runArgumentParser' tree state cok cerr hhelp = runStreamParser (satiate tree) handler state @@ -197,5 +196,5 @@ { onSuccess = _onSuccess , onFailure = _onFailure , onEmpty = flip _onFailure "empty" - , onHelpRequest = hhelp + , onRequest = hhelp } diff --git a/src/Mangrove/Parser.hs b/src/Mangrove/Parser.hs --- a/src/Mangrove/Parser.hs +++ b/src/Mangrove/Parser.hs @@ -44,18 +44,19 @@ -- * Parsing Schemes , Scheme(..) - , HelpCapability(..) - , SupportsHelp(..) + , ProgramInfo(..) + , SupportsResponse(..) -- * Stream Parser , StreamParser(..) , StreamHandler(..) , StreamState(..) - , HelpHandler - , HelpContinuation(..) + , RequestHandler + , ReqContinuation(..) - -- ** Help - , requestHelp + -- ** Requests + , RequestType(..) + , request -- ** Escaping , setEscaped @@ -80,14 +81,13 @@ import Control.Monad.Except import Data.Kind import qualified Data.List as List -import Data.Maybe import Data.Proxy import Data.Text (Text) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB +import Data.Version import Mangrove.Resolve -import Mangrove.Separable import Mangrove.Text import Mangrove.Valency @@ -225,39 +225,9 @@ -- Constant nodes that don't accept input have no usage. render _ = "" -instance (Separable s, Valency s) => Separable (ParseTree s) where - separate (SumNode l r) = Exhibit norm (modalsL <> modalsR) - where - Exhibit normL modalsL = separate l - Exhibit normR modalsR = separate r - norm = liftA2 SumNode normL normR - <|> normL - <|> normR - separate (ProdNode f l r) = Exhibit norm modals - where - Exhibit normL modalsL = separate l - Exhibit normR modalsR = separate r - node = ProdNode f - norm = liftA2 node normL normR - cross g modalTrees normalTrees = - [ g (if usesTerseOutput m && isOptional n then empty else n) <$> m - | m <- modalTrees - , n <- normalTrees - ] - modals = cross (flip node) modalsL (maybeToList normR) - <> cross node modalsR (maybeToList normL) - <> [liftA2 node u v | u <- modalsL, v <- modalsR] - separate (ParseNode p) = ParseNode <$> separate p - separate n = Exhibit (Just n) [] - -------------------------------------------------------------------------------- -- Parsing Schemes --- | A marker that distinguishes "silent" schemes (which produce no --- help output) from "helpful" schemes, which support the production --- of help output. -data HelpCapability = Silent | Helpful - -- | A scheme is a system of parsers and tokens. It parses a sequence -- of arguments into tokens and values. class (Functor s, Resolve s, Eq (Token s), Render (Token s), Show (Token s)) => Scheme (s :: Type -> Type) where @@ -265,13 +235,13 @@ -- string under this parsing scheme. data Token s - -- | This type indicates whether a parsing scheme supports help - -- output. + -- | This type indicates whether a parsing scheme accepts requests + -- for information. -- - -- It is 'Silent' by default, but must be set to 'Helpful' if the - -- scheme will implement an instance of 'SupportsHelp'. - type HelpSupport s :: HelpCapability - type HelpSupport s = 'Silent + -- When @RequestSupport scheme@ is @True@, a 'SupportsResponse' + -- instance should be provided for @scheme@. + type RequestSupport s :: Bool + type RequestSupport s = 'False -- | 'delimiter' is the character that separates argument strings in -- combined string representation. For example, arguments in the CLI @@ -294,13 +264,19 @@ -- parser. usageInfo :: s r -> Builder --- | A class for schemes that support human-readable help output. --- --- NOTE: In order to define a 'SupportsHelp' instance for some @Scheme --- s@, @HelpSupport s@ must be set to 'Helpful'. -class (Scheme s, HelpSupport s ~ 'Helpful) => SupportsHelp s where - makeHelpInfo :: ParseTree s r -> [Token s] -> Text -> Text -> Text +-- | Program metadata for displaying help output. +data ProgramInfo (s :: Type -> Type) = ProgramInfo + { programName :: !Text -- ^ The program name + , programVersion :: !Version -- ^ The program version + , programDesc :: !Text -- ^ A description of the program + } deriving (Show) +-- | A class for schemes that support human-readable responses to +-- requests for help or version information. +class (Scheme s, RequestSupport s ~ 'True) => SupportsResponse s where + makeVersionInfo :: ProgramInfo s -> Text + makeHelpInfo :: ParseTree s r -> [Token s] -> ProgramInfo s -> Text + -------------------------------------------------------------------------------- -- Stream Parser @@ -327,38 +303,44 @@ deriving instance Scheme s => Show (StreamState s) deriving instance Scheme s => Eq (StreamState s) --- | A handler for when help is requested. +-- | What information is being requested? +data RequestType + = VersionRequest -- ^ A request for version information + | HelpRequest -- ^ A request for help and usage information + deriving (Eq, Show) + +-- | A handler for when information is requested. -- -- This will hold a continuation function for helpful parsing -- schemes, or a placeholder value for silent schemes. -data family HelpContinuation (cap :: HelpCapability) (s :: Type -> Type) r +data family ReqContinuation (cap :: Bool) (s :: Type -> Type) r -data instance HelpContinuation 'Silent s r - = NoHelp +data instance ReqContinuation 'False s r + = NoRequests deriving (Functor) -newtype instance HelpContinuation 'Helpful s r - = OnHelp (StreamState s -> r) +newtype instance ReqContinuation 'True s r + = OnRequest (StreamState s -> RequestType -> r) deriving (Functor) --- | A handler for when help is requested. +-- | A handler for when information is requested. -- -- This will hold a continuation function for helpful parsing -- schemes, or a placeholder value for silent schemes. -type HelpHandler s r = HelpContinuation (HelpSupport s) s r +type RequestHandler s r = ReqContinuation (RequestSupport s) s r -- | A collection of continuations to be called for each situation a -- stream parser might encounter. data StreamHandler s a r = StreamHandler - { onSuccess :: StreamState s -> a -> r -- ^ Success Continuation - , onEmpty :: StreamState s -> r -- ^ Empty continuation - , onFailure :: StreamState s -> Builder -> r -- ^ Failure Continuation - , onHelpRequest :: HelpHandler s r -- ^ Help Continuation + { onSuccess :: StreamState s -> a -> r -- ^ Success Continuation + , onEmpty :: StreamState s -> r -- ^ Empty continuation + , onFailure :: StreamState s -> Builder -> r -- ^ Failure Continuation + , onRequest :: RequestHandler s r -- ^ Request Continuation } -- | The amazing stream parsing monad! This monad tracks the stream --- state and context. It short-circuits when exceptions or --- help-requests are raised. +-- state and context. It short-circuits when exceptions or requests +-- are raised. newtype StreamParser s a = StreamParser { runStreamParser :: forall r. StreamHandler s a r @@ -408,12 +390,12 @@ getEscaped = StreamParser $ \handler state -> onSuccess handler state (streamEscaped state) --- | Signal that help information is requested. Short-circuits any --- further operations. -requestHelp :: HelpSupport s ~ 'Helpful => StreamParser s a -requestHelp = StreamParser $ \handler state -> - case onHelpRequest handler of - OnHelp h -> h state +-- | Signal that information is requested. Short-circuits any further +-- operations. +request :: RequestSupport s ~ 'True => RequestType -> StreamParser s a +request requestType = StreamParser $ \handler state -> + case onRequest handler of + OnRequest h -> h state requestType -- | Get a list representing the current context stack. getContext :: StreamParser s [Token s] diff --git a/src/Mangrove/Scheme/Sub.hs b/src/Mangrove/Scheme/Sub.hs --- a/src/Mangrove/Scheme/Sub.hs +++ b/src/Mangrove/Scheme/Sub.hs @@ -26,7 +26,6 @@ import Mangrove.Parser import Mangrove.Resolve -import Mangrove.Separable import Mangrove.Text import Mangrove.TextParser import Mangrove.Valency @@ -45,9 +44,6 @@ ExpectedError [render hint] resolve (Option key (TextParser hint _)) = ExpectedError [render key <> "=" <> render hint] - -instance Separable SubScheme where - separate s = Exhibit (Just s) [] instance Scheme SubScheme where data Token SubScheme diff --git a/src/Mangrove/Scheme/Unix.hs b/src/Mangrove/Scheme/Unix.hs --- a/src/Mangrove/Scheme/Unix.hs +++ b/src/Mangrove/Scheme/Unix.hs @@ -44,13 +44,14 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB +import Data.Version +import Data.Void import Mangrove import Mangrove.Parser import Mangrove.Resolve import Mangrove.Scheme.Sub (SubScheme) import qualified Mangrove.Scheme.Sub as Sub -import Mangrove.Separable import Mangrove.Text import Mangrove.TextParser import Mangrove.Valency @@ -112,34 +113,26 @@ | Command !CommandInfo (ParseTree UnixScheme r) -- | A named option that might support suboptions | Option !OptionInfo (ParseTree SubScheme r) - -- | A special option that requests help information - | HelpOption !OptionInfo + -- | A special option that raises a request for information + | RequestOption !OptionInfo !RequestType deriving (Functor) instance Valency UnixScheme where valency (Parameter _) = Just 1 valency (Command _ subtree) = fmap (+1) (valency subtree) valency (Option _ subtree) = fmap (max 2) (valency subtree) - valency (HelpOption _) = Just 1 + valency (RequestOption {}) = Just 1 instance Resolve UnixScheme where resolve (Parameter (TextParser hint _)) = ExpectedError [render hint] resolve (Option info _) = ExpectedError [render $ optHead info] - resolve (HelpOption info) = + resolve (RequestOption info _) = ExpectedError [render $ optHead info] resolve (Command info _) = ExpectedError [render $ cmdHead info] -instance Separable UnixScheme where - separate p@(HelpOption _) = Exhibit Nothing [Modal True p] - separate (Command info subtree) = - Exhibit Nothing $ (Modal False <$> maybeToList mregular) <> modals - where - Exhibit mregular modals = Command info <$> separate subtree - separate p = Exhibit (Just p) [] - -- | A parser for interpreting options. An option always begins with a -- flag, followed optionally by an "=" sign and a bound argument. The -- strings "--" and "-" are not treated as options. @@ -170,7 +163,7 @@ | UnixOption Flag (Maybe Text) deriving (Eq, Show) - type HelpSupport UnixScheme = 'Helpful + type RequestSupport UnixScheme = 'True delimiter _ = ' ' @@ -224,7 +217,7 @@ runArgumentParser' subtree (initState args) (curry pure) (throwError . render) - NoHelp + NoRequests withContext (UnixOption flag mbound) $ do -- If a bound argument (e.g. --floop=blah) is provided, we @@ -259,7 +252,7 @@ (_, result) <- parseSubargs [] pure result - activate (HelpOption info) = do + activate (RequestOption info requestType) = do -- Arguments should never be interpreted as options when escaped. getEscaped >>= guard . not @@ -267,8 +260,8 @@ guard $ flag `elem` optFlags info pop_ - withContext (UnixOption flag mbound) - requestHelp + withContext (UnixOption flag mbound) $ + request requestType activate (Command info subtree) = do -- Arguments should never be interpreted as commands when escaped. @@ -295,7 +288,7 @@ separator = case flag of LongFlag _ -> "=" _ -> "" - usageInfo (HelpOption info) = + usageInfo (RequestOption info _) = render (optHead info) instance Render (Token UnixScheme) where @@ -305,15 +298,107 @@ render (UnixOption f@(LongFlag _) (Just v)) = render f <> "=" <> render v render (UnixOption f@(ShortFlag _) (Just v)) = render f <> render v -instance SupportsHelp UnixScheme where - makeHelpInfo tree context name desc = renderText +-- | A factored group of subtrees (branches) representing different +-- usage modes. +data Usages a = Usages + [ParseTree UnixScheme Void] -- ^ Request branches + (Maybe (ParseTree UnixScheme a)) -- ^ Uncategorized branch + [ParseTree UnixScheme a] -- ^ Command branches + +-- | Factor a 'ParseTree' into several independant subtrees +-- (branches), potentially filtered to specific commands. +-- +-- Each branch can be thought of as corresponding to one particular +-- mode of operation, in that it contains at least one command or +-- option that conflicts with commands or options in other branches. +-- +-- We can select only branches that correspond to a particular +-- subcommand by passing the components of that subcommand as a list: +-- +-- > decomposeTree tree [] -- No filtering +-- > decomposeTree tree ["stash", "list"] -- Select "stash list" command +decomposeTree :: ParseTree UnixScheme r -> [Text] -> Usages r +decomposeTree (ParseNode (RequestOption info requestType)) commands = + -- If we're currently searching for a specific command, then + -- this request option is irrelevant. + let node = ParseNode (RequestOption info requestType) + in Usages (if null commands then [node] else []) Nothing [] + +decomposeTree (ParseNode (Command info subtree)) commands + | commandMismatch = + -- We are looking for a specific command and it's not this + -- one, so don't return any trees. + Usages [] Nothing [] + | otherwise = + -- Either this is the command we're looking for, or we're not + -- looking for a command. + let Usages req misc cmd = decomposeTree subtree (drop 1 commands) + req' = ParseNode . Command info <$> req + cmd' = ParseNode . Command info <$> maybeToList misc <> cmd + in Usages req' Nothing cmd' + where + commandMismatch = + case commands of + (command : _) -> not $ command `elem` cmdNames info + [] -> False + +decomposeTree (SumNode l r) commands = + let Usages reqLs miscL cmdLs = decomposeTree l commands + Usages reqRs miscR cmdRs = decomposeTree r commands + + -- When both subtrees yield uncategorized branches, then we + -- want to sum them normally. However, if only one subtree + -- yields an uncategorized branch, we can just replace sum + -- with that branch. + misc = liftA2 SumNode miscL miscR + <|> miscL + <|> miscR + in Usages (reqLs <> reqRs) misc (cmdLs <> cmdRs) + +decomposeTree (ProdNode f l r) commands = + let Usages reqLs miscL cmdLs = decomposeTree l commands + Usages reqRs miscR cmdRs = decomposeTree r commands + prod = ProdNode f + + -- Requests prevent any further parsing, so if one of the + -- subtrees yields request branches, the other subtree is + -- irrelevant. If somehow both subtrees yield request + -- branches, then a product node behaves effectively like a + -- sum node because we could never actually trigger both + -- requests. + reqs = reqRs <> reqLs + misc = liftA2 prod miscL miscR + cmds = liftA2 prod (maybeToList miscL) cmdRs <> + liftA2 prod cmdLs (maybeToList miscR) + in Usages reqs misc cmds + +decomposeTree tree _ = Usages [] (Just tree) [] + +formatUsages :: Text -> Usages r -> Builder +formatUsages progName (Usages reqs misc cmds) = + mconcat + $ List.intersperse "\n" + $ map (\t -> TLB.fromText progName <> " " <> render t) usageModes + where + usageModes = map vacuous reqs <> maybeToList misc <> cmds + +instance SupportsResponse UnixScheme where + makeVersionInfo info = renderText + $ render (programName info) + <> " version " + <> renderVersion (programVersion info) + <> "\n" + where + renderVersion = TLB.fromString . showVersion + + makeHelpInfo tree context info = renderText $ "Usage:\n" - <> renderUsages tree <> "\n" - <> render desc <> "\n" + <> formatUsages (programName info) usages <> "\n\n" + <> render (programDesc info) <> "\n" <> renderHelp tree context where - renderUsageLine s = render name <> " " <> render s <> "\n" - renderUsages = foldMap renderUsageLine . exhibitToList . separate + commandContext = [cmd | UnixCommand cmd <- context] + usages = decomposeTree tree commandContext -- | Convenient type alias for Unix-flavored parse trees. type UnixParser = ParseTree UnixScheme @@ -331,7 +416,7 @@ addHelpOptions flags desc tree = ParseNode helpOption <|> go tree where helpOption :: UnixScheme a - helpOption = HelpOption $ OptionInfo flags desc + helpOption = RequestOption (OptionInfo flags desc) HelpRequest go :: ParseTree UnixScheme a -> ParseTree UnixScheme a go (ParseNode (Command info subtree)) = @@ -369,15 +454,15 @@ -- | Enumerate descriptive information for all options available in a -- parse tree, indexed by the set of commands under which they exist. collectOptions :: ParseTree UnixScheme r -> Map [CommandInfo] [OptionHelp] -collectOptions tree = go tree mempty +collectOptions tree = go tree (Map.singleton [] []) where go :: ParseTree UnixScheme r -> Map [CommandInfo] [OptionHelp] -> Map [CommandInfo] [OptionHelp] go (ParseNode (Option info subtree)) = - Map.insertWith (<>) [] [makeOptionHelp info subtree] - go (ParseNode (HelpOption info)) = - Map.insertWith (<>) [] [makeOptionHelp info empty] + Map.adjust (makeOptionHelp info subtree :) [] + go (ParseNode (RequestOption info _)) = + Map.adjust (makeOptionHelp info empty :) [] go (ParseNode (Command info subtree)) = Map.union $ Map.mapKeys (info :) $ collectOptions subtree go (ProdNode _ l r) = go r . go l diff --git a/src/Mangrove/Separable.hs b/src/Mangrove/Separable.hs deleted file mode 100644 --- a/src/Mangrove/Separable.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE KindSignatures #-} - -{-| -Module : Mangrove.Separable -Copyright : (c) Quytelda Kahja, 2026 -License : BSD-3-Clause - -Tools for decomposing parsers into different modal subparsers. --} -module Mangrove.Separable - ( Separable(..) - , Modal(..) - , usesTerseOutput - , Exhibit(..) - , exhibitToList - ) where - -import Data.Kind -import Data.Maybe - --- | A modal branch of a parser or parse tree is a particular subtree --- that, when triggered, excludes the rest of the tree from receiving --- input. This can happen because the parsing context changed (for --- example, when a command is recognized) or when the parsing is --- exited entirely (for example, when a help option is encountered). -data Modal a = Modal !Bool a - deriving (Functor) - -instance Applicative Modal where - pure = Modal False - Modal terse1 f <*> Modal terse2 x = Modal (terse1 && terse2) (f x) - --- | Modal trees that exit the parsing flow entirely have no --- opportunity to make use of optional parsers, since their values --- will never be evaluated. Thus, we mark those trees as having --- "terse" output so that we can omit the optional subtrees when --- generating help information. -usesTerseOutput :: Modal a -> Bool -usesTerseOutput (Modal terseOutput _) = terseOutput - --- | A representation of an object whose modal sub-components have --- been split off for the purpose of better help output. --- --- Every parser and parse tree can be decomposed into one regular tree --- and a list of modal trees. -data Exhibit a = Exhibit (Maybe a) [Modal a] - deriving (Functor) - --- | Convert an t'Exhibit' to a regular list of regular and modal --- components. -exhibitToList :: Exhibit a -> [a] -exhibitToList (Exhibit mnorm modals) = - maybeToList mnorm <> [t | Modal _ t <- modals] - --- | A 'Separable' parser is one that can be decomposed into regular --- and modal subparsers. --- --- We do this so that we can render usage information for each parser --- mode separately. This makes the usage of complex commands --- significantly easier to read. --- --- NOTE: Decomposed subparsers are intended for display purposes --- (hence the t'Exhibit' type). Trying to parse input with them is --- likely to fail. -class Functor s => Separable (s :: Type -> Type) where - separate :: s r -> Exhibit (s r) diff --git a/src/Mangrove/TextParser.hs b/src/Mangrove/TextParser.hs --- a/src/Mangrove/TextParser.hs +++ b/src/Mangrove/TextParser.hs @@ -15,8 +15,24 @@ -} module Mangrove.TextParser - ( TextParser(..) + ( -- * TextParser + TextParser(..) , runTextParser + + -- * Parsers for Common Types + , parseBool + , parseInt + , parseInteger + , parseWord + , parseChar + , parseFloat + , parseDouble + , parseText + , parseLazyText + , parseLazyTextBuilder + , parseString + + -- * Automatic Parser Selection , DefaultParser(..) ) where @@ -24,6 +40,7 @@ import Data.Bifunctor import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Text.Read as TR @@ -55,65 +72,122 @@ Right (result, "") -> pure result Right (_, leftover) -> throwError $ "unexpected input: " <> leftover +-- | Parses a boolean value. This parser accepts @"true"@, @"false"@, +-- @"yes"@, or @"no"@ as input. +parseBool :: TextParser Bool +parseBool = TextParser + { parserHint = "BOOL" + , parserRun = parse + } + where + parse "true" = pure True + parse "false" = pure False + parse "yes" = pure True + parse "no" = pure False + parse _ = throwError "expected true|false|yes|no" + instance DefaultParser Bool where - defaultParser = TextParser - { parserHint = "BOOL" - , parserRun = parse - } - where - parse "true" = pure True - parse "false" = pure False - parse "yes" = pure True - parse "no" = pure False - parse _ = throwError "expected true|false|yes|no" + defaultParser = parseBool +-- | Parse a signed 'Int' value in base-10. +parseInt :: TextParser Int +parseInt = TextParser + { parserHint = "INT" + , parserRun = exactly TR.decimal + } + instance DefaultParser Int where - defaultParser = TextParser - { parserHint = "INT" - , parserRun = exactly TR.decimal - } + defaultParser = parseInt +-- | Parse a signed 'Integer' value in base-10. +parseInteger :: TextParser Integer +parseInteger = TextParser + { parserHint = "INT" + , parserRun = exactly TR.decimal + } + instance DefaultParser Integer where - defaultParser = TextParser - { parserHint = "INT" - , parserRun = exactly TR.decimal - } + defaultParser = parseInteger +-- | Parse an unsigned `Word` value in base-10. +parseWord :: TextParser Word +parseWord = TextParser + { parserHint = "INT" + , parserRun = exactly TR.decimal + } + instance DefaultParser Word where - defaultParser = TextParser - { parserHint = "INT" - , parserRun = exactly TR.decimal - } + defaultParser = parseWord +-- | Parse exactly one character. If the input is longer than 1 character, the parser fails. +parseChar :: TextParser Char +parseChar = TextParser + { parserHint = "CHAR" + , parserRun = parse + } + where + parse (T.unpack -> [c]) = pure c + parse _ = throwError "input contains multiple characters" + instance DefaultParser Char where - defaultParser = TextParser - { parserHint = "CHAR" - , parserRun = parse - } - where - parse (T.unpack -> [c]) = pure c - parse _ = throwError "input contains multiple characters" + defaultParser = parseChar +-- | Parse a floating point value in base-10. +parseFloat :: TextParser Float +parseFloat = TextParser + { parserHint = "FLOAT" + , parserRun = exactly TR.rational + } + instance DefaultParser Float where - defaultParser = TextParser - { parserHint = "FLOAT" - , parserRun = exactly TR.rational - } + defaultParser = parseFloat +-- | Parse a double width value in base-10. +parseDouble :: TextParser Double +parseDouble = TextParser + { parserHint = "DOUBLE" + , parserRun = exactly TR.rational + } + instance DefaultParser Double where - defaultParser = TextParser - { parserHint = "DOUBLE" - , parserRun = exactly TR.rational - } + defaultParser = parseDouble +-- | Parse a strict 'Text' value. +-- +-- Since the input is already strict 'Text', this parser simply returns it for free. +parseText :: TextParser Text +parseText = TextParser + { parserHint = "STRING" + , parserRun = pure + } + instance DefaultParser Text where - defaultParser = TextParser - { parserHint = "STRING" - , parserRun = pure - } + defaultParser = parseText +parseLazyText :: TextParser TL.Text +parseLazyText = TextParser + { parserHint = "STRING" + , parserRun = pure . TL.fromStrict + } + +instance DefaultParser TL.Text where + defaultParser = parseLazyText + +parseLazyTextBuilder :: TextParser TLB.Builder +parseLazyTextBuilder = TextParser + { parserHint = "STRING" + , parserRun = pure . TLB.fromText + } + +instance DefaultParser TLB.Builder where + defaultParser = parseLazyTextBuilder + +-- | Parse a Haskell 'String' (i.e. @[Char]@) value. +parseString :: TextParser String +parseString = TextParser + { parserHint = "STRING" + , parserRun = pure . T.unpack + } + instance DefaultParser String where - defaultParser = TextParser - { parserHint = "STRING" - , parserRun = pure . T.unpack - } + defaultParser = parseString diff --git a/src/Mangrove/Unix.hs b/src/Mangrove/Unix.hs --- a/src/Mangrove/Unix.hs +++ b/src/Mangrove/Unix.hs @@ -24,6 +24,7 @@ , option , optionPure , switch + , requestOption , command , subparameter , suboption @@ -37,7 +38,7 @@ import Data.Text (Text) import Mangrove.Parser -import Mangrove.Scheme.Sub (SubScheme, SubParser) +import Mangrove.Scheme.Sub (SubParser, SubScheme) import qualified Mangrove.Scheme.Sub as Sub import Mangrove.Scheme.Unix import Mangrove.TextParser @@ -65,12 +66,24 @@ -> Text -> a -> UnixParser a -optionPure flags help = ParseNode . Option (OptionInfo flags help) . pure +optionPure flags help = option flags help . pure -- | Define a CLI option which produces 'True' if present and 'False' -- otherwise. switch :: NonEmpty Flag -> Text -> UnixParser Bool switch flags help = optionPure flags help True <|> pure False + +-- | A special option that triggers a request for information. +-- +-- When a request option is encountered in the command line, a +-- "request" is raised and parsing is abandoned in favor of yielding a +-- human-readable response. +requestOption + :: NonEmpty Flag + -> Text + -> RequestType + -> UnixParser a +requestOption flags help = ParseNode . RequestOption (OptionInfo flags help) -- | Define a CLI subcommand with it's own parsing subtree. command diff --git a/test/General.hs b/test/General.hs --- a/test/General.hs +++ b/test/General.hs @@ -5,6 +5,7 @@ import Control.Applicative +import Data.Version import Test.Hspec import Mangrove @@ -113,19 +114,24 @@ `shouldBe` Success [] "value=asdf" describe "help options" $ do - let progInfo = ProgramInfo "example" "description" - isHelpResult (Help _) = True - isHelpResult _ = False + let progInfo = ProgramInfo + { programName = "example" + , programVersion = makeVersion [1,0] + , programDesc = "description" + } :: ProgramInfo s + isResponse (Response {}) = True + isResponse _ = False + context "when a help option is present" $ do it "requests help" $ do runHelpfulParser progInfo (withHelp opt_example_unit) ["--help"] - `shouldSatisfy` isHelpResult + `shouldSatisfy` isResponse it "works for subcommands" $ do runHelpfulParser progInfo (withHelp cmd_example_tree) ["example", "--help"] - `shouldSatisfy` isHelpResult + `shouldSatisfy` isResponse runHelpfulParser progInfo (withHelp cmd_example_tree) ["example", "asdf", "--help"] - `shouldSatisfy` isHelpResult + `shouldSatisfy` isResponse context "when a help option is absent" $ do it "doesn't request help" $ do diff --git a/test/Mangrove/ParserSpec.hs b/test/Mangrove/ParserSpec.hs --- a/test/Mangrove/ParserSpec.hs +++ b/test/Mangrove/ParserSpec.hs @@ -120,12 +120,12 @@ = SSuccess r | SEmpty | SFailure Builder - | SHelpReq + | SRequest RequestType deriving (Eq, Show) -- | Sink the results of a 'StreamParser' into a data type for easier inspection. runStreamParser' - :: SupportsHelp s + :: SupportsResponse s => StreamParser s r -> StreamState s -> (StreamState s, StreamResult r) @@ -136,7 +136,7 @@ { onSuccess = \s result -> (s, SSuccess result) , onEmpty = \s -> (s, SEmpty) , onFailure = \s err -> (s, SFailure err) - , onHelpRequest = OnHelp $ \s -> (s, SHelpReq) + , onRequest = OnRequest $ \s t -> (s, SRequest t) } initState_empty :: StreamState s