Safe Haskell | None |
---|---|
Language | Haskell2010 |
This libraries provides an in-other-words effect that provides interactive command line usage.
This module provides the following effects:
Readline
which offers basic I/O operations on the command lineHandleInterrupt
which offers the ability to handle Ctrl-C interrupts
In addition to providing effects/handlers this also re-exports haskeline's types/functions where relevant, so you shouldn't need to import any haskeline modules.
If you need to tamper with the history functionality provided by haskeline,
check out Control.Effect.Readline.History which provides a
ReadlineHistory
effect for doing that.
Synopsis
- data Readline :: Effect where
- GetInputLine :: String -> Readline m (Maybe String)
- GetInputLineWithInitial :: String -> (String, String) -> Readline m (Maybe String)
- GetInputChar :: String -> Readline m (Maybe Char)
- GetPassword :: Maybe Char -> String -> Readline m (Maybe String)
- WaitForAnyKey :: String -> Readline m Bool
- OutputStr :: String -> Readline m ()
- getInputLine :: Eff Readline m => String -> m (Maybe String)
- getInputLineWithInitial :: Eff Readline m => String -> (String, String) -> m (Maybe String)
- getInputChar :: Eff Readline m => String -> m (Maybe Char)
- getPassword :: Eff Readline m => Maybe Char -> String -> m (Maybe String)
- waitForAnyKey :: Eff Readline m => String -> m Bool
- outputStr :: Eff Readline m => String -> m ()
- outputStrLn :: Eff Readline m => String -> m ()
- data HandleInterrupt :: Effect where
- WithInterrupt :: m a -> HandleInterrupt m a
- HandleInterrupt :: m a -> m a -> HandleInterrupt m a
- withInterrupt :: Eff HandleInterrupt m => m a -> m a
- handleInterrupt :: Eff HandleInterrupt m => m a -> m a -> m a
- catchInterrupt :: Eff HandleInterrupt m => m a -> m a -> m a
- runReadline :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Settings m -> ReadlineInterruptC m a -> m a
- runReadlineBehavior :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Behavior -> Settings m -> ReadlineInterruptC m a -> m a
- runReadlineWithPrefs :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Prefs -> Settings m -> ReadlineInterruptC m a -> m a
- runReadlineBehaviorWithPrefs :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Behavior -> Prefs -> Settings m -> ReadlineInterruptC m a -> m a
- runReadline' :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Settings m -> ReadlineC m a -> m a
- runReadlineBehavior' :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Behavior -> Settings m -> ReadlineC m a -> m a
- runReadlineWithPrefs' :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Prefs -> Settings m -> ReadlineC m a -> m a
- runReadlineBehaviorWithPrefs' :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Behavior -> Prefs -> Settings m -> ReadlineC m a -> m a
- data ReadlineC m a
- data ReadlineInterruptC m a
- class Threads ReadlineT p => ReadlineThreads p
- data Settings (m :: Type -> Type) = Settings {}
- defaultSettings :: forall (m :: Type -> Type). MonadIO m => Settings m
- setComplete :: CompletionFunc m -> Settings m -> Settings m
- module System.Console.Haskeline.Completion
- data Behavior
- defaultBehavior :: Behavior
- useFileHandle :: Handle -> Behavior
- useFile :: FilePath -> Behavior
- preferTerm :: Behavior
- data Prefs
- readPrefs :: FilePath -> IO Prefs
- defaultPrefs :: Prefs
Effect and Actions
Readline
data Readline :: Effect where Source #
GetInputLine :: String -> Readline m (Maybe String) | |
GetInputLineWithInitial :: String -> (String, String) -> Readline m (Maybe String) | |
GetInputChar :: String -> Readline m (Maybe Char) | |
GetPassword :: Maybe Char -> String -> Readline m (Maybe String) | |
WaitForAnyKey :: String -> Readline m Bool | |
OutputStr :: String -> Readline m () |
getInputLine :: Eff Readline m => String -> m (Maybe String) Source #
Reads one line of input. The final newline (if any) is removed. When using terminal-style interaction, this function provides a rich line-editing user interface.
If
and the line input is nonblank (i.e., is not all
spaces), it will be automatically added to the history.autoAddHistory
== True
getInputLineWithInitial :: Eff Readline m => String -> (String, String) -> m (Maybe String) Source #
Reads one line of input and fills the insertion space with initial text. When using terminal-style interaction, this function provides a rich line-editing user interface with the added ability to give the user default values.
This function behaves in the exact same manner as getInputLine
, except that
it pre-populates the input area. The text that resides in the input area is given as a 2-tuple
with two String
s. The string on the left of the tuple (obtained by calling fst
) is
what will appear to the left of the cursor and the string on the right (obtained by
calling snd
) is what will appear to the right of the cursor.
Some examples of calling of this function are:
getInputLineWithInitial "prompt> " ("left", "") -- The cursor starts at the end of the line. getInputLineWithInitial "prompt> " ("left ", "right") -- The cursor starts before the second word.
getInputChar :: Eff Readline m => String -> m (Maybe Char) Source #
Reads one character of input. Ignores non-printable characters.
When using terminal-style interaction, the character will be read without waiting for a newline.
When using file-style interaction, a newline will be read if it is immediately available after the input character.
getPassword :: Eff Readline m => Maybe Char -> String -> m (Maybe String) Source #
Reads one line of input, without displaying the input while it is being typed. When using terminal-style interaction, the masking character (if given) will replace each typed character.
When using file-style interaction, this function turns off echoing while reading the line of input.
Note that if Haskeline is built against a version of the Win32
library
earlier than 2.5, getPassword
will incorrectly echo back input on MinTTY
consoles (such as Cygwin or MSYS).
waitForAnyKey :: Eff Readline m => String -> m Bool Source #
Waits for one key to be pressed, then returns. Ignores the value of the specific key.
Returns True
if it successfully accepted one key. Returns False
if it encountered the end of input; i.e., an EOF
in file-style interaction,
or a Ctrl-D
in terminal-style interaction.
When using file-style interaction, consumes a single character from the input which may be non-printable.
outputStr :: Eff Readline m => String -> m () Source #
Write a Unicode string to the user's standard output.
outputStrLn :: Eff Readline m => String -> m () Source #
Write a Unicode string to the user's standard output, followed by a newline.
HandleInterrupt
data HandleInterrupt :: Effect where Source #
WithInterrupt :: m a -> HandleInterrupt m a | |
HandleInterrupt :: m a -> m a -> HandleInterrupt m a |
withInterrupt :: Eff HandleInterrupt m => m a -> m a Source #
If Ctrl-C is pressed during the given action, enables interrupt handling within the nested scope. For example:
tryAction :: Eff '[Readline, HandleInterrupt] m => m () tryAction = handleInterrupt (outputStrLn "Cancelled.") $ withInterrupt $ someLongAction
The action can handle the interrupt itself every time Ctrl-C is pressed.
{-# LANGUAGE -XBlockArguments #-} tryAction :: Eff '[Readline, HandleInterrupt] m => m () tryAction = withInterrupt loop where loop = someLongAction `catchInterrupt` do outputStrLn "Cancelled; trying again." loop
This behavior differs from GHC's built-in Ctrl-C handling, which may immediately terminate the program after the second time that the user presses Ctrl-C.
handleInterrupt :: Eff HandleInterrupt m => m a -> m a -> m a Source #
Handle an Interrupt
. When an interrupt occurs in the second argument,
the first argument will be called.
catchInterrupt :: Eff HandleInterrupt m => m a -> m a -> m a Source #
Specify a continuation that should be called when an Interrupt
occurs.
catchInterrupt = flip handleInterrupt
Interpreters
runReadline :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Settings m -> ReadlineInterruptC m a -> m a Source #
Main interpreter for Readline
, ReadlineHistory
, and HandleInterrupt
effects. defaultSettings
exists as a default for settings.
Example usage:
import Control.Effect import Control.Effect.Readline repl :: Effs '[Readline, HandleInterrupt] m => m () repl = handleInterrupt (outputStrLn "Interrupt!" *> repl) $ withInterrupt $ do mline <- getInputLine "> " case mline of Nothing -> pure () Just line -> outputStrLn line *> repl main :: IO () main = runM $ runReadline defaultSettings repl
runReadlineBehavior :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Behavior -> Settings m -> ReadlineInterruptC m a -> m a Source #
Like runReadline
but additionally allows specifying a Behavior
.
runReadlineWithPrefs :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Prefs -> Settings m -> ReadlineInterruptC m a -> m a Source #
Like runReadline
but additionally allows specifying a Prefs
.
runReadlineBehaviorWithPrefs :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Behavior -> Prefs -> Settings m -> ReadlineInterruptC m a -> m a Source #
Like runReadline
but additionally allows specifying a Behavior
and a
Prefs
.
runReadline' :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Settings m -> ReadlineC m a -> m a Source #
Weaker version of runReadline
intended for circumstances where the
primitive effect Optional
can't be threaded. This version is incapable of
interpreting HandleInterrupt
though.
runReadlineBehavior' :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Behavior -> Settings m -> ReadlineC m a -> m a Source #
Weaker version of runReadlineBehavior
intended for circumstances where
the primitive effect Optional
can't be threaded. This version is incapable
of interpreting HandleInterrupt
though.
runReadlineWithPrefs' :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Prefs -> Settings m -> ReadlineC m a -> m a Source #
Weaker version of runReadlineWithPrefs
intended for circumstances where
the primitive effect Optional
can't be threaded. This version is incapable
of interpreting HandleInterrupt
though.
runReadlineBehaviorWithPrefs' :: (Eff (Embed IO) m, MonadMask m, Carrier m, Threaders '[ReadlineThreads] m p) => Behavior -> Prefs -> Settings m -> ReadlineC m a -> m a Source #
Weaker version of runReadlineBehaviorWithPrefs
intended for
circumstances where the primitive effect Optional
can't be threaded. This
version is incapable of interpreting HandleInterrupt
though.
Carriers + Threading
Instances
data ReadlineInterruptC m a Source #
Instances
class Threads ReadlineT p => ReadlineThreads p Source #
Threading constraint for handlers using InputT
/ReadlineT
internally.
ReadlineThreads
accepts all the primitive effects
(intended to be used as such) offered by in-other-words.
Most notably, ReadlineThreads
accepts
.Unlift
b
Instances
Threads ReadlineT p => ReadlineThreads p Source # | |
Defined in Control.Effect.Readline.Internal |
Re-exports from haskeline
Settings
data Settings (m :: Type -> Type) #
Application-specific customizations to the user interface.
Settings | |
|
Instances
(MonadIO m, MonadMask m) => CommandMonad (InputCmdT m) | |
Defined in System.Console.Haskeline.InputT runCompletion :: (String, String) -> InputCmdT m (String, [Completion]) |
defaultSettings :: forall (m :: Type -> Type). MonadIO m => Settings m #
A useful default. In particular:
defaultSettings = Settings { complete = completeFilename, historyFile = Nothing, autoAddHistory = True }
setComplete :: CompletionFunc m -> Settings m -> Settings m #
Completion
Behavior
Haskeline has two ways of interacting with the user:
- "Terminal-style" interaction provides an rich user interface by connecting
to the user's terminal (which may be different than
stdin
orstdout
). - "File-style" interaction treats the input as a simple stream of characters, for example
when reading from a file or pipe. Input functions (e.g.,
getInputLine
) print the prompt tostdout
.
A Behavior
is a method for deciding at run-time which type of interaction to use.
For most applications (e.g., a REPL), defaultBehavior
should have the correct effect.
useFileHandle :: Handle -> Behavior #
Use file-style interaction, reading input from the given Handle
.
preferTerm :: Behavior #
Preferences
Prefs
allow the user to customize the terminal-style line-editing interface. They are
read by default from ~/.haskeline
; to override that behavior, use
readPrefs
and runInputTWithPrefs
.
Each line of a .haskeline
file defines
one field of the Prefs
datatype; field names are case-insensitive and
unparseable lines are ignored. For example:
editMode: Vi completionType: MenuCompletion maxhistorysize: Just 40
Instances
Show Prefs | |
(MonadIO m, MonadMask m) => CommandMonad (InputCmdT m) | |
Defined in System.Console.Haskeline.InputT runCompletion :: (String, String) -> InputCmdT m (String, [Completion]) |
readPrefs :: FilePath -> IO Prefs #
Read Prefs
from a given file. If there is an error reading the file,
the defaultPrefs
will be returned.
defaultPrefs :: Prefs #
The default preferences which may be overwritten in the
.haskeline
file.