Shellac-0.9.9: A framework for creating shell envinronments

Safe HaskellNone
LanguageHaskell2010

System.Console.Shell

Contents

Description

This module implements a framework for creating read-eval-print style command shells. Shells are created by declaratively defining evaluation functions and "shell commands". Input is read using a pluggable backend. The shell framework handles command history and word completion if the backend supports it.

The basic idea is for creating a shell is:

  1. Create a list of shell commands and an evaluation function
  2. Create a shell description (using mkShellDescription)
  3. Set up the initial shell state
  4. Run the shell (using runShell)

Shell commands and the evaluation function are written in a custom monad. See System.Console.Shell.ShellMonad for details on using this monad.

Synopsis

Shell Descriptions

data ShellDescription st Source #

A record type which describes the attributes of a shell.

Constructors

ShDesc 

Fields

initialShellDescription :: ShellDescription st Source #

A basic shell description with sane initial values.

mkShellDescription :: [ShellCommand st] -> (String -> Sh st ()) -> ShellDescription st Source #

Creates a simple shell description from a list of shell commands and an evaluation function.

defaultExceptionHandler :: ShellacException -> Sh st () Source #

The default shell exception handler. It simply prints the exception and returns the shell state unchanged. (However, it specificaly ignores the thread killed exception, because that is used to implement execution canceling)

Executing Shells

runShell :: ShellDescription st -> ShellBackend bst -> st -> IO st Source #

Run a shell. Given a shell description, a shell backend to use and an initial state this function runs the shell until it exits, and then returns the final state.

Creating Shell Commands

exitCommand Source #

Arguments

:: String

the name of the command

-> ShellCommand st 

Creates a shell command which will exit the shell.

helpCommand Source #

Arguments

:: String

the name of the command

-> ShellCommand st 

Creates a command which will print the shell help message.

toggle Source #

Arguments

:: String

command name

-> String

help message

-> (st -> Bool)

getter

-> (Bool -> st -> st)

setter

-> ShellCommand st 

Creates a command to toggle a boolean value

cmd Source #

Arguments

:: CommandFunction f st 
=> String

the name of the command

-> f

the command function. See CommandFunction for restrictions on the type of this function.

-> String

the help string for this command

-> ShellCommand st 

Creates a user defined shell commmand. This relies on the typeclass machenery defined by CommandFunction.

class CommandFunction f st | f -> st Source #

This class is used in the cmd function to automaticly generate the command parsers and command syntax strings for user defined commands. The type of 'f' is restricted to have a restricted set of monomorphic arguments (Int, Integer, Float, Double, String, File, Username, and Completable) and the head type must be Sh st ()

 f :: Int -> File -> Sh MyShellState ()
 g :: Double -> Sh st ()
 h :: Sh SomeShellState ()

are all legal types, whereas:

 bad1 :: a -> Sh (MyShellState a) ()
 bad2 :: [Int] -> Sh MyShellState ()
 bad3 :: Bool -> MyShellState

are not.

Minimal complete definition

parseCommand, commandSyntax

Instances

CommandFunction r st => CommandFunction (Double -> r) st Source # 

Methods

parseCommand :: String -> (Double -> r) -> CommandParser st

commandSyntax :: (Double -> r) -> [Doc]

CommandFunction r st => CommandFunction (Float -> r) st Source # 

Methods

parseCommand :: String -> (Float -> r) -> CommandParser st

commandSyntax :: (Float -> r) -> [Doc]

CommandFunction r st => CommandFunction (Int -> r) st Source # 

Methods

parseCommand :: String -> (Int -> r) -> CommandParser st

commandSyntax :: (Int -> r) -> [Doc]

CommandFunction r st => CommandFunction (Integer -> r) st Source # 

Methods

parseCommand :: String -> (Integer -> r) -> CommandParser st

commandSyntax :: (Integer -> r) -> [Doc]

CommandFunction r st => CommandFunction (String -> r) st Source # 

Methods

parseCommand :: String -> (String -> r) -> CommandParser st

commandSyntax :: (String -> r) -> [Doc]

(CommandFunction r st, Completion compl st) => CommandFunction (Completable compl -> r) st Source # 

Methods

parseCommand :: String -> (Completable compl -> r) -> CommandParser st

