structured-cli-2.7.0.1: Application library for building interactive console CLIs
Copyright(c) Erick Gonzalez 2017-2018
LicenseBSD3
Maintainererick@codemonkeylabs.de
Safe HaskellNone
LanguageHaskell2010

System.Console.StructuredCLI

Description

This module provides the tools to build a complete "structured" CLI application, similar to those found in systems like Cisco IOS or console configuration utilities etc. It aims to be easy for implementors to use.

Synopsis

How to use this module:

It is often the case that a simple example is the best user guide, at least for the experienced programmer. The following code illustrates a basic but functioning CLI application

module Main where

import Control.Monad                 (void)
import Control.Monad.IO.Class        (liftIO)
import Data.Default                  (def)
import System.Console.StructuredCLI

root :: Commands ()
root = do
  world >+ do
    hello
    bye
    command "exit" "return to previous level" exit

world :: Commands ()
world = command "world" "enter into the world" $ return NewLevel

hello :: Commands ()
hello = command "hello" "prints a greeting" $ do
          liftIO . putStrLn $ "Hello world!"
          return NoAction

bye :: Commands ()
bye = command "bye" "say goodbye" $ do
        liftIO . putStrLn $ "Sayonara!"
        return NoAction

main :: IO ()
main = void $ runCLI "Hello CLI" def root

resulting example CLI session:

>>> Hello CLI > ?
- world: enter into the world
>>> Hello CLI > world
>>> Hello CLI world > ?
- exit: return to previous level
- bye: say goodbye
- hello: prints a greeting
>>> Hello CLI world > hello
Hello world!
>>> Hello CLI world > bye
Sayonara!
>>> Hello CLI world > exit
>>> Hello CLI >

A good way to get you started is to grab the example code available under example/Main.hs and modify it to suit your needs.

data Action Source #

An Action is returned as the result of a command handler provided by the user and it instructs the CLI of any changes in the CLI state

Constructors

NewLevel

The command executed is "entered" into, creating a new CLI level.

NoAction

Do not enter a new level.

LevelUp Int

Reset the CLI state up to a given number of levels.

ToRoot

Go back up all the way to the top (root) of the CLI.

Instances

Instances details
Show Action Source # 
Instance details

Defined in System.Console.StructuredCLI

type Commands = CommandsT IO Source #

An alias type for the case where CommandsT wraps IO only (i.e. no state, etc)

newtype CommandsT m a Source #

The CommandsT transformer monad is the key to building a CLI tree. It is meant to be used as a transformer wrapping an application specific "user" monad (for example, a State monad encapsulating application state). This monad is executed _once_ upon calling runCLI to build the command tree. Keep in mind however that any parsers or actions used in any given command all run in the "user" monad and unlike the process of building the command tree, they will be called multiple times as the user navigates the CLI at runtime. Each CommandsT monadic action corresponds to a single "node" (a.k.a. command) in the CLI. Succesive actions simply add commands to the current "level". It is possible to "nest" a new level to a command by using the (>+) operator. When properly indented (see example code above) it provides a pretty self explanatory way to build the CLI tree.

Constructors

CommandsT 

Fields

Instances

Instances details
MonadTrans CommandsT Source # 
Instance details

Defined in System.Console.StructuredCLI

Methods

lift :: Monad m => m a -> CommandsT m a #

Monad m => Monad (CommandsT m) Source # 
Instance details

Defined in System.Console.StructuredCLI

Methods

(>>=) :: CommandsT m a -> (a -> CommandsT m b) -> CommandsT m b #

(>>) :: CommandsT m a -> CommandsT m b -> CommandsT m b #

return :: a -> CommandsT m a #

Functor f => Functor (CommandsT f) Source # 
Instance details

Defined in System.Console.StructuredCLI

Methods

fmap :: (a -> b) -> CommandsT f a -> CommandsT f b #

(<$) :: a -> CommandsT f b -> CommandsT f a #

Applicative a => Applicative (CommandsT a) Source # 
Instance details

Defined in System.Console.StructuredCLI

Methods

pure :: a0 -> CommandsT a a0 #

(<*>) :: CommandsT a (a0 -> b) -> CommandsT a a0 -> CommandsT a b #

liftA2 :: (a0 -> b -> c) -> CommandsT a a0 -> CommandsT a b -> CommandsT a c #

(*>) :: CommandsT a a0 -> CommandsT a b -> CommandsT a b #

(<*) :: CommandsT a a0 -> CommandsT a b -> CommandsT a a0 #

MonadIO m => MonadIO (CommandsT m) Source # 
Instance details

Defined in System.Console.StructuredCLI

Methods

liftIO :: IO a -> CommandsT m a #

type Handler m a = a -> m Action Source #

data Node m Source #

The Node type contains the internal representation of a command. Normally there is no need to be concerned with it other than perhaps passing it opaquely to any utility parsers (like labelParser for example), when writing a custom parser

Instances

Instances details
Monad m => Default (Parser m String) Source # 
Instance details

Defined in System.Console.StructuredCLI

Methods

def :: Parser m String #

type Parser m a = Node m -> String -> m (ParseResult a) Source #

data ParseResult a Source #

There is no need to concern oneself with the ParseResult type unless one is writing a custom parser, which should actually be rarer than not.

Constructors

Done 

