moduleSystem.Console.Haskeline(-- * Main functions---- $maindocInputT,runInputT,runInputTWithPrefs,getInputLine,outputStr,outputStrLn,-- * SettingsSettings(..),defaultSettings,setComplete,-- * Ctrl-C handlingInterrupt(..),handleInterrupt,moduleSystem.Console.Haskeline.Completion,moduleSystem.Console.Haskeline.Prefs,moduleSystem.Console.Haskeline.MonadException)whereimportSystem.Console.Haskeline.LineStateimportSystem.Console.Haskeline.CommandimportSystem.Console.Haskeline.Command.HistoryimportSystem.Console.Haskeline.ViimportSystem.Console.Haskeline.EmacsimportSystem.Console.Haskeline.PrefsimportSystem.Console.Haskeline.MonadsimportSystem.Console.Haskeline.MonadExceptionimportSystem.Console.Haskeline.InputTimportSystem.Console.Haskeline.CompletionimportSystem.Console.Haskeline.TermimportSystem.IOimportData.Char(isSpace)importControl.MonadimportqualifiedControl.ExceptionasExceptionimportData.Dynamic{- $maindoc
An example use of this library for a simple read-eval-print loop is the
following.
> import System.Console.Haskeline
> import Control.Monad.Trans
>
> 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
-}-- | A useful default. In particular:---- @-- defaultSettings = Settings {-- complete = completeFilename,-- historyFile = Nothing,-- handleSigINT = False-- }-- @defaultSettings::MonadIOm=>SettingsmdefaultSettings=Settings{complete=completeFilename,historyFile=Nothing,handleSigINT=False}-- NOTE: If we set stdout to NoBuffering, there can be a flicker effect when many-- characters are printed at once. We'll keep it buffered here, and let the Draw-- monad manually flush outputs that don't print a newline.wrapTerminalOps::MonadExceptionm=>ma->mawrapTerminalOps=bracketSet(hGetBufferingstdin)(hSetBufferingstdin)NoBuffering.bracketSet(hGetBufferingstdout)(hSetBufferingstdout)LineBuffering.bracketSet(hGetEchostdout)(hSetEchostdout)FalsebracketSet::(Eqa,MonadExceptionm)=>IOa->(a->IO())->a->mb->mbbracketSetgetStatesetnewStatef=dooldState<-liftIOgetStateifoldState==newStatethenfelsefinally(liftIO(setnewState)>>f)(liftIO(setoldState))-- | Write a string to the console output. Allows cross-platform display of-- Unicode characters.outputStr::forallm.MonadIOm=>String->InputTm()outputStrxs=dorun::RunTerm(InputCmdTm)<-askliftIO$putStrTermrunxs-- | Write a string to the console output, followed by a newline. Allows-- cross-platform display of Unicode characters.outputStrLn::MonadIOm=>String->InputTm()outputStrLnxs=outputStr(xs++"\n"){- | Read one line of input from the user, with a rich line-editing
user interface. Returns 'Nothing' if the user presses Ctrl-D when the input
text is empty. Otherwise, it returns the input line with the final newline
removed.
If 'stdin' is not connected to a terminal (for example, piped from
another process), then this function is equivalent to 'getLine', except that
it returns 'Nothing' if an EOF is encountered before any characters are
read.
If signal handling is enabled in the 'Settings', then 'getInputLine' will
throw an 'Interrupt' exception when the user presses Ctrl-C.
-}getInputLine::forallm.MonadExceptionm=>String-- ^ The input prompt->InputTm(MaybeString)getInputLineprefix=doisTerm<-liftIO$hIsTerminalDevicestdinifisTermthengetInputCmdLineprefixelsedoatEOF<-liftIO$hIsEOFstdinifatEOFthenreturnNothingelseliftMJust$liftIO$hGetLinestdingetInputCmdLine::forallm.MonadExceptionm=>String->InputTm(MaybeString)getInputCmdLineprefix=do-- TODO: Cache the terminal, actionsemode<-asks(\prefs->caseeditModeprefsofVi->viActionsEmacs->emacsCommands)settings::Settingsm<-askwrapTerminalOps$doletls=emptyIMRunTerm{withGetEvent=withGetEvent',runTerm=runTerm'}<-askresult<-runInputCmdT$runTerm'$withGetEvent'(handleSigINTsettings)$\getEvent->dodrawLineprefixlsrepeatTillFinishgetEventprefixlsemodecaseresultofJustline|not(allisSpaceline)->addHistoryline_->return()returnresultrepeatTillFinish::forallmsd.(MonadTransd,Term(dm),MonadIOm,LineStates,MonadReaderPrefsm)=>dmEvent->String->s->KeyMapms->dm(MaybeString)repeatTillFinishgetEventprefix=loopwhere-- NOTE: since the functions in this mutually recursive binding group do not have the -- same contexts, we need the -XGADTs flag (or -fglasgow-exts)loop::forallt.LineStatet=>t->KeyMapmt->dm(MaybeString)loopsprocessor=doevent<-getEventcaseeventofSigInt->domoveToNextLinesliftIO$Exception.evaluate(Exception.throwDynInterrupt)WindowResizenewLayout->withRepositionnewLayout(loopsprocessor)KeyInputk->caselookupKMprocessorkofNothing->actBell>>loopsprocessorJustg->casegsofLeftr->moveToNextLines>>returnrRightf->doKeyActioneffectnext<-liftfdrawEffectprefixseffectloop(effectStateeffect)next{--
Note why it is necessary to integrate ctrl-c handling with this module:
if the user is in the middle of a few wrapped lines, we want to clean up
by moving the cursor to the start of the following line.
--}dataInterrupt=Interruptderiving(Show,Typeable,Eq)-- | Catch and handle an exception of type 'Interrupt'.handleInterrupt::MonadExceptionm=>ma-- ^ Handler to run if Ctrl-C is pressed->ma-- ^ Computation to run->mahandleInterruptf=handle$\e->caseException.dynExceptionseofJustdyn|JustInterrupt<-fromDynamicdyn->f_->throwIOedrawEffect::(LineStates,LineStatet,Term(dm),MonadTransd,MonadReaderPrefsm)=>String->s->Effectt->dm()drawEffectprefixs(RedrawshouldCleart)=ifshouldClearthenclearLayout>>drawLineprefixtelseclearLineprefixs>>drawLineprefixtdrawEffectprefixs(Changet)=drawLineDiffprefixstdrawEffectprefixs(PrintLineslst)=doifisTemporarysthenclearLineprefixselsemoveToNextLinesprintLineslsdrawLineprefixtdrawEffect__(RingBell_)=actBelldrawLine::(LineStates,Termm)=>String->s->m()drawLineprefixs=drawLineDiffprefixClearedsclearLine::(LineStates,Termm)=>String->s->m()clearLineprefixs=drawLineDiffprefixsClearedactBell::(Term(dm),MonadTransd,MonadReaderPrefsm)=>dm()actBell=dostyle<-lift(asksbellStyle)casestyleofNoBell->return()VisualBell->ringBellFalseAudibleBell->ringBellTrue