commandSyntax :: (Completable compl -> r) -> [Doc]

CommandFunction r st => CommandFunction (Username -> r) st Source # 

Methods

parseCommand :: String -> (Username -> r) -> CommandParser st

commandSyntax :: (Username -> r) -> [Doc]

CommandFunction r st => CommandFunction (File -> r) st Source # 

Methods

parseCommand :: String -> (File -> r) -> CommandParser st

commandSyntax :: (File -> r) -> [Doc]

CommandFunction (Sh st ()) st Source # 

Methods

parseCommand :: String -> Sh st () -> CommandParser st

commandSyntax :: Sh st () -> [Doc]

newtype File Source #

Represents a command argument which is a filename

Constructors

File String 

Instances

CommandFunction r st => CommandFunction (File -> r) st Source # 

Methods

parseCommand :: String -> (File -> r) -> CommandParser st

commandSyntax :: (File -> r) -> [Doc]

newtype Username Source #

Represents a command argument which is a username

Constructors

Username String 

Instances

CommandFunction r st => CommandFunction (Username -> r) st Source # 

Methods

parseCommand :: String -> (Username -> r) -> CommandParser st

commandSyntax :: (Username -> r) -> [Doc]

newtype Completable compl Source #

Represents a command argument which is an arbitrary completable item. The type argument determines the instance of Completion which is used to create completions for this command argument.

Constructors

Completable String 

Instances

(CommandFunction r st, Completion compl st) => CommandFunction (Completable compl -> r) st Source # 

Methods

parseCommand :: String -> (Completable compl -> r) -> CommandParser st

commandSyntax :: (Completable compl -> r) -> [Doc]

class Completion compl st | compl -> st where Source #

A typeclass representing user definable completion functions.

Minimal complete definition

complete, completableLabel

Methods

complete :: compl -> st -> String -> IO [String] Source #

Actually generates the list of possible completions, given the current shell state and a string representing the beginning of the word.

completableLabel :: compl -> String Source #

generates a label for the argument for use in the help displays.

type ShellCommand st = ShellDescription st -> (String, CommandParser st, Doc, Doc) Source #

The type of a shell command. The shell description is passed in, and the tuple consists of (command name,command parser,command syntax document,help message document)

Subshells

type Subshell st st' = (st -> IO st', st' -> IO st, st' -> IO (ShellDescription st')) Source #

The type of subshells. The tuple consists of:

  1. A function to generate the initial subshell state from the outer shell state
  2. A function to generate the outer shell state from the final subshell state
  3. A function to generate the shell description from the initial subshell state

simpleSubshell Source #

Arguments

:: (st -> IO st')

A function to generate the initial subshell state from the outer shell state

-> ShellDescription st'

A shell description for the subshell

-> IO (Subshell st st') 

Creates a simple subshell from a state mapping function and a shell description.

Printing Help Messages

showShellHelp :: ShellDescription st -> String Source #

Prints the help message for this shell, which lists all avaliable commands with their syntax and a short informative message about each.

showCmdHelp :: ShellDescription st -> String -> String Source #

Print the help message for a particular shell command

Auxiliary Types

data CommandStyle Source #

Datatype describing the style of shell commands. This determines how shell input is parsed.

Constructors

OnlyCommands

Indicates that all input is to be interpreted as shell commands; input is only passed to the evaluation fuction if it cannot be parsed as a command.

CharPrefixCommands Char

Indicates that commands are prefixed with a particular character. Colon ':' is the default character (a la GHCi).

SingleCharCommands

Commands consist of a single character.

data ShellSpecial st Source #

Special commands for the shell framework.

Constructors

ShellExit

Causes the shell to exit

ShellHelp (Maybe String)

Causes the shell to print an informative message. If a command name is specified, only information about that command will be displayed

ShellNothing

Instructs the shell to do nothing; redisplay the prompt and continue

ShellContinueLine String

Ask the shell to continue accepting input on another line, which should be appended to the given string

ExecSubshell (Subshell st st')

Causes the shell to execute a subshell

type OutputCommand = BackendOutput -> IO () Source #

The type of commands which produce output on the shell console.

type CommandResult st = (st, Maybe (ShellSpecial st)) Source #

The type of results from shell commands. They are a modified shell state and possibly a shell "special" action to execute.