-- Hoogle documentation, generated by Haddock
-- See Hoogle, http://www.haskell.org/hoogle/
-- | A command-line interface for user input, written in Haskell.
--
-- Haskeline provides a user interface for line input in command-line
-- programs. This library is similar in purpose to readline, but since it
-- is written in Haskell it is (hopefully) more easily used in other
-- Haskell programs.
--
-- Haskeline runs both on POSIX-compatible systems and on Windows.
@package haskeline
@version 0.6.3.1
-- | This module provides a low-level API to the line history stored in the
-- InputT monad transformer.
--
-- For most application, it should suffice to instead use the following
-- Settings flags:
--
--
-- - autoAddHistory: add nonblank lines to the command history
-- (True by default).
-- - historyFile: read/write the history to a file before and
-- after the line input session.
--
--
-- If you do want custom history behavior, you may need to disable the
-- above default setting(s).
module System.Console.Haskeline.History
data History
emptyHistory :: History
addHistory :: String -> History -> History
-- | Add a line to the history unless it matches the previously recorded
-- line.
addHistoryUnlessConsecutiveDupe :: String -> History -> History
-- | Add a line to the history, and remove all previous entries which are
-- the same as it.
addHistoryRemovingAllDupes :: String -> History -> History
-- | The input lines stored in the history (newest first)
historyLines :: History -> [String]
-- | Reads the line input history from the given file. Returns
-- emptyHistory if the file does not exist or could not be read.
readHistory :: FilePath -> IO History
-- | Writes the line history to the given file. If there is an error when
-- writing the file, it will be ignored.
writeHistory :: FilePath -> History -> IO ()
-- | Limit the number of lines stored in the history.
stifleHistory :: Maybe Int -> History -> History
-- | The maximum number of lines stored in the history. If Nothing,
-- the history storage is unlimited.
stifleAmount :: History -> Maybe Int
instance [overlap ok] Show History
-- | This module redefines some of the functions in
-- Control.Exception.Extensible to work for more general monads
-- than only IO.
module System.Console.Haskeline.MonadException
class (MonadIO m) => MonadException m
catch :: (MonadException m, Exception e) => m a -> (e -> m a) -> m a
block :: (MonadException m) => m a -> m a
unblock :: (MonadException m) => m a -> m a
handle :: (MonadException m, Exception e) => (e -> m a) -> m a -> m a
finally :: (MonadException m) => m a -> m b -> m a
throwIO :: (MonadIO m, Exception e) => e -> m a
throwTo :: (MonadIO m, Exception e) => ThreadId -> e -> m ()
bracket :: (MonadException m) => m a -> (a -> m b) -> (a -> m c) -> m c
throwDynIO :: (Exception exception, MonadIO m) => exception -> m a
handleDyn :: (Exception exception, MonadException m) => (exception -> m a) -> m a -> m a
-- | Any type that you wish to throw or catch as an exception must be an
-- instance of the Exception class. The simplest case is a new
-- exception type directly below the root:
--
-- data MyException = ThisException | ThatException deriving (Show,
-- Typeable) instance Exception MyException
--
-- The default method definitions in the Exception class do what
-- we need in this case. You can now throw and catch
-- ThisException and ThatException as exceptions:
--
-- *Main> throw ThisException catch e -> putStrLn ("Caught "
-- ++ show (e :: MyException)) Caught ThisException
--
-- In more complicated examples, you may wish to define a whole hierarchy
-- of exceptions:
--
--
-- ---------------------------------------------------------------------
-- -- Make the root exception type for all the exceptions in a compiler
-- data SomeCompilerException = forall e . Exception e =>
-- SomeCompilerException e deriving Typeable instance Show
-- SomeCompilerException where show (SomeCompilerException e) = show e
-- instance Exception SomeCompilerException compilerExceptionToException
-- :: Exception e => e -> SomeException
-- compilerExceptionToException = toException . SomeCompilerException
-- compilerExceptionFromException :: Exception e => SomeException
-- -> Maybe e compilerExceptionFromException x = do
-- SomeCompilerException a <- fromException x cast a
-- ---------------------------------------------------------------------
-- -- Make a subhierarchy for exceptions in the frontend of the compiler
-- data SomeFrontendException = forall e . Exception e =>
-- SomeFrontendException e deriving Typeable instance Show
-- SomeFrontendException where show (SomeFrontendException e) = show e
-- instance Exception SomeFrontendException where toException =
-- compilerExceptionToException fromException =
-- compilerExceptionFromException frontendExceptionToException ::
-- Exception e => e -> SomeException frontendExceptionToException =
-- toException . SomeFrontendException frontendExceptionFromException ::
-- Exception e => SomeException -> Maybe e
-- frontendExceptionFromException x = do SomeFrontendException a <-
-- fromException x cast a
-- ---------------------------------------------------------------------
-- -- Make an exception type for a particular frontend compiler exception
-- data MismatchedParentheses = MismatchedParentheses deriving (Typeable,
-- Show) instance Exception MismatchedParentheses where toException =
-- frontendExceptionToException fromException =
-- frontendExceptionFromException
--
-- We can now catch a MismatchedParentheses exception as
-- MismatchedParentheses, SomeFrontendException or
-- SomeCompilerException, but not other types, e.g.
-- IOException:
--
-- *Main> throw MismatchedParentheses catch e -> putStrLn
-- ("Caught " ++ show (e :: MismatchedParentheses)) Caught
-- MismatchedParentheses *Main> throw MismatchedParentheses catch e
-- -> putStrLn ("Caught " ++ show (e :: SomeFrontendException)) Caught
-- MismatchedParentheses *Main> throw MismatchedParentheses catch e
-- -> putStrLn ("Caught " ++ show (e :: SomeCompilerException)) Caught
-- MismatchedParentheses *Main> throw MismatchedParentheses catch e
-- -> putStrLn ("Caught " ++ show (e :: IOException)) *** Exception:
-- MismatchedParentheses
class (Typeable e, Show e) => Exception e
-- | The SomeException type is the root of the exception type
-- hierarchy. When an exception of type e is thrown, behind the
-- scenes it is encapsulated in a SomeException.
data SomeException :: *
SomeException :: e -> SomeException
-- | Exceptions that occur in the IO monad. An
-- IOException records a more specific error type, a descriptive
-- string and maybe the handle that was used when the error was flagged.
data IOException :: *
instance [overlap ok] (MonadException m) => MonadException (StateT s m)
instance [overlap ok] (MonadException m) => MonadException (ReaderT r m)
instance [overlap ok] MonadException IO
module System.Console.Haskeline.Completion
-- | Performs completions from the given line state.
--
-- The first String argument is the contents of the line to the
-- left of the cursor, reversed. The second String argument is the
-- contents of the line to the right of the cursor.
--
-- The output String is the unused portion of the left half of the
-- line, reversed.
type CompletionFunc m = (String, String) -> m (String, [Completion])
data Completion
Completion :: String -> String -> Bool -> Completion
-- | Text to insert in line.
replacement :: Completion -> String
-- | Text to display when listing alternatives.
display :: Completion -> String
-- | Whether this word should be followed by a space, end quote, etc.
isFinished :: Completion -> Bool
-- | Disable completion altogether.
noCompletion :: (Monad m) => CompletionFunc m
-- | Create a finished completion out of the given word.
simpleCompletion :: String -> Completion
-- | A custom CompletionFunc which completes the word immediately to
-- the left of the cursor.
--
-- A word begins either at the start of the line or after an unescaped
-- whitespace character.
completeWord :: (Monad m) => Maybe Char -> [Char] -> (String -> m [Completion]) -> CompletionFunc m
-- | A custom CompletionFunc which completes the word immediately to
-- the left of the cursor, and takes into account the line contents to
-- the left of the word.
--
-- A word begins either at the start of the line or after an unescaped
-- whitespace character.
completeWordWithPrev :: (Monad m) => Maybe Char -> [Char] -> (String -> String -> m [Completion]) -> CompletionFunc m
completeQuotedWord :: (Monad m) => Maybe Char -> [Char] -> (String -> m [Completion]) -> CompletionFunc m -> CompletionFunc m
completeFilename :: (MonadIO m) => CompletionFunc m
-- | List all of the files or folders beginning with this path.
listFiles :: (MonadIO m) => FilePath -> m [Completion]
filenameWordBreakChars :: String
instance [overlap ok] Show Completion
-- | This module exposes the console Unicode API which is used by the
-- functions in System.Console.Haskeline. On POSIX systems, it
-- uses iconv plus the console's locale; on Windows it uses the
-- console's current code page.
--
-- Characters or bytes which cannot be encoded/decoded (for example, not
-- belonging to the output range) will be ignored.
module System.Console.Haskeline.Encoding
-- | Encode a Unicode String into a ByteString suitable for
-- the current console.
encode :: (MonadIO m) => String -> InputT m ByteString
-- | Convert a ByteString from the console's encoding into a Unicode
-- String.
decode :: (MonadIO m) => ByteString -> InputT m String
getEncoder :: (Monad m) => InputT m (String -> IO ByteString)
getDecoder :: (Monad m) => InputT m (ByteString -> IO String)
-- | A rich user interface for line input in command-line programs.
-- Haskeline is Unicode-aware and runs both on POSIX-compatible systems
-- and on Windows.
--
-- Users may customize the interface with a ~/.haskeline file;
-- see http://trac.haskell.org/haskeline/wiki/UserPrefs for more
-- information.
--
-- An example use of this library for a simple read-eval-print loop
-- (REPL) is the following:
--
--
-- import System.Console.Haskeline
--
-- main :: IO ()
-- main = runInputT defaultSettings loop
-- where
-- loop :: InputT IO ()
-- loop = do
-- minput <- getInputLine "% "
-- case minput of
-- Nothing -> return ()
-- Just "quit" -> return ()
-- Just input -> do outputStrLn $ "Input was: " ++ input
-- loop
--
module System.Console.Haskeline
-- | A monad transformer which carries all of the state and settings
-- relevant to a line-reading application.
data InputT m a
-- | Run a line-reading application. This function should suffice for most
-- applications.
--
-- This function is equivalent to runInputTBehavior
-- defaultBehavior. It uses terminal-style interaction if
-- stdin is connected to a terminal and has echoing enabled.
-- Otherwise (e.g., if stdin is a pipe), it uses file-style
-- interaction.
--
-- If it uses terminal-style interaction, Prefs will be read from
-- the user's ~/.haskeline file (if present). If it uses
-- file-style interaction, Prefs are not relevant and will not be
-- read.
runInputT :: (MonadException m) => Settings m -> InputT m a -> m a
-- | Returns True if the current session uses terminal-style
-- interaction. (See Behavior.)
haveTerminalUI :: (Monad m) => InputT m Bool
-- | 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.
data Behavior
-- | Run a line-reading application according to the given behavior.
--
-- If it uses terminal-style interaction, Prefs will be read from
-- the user's ~/.haskeline file (if present). If it uses
-- file-style interaction, Prefs are not relevant and will not be
-- read.
runInputTBehavior :: (MonadException m) => Behavior -> Settings m -> InputT m a -> m a
-- | 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.
defaultBehavior :: Behavior
-- | Use file-style interaction, reading input from the given
-- Handle.
useFileHandle :: Handle -> Behavior
-- | Use file-style interaction, reading input from the given file.
useFile :: FilePath -> 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.
preferTerm :: Behavior
-- | 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.
getInputLine :: (MonadException m) => String -> InputT m (Maybe String)
-- | 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.
getInputChar :: (MonadException m) => String -> InputT m (Maybe Char)
-- | 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.
getPassword :: (MonadException m) => Maybe Char -> String -> InputT m (Maybe String)
-- | Write a Unicode string to the user's standard output.
outputStr :: (MonadIO m) => String -> InputT m ()
-- | Write a string to the user's standard output, followed by a newline.
outputStrLn :: (MonadIO m) => String -> InputT m ()
-- | Application-specific customizations to the user interface.
data Settings m
Settings :: CompletionFunc m -> Maybe FilePath -> Bool -> Settings m
-- | Custom tab completion.
complete :: Settings m -> CompletionFunc m
-- | Where to read/write the history at the start and end of each line
-- input session.
historyFile :: Settings m -> Maybe FilePath
-- | If True, each nonblank line returned by getInputLine
-- will be automatically added to the history.
autoAddHistory :: Settings m -> Bool
-- | A useful default. In particular:
--
--
-- defaultSettings = Settings {
-- complete = completeFilename,
-- historyFile = Nothing,
-- autoAddHistory = True
-- }
--
defaultSettings :: (MonadIO 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.
setComplete :: CompletionFunc m -> Settings m -> Settings m
-- | 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
--
data Prefs
-- | Read Prefs from a given file. If there is an error reading the
-- file, the defaultPrefs will be returned.
readPrefs :: FilePath -> IO Prefs
-- | The default preferences which may be overwritten in the
-- .haskeline file.
defaultPrefs :: Prefs
-- | Run a line-reading application. Uses defaultBehavior to
-- determine the interaction behavior.
runInputTWithPrefs :: (MonadException m) => Prefs -> Settings m -> InputT m a -> m a
-- | Run a line-reading application.
runInputTBehaviorWithPrefs :: (MonadException m) => Behavior -> Prefs -> Settings m -> InputT m a -> m a
data Interrupt
Interrupt :: Interrupt
-- | If Ctrl-C is pressed during the given computation, throw an exception
-- of type Interrupt.
withInterrupt :: (MonadException m) => InputT m a -> InputT m a
-- | Catch and handle an exception of type Interrupt.
handleInterrupt :: (MonadException m) => m a -> m a -> m a
-- | This module provides a stateful, IO-based interface to Haskeline,
-- which may be easier to integrate into some existing programs or
-- libraries.
--
-- It is strongly recommended to use the safer, monadic API of
-- System.Console.Haskeline, if possible, rather than the explicit
-- state management functions of this module.
--
-- The equivalent REPL example is:
--
--
-- import System.Console.Haskeline
-- import System.Console.Haskeline.IO
-- import Control.Concurrent
--
-- main = bracketOnError (initializeInput defaultSettings)
-- cancelInput -- This will only be called if an exception such
-- -- as a SigINT is received.
-- (\hd -> loop hd >> closeInput hd)
-- where
-- loop :: InputState -> IO ()
-- loop hd = do
-- minput <- queryInput hd (getInputLine "% ")
-- case minput of
-- Nothing -> return ()
-- Just "quit" -> return ()
-- Just input -> do queryInput hd $ outputStrLn
-- $ "Input was: " ++ input
-- loop hd
--
module System.Console.Haskeline.IO
data InputState
-- | Initialize a session of line-oriented user interaction.
initializeInput :: Settings IO -> IO InputState
-- | Finish and clean up the line-oriented user interaction session. Blocks
-- on an existing call to queryInput.
closeInput :: InputState -> IO ()
-- | Cancel and clean up the user interaction session. Does not block on an
-- existing call to queryInput.
cancelInput :: InputState -> IO ()
-- | Run one action (for example, getInputLine) as part of a session
-- of user interaction.
--
-- For example, multiple calls to queryInput using the same
-- InputState will share the same input history. In constrast,
-- multiple calls to runInputT will use distinct histories unless
-- they share the same history file.
--
-- This function should not be called on a closed or cancelled
-- InputState.
queryInput :: InputState -> InputT IO a -> IO a