commander-0.1.0.0: pattern matching against string based commands

Safe HaskellNone
LanguageHaskell2010

Commander.Commands

Contents

Description

This module contains the core types and functions for working with them.

Synopsis

Creating new Commands

These types and functions are involved in building up a Command out object, where out is the output type of the functions attached to the different command paths.

Core types

data Command out Source

This is the type returned from using the commands function along with helpers like command and run to build up a nested structure of commands. We can manually traverse it by looking through the cmdChildren Map to acess nested commands, or inspecting the cmdHelp and cmdFunc properties of the current command. This makes it easy to do things like autocomplete commands, or print out help etc.

Constructors

Command 

Fields

cmdChildren :: Map String (Command out)
 
cmdHelp :: String
 
cmdFunc :: Maybe (Fn out)
 

Instances

type Commands out = State (Command out) Source

You probably won't ever need to interact with this type; it is just a State monad on our Command type in order that we can use monadic notation to build up our nested structure.

data CommandError Source

A collection of the errors that can be encountered upon trying to get and run a Command

Constructors

ErrParamHasNoFlags

If a parameter's ParamFlags instance returns Just [], complain:

ErrTooManyValues [String]

More input values are provided than the function requires. Provides the list of remaining values.

ErrNotEnoughValues

Not enough input values are provided to the function, so it can't run.

ErrNotEnoughPath [String]

We didn't find any function with the given path. Provides the possible path pieces that could have been supplied to go one level deeper.

ErrPathNotFound [String] String

We didn't find a path corresponding to some string. Returns the possible paths that could have been taken from that location, and the failing string.

ErrCastingFlag String String

We tried converting the flag (provided as the first param) to the type asked for, and failed for some reason (provided as the second param).

ErrCastingValue String

We tried converting some value to the type asked and failed with the reason provided.

Attaching values to Commands

These functions allow us to build up our nested command structure.

commands :: Commands out () -> Command out Source

Given a Commands type as its only argument, this resolves it to a Command object, ready to make use of. This is basically the entry point to defining our commands, inside which we can use the functions below to populate our structure.

command :: String -> Commands out () -> Commands out () Source

Nest a command with some name inside the current command.

help :: String -> Commands out () Source

Attach help to the current command.

run :: (ExtractParameters fn out, InjectParameters fn out) => fn -> Commands out () Source

Attach a function which will be tried if the current command is matched. The parameters to the function must satisfy the IsParameter typeclasses, which will automatically make the function satisfy the ExtractParameters and InjectParameters typeclasses.

Extracting and running Commands

The below are helpers for simpler interaction with our Command object.

evalCommand :: [String] -> Map String String -> Command out -> Either CommandError out Source

Attempt to run a function inside a Command object, using the first argument (a list of strings) to first navigate to the relevant subcommand and then have any remainder used as values to be passed to the command, and the second argument as a map of flags to be passed to the command.

getCommand :: [String] -> Command out -> Either CommandError (Command out) Source

Attempt to get hold of the nested Command at the path provided inside a provided Command object.

Function parameters

Functions are wrapped up inside an existential Fn type in order that we can hide away their implementation details and satisfy the type system. In order for a function to be wrappable inside this type, you need only actually satisfy the IsParameter tuple of typeclasses for the types of any of the arguments to the function. Of these, only the ToParam class is actually mandatory.

Creating new function parameters

type IsParameter a = (ToParam a, ParamFlags a, ParamHelp a) Source

A tuple of typeclasses that must all be implemented for function parameter types in order that they can be used in the functions attached to commands. ToParam is the only mandatory requirement (ParamFlags and ParamHelp have default defitions), however it is recommended that you implement ParamHelp in all cases, and you must implement ParamFlags if you want your new type to match against provided flags. An example custom parameter implementation:

data Verbose = Verbose Bool

instance ParamFlags Verbose where
    paramFlags _ = Just ["v", "verbose"]
instance ParamHelp Verbose where
    paramHelp _ = "Make the command more verbose"
instance ToParam Verbose where
    toParam (Just _) = Right (Verbose True)
    toParam Nothing = Right (Verbose False)

Here, we define a Verbose type that will equal Verbose True if the "v" or "verbose" flag is used in the command, or Verbose False otherwise.

To extract the value, all we have to do is use (Verbose b) in our commands function now, where b will be either True or False.

See Params for the definitions of the provided Value and Flag parameter types.

class ToParam a where Source

Describe how to turn the String parameter given into our custom type. The input may be Nothing if the flag/value is not provided, else it will be Just str where str is the input string.

Instances

FromString a => ToParam (Value help a) Source 
FromString a => ToParam (Flag flags help a) Source 
ToParam (Flag flags help Bool) Source 
FromString a => ToParam (Flag flags help (Maybe a)) Source 

class ParamFlags a where Source

Should the parameter match against flags? If so, return Just [flags] from this. If the param should be a value instead, return Nothing.

Minimal complete definition

Nothing

Methods

paramFlags :: proxy a -> Maybe [String] Source

Instances

ParamFlags (Value help a) Source 
KnownSymbols flags => ParamFlags (Flag flags help a) Source 

class ParamHelp a where Source

Return a piece of help text describing what the parameter means.

Minimal complete definition

Nothing

Methods

paramHelp :: proxy a -> String Source

Instances

KnownSymbol help => ParamHelp (Value help a) Source 
KnownSymbol help => ParamHelp (Flag flags help a) Source 

Working with function parameters

data Fn out Source

Our existential Fn type is used for hiding away the details of some provided function. Any function that satisfies the IsParameter tuple of type classes can be wrapped in this.

Constructors

forall fn . (ExtractParameters fn out, InjectParameters fn out) => Fn fn 

Instances

Show (Fn out) Source 

injectParams :: [String] -> Map String String -> Fn out -> Either CommandError out Source

given our Fn out type, containing some function that will return out on successful execution, attempt to run the function by injecting a list of values and a map of flags to it. This will either return a CommandError denoting what failed, or the output from running the function.

extractParams :: Fn out -> [Parameter] Source

Run against our Fn out wrapped function, this will return a list of Parameter details for each parameter in the contained function.

data Parameter Source

A type containing information about a function parameter.