readline-in-other-words-0.1.0.2: Readline effect for in-other-words.
Safe HaskellNone
LanguageHaskell2010

Control.Effect.Readline

Description

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 line
  • HandleInterrupt 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

Effect and Actions

Readline

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 autoAddHistory == True and the line input is nonblank (i.e., is not all spaces), it will be automatically added to the history.

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 Strings. 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 #

Constructors

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

data ReadlineC m a Source #

Instances

Instances details
MonadTrans ReadlineC Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

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

MonadBaseControl b m => MonadBaseControl b (ReadlineC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Associated Types

type StM (ReadlineC m) a #

Methods

liftBaseWith :: (RunInBase (ReadlineC m) b -> b a) -> ReadlineC m a #

restoreM :: StM (ReadlineC m) a -> ReadlineC m a #

MonadBase b m => MonadBase b (ReadlineC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

liftBase :: b α -> ReadlineC m α #

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

Defined in Control.Effect.Readline.Internal

Methods

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

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

return :: a -> ReadlineC m a #

Functor m => Functor (ReadlineC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

fmap :: (a -> b) -> ReadlineC m a -> ReadlineC m b #

(<$) :: a -> ReadlineC m b -> ReadlineC m a #

MonadFix m => MonadFix (ReadlineC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

mfix :: (a -> ReadlineC m a) -> ReadlineC m a #

MonadFail m => MonadFail (ReadlineC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

fail :: String -> ReadlineC m a #

Applicative m => Applicative (ReadlineC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

pure :: a -> ReadlineC m a #

(<*>) :: ReadlineC m (a -> b) -> ReadlineC m a -> ReadlineC m b #

liftA2 :: (a -> b -> c) -> ReadlineC m a -> ReadlineC m b -> ReadlineC m c #

(*>) :: ReadlineC m a -> ReadlineC m b -> ReadlineC m b #

(<*) :: ReadlineC m a -> ReadlineC m b -> ReadlineC m a #

Eff (Embed IO) m => MonadIO (ReadlineC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

liftIO :: IO a -> ReadlineC m a #

MonadThrow m => MonadThrow (ReadlineC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

throwM :: Exception e => e -> ReadlineC m a #

MonadCatch m => MonadCatch (ReadlineC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

catch :: Exception e => ReadlineC m a -> (e -> ReadlineC m a) -> ReadlineC m a #

MonadMask m => MonadMask (ReadlineC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

mask :: ((forall a. ReadlineC m a -> ReadlineC m a) -> ReadlineC m b) -> ReadlineC m b #

uninterruptibleMask :: ((forall a. ReadlineC m a -> ReadlineC m a) -> ReadlineC m b) -> ReadlineC m b #

generalBracket :: ReadlineC m a -> (a -> ExitCase b -> ReadlineC m c) -> (a -> ReadlineC m b) -> ReadlineC m (b, c) #

(Carrier m, Eff (Embed IO) m, MonadMask m, Threads ReadlineT (Prims m)) => Carrier (ReadlineC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Associated Types

type Derivs (ReadlineC m) :: [Effect] #

type Prims (ReadlineC m) :: [Effect] #

type Prims (ReadlineC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

type Prims (ReadlineC m) = Prims m
type Derivs (ReadlineC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

type StM (ReadlineC m) a Source # 
Instance details

Defined in Control.Effect.Readline.Internal

type StM (ReadlineC m) a = StM (ReadlineT (EfflyIO m)) a

data ReadlineInterruptC m a Source #

Instances

Instances details
MonadTrans ReadlineInterruptC Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

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

MonadBaseControl b m => MonadBaseControl b (ReadlineInterruptC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Associated Types

type StM (ReadlineInterruptC m) a #

MonadBase b m => MonadBase b (ReadlineInterruptC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

liftBase :: b α -> ReadlineInterruptC m α #

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

Defined in Control.Effect.Readline.Internal

Functor m => Functor (ReadlineInterruptC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

fmap :: (a -> b) -> ReadlineInterruptC m a -> ReadlineInterruptC m b #

(<$) :: a -> ReadlineInterruptC m b -> ReadlineInterruptC m a #

MonadFix m => MonadFix (ReadlineInterruptC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

mfix :: (a -> ReadlineInterruptC m a) -> ReadlineInterruptC m a #

MonadFail m => MonadFail (ReadlineInterruptC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

fail :: String -> ReadlineInterruptC m a #

Applicative m => Applicative (ReadlineInterruptC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Eff (Embed IO) m => MonadIO (ReadlineInterruptC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

liftIO :: IO a -> ReadlineInterruptC m a #

MonadThrow m => MonadThrow (ReadlineInterruptC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Methods

throwM :: Exception e => e -> ReadlineInterruptC m a #

MonadCatch m => MonadCatch (ReadlineInterruptC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

MonadMask m => MonadMask (ReadlineInterruptC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

(Carrier m, Eff (Embed IO) m, MonadMask m, Threads ReadlineT (Prims m)) => Carrier (ReadlineInterruptC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Associated Types

type Derivs (ReadlineInterruptC m) :: [Effect] #

type Prims (ReadlineInterruptC m) :: [Effect] #

type Prims (ReadlineInterruptC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

type Derivs (ReadlineInterruptC m) Source # 
Instance details

Defined in Control.Effect.Readline.Internal

type StM (ReadlineInterruptC m) a Source # 
Instance details

Defined in Control.Effect.Readline.Internal

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

Instances details
Threads ReadlineT p => ReadlineThreads p Source # 
Instance details

Defined in Control.Effect.Readline.Internal

Re-exports from haskeline

Settings

data Settings (m :: Type -> Type) #

Application-specific customizations to the user interface.

Constructors

Settings 

Fields

Instances

Instances details
(MonadIO m, MonadMask m) => CommandMonad (InputCmdT m) 
Instance details

Defined in System.Console.Haskeline.InputT

Methods

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 #

Because complete is the only field of Settings depending on m, the expression defaultSettings {completionFunc = f} leads to a type error from being too general. This function works around that issue, and may become unnecessary if another field depending on m is added.

Completion

Behavior

data 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 or stdout).
  • "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 to stdout.

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.

defaultBehavior :: Behavior #

Read input from stdin. Use terminal-style interaction if stdin is connected to a terminal and has echoing enabled. Otherwise (e.g., if stdin is a pipe), use file-style interaction.

This behavior should suffice for most applications.

useFileHandle :: Handle -> Behavior #

Use file-style interaction, reading input from the given Handle.

useFile :: FilePath -> Behavior #

Use file-style interaction, reading input from the given file.

preferTerm :: Behavior #

Use terminal-style interaction whenever possible, even if stdin and/or stdout are not terminals.

If it cannot open the user's terminal, use file-style interaction, reading input from stdin.

Preferences

data Prefs #

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

Instances details
Show Prefs 
Instance details

Defined in System.Console.Haskeline.Prefs

Methods

showsPrec :: Int -> Prefs -> ShowS #

show :: Prefs -> String #

showList :: [Prefs] -> ShowS #

(MonadIO m, MonadMask m) => CommandMonad (InputCmdT m) 
Instance details

Defined in System.Console.Haskeline.InputT

Methods

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.