Fields

Partial 

Fields

Fail 

Fields

NoMatch

Parsing provided input doesnt match this command. The difference between Fail and NoMatch is a fine but important one. Failure should be used for example when a command keyword is correct but a required parameter is invalid or contains an error for example. A NoMatch should be exclusively used when a command keyword does not correspond to the given input

Instances

Instances details
Show a => Show (ParseResult a) Source # 
Instance details

Defined in System.Console.StructuredCLI

Monad m => Default (Parser m String) Source # 
Instance details

Defined in System.Console.StructuredCLI

Methods

def :: Parser m String #

data Settings m Source #

Constructors

Settings

CLI Settings provided upon launching the CLI. It is recommended to modify the settings provided by the Default instance: i.e: def { getBanner = "My CLI" } that way you can use for example the default exception handler which should suit usual needs, etc.

Fields

Instances

Instances details
MonadIO m => Default (Settings m) Source # 
Instance details

Defined in System.Console.StructuredCLI

Methods

def :: Settings m #

type Validator m a = String -> m (Maybe a) Source #

A Validator is a function to which a parsed string is given in order to perform any checks for validity that may be applicable, or even transforming the argument if necessary. Note that the validator runs in the "user" monad

(>+) :: Monad m => CommandsT m () -> CommandsT m () -> CommandsT m () Source #

the CommandsT "nest" operation. It adds a new deeper CLI level to the command on the left side with the commands on the right side, for example: activate >+ do foo bar baz Would result in the following CLI command structure:

>>> > activate
>>> activate > ?
>>> - foo ..
>>> - bar ..
>>> - baz ..

command Source #

Arguments

:: Monad m 
=> String

Command keyword

-> String

Help text for this command

-> m Action

Action in the "user" monad (i.e. return NewLevel)

-> CommandsT m () 

Build a command node that is always active and takes no parameters

command' Source #

Arguments

:: Monad m 
=> String

Command keyword

-> String

Help text for this command

-> m Bool

Enable action in the "user" monad

-> m Action

Action in the "user" monad (i.e. return NewLevel)

-> CommandsT m () 

A variation of command that allows for "disabling" the command at runtime by running the given "enable" monadic action (as always in the "user" monad) to check if the command should be displayed as an option and/or accepted or not.

custom Source #

Arguments

:: Monad m 
=> String

Command keyword

-> String

Help text for this command

-> Parser m a

Custom parser (runs in the "user" monad)

-> m Bool

Enable action in the "user" monad

-> Handler m a

Handling action. Takes the validator output as argument

-> CommandsT m () 

Create a command using a custom parser, providing thus complete flexibility

exit :: Monad m => m Action Source #

A utility action to "leave" the current CLI level. Equivalent to return $ LevelUp 1

isCompleted :: Monad m => SearchResult m -> Bool Source #

isIncomplete :: Monad m => SearchResult m -> Bool Source #

isNoResult :: Monad m => SearchResult m -> Bool Source #

isFailed :: Monad m => SearchResult m -> Bool Source #

labelParser :: Monad m => Node m -> String -> m (ParseResult String) Source #

A utility parser that reads an input and parses a command label. It can be used as part of custom parsers to first read the command keyword before parsing any arguments etc.

newLevel :: Monad m => m Action Source #

A utility action to "nest" into a new CLI level. Equivalent to return NewLevel

noAction :: Monad m => m Action Source #

A utility action to leave the current CLI level untouched. Equivalent to return NoAction

param Source #

Arguments

:: Monad m 
=> String

Command keyword

-> String

Help text for this command (including argument description)

-> Validator m a

Monadic validator (in the "user" monad)

-> Handler m a

Handling action. Takes the validator output as argument

-> CommandsT m () 

Build a command node that takes one parameter (delimited by space). The parsed parameter is fed to the validator monadic function (in the "user" monad) and the resulting value if any is fed in turn as an argument to the handler action (also in the "user" monad).

param' Source #

Arguments

:: Monad m 
=> String

Command keyword

-> String

Help text for this command (including argument description)

-> Validator m a

Monadic validator (in the "user" monad)

-> m Bool

Enable action in the "user" monad

-> Handler m a

Handling action. Takes the validator output as argument

-> CommandsT m () 

A variation of param that allows for "disabling" the command at runtime by running the given "enable" monadic action (as always in the "user" monad) to check if the command should be displayed as an option and/or accepted or not.

paramParser :: Monad m => String -> (String -> m (Maybe a)) -> Node m -> String -> m (ParseResult a) Source #

parseOneOf :: Monad m => [String] -> String -> Node m -> String -> m (ParseResult String) Source #

A utility parser that reads an input and parses any of the provided possibilities as a parameter for the command node using this parser (see provided example.hs)

runCLI :: (MonadMask m, MonadIO m) => String -> Settings m -> CommandsT m a -> m (Either CLIException a) Source #

Launches the CLI application. It doesn't normally return unless an exception is thrown or if it runs out of input in batch mode. Normal return value is that returned by the CommandsT action that built the tree. Remember that Settings is an instance of Default

top :: Monad m => m Action Source #

A utility action to reset the CLI tree to the root node . Equivalent to return ToRoot

Orphan instances

Monad m => Default (Validator m String) Source # 
Instance details

Methods

def :: Validator m String #