Safe Haskell | None |
---|---|
Language | Haskell2010 |
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:
- Create a list of shell commands and an evaluation function
- Create a shell description (using
mkShellDescription
) - Set up the initial shell state
- 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.
- data ShellDescription st = ShDesc {
- shellCommands :: [ShellCommand st]
- commandStyle :: CommandStyle
- evaluateFunc :: String -> Sh st ()
- greetingText :: Maybe String
- wordBreakChars :: [Char]
- beforePrompt :: Sh st ()
- prompt :: st -> IO String
- secondaryPrompt :: Maybe (st -> IO String)
- exceptionHandler :: ShellacException -> Sh st ()
- defaultCompletions :: Maybe (st -> String -> IO [String])
- historyFile :: Maybe FilePath
- maxHistoryEntries :: Int
- historyEnabled :: Bool
- initialShellDescription :: ShellDescription st
- mkShellDescription :: [ShellCommand st] -> (String -> Sh st ()) -> ShellDescription st
- defaultExceptionHandler :: ShellacException -> Sh st ()
- runShell :: ShellDescription st -> ShellBackend bst -> st -> IO st
- exitCommand :: String -> ShellCommand st
- helpCommand :: String -> ShellCommand st
- toggle :: String -> String -> (st -> Bool) -> (Bool -> st -> st) -> ShellCommand st
- cmd :: CommandFunction f st => String -> f -> String -> ShellCommand st
- class CommandFunction f st | f -> st
- newtype File = File String
- newtype Username = Username String
- newtype Completable compl = Completable String
- class Completion compl st | compl -> st where
- type ShellCommand st = ShellDescription st -> (String, CommandParser st, Doc, Doc)
- type Subshell st st' = (st -> IO st', st' -> IO st, st' -> IO (ShellDescription st'))
- simpleSubshell :: (st -> IO st') -> ShellDescription st' -> IO (Subshell st st')
- showShellHelp :: ShellDescription st -> String
- showCmdHelp :: ShellDescription st -> String -> String
- data CommandStyle
- data ShellSpecial st
- = ShellExit
- | ShellHelp (Maybe String)
- | ShellNothing
- | ShellContinueLine String
- | ExecSubshell (Subshell st st')
- type OutputCommand = BackendOutput -> IO ()
- type CommandResult st = (st, Maybe (ShellSpecial st))
- type ShellacException = SomeException
Shell Descriptions
data ShellDescription st Source #
A record type which describes the attributes of a shell.
ShDesc | |
|
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
:: String | the name of the command |
-> ShellCommand st |
Creates a shell command which will exit the shell.
:: String | the name of the command |
-> ShellCommand st |
Creates a command which will print the shell help message.
:: String | command name |
-> String | help message |
-> (st -> Bool) | getter |
-> (Bool -> st -> st) | setter |
-> ShellCommand st |
Creates a command to toggle a boolean value
:: CommandFunction f st | |
=> String | the name of the command |
-> f | the command function. See |
-> 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.
parseCommand, commandSyntax
CommandFunction r st => CommandFunction (Double -> r) st Source # | |
CommandFunction r st => CommandFunction (Float -> r) st Source # | |
CommandFunction r st => CommandFunction (Int -> r) st Source # | |
CommandFunction r st => CommandFunction (Integer -> r) st Source # | |
CommandFunction r st => CommandFunction (String -> r) st Source # | |
(CommandFunction r st, Completion compl st) => CommandFunction (Completable compl -> r) st Source # | |
CommandFunction r st => CommandFunction (Username -> r) st Source # | |
CommandFunction r st => CommandFunction (File -> r) st Source # | |
CommandFunction (Sh st ()) st Source # | |
Represents a command argument which is a filename
CommandFunction r st => CommandFunction (File -> r) st Source # | |
Represents a command argument which is a username
CommandFunction r st => CommandFunction (Username -> r) st Source # | |
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.
(CommandFunction r st, Completion compl st) => CommandFunction (Completable compl -> r) st Source # | |
class Completion compl st | compl -> st where Source #
A typeclass representing user definable completion functions.
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:
- A function to generate the initial subshell state from the outer shell state
- A function to generate the outer shell state from the final subshell state
- A function to generate the shell description from the initial subshell state
:: (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.
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.
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.
type ShellacException = SomeException Source #