module System.Console.Haskeline(
InputT,
runInputT,
haveTerminalUI,
Behavior,
runInputTBehavior,
defaultBehavior,
useFileHandle,
useFile,
preferTerm,
getInputLine,
getInputLineWithInitial,
getInputChar,
getPassword,
outputStr,
outputStrLn,
Settings(..),
defaultSettings,
setComplete,
Prefs(),
readPrefs,
defaultPrefs,
runInputTWithPrefs,
runInputTBehaviorWithPrefs,
Interrupt(..),
withInterrupt,
handleInterrupt,
module System.Console.Haskeline.Completion,
module System.Console.Haskeline.MonadException)
where
import System.Console.Haskeline.LineState
import System.Console.Haskeline.Command
import System.Console.Haskeline.Vi
import System.Console.Haskeline.Emacs
import System.Console.Haskeline.Prefs
import System.Console.Haskeline.History
import System.Console.Haskeline.Monads
import System.Console.Haskeline.MonadException
import System.Console.Haskeline.InputT
import System.Console.Haskeline.Completion
import System.Console.Haskeline.Term
import System.Console.Haskeline.Key
import System.Console.Haskeline.RunCommand
import System.IO
import Data.Char (isSpace, isPrint)
defaultSettings :: MonadIO m => Settings m
defaultSettings = Settings {complete = completeFilename,
historyFile = Nothing,
autoAddHistory = True}
outputStr :: MonadIO m => String -> InputT m ()
outputStr xs = do
putter <- asks putStrOut
liftIO $ putter xs
outputStrLn :: MonadIO m => String -> InputT m ()
outputStrLn = outputStr . (++ "\n")
getInputLine :: MonadException m => String
-> InputT m (Maybe String)
getInputLine = promptedInput (getInputCmdLine emptyIM) $ unMaybeT . getLocaleLine
getInputLineWithInitial :: MonadException m
=> String
-> (String, String)
-> InputT m (Maybe String)
getInputLineWithInitial prompt (left,right) = promptedInput (getInputCmdLine initialIM)
(unMaybeT . getLocaleLine) prompt
where
initialIM = insertString left $ moveToStart $ insertString right $ emptyIM
getInputCmdLine :: MonadException m => InsertMode -> TermOps -> String -> InputT m (Maybe String)
getInputCmdLine initialIM tops prefix = do
emode <- asks editMode
result <- runInputCmdT tops $ case emode of
Emacs -> runCommandLoop tops prefix emacsCommands initialIM
Vi -> evalStateT' emptyViState $
runCommandLoop tops prefix viKeyCommands initialIM
maybeAddHistory result
return result
maybeAddHistory :: forall m . Monad m => Maybe String -> InputT m ()
maybeAddHistory result = do
settings :: Settings m <- ask
histDupes <- asks historyDuplicates
case result of
Just line | autoAddHistory settings && not (all isSpace line)
-> let adder = case histDupes of
AlwaysAdd -> addHistory
IgnoreConsecutive -> addHistoryUnlessConsecutiveDupe
IgnoreAll -> addHistoryRemovingAllDupes
in modify (adder line)
_ -> return ()
getInputChar :: MonadException m => String
-> InputT m (Maybe Char)
getInputChar = promptedInput getInputCmdChar $ \fops -> do
c <- getPrintableChar fops
maybeReadNewline fops
return c
getPrintableChar :: FileOps -> IO (Maybe Char)
getPrintableChar fops = do
c <- unMaybeT $ getLocaleChar fops
case fmap isPrint c of
Just False -> getPrintableChar fops
_ -> return c
getInputCmdChar :: MonadException m => TermOps -> String -> InputT m (Maybe Char)
getInputCmdChar tops prefix = runInputCmdT tops
$ runCommandLoop tops prefix acceptOneChar emptyIM
acceptOneChar :: Monad m => KeyCommand m InsertMode (Maybe Char)
acceptOneChar = choiceCmd [useChar $ \c s -> change (insertChar c) s
>> return (Just c)
, ctrlChar 'l' +> clearScreenCmd >|>
keyCommand acceptOneChar
, ctrlChar 'd' +> failCmd]
getPassword :: MonadException m => Maybe Char
-> String -> InputT m (Maybe String)
getPassword x = promptedInput
(\tops prefix -> runInputCmdT tops
$ runCommandLoop tops prefix loop
$ Password [] x)
(\fops -> let h_in = inputHandle fops
in bracketSet (hGetEcho h_in) (hSetEcho h_in) False
$ unMaybeT $ getLocaleLine fops)
where
loop = choiceCmd [ simpleChar '\n' +> finish
, simpleKey Backspace +> change deletePasswordChar
>|> loop'
, useChar $ \c -> change (addPasswordChar c) >|> loop'
, ctrlChar 'd' +> \p -> if null (passwordState p)
then failCmd p
else finish p
, ctrlChar 'l' +> clearScreenCmd >|> loop'
]
loop' = keyCommand loop
promptedInput :: MonadIO m => (TermOps -> String -> InputT m a)
-> (FileOps -> IO a)
-> String -> InputT m a
promptedInput doTerm doFile prompt = do
liftIO $ hFlush stdout
rterm <- ask
case termOps rterm of
Right fops -> liftIO $ do
putStrOut rterm prompt
doFile fops
Left tops -> do
let (lastLine,rest) = break (`elem` "\r\n") $ reverse prompt
outputStr $ reverse rest
doTerm tops $ reverse lastLine
withInterrupt :: MonadException m => InputT m a -> InputT m a
withInterrupt f = do
rterm <- ask
wrapInterrupt rterm f
handleInterrupt :: MonadException m => m a
-> m a
-> m a
handleInterrupt f = handleDyn $ \Interrupt -> f