haskeline 0.7.5.0 → 0.8.0.0

raw patch · 26 files changed

+849/−336 lines, 26 filesdep +HUnitdep +exceptionsdep +haskelinedep ~basedep ~bytestringdep ~containersnew-component:exe:haskeline-examples-TestPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, exceptions, haskeline, text

Dependency ranges changed: base, bytestring, containers, process, transformers, unix

API changes (from Hackage documentation)

Files

• Changelog +17/−0
• LICENSE +14/−11
• System/Console/Haskeline.hs +55/−21
• System/Console/Haskeline/Backend/DumbTerm.hs +4/−2
• System/Console/Haskeline/Backend/Posix.hsc +12/−10
• System/Console/Haskeline/Backend/Posix/Encoder.hs +3/−2
• System/Console/Haskeline/Backend/Terminfo.hs +6/−4
• System/Console/Haskeline/Backend/Win32.hsc +15/−6
• System/Console/Haskeline/Backend/Win32/Echo.hs +4/−4
• System/Console/Haskeline/Command/History.hs +2/−1
• System/Console/Haskeline/Emacs.hs +8/−2
• System/Console/Haskeline/IO.hs +1/−0
• System/Console/Haskeline/InputT.hs +17/−10
• System/Console/Haskeline/Internal.hs +37/−0
• System/Console/Haskeline/Key.hs +46/−7
• System/Console/Haskeline/MonadException.hs +0/−180
• System/Console/Haskeline/Monads.hs +7/−52
• System/Console/Haskeline/Prefs.hs +2/−1
• System/Console/Haskeline/RunCommand.hs +7/−5
• System/Console/Haskeline/Term.hs +17/−9
• System/Console/Haskeline/Vi.hs +8/−2
• examples/Test.hs +2/−2
• haskeline.cabal +26/−5
• tests/Pty.hs +98/−0
• tests/RunTTY.hs +109/−0
• tests/Unit.hs +332/−0

@@ -1,3 +1,20 @@+Changed in version 0.8.0.0:+   * Breaking changes:+     * Add a `MonadFail` instance for `InputT`.+     * Switch the LICENSE file from BSD2 to BSD3, to be consistent+       with the .cabal file.+   * Backwards-compatible changes+     * Improve the documentation around when input functions return+       `Nothing`.+     * Allow binding keys to incremental search, as+       `ReverseSearchHistory` and `ForwardSearchHistory`.+     * Handling `STX`-wrapped control sequences on any lines of the+       prompt, not just the last one.+     * Add `debugTerminalKeys` to help debug input problems+     * Add `waitForAnyKey` to wait for a single key press.+     * Define test targest in the .cabal file+     * Bump the upper bound to base-4.15.+ Changed in version 0.7.5.0:    * Add the new function `fallbackCompletion` to combine      multiple `CompletionFunc`s

@@ -1,23 +1,26 @@-Copyright 2007-2009, Judah Jacobson.-All Rights Reserved.+Copyright 2007 Judah Jacobson  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -- Redistribution of source code must retain the above copyright notice,-this list of conditions and the following disclaimer.+1. Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer. -- Redistribution in binary form must reproduce the above copyright notice,+2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. -THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY-EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+3. Neither the name of the copyright holder nor the names of its contributors+may be used to endorse or promote products derived from this software without+specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR THE CONTRIBUTORS BE LIABLE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE-USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -47,6 +47,7 @@                     getInputLineWithInitial,                     getInputChar,                     getPassword,+                    waitForAnyKey,                     -- ** Outputting text                     -- $outputfncs                     outputStr,@@ -73,8 +74,7 @@                     Interrupt(..),                     handleInterrupt,                     -- * Additional submodules-                    module System.Console.Haskeline.Completion,-                    module System.Console.Haskeline.MonadException)+                    module System.Console.Haskeline.Completion)                      where  import System.Console.Haskeline.LineState@@ -84,15 +84,16 @@ 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 Control.Monad.Catch (MonadMask, handle) import Data.Char (isSpace, isPrint)+import Data.Maybe (isJust)+import System.IO   -- | A useful default.  In particular:@@ -128,11 +129,13 @@ {- $inputfncs The following functions read one line or character of input from the user. -When using terminal-style interaction, these functions return 'Nothing' if the user-pressed @Ctrl-D@ when the input text was empty.+They return `Nothing` if they encounter the end of input.  More specifically: -When using file-style interaction, these functions return 'Nothing' if-an @EOF@ was encountered before any characters were read.+- When using terminal-style interaction, they return `Nothing` if the user+  pressed @Ctrl-D@ when the input text was empty.++- When using file-style interaction, they return `Nothing` if an @EOF@ was+  encountered before any characters were read. -}  @@ -141,7 +144,8 @@ 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 -- ^ The input prompt+getInputLine :: (MonadIO m, MonadMask m)+            => String -- ^ The input prompt                             -> InputT m (Maybe String) getInputLine = promptedInput (getInputCmdLine emptyIM) $ runMaybeT . getLocaleLine @@ -160,7 +164,7 @@ > getInputLineWithInitial "prompt> " ("left", "") -- The cursor starts at the end of the line. > getInputLineWithInitial "prompt> " ("left ", "right") -- The cursor starts before the second word.  -}-getInputLineWithInitial :: MonadException m+getInputLineWithInitial :: (MonadIO m, MonadMask m)                             => String           -- ^ The input prompt                             -> (String, String) -- ^ The initial value left and right of the cursor                             -> InputT m (Maybe String)@@ -169,7 +173,7 @@   where     initialIM = insertString left $ moveToStart $ insertString right $ emptyIM -getInputCmdLine :: MonadException m => InsertMode -> TermOps -> String -> InputT m (Maybe String)+getInputCmdLine :: (MonadIO m, MonadMask m) => InsertMode -> TermOps -> Prefix -> InputT m (Maybe String) getInputCmdLine initialIM tops prefix = do     emode <- InputT $ asks editMode     result <- runInputCmdT tops $ case emode of@@ -202,7 +206,7 @@ When using file-style interaction, a newline will be read if it is immediately available after the input character. -}-getInputChar :: MonadException m => String -- ^ The input prompt+getInputChar :: (MonadIO m, MonadMask m) => String -- ^ The input prompt                     -> InputT m (Maybe Char) getInputChar = promptedInput getInputCmdChar $ \fops -> do                         c <- getPrintableChar fops@@ -216,7 +220,7 @@         Just False -> getPrintableChar fops         _ -> return c -getInputCmdChar :: MonadException m => TermOps -> String -> InputT m (Maybe Char)+getInputCmdChar :: (MonadIO m, MonadMask m) => TermOps -> Prefix -> InputT m (Maybe Char) getInputCmdChar tops prefix = runInputCmdT tops         $ runCommandLoop tops prefix acceptOneChar emptyIM @@ -228,6 +232,32 @@                           , ctrlChar 'd' +> failCmd]  ----------+{- | 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.+-}+waitForAnyKey :: (MonadIO m, MonadMask m)+    => String -- ^ The input prompt+    -> InputT m Bool+waitForAnyKey = promptedInput getAnyKeyCmd+            $ \fops -> fmap isJust . runMaybeT $ getLocaleChar fops++getAnyKeyCmd :: (MonadIO m, MonadMask m) => TermOps -> Prefix -> InputT m Bool+getAnyKeyCmd tops prefix = runInputCmdT tops+    $ runCommandLoop tops prefix acceptAnyChar emptyIM+  where+    acceptAnyChar = choiceCmd+                [ ctrlChar 'd' +> const (return False)+                , KeyMap $ const $ Just (Consumed $ const $ return True)+                ]++---------- -- Passwords  {- | Reads one line of input, without displaying the input while it is being typed.@@ -241,7 +271,7 @@ consoles (such as Cygwin or MSYS). -} -getPassword :: MonadException m => Maybe Char -- ^ A masking character; e.g., @Just \'*\'@+getPassword :: (MonadIO m, MonadMask m) => Maybe Char -- ^ A masking character; e.g., @Just \'*\'@                             -> String -> InputT m (Maybe String) getPassword x = promptedInput                     (\tops prefix -> runInputCmdT tops@@ -273,7 +303,7 @@ -- | Wrapper for input functions. -- This is the function that calls "wrapFileInput" around file backend input -- functions (see Term.hs).-promptedInput :: MonadIO m => (TermOps -> String -> InputT m a)+promptedInput :: MonadIO m => (TermOps -> Prefix -> InputT m a)                         -> (FileOps -> IO a)                         -> String -> InputT m a promptedInput doTerm doFile prompt = do@@ -286,9 +316,13 @@                         putStrOut rterm prompt                         wrapFileInput fops $ doFile fops         Left tops -> do+            -- Convert the full prompt to graphemes (not just the last line)+            -- to account for the `\ESC...STX` appearing anywhere in it.+            let prompt' = stringToGraphemes prompt             -- If the prompt contains newlines, print all but the last line.-            let (lastLine,rest) = break (`elem` "\r\n") $ reverse prompt-            outputStr $ reverse rest+            let (lastLine,rest) = break (`elem` stringToGraphemes "\r\n")+                                    $ reverse prompt'+            outputStr $ graphemesToString $ reverse rest             doTerm tops $ reverse lastLine  {- | If Ctrl-C is pressed during the given action, throw an exception@@ -311,21 +345,21 @@ Ctrl-C.  -}-withInterrupt :: MonadException m => InputT m a -> InputT m a+withInterrupt :: (MonadIO m, MonadMask m) => InputT m a -> InputT m a withInterrupt act = do     rterm <- InputT ask-    liftIOOp_ (wrapInterrupt rterm) act+    wrapInterrupt rterm act  -- | Catch and handle an exception of type 'Interrupt'. -- -- > handleInterrupt f = handle $ \Interrupt -> f-handleInterrupt :: MonadException m => m a -> m a -> m a+handleInterrupt :: MonadMask m => m a -> m a -> m a handleInterrupt f = handle $ \Interrupt -> f  {- | Return a printing function, which in terminal-style interactions is thread-safe and may be run concurrently with user input without affecting the prompt. -}-getExternalPrint :: MonadException m => InputT m (String -> IO ())+getExternalPrint :: MonadIO m => InputT m (String -> IO ()) getExternalPrint = do     rterm <- InputT ask     return $ case termOps rterm of

@@ -9,6 +9,7 @@ import System.IO import Control.Applicative(Applicative) import Control.Monad(liftM)+import Control.Monad.Catch  -- TODO:  ---- Put "<" and ">" at end of term if scrolls off.@@ -21,7 +22,8 @@ initWindow = Window {pos=0}  newtype DumbTerm m a = DumbTerm {unDumbTerm :: StateT Window (PosixT m) a}-                deriving (Functor, Applicative, Monad, MonadIO, MonadException,+                deriving (Functor, Applicative, Monad, MonadIO,+                          MonadThrow, MonadCatch, MonadMask,                           MonadState Window, MonadReader Handles)  type DumbTermM a = forall m . (MonadIO m, MonadReader Layout m) => DumbTerm m a@@ -35,7 +37,7 @@ runDumbTerm :: Handles -> MaybeT IO RunTerm runDumbTerm h = liftIO $ posixRunTerm h (posixLayouts h) [] id evalDumb                                 -instance (MonadException m, MonadReader Layout m) => Term (DumbTerm m) where+instance (MonadIO m, MonadMask m, MonadReader Layout m) => Term (DumbTerm m) where     reposition _ s = refitLine s     drawLineDiff = drawLineDiff'     

@@ -17,7 +17,9 @@ import Foreign.C.Types import qualified Data.Map as Map import System.Posix.Terminal hiding (Interrupt)+import Control.Exception (throwTo) import Control.Monad+import Control.Monad.Catch (MonadMask, handle, finally) import Control.Concurrent.STM import Control.Concurrent hiding (throwTo) import Data.Maybe (catMaybes)@@ -27,7 +29,7 @@ import System.IO import System.Environment -import System.Console.Haskeline.Monads hiding (Handler)+import System.Console.Haskeline.Monads import System.Console.Haskeline.Key import System.Console.Haskeline.Term as Term import System.Console.Haskeline.Prefs@@ -201,7 +203,7 @@  ----------------------------- -withPosixGetEvent :: (MonadException m, MonadReader Prefs m)+withPosixGetEvent :: (MonadIO m, MonadMask m, MonadReader Prefs m)         => TChan Event -> Handles -> [(String,Key)]                 -> (m Event -> m a) -> m a withPosixGetEvent eventChan h termKeys f = wrapTerminalOps h $ do@@ -209,18 +211,18 @@     withWindowHandler eventChan         $ f $ liftIO $ getEvent (ehIn h) baseMap eventChan -withWindowHandler :: MonadException m => TChan Event -> m a -> m a+withWindowHandler :: (MonadIO m, MonadMask m) => TChan Event -> m a -> m a withWindowHandler eventChan = withHandler windowChange $     Catch $ atomically $ writeTChan eventChan WindowResize -withSigIntHandler :: MonadException m => m a -> m a+withSigIntHandler :: (MonadIO m, MonadMask m) => m a -> m a withSigIntHandler f = do     tid <- liftIO myThreadId     withHandler keyboardSignal             (Catch (throwTo tid Interrupt))             f -withHandler :: MonadException m => Signal -> Handler -> m a -> m a+withHandler :: (MonadIO m, MonadMask m) => Signal -> Handler -> m a -> m a withHandler signal handler f = do     old_handler <- liftIO $ installHandler signal handler Nothing     f `finally` liftIO (installHandler signal old_handler Nothing)@@ -279,8 +281,8 @@     Handles     -> [IO (Maybe Layout)]     -> [(String,Key)]-    -> (forall m b . MonadException m => m b -> m b)-    -> (forall m . (MonadException m, CommandMonad m) => EvalTerm (PosixT m))+    -> (forall m b . (MonadIO m, MonadMask m) => m b -> m b)+    -> (forall m . (MonadMask m, CommandMonad m) => EvalTerm (PosixT m))     -> IO RunTerm posixRunTerm hs layoutGetters keys wrapGetEvent evalBackend = do     ch <- newTChanIO@@ -336,7 +338,7 @@ -- 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 :: MonadException m => Handles -> m a -> m a+wrapTerminalOps :: (MonadIO m, MonadMask m) => Handles -> m a -> m a wrapTerminalOps hs =     bracketSet (hGetBuffering h_in) (hSetBuffering h_in) NoBuffering     -- TODO: block buffering?  Certain \r and \n's are causing flicker...@@ -344,8 +346,8 @@     -- - breaking line after offset widechar?     . bracketSet (hGetBuffering h_out) (hSetBuffering h_out) LineBuffering     . bracketSet (hGetEcho h_in) (hSetEcho h_in) False-    . liftIOOp_ (withCodingMode $ hIn hs)-    . liftIOOp_ (withCodingMode $ hOut hs)+    . withCodingMode (hIn hs)+    . withCodingMode (hOut hs)   where     h_in = ehIn hs     h_out = ehOut hs

@@ -13,6 +13,7 @@         openInCodingMode,         ) where +import Control.Monad.Catch (MonadMask, bracket) import System.IO import System.Console.Haskeline.Monads @@ -41,13 +42,13 @@  -- | Use to ensure that an external handle is in the correct mode -- for the duration of the given action.-withCodingMode :: ExternalHandle -> IO a -> IO a+withCodingMode :: (MonadIO m, MonadMask m) => ExternalHandle -> m a -> m a withCodingMode ExternalHandle {externalMode=CodingMode} act = act withCodingMode (ExternalHandle OtherMode h) act = do     bracket (liftIO $ hGetEncoding h)             (liftIO . hSetBinOrEncoding h)             $ const $ do-                hSetEncoding h haskelineEncoding+                liftIO $ hSetEncoding h haskelineEncoding                 act  hSetBinOrEncoding :: Handle -> Maybe TextEncoding -> IO ()

@@ -1,4 +1,4 @@-#if __GLASGOW_HASKELL__ <= 802+#if __GLASGOW_HASKELL__ < 802 {-# OPTIONS_GHC -Wno-redundant-constraints #-} #endif module System.Console.Haskeline.Backend.Terminfo(@@ -9,6 +9,7 @@  import System.Console.Terminfo import Control.Monad+import Control.Monad.Catch import Data.List(foldl') import System.IO import qualified Control.Exception as Exception@@ -105,7 +106,8 @@                                     (StateT TermRows                                     (StateT TermPos                                     (PosixT m))))) a}-    deriving (Functor, Applicative, Monad, MonadIO, MonadException,+    deriving (Functor, Applicative, Monad, MonadIO,+              MonadMask, MonadThrow, MonadCatch,               MonadReader Actions, MonadReader Terminal, MonadState TermPos,               MonadState TermRows, MonadReader Handles) @@ -136,7 +138,7 @@                 (evalDraw term actions)  -- If the keypad on/off capabilities are defined, wrap the computation with them.-wrapKeypad :: MonadException m => Handle -> Terminal -> m a -> m a+wrapKeypad :: (MonadIO m, MonadMask m) => Handle -> Terminal -> m a -> m a wrapKeypad h term f = (maybeOutput keypadOn >> f)                             `finally` maybeOutput keypadOff   where@@ -349,7 +351,7 @@     put initTermRows     drawLineDiffT ([],[]) s -instance (MonadException m, MonadReader Layout m) => Term (Draw m) where+instance (MonadIO m, MonadMask m, MonadReader Layout m) => Term (Draw m) where     drawLineDiff xs ys = runActionT $ drawLineDiffT xs ys     reposition layout lc = runActionT $ repositionT layout lc     

@@ -15,10 +15,18 @@ import Control.Concurrent hiding (throwTo) import Data.Char(isPrint) import Data.Maybe(mapMaybe)+import Control.Exception (IOException, throwTo) import Control.Monad+import Control.Monad.Catch+    ( MonadThrow+    , MonadCatch+    , MonadMask+    , bracket+    , handle+    )  import System.Console.Haskeline.Key-import System.Console.Haskeline.Monads hiding (Handler)+import System.Console.Haskeline.Monads import System.Console.Haskeline.LineState import System.Console.Haskeline.Term import System.Console.Haskeline.Backend.WCWidth@@ -239,7 +247,7 @@ foreign import WINDOWS_CCONV "windows.h SetConsoleMode" c_SetConsoleMode     :: HANDLE -> DWORD -> IO Bool -withWindowMode :: MonadException m => Handles -> m a -> m a+withWindowMode :: (MonadIO m, MonadMask m) => Handles -> m a -> m a withWindowMode hs f = do     let h = hIn hs     bracket (getConsoleMode h) (setConsoleMode h)@@ -259,7 +267,8 @@ closeHandles hs = closeHandle (hIn hs) >> closeHandle (hOut hs)  newtype Draw m a = Draw {runDraw :: ReaderT Handles m a}-    deriving (Functor, Applicative, Monad, MonadIO, MonadException, MonadReader Handles)+    deriving (Functor, Applicative, Monad, MonadIO, MonadReader Handles,+              MonadThrow, MonadCatch, MonadMask)  type DrawM a = forall m . (MonadIO m, MonadReader Layout m) => Draw m a @@ -345,7 +354,7 @@ crlf :: String crlf = "\r\n" -instance (MonadException m, MonadReader Layout m) => Term (Draw m) where+instance (MonadMask m, MonadIO m, MonadReader Layout m) => Term (Draw m) where     drawLineDiff (xs1,ys1) (xs2,ys2) = let         fixEsc = filter ((/= '\ESC') . baseChar)         in drawLineDiffWin (fixEsc xs1, fixEsc ys1) (fixEsc xs2, fixEsc ys2)@@ -391,7 +400,7 @@           closeHandles hs       } -win32WithEvent :: MonadException m => Handles -> TChan Event+win32WithEvent :: MonadIO m => Handles -> TChan Event                                         -> (m Event -> m a) -> m a win32WithEvent h eventChan f = f $ liftIO $ getEvent (hIn h) eventChan @@ -437,7 +446,7 @@     :: FunPtr Handler -> BOOL -> IO BOOL  -- sets the tv to True when ctrl-c is pressed.-withCtrlCHandler :: MonadException m => m a -> m a+withCtrlCHandler :: (MonadMask m, MonadIO m) => m a -> m a withCtrlCHandler f = bracket (liftIO $ do                                     tid <- myThreadId                                     fp <- wrapHandler (handler tid)

@@ -4,9 +4,9 @@  import Control.Exception (throw) import Control.Monad (void)-import Control.Monad.IO.Class (liftIO)+import Control.Monad.Catch (MonadMask, bracket)+import Control.Monad.IO.Class (MonadIO(..)) -import System.Console.Haskeline.MonadException (MonadException, bracket) import System.Exit (ExitCode(..)) import System.IO (Handle, hGetContents, hGetEcho, hSetEcho) import System.Process (StdStream(..), createProcess, shell,@@ -67,7 +67,7 @@ --            ('liftIO' . 'hSetInputEchoState' input) --            (const action) -- @-hBracketInputEcho :: MonadException m => Handle -> m a -> m a+hBracketInputEcho :: (MonadIO m, MonadMask m) => Handle -> m a -> m a hBracketInputEcho input action =   bracket (liftIO $ hGetInputEchoState input)           (liftIO . hSetInputEchoState input)@@ -76,7 +76,7 @@ -- | Perform a computation with the handle's input echoing disabled. Before -- running the computation, the handle's input 'EchoState' is saved, and the -- saved 'EchoState' is restored after the computation finishes.-hWithoutInputEcho :: MonadException m => Handle -> m a -> m a+hWithoutInputEcho :: (MonadIO m, MonadMask m) => Handle -> m a -> m a hWithoutInputEcho input action = do   echo_off <- liftIO $ hEchoOff input   hBracketInputEcho input

@@ -9,6 +9,7 @@ import Data.Maybe(fromMaybe) import System.Console.Haskeline.History import Data.IORef+import Control.Monad.Catch  data HistLog = HistLog {pastHistory, futureHistory :: [[Grapheme]]}                     deriving Show@@ -27,7 +28,7 @@ histLog hist = HistLog {pastHistory = map stringToGraphemes $ historyLines hist,                         futureHistory = []} -runHistoryFromFile :: MonadException m => Maybe FilePath -> Maybe Int+runHistoryFromFile :: (MonadIO m, MonadMask m) => Maybe FilePath -> Maybe Int                             -> ReaderT (IORef History) m a -> m a runHistoryFromFile Nothing _ f = do     historyRef <- liftIO $ newIORef emptyHistory

@@ -1,3 +1,6 @@+#if __GLASGOW_HASKELL__ < 802+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+#endif module System.Console.Haskeline.Emacs where  import System.Console.Haskeline.Command@@ -10,10 +13,11 @@ import System.Console.Haskeline.LineState import System.Console.Haskeline.InputT +import Control.Monad.Catch (MonadMask) import Data.Char -type InputCmd s t = forall m . MonadException m => Command (InputCmdT m) s t-type InputKeyCmd s t = forall m . MonadException m => KeyCommand (InputCmdT m) s t+type InputCmd s t = forall m . (MonadIO m, MonadMask m) => Command (InputCmdT m) s t+type InputKeyCmd s t = forall m . (MonadIO m, MonadMask m) => KeyCommand (InputCmdT m) s t  emacsCommands :: InputKeyCmd InsertMode (Maybe String) emacsCommands = choiceCmd [@@ -42,6 +46,8 @@             , completionCmd (simpleChar '\t')             , simpleKey UpKey +> historyBack             , simpleKey DownKey +> historyForward+            , simpleKey SearchReverse +> searchForPrefix Reverse+            , simpleKey SearchForward +> searchForPrefix Forward             , searchHistory             ]              

@@ -42,6 +42,7 @@ import System.Console.Haskeline hiding (completeFilename) import Control.Concurrent +import Control.Exception (finally) import Control.Monad.IO.Class  -- Providing a non-monadic API for haskeline

@@ -11,11 +11,14 @@ import System.Console.Haskeline.Backend import System.Console.Haskeline.Term +import Control.Exception (IOException)+import Control.Monad.Catch+import Control.Monad.Fail as Fail+import Control.Monad.Fix+import Data.IORef import System.Directory(getHomeDirectory) import System.FilePath-import Control.Monad.Fix import System.IO-import Data.IORef  -- | Application-specific customizations to the user interface. data Settings m = Settings {complete :: CompletionFunc m, -- ^ Custom tab completion.@@ -46,7 +49,8 @@                                 (ReaderT (IORef KillRing)                                 (ReaderT Prefs                                 (ReaderT (Settings m) m)))) a}-                            deriving (Functor, Applicative, Monad, MonadIO, MonadException)+                            deriving (Functor, Applicative, Monad, MonadIO,+                                      MonadThrow, MonadCatch, MonadMask)                 -- NOTE: we're explicitly *not* making InputT an instance of our                 -- internal MonadState/MonadReader classes.  Otherwise haddock                 -- displays those instances to the user, and it makes it seem like@@ -55,6 +59,9 @@ instance MonadTrans InputT where     lift = InputT . lift . lift . lift . lift . lift +instance ( Fail.MonadFail m ) => Fail.MonadFail (InputT m) where+    fail = lift . Fail.fail+ instance ( MonadFix m ) => MonadFix (InputT m) where     mfix f = InputT (mfix (unInputT . f)) @@ -82,14 +89,14 @@     history <- get     lift $ lift $ evalStateT' (histLog history) $ runUndoT $ evalStateT' layout f -instance MonadException m => CommandMonad (InputCmdT m) where+instance (MonadIO m, MonadMask m) => CommandMonad (InputCmdT m) where     runCompletion lcs = do         settings <- ask         lift $ lift $ lift $ lift $ lift $ lift $ complete settings lcs  -- | Run a line-reading application.  Uses 'defaultBehavior' to determine the -- interaction behavior.-runInputTWithPrefs :: MonadException m => Prefs -> Settings m -> InputT m a -> m a+runInputTWithPrefs :: (MonadIO m, MonadMask m) => Prefs -> Settings m -> InputT m a -> m a runInputTWithPrefs = runInputTBehaviorWithPrefs defaultBehavior  -- | Run a line-reading application.  This function should suffice for most applications.@@ -101,7 +108,7 @@ -- 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+runInputT :: (MonadIO m, MonadMask m) => Settings m -> InputT m a -> m a runInputT = runInputTBehavior defaultBehavior  -- | Returns 'True' if the current session uses terminal-style interaction.  (See 'Behavior'.)@@ -125,7 +132,7 @@  -- | Create and use a RunTerm, ensuring that it will be closed even if -- an async exception occurs during the creation or use.-withBehavior :: MonadException m => Behavior -> (RunTerm -> m a) -> m a+withBehavior :: (MonadIO m, MonadMask m) => Behavior -> (RunTerm -> m a) -> m a withBehavior (Behavior run) f = bracket (liftIO run) (liftIO . closeTerm) f  -- | Run a line-reading application according to the given behavior.@@ -133,7 +140,7 @@ -- 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+runInputTBehavior :: (MonadIO m, MonadMask m) => Behavior -> Settings m -> InputT m a -> m a runInputTBehavior behavior settings f = withBehavior behavior $ \run -> do     prefs <- if isTerminalStyle run                 then liftIO readPrefsFromHome@@ -141,13 +148,13 @@     execInputT prefs settings run f  -- | Run a line-reading application.-runInputTBehaviorWithPrefs :: MonadException m+runInputTBehaviorWithPrefs :: (MonadIO m, MonadMask m)     => Behavior -> Prefs -> Settings m -> InputT m a -> m a runInputTBehaviorWithPrefs behavior prefs settings f     = withBehavior behavior $ flip (execInputT prefs settings) f  -- | Helper function to feed the parameters into an InputT.-execInputT :: MonadException m => Prefs -> Settings m -> RunTerm+execInputT :: (MonadIO m, MonadMask m) => Prefs -> Settings m -> RunTerm                 -> InputT m a -> m a execInputT prefs settings run (InputT f)     = runReaderT' settings $ runReaderT' prefs

@@ -0,0 +1,37 @@+module System.Console.Haskeline.Internal+    ( debugTerminalKeys ) where++import System.Console.Haskeline (defaultSettings, outputStrLn)+import System.Console.Haskeline.Command+import System.Console.Haskeline.InputT+import System.Console.Haskeline.LineState+import System.Console.Haskeline.Monads+import System.Console.Haskeline.RunCommand+import System.Console.Haskeline.Term++-- | This function may be used to debug Haskeline's input.+--+-- It loops indefinitely; every time a key is pressed, it will+-- print that key as it was recognized by Haskeline.+-- Pressing Ctrl-C will stop the loop.+--+-- Haskeline's behavior may be modified by editing your @~/.haskeline@+-- file.  For details, see: <https://github.com/judah/haskeline/wiki/CustomKeyBindings>+--+debugTerminalKeys :: IO a+debugTerminalKeys = runInputT defaultSettings $ do+    outputStrLn+        "Press any keys to debug Haskeline's input, or ctrl-c to exit:"+    rterm <- InputT ask+    case termOps rterm of+        Right _ -> error "debugTerminalKeys: not run in terminal mode"+        Left tops -> runInputCmdT tops $ runCommandLoop tops prompt+                                            loop emptyIM+  where+    loop = KeyMap $ \k -> Just $ Consumed $+            (const $ do+                effect (LineChange $ const ([],[]))+                effect (PrintLines [show k])+                setState emptyIM)+            >|> keyCommand loop+    prompt = stringToGraphemes "> "

@@ -11,19 +11,26 @@             parseKey             ) where +import Data.Bits import Data.Char-import Control.Monad import Data.Maybe-import Data.Bits+import Data.List (intercalate)+import Control.Monad  data Key = Key Modifier BaseKey-            deriving (Show,Eq,Ord)+            deriving (Eq,Ord) +instance Show Key where+    show (Key modifier base)+        | modifier == noModifier = show base+        | otherwise = show modifier ++ "-" ++ show base+ data Modifier = Modifier {hasControl, hasMeta, hasShift :: Bool}             deriving (Eq,Ord)  instance Show Modifier where-    show m = show $ catMaybes [maybeUse hasControl "ctrl"+    show m = intercalate "-"+            $ catMaybes [maybeUse hasControl "ctrl"                         , maybeUse hasMeta "meta"                         , maybeUse hasShift "shift"                         ]@@ -33,14 +40,41 @@ noModifier :: Modifier noModifier = Modifier False False False +-- Note: a few of these aren't really keys (e.g., KillLine),+-- but they provide useful enough binding points to include. data BaseKey = KeyChar Char              | FunKey Int              | LeftKey | RightKey | DownKey | UpKey-             -- TODO: is KillLine really a key?              | KillLine | Home | End | PageDown | PageUp              | Backspace | Delete-            deriving (Show,Eq,Ord)+             | SearchReverse | SearchForward+            deriving (Eq, Ord) +instance Show BaseKey where+    show (KeyChar '\n') = "Return"+    show (KeyChar '\t') = "Tab"+    show (KeyChar '\ESC') = "Esc"+    show (KeyChar c)+        | isPrint c = [c]+        | isPrint unCtrld = "ctrl-" ++ [unCtrld]+        | otherwise = show c+      where+        unCtrld = toEnum (fromEnum c .|. ctrlBits)+    show (FunKey n) = 'f' : show n+    show LeftKey = "Left"+    show RightKey = "Right"+    show DownKey = "Down"+    show UpKey = "Up"+    show KillLine = "KillLine"+    show Home = "Home"+    show End = "End"+    show PageDown = "PageDown"+    show PageUp = "PageUp"+    show Backspace = "Backspace"+    show Delete = "Delete"+    show SearchReverse = "SearchReverse"+    show SearchForward = "SearchForward"+ simpleKey :: BaseKey -> Key simpleKey = Key noModifier @@ -58,8 +92,11 @@  setControlBits :: Char -> Char setControlBits '?' = toEnum 127-setControlBits c = toEnum $ fromEnum c .&. complement (bit 5 .|. bit 6)+setControlBits c = toEnum $ fromEnum c .&. complement ctrlBits +ctrlBits :: Int+ctrlBits = bit 5 .|. bit 6+ specialKeys :: [(String,BaseKey)] specialKeys = [("left",LeftKey)               ,("right",RightKey)@@ -77,6 +114,8 @@               ,("tab",KeyChar '\t')               ,("esc",KeyChar '\ESC')               ,("escape",KeyChar '\ESC')+              ,("reversesearchhistory",SearchReverse)+              ,("forwardsearchhistory",SearchForward)               ]  parseModifiers :: [String] -> BaseKey -> Key

@@ -1,180 +0,0 @@-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}-{- | This module redefines some of the functions in "Control.Exception" to-work for more general monads built on top of 'IO'.--}--module System.Console.Haskeline.MonadException(-    -- * The MonadException class-    MonadException(..),-    -- * Generalizations of Control.Exception-    catch,-    handle,-    catches,-    Handler(..),-    finally,-    throwIO,-    throwTo,-    bracket,-    -- * Helpers for defining \"wrapper\" functions-    liftIOOp,-    liftIOOp_,-    -- * Internal implementation-    RunIO(..),-    -- * Extensible Exceptions-    Exception,-    SomeException(..),-    E.IOException(),-    )-     where--import qualified Control.Exception as E-import Control.Exception (Exception,SomeException)-import Control.Monad(liftM, join)-import Control.Monad.IO.Class-import Control.Monad.Trans.Identity-import Control.Monad.Trans.Reader-import Control.Monad.Trans.State.Strict-import Control.Monad.Trans.Error-import Control.Monad.Trans.List-import Control.Monad.Trans.Maybe-import Control.Monad.Trans.RWS-import Control.Monad.Trans.Writer-import Control.Concurrent(ThreadId)---- This approach is based on that of the monad-control package.--- Since we want to use haskeline to bootstrap GHC, we reimplement--- a simplified version here.  --- Additionally, we avoid TypeFamilies (which are used in the latest version of--- monad-control) so that we're still compatible with older versions of GHC.---- | A 'RunIO' function takes a monadic action @m@ as input,--- and outputs an IO action which performs the underlying impure part of @m@--- and returns the ''pure'' part of @m@.------ Note that @(RunIO return)@ is an incorrect implementation, since it does not--- separate the pure and impure parts of the monadic action.  This module defines--- implementations for several common monad transformers.-newtype RunIO m = RunIO (forall b . m b -> IO (m b))--- Uses a newtype so we don't need RankNTypes.---- | An instance of 'MonadException' is generally made up of monad transformers--- layered on top of the IO monad.  --- --- The 'controlIO' method enables us to \"lift\" a function that manages IO actions (such--- as 'bracket' or 'catch') into a function that wraps arbitrary monadic actions.-class MonadIO m => MonadException m where-    controlIO :: (RunIO m -> IO (m a)) -> m a---- | Lift a IO operation--- --- > wrap :: (a -> IO b) -> IO b--- --- to a more general monadic operation--- --- > liftIOOp wrap :: MonadException m => (a -> m b) -> m b------ For example: ------ @---  'liftIOOp' ('System.IO.withFile' f m) :: MonadException m => (Handle -> m r) -> m r---  'liftIOOp' 'Foreign.Marshal.Alloc.alloca' :: (MonadException m, Storable a) => (Ptr a -> m b) -> m b---  'liftIOOp' (`Foreign.ForeignPtr.withForeignPtr` fp) :: MonadException m => (Ptr a -> m b) -> m b--- @-liftIOOp :: MonadException m => ((a -> IO (m b)) -> IO (m c)) -> (a -> m b) -> m c-liftIOOp f g = controlIO $ \(RunIO run) -> f (run . g)---- | Lift an IO operation--- --- > wrap :: IO a -> IO a--- --- to a more general monadic operation--- --- > liftIOOp_ wrap :: MonadException m => m a -> m a-liftIOOp_ :: MonadException m => (IO (m a) -> IO (m a)) -> m a -> m a-liftIOOp_ f act = controlIO $ \(RunIO run) -> f (run act)---catch :: (MonadException m, E.Exception e) => m a -> (e -> m a) -> m a-catch act handler = controlIO $ \(RunIO run) -> E.catch-                                                    (run act)-                                                    (run . handler)--handle :: (MonadException m, Exception e) => (e -> m a) -> m a -> m a-handle = flip catch- -catches :: (MonadException m) => m a -> [Handler m a] -> m a-catches act handlers = controlIO $ \(RunIO run) ->-                           let catchesHandler e = foldr tryHandler (E.throw e) handlers-                                   where tryHandler (Handler handler) res =-                                             case E.fromException e of-                                               Just e' -> run $ handler e'-                                               Nothing -> res-                           in E.catch (run act) catchesHandler--data Handler m a = forall e . Exception e => Handler (e -> m a)---bracket :: MonadException m => m a -> (a -> m b) -> (a -> m c) -> m c-bracket before after thing -    = controlIO $ \(RunIO run) -> E.bracket-                                    (run before)-                                    (\m -> run (m >>= after))-                                    (\m -> run (m >>= thing))--finally :: MonadException m => m a -> m b -> m a-finally thing ender = controlIO $ \(RunIO run) -> E.finally (run thing) (run ender)--throwIO :: (MonadIO m, Exception e) => e -> m a-throwIO = liftIO . E.throwIO--throwTo :: (MonadIO m, Exception e) => ThreadId -> e -> m ()-throwTo tid = liftIO . E.throwTo tid--------------- Instances of MonadException.--- Since implementations of this class are non-obvious to a casual user,--- we provide instances for nearly everything in the transformers package.--instance MonadException IO where-    controlIO f = join $ f (RunIO (liftM return))-    -- Note: it's crucial that we use "liftM return" instead of "return" here.-    -- For example, in "finally thing end", this ensures that "end" will always run, -    -- regardless of whether an mzero occurred inside of "thing".--instance MonadException m => MonadException (ReaderT r m) where-    controlIO f = ReaderT $ \r -> controlIO $ \(RunIO run) -> let-                    run' = RunIO (fmap (ReaderT . const) . run . flip runReaderT r)-                    in fmap (flip runReaderT r) $ f run'--instance MonadException m => MonadException (StateT s m) where-    controlIO f = StateT $ \s -> controlIO $ \(RunIO run) -> let-                    run' = RunIO (fmap (StateT . const) . run . flip runStateT s)-                    in fmap (flip runStateT s) $ f run'--instance MonadException m => MonadException (MaybeT m) where-    controlIO f = MaybeT $ controlIO $ \(RunIO run) -> let-                    run' = RunIO (fmap MaybeT . run . runMaybeT)-                    in fmap runMaybeT $ f run' --instance (MonadException m, Error e) => MonadException (ErrorT e m) where-    controlIO f = ErrorT $ controlIO $ \(RunIO run) -> let-                    run' = RunIO (fmap ErrorT . run . runErrorT)-                    in fmap runErrorT $ f run'--instance MonadException m => MonadException (ListT m) where-    controlIO f = ListT $ controlIO $ \(RunIO run) -> let-                    run' = RunIO (fmap ListT . run . runListT)-                    in fmap runListT $ f run'--instance (Monoid w, MonadException m) => MonadException (WriterT w m) where-    controlIO f = WriterT $ controlIO $ \(RunIO run) -> let-                    run' = RunIO (fmap WriterT . run . runWriterT)-                    in fmap runWriterT $ f run'--instance (Monoid w, MonadException m) => MonadException (RWST r w s m) where-    controlIO f = RWST $ \r s -> controlIO $ \(RunIO run) -> let-                    run' = RunIO (fmap (\act -> RWST (\_ _ -> act))-                                    . run . (\m -> runRWST m r s))-                    in fmap (\m -> runRWST m r s) $ f run'--deriving instance MonadException m => MonadException (IdentityT m)

@@ -1,5 +1,4 @@ module System.Console.Haskeline.Monads(-                module System.Console.Haskeline.MonadException,                 MonadTrans(..),                 MonadIO(..),                 ReaderT,@@ -21,16 +20,17 @@                 orElse                 ) where -import Control.Applicative (Applicative(..))-import Control.Monad (ap, liftM)+import Control.Monad (liftM)+import Control.Monad.Catch () import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Maybe (MaybeT(MaybeT),runMaybeT) import Control.Monad.Trans.Reader hiding (ask,asks) import qualified Control.Monad.Trans.Reader as Reader-import Data.IORef+import Control.Monad.Trans.State.Strict hiding (get, put, gets, modify)+import qualified Control.Monad.Trans.State.Strict as State -import System.Console.Haskeline.MonadException+import Data.IORef  class Monad m => MonadReader r m where     ask :: m r@@ -68,46 +68,9 @@ runReaderT' :: r -> ReaderT r m a -> m a runReaderT' = flip runReaderT -newtype StateT s m a = StateT { getStateTFunc -                                    :: forall r . s -> m ((a -> s -> r) -> r)}--instance Monad m => Functor (StateT s m) where-    fmap  = liftM--instance Monad m => Applicative (StateT s m) where-    pure x = StateT $ \s -> return $ \f -> f x s-    (<*>) = ap--instance Monad m => Monad (StateT s m) where-    return = pure-    StateT f >>= g = StateT $ \s -> do-        useX <- f s-        useX $ \x s' -> getStateTFunc (g x) s'--instance MonadTrans (StateT s) where-    lift m = StateT $ \s -> do-        x <- m-        return $ \f -> f x s--instance MonadIO m => MonadIO (StateT s m) where-    liftIO = lift . liftIO--mapStateT :: (forall b . m b -> n b) -> StateT s m a -> StateT s n a-mapStateT f (StateT m) = StateT (\s -> f (m s))--runStateT :: Monad m => StateT s m a -> s -> m (a, s)-runStateT f s = do-    useXS <- getStateTFunc f s-    return $ useXS $ \x s' -> (x,s')--makeStateT :: Monad m => (s -> m (a,s)) -> StateT s m a-makeStateT f = StateT $ \s -> do-                            (x,s') <- f s-                            return $ \g -> g x s'- instance Monad m => MonadState s (StateT s m) where-    get = StateT $ \s -> return $ \f -> f s s-    put s = s `seq` StateT $ \_ -> return $ \f -> f () s+    get = State.get+    put x = State.put $! x  instance {-# OVERLAPPABLE #-} (MonadState s m, MonadTrans t, Monad (t m))     => MonadState s (t m) where@@ -122,14 +85,6 @@  evalStateT' :: Monad m => s -> StateT s m a -> m a evalStateT' s f = liftM fst $ runStateT f s--instance MonadException m => MonadException (StateT s m) where-    controlIO f = makeStateT $ \s -> controlIO $ \run ->-                    fmap (flip runStateT s) $ f $ stateRunIO s run-      where-        stateRunIO :: s -> RunIO m -> RunIO (StateT s m)-        stateRunIO s (RunIO run) = RunIO (\m -> fmap (makeStateT . const)-                                        $ run (runStateT m s))  orElse :: Monad m => MaybeT m a -> m a -> m a orElse (MaybeT f) g = f >>= maybe g return

@@ -9,10 +9,11 @@                         lookupKeyBinding                         ) where +import Control.Monad.Catch (handle)+import Control.Exception (IOException) import Data.Char(isSpace,toLower) import Data.List(foldl') import qualified Data.Map as Map-import System.Console.Haskeline.MonadException(handle,IOException) import System.Console.Haskeline.Key  {- |

@@ -7,16 +7,18 @@ import System.Console.Haskeline.Prefs import System.Console.Haskeline.Key +import Control.Exception (SomeException) import Control.Monad+import Control.Monad.Catch (handle, throwM)  runCommandLoop :: (CommandMonad m, MonadState Layout m, LineState s)-    => TermOps -> String -> KeyCommand m s a -> s -> m a+    => TermOps -> Prefix -> KeyCommand m s a -> s -> m a runCommandLoop tops@TermOps{evalTerm = e} prefix cmds initState     = case e of -- NB: Need to separate this case out from the above pattern                 -- in order to build on ghc-6.12.3         EvalTerm eval liftE             -> eval $ withGetEvent tops-                $ runCommandLoop' liftE tops (stringToGraphemes prefix) initState +                $ runCommandLoop' liftE tops prefix initState                     cmds   runCommandLoop' :: forall m n s a . (Term n, CommandMonad n,@@ -30,10 +32,10 @@   where     readMoreKeys :: LineChars -> KeyMap (CmdM m (a,[Key])) -> n a     readMoreKeys s next = do-        event <- handle (\(e::SomeException) -> moveToNextLine s-                                    >> throwIO e) getEvent+        event <- handle (\(e::SomeException) -> moveToNextLine s >> throwM e)+                    getEvent         case event of-                    ErrorEvent e -> moveToNextLine s >> throwIO e+                    ErrorEvent e -> moveToNextLine s >> throwM e                     WindowResize -> do                         drawReposition liftE tops s                         readMoreKeys s next

@@ -8,6 +8,14 @@  import Control.Concurrent import Control.Concurrent.STM+import Control.Exception (Exception, SomeException(..))+import Control.Monad.Catch+    ( MonadMask+    , bracket+    , handle+    , throwM+    , finally+    ) import Data.Word import Control.Exception (fromException, AsyncException(..)) import Data.Typeable@@ -17,7 +25,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BC -class (MonadReader Layout m, MonadException m) => Term m where+class (MonadReader Layout m, MonadIO m, MonadMask m) => Term m where     reposition :: Layout -> LineChars -> m ()     moveToNextLine :: LineChars -> m ()     printLines :: [String] -> m ()@@ -34,7 +42,7 @@             -- | Write unicode characters to stdout.             putStrOut :: String -> IO (),             termOps :: Either TermOps FileOps,-            wrapInterrupt :: forall a . IO a -> IO a,+            wrapInterrupt :: forall a m . (MonadIO m, MonadMask m) => m a -> m a,             closeTerm :: IO ()     } @@ -68,7 +76,7 @@ -- Backends can assume that getLocaleLine, getLocaleChar and maybeReadNewline -- are "wrapped" by wrapFileInput. data FileOps = FileOps {-            withoutInputEcho :: forall m a . MonadException m => m a -> m a,+            withoutInputEcho :: forall m a . (MonadIO m, MonadMask m) => m a -> m a,             -- ^ Perform an action without echoing input.             wrapFileInput :: forall a . IO a -> IO a,             getLocaleLine :: MaybeT IO String,@@ -100,12 +108,12 @@   -class (MonadReader Prefs m , MonadReader Layout m, MonadException m)+class (MonadReader Prefs m , MonadReader Layout m, MonadIO m, MonadMask m)         => CommandMonad m where     runCompletion :: (String,String) -> m (String,[Completion])  instance {-# OVERLAPPABLE #-} (MonadTrans t, CommandMonad m, MonadReader Prefs (t m),-        MonadException (t m),+        MonadIO (t m), MonadMask (t m),         MonadReader Layout (t m))             => CommandMonad (t m) where     runCompletion = lift . runCompletion@@ -153,14 +161,14 @@ -- Utility functions for the various backends.  -- | Utility function since we're not using the new IO library yet.-hWithBinaryMode :: MonadException m => Handle -> m a -> m a+hWithBinaryMode :: (MonadIO m, MonadMask m) => Handle -> m a -> m a hWithBinaryMode h = bracket (liftIO $ hGetEncoding h)                         (maybe (return ()) (liftIO . hSetEncoding h))                         . const . (liftIO (hSetBinaryMode h True) >>)  -- | Utility function for changing a property of a terminal for the duration of -- a computation.-bracketSet :: MonadException m => IO a -> (a -> IO ()) -> a -> m b -> m b+bracketSet :: (MonadMask m, MonadIO m) => IO a -> (a -> IO ()) -> a -> m b -> m b bracketSet getState set newState f = bracket (liftIO getState)                             (liftIO . set)                             (\_ -> liftIO (set newState) >> f)@@ -193,10 +201,10 @@         c <- hLookAhead h         when (c == '\n') $ getChar >> return () -returnOnEOF :: MonadException m => a -> m a -> m a+returnOnEOF :: MonadMask m => a -> m a -> m a returnOnEOF x = handle $ \e -> if isEOFError e                                 then return x-                                else throwIO e+                                else throwM e  -- | Utility function to correctly get a line of input as an undecoded ByteString. hGetLocaleLine :: Handle -> MaybeT IO ByteString

@@ -1,3 +1,6 @@+#if __GLASGOW_HASKELL__ < 802+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+#endif module System.Console.Haskeline.Vi where  import System.Console.Haskeline.Command@@ -12,6 +15,7 @@  import Data.Char import Control.Monad(liftM)+import Control.Monad.Catch (MonadMask)  type EitherMode = Either CommandMode InsertMode @@ -30,8 +34,8 @@  type ViT m = StateT (ViState m) (InputCmdT m) -type InputCmd s t = forall m . MonadException m => Command (ViT m) s t-type InputKeyCmd s t = forall m . MonadException m => KeyCommand (ViT m) s t+type InputCmd s t = forall m . (MonadIO m, MonadMask m) => Command (ViT m) s t+type InputKeyCmd s t = forall m . (MonadIO m, MonadMask m) => KeyCommand (ViT m) s t  viKeyCommands :: InputKeyCmd InsertMode (Maybe String) viKeyCommands = choiceCmd [@@ -57,6 +61,8 @@                    , ctrlChar 'l' +> clearScreenCmd                    , simpleKey UpKey +> historyBack                    , simpleKey DownKey +> historyForward+                   , simpleKey SearchReverse +> searchForPrefix Reverse+                   , simpleKey SearchForward +> searchForPrefix Forward                    , searchHistory                    , simpleKey KillLine +> killFromHelper (SimpleMove moveToStart)                    , ctrlChar 'w' +> killFromHelper wordErase

@@ -2,7 +2,6 @@  import System.Console.Haskeline import System.Environment-import Control.Exception (AsyncException(..))  {-- Testing the line-input functions and their interaction with ctrl-c signals.@@ -29,8 +28,9 @@                 _ -> getInputLine         runInputT mySettings $ withInterrupt $ loop inputFunc 0     where+        loop :: (String -> InputT IO (Maybe String)) -> Int -> InputT IO ()         loop inputFunc n = do-            minput <-  handle (\Interrupt -> return (Just "Caught interrupted"))+            minput <-  handleInterrupt (return (Just "Caught interrupted"))                         $ inputFunc (show n ++ ":")             case minput of                 Nothing -> return ()

@@ -1,6 +1,6 @@ Name:           haskeline Cabal-Version:  >=1.10-Version:        0.7.5.0+Version:        0.8.0.0 Category:       User Interfaces License:        BSD3 License-File:   LICENSE@@ -42,10 +42,11 @@     -- We require ghc>=7.4.1 (base>=4.5) to use the base library encodings, even     -- though it was implemented in earlier releases, due to GHC bug #5436 which     -- wasn't fixed until 7.4.1-    Build-depends: base >=4.9 && < 4.13, containers>=0.4 && < 0.7,+    Build-depends: base >=4.9 && < 4.15, containers>=0.4 && < 0.7,                    directory>=1.1 && < 1.4, bytestring>=0.9 && < 0.11,-                   filepath >= 1.2 && < 1.5, transformers >= 0.4 && < 0.6,-                   process >= 1.0 && < 1.7, stm >= 2.4 && < 2.6+                   filepath >= 1.2 && < 1.5, transformers >= 0.2 && < 0.6,+                   process >= 1.0 && < 1.7, stm >= 2.4 && < 2.6,+                   exceptions == 0.10.*     Default-Language: Haskell98     Default-Extensions:                 ForeignFunctionInterface, Rank2Types, FlexibleInstances,@@ -60,9 +61,9 @@     Exposed-Modules:                 System.Console.Haskeline                 System.Console.Haskeline.Completion-                System.Console.Haskeline.MonadException                 System.Console.Haskeline.History                 System.Console.Haskeline.IO+                System.Console.Haskeline.Internal     Other-Modules:                 System.Console.Haskeline.Backend                 System.Console.Haskeline.Backend.WCWidth@@ -108,4 +109,24 @@             cpp-options: -DUSE_TERMIOS_H         }     }+     ghc-options: -Wall++test-suite haskeline-tests+    type: exitcode-stdio-1.0+    hs-source-dirs: tests+    Default-Language: Haskell98++    if os(windows)+        buildable: False+    Main-Is:    Unit.hs+    Build-depends: base, containers, text, bytestring, HUnit, process, unix+    Other-Modules: RunTTY, Pty+    build-tool-depends: haskeline:haskeline-examples-Test++-- The following program is used by unit tests in `tests` executable+Executable haskeline-examples-Test+    Build-depends: base, containers, haskeline+    Default-Language: Haskell2010+    hs-source-dirs: examples+    Main-Is: Test.hs

@@ -0,0 +1,98 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-- This module is a quick-and-dirty way to run an executable+-- within a pseudoterminal and obtain its output.+-- +-- It is not intended for general use.  In particular:+-- - It expects the output to be available quickly (<0.2s)+--   after each chunk of input.+-- - It expects each output chunk be no more than 4096 bytes.+module Pty (runCommandInPty) where++import System.Posix.Types+import System.Posix.Terminal+import System.Posix.Process+import System.Posix.Signals+import qualified Data.ByteString as B+import System.Posix.IO.ByteString+import Foreign.Marshal.Alloc+import Foreign.C.Error+import Foreign.C.Types+import Foreign.Ptr+import Control.Concurrent++-- Run the given command in a pseudoterminal, and return its output chunks.+-- Read the initial output, then feed the given input to it+-- one block at a time.+-- After each input, pause for 0.2s and then read as much output as possible.+runCommandInPty :: String -> [String] -> Maybe [(String,String)]+        -> [B.ByteString] -> IO [B.ByteString]+runCommandInPty prog args env inputs = do+    (fd,pid) <- forkCommandInPty prog args env+    -- Block until the initial output from the program.+    -- After that, only use non-blocking reads.  Otherwise,+    -- we would hang the program in cases where the program has no output+    -- in between inputs.+    firstOutput <- getOutput fd+    setFdOption fd NonBlockingRead True+    outputs <- mapM (inputOutput fd) inputs+    signalProcess killProcess pid+    _status <- getProcessStatus True False pid+    closeFd fd+    return (firstOutput : outputs)++inputOutput :: Fd -> B.ByteString -> IO B.ByteString+inputOutput fd input = do+    putInput fd input+    getOutput fd++putInput :: Fd -> B.ByteString -> IO ()+putInput fd input =+    B.useAsCStringLen input $ \(cstr,len) -> do+        written <- fdWriteBuf fd (castPtr cstr) (fromIntegral len)+        if written == 0+            then threadDelay 1000 >> putInput fd input+            else return ()++getOutput :: Fd -> IO B.ByteString+getOutput fd = do+            threadDelay 20000+            allocaBytes (fromIntegral numBytes) $ \buf -> do+                num <- fdReadNonBlocking fd buf numBytes+                B.packCStringLen (castPtr buf, fromIntegral num)+  where+    numBytes = 4096+++-- Unlike fdReadBuf, don't throw an error if nothing's immediately available.+-- Instead, just return empty output.+fdReadNonBlocking :: Fd -> Ptr CChar -> CSize -> IO CSsize+fdReadNonBlocking fd buf n = do+    num_read <- c_read fd buf n+    if num_read >= 0+        then return num_read+        else do+            e <- getErrno+            if e == eAGAIN+                then return 0+                else throwErrno "fdReadNonBlocking"++foreign import ccall "read" c_read :: Fd -> Ptr CChar -> CSize -> IO CSsize+++-- returns the master Fd, and the pid for the subprocess.+forkCommandInPty :: String -> [String] -> Maybe [(String,String)]+                    -> IO (Fd,ProcessID)+forkCommandInPty prog args env = do+    (master,slave) <- openPseudoTerminal+    pid <- forkProcess $ do+                    closeFd master+                    loginTTY slave+                    executeFile prog False args env+    return (master,pid)+++loginTTY :: Fd -> IO ()+loginTTY = throwErrnoIfMinus1_ "loginTTY" . login_tty++foreign import ccall login_tty :: Fd -> IO CInt+

@@ -0,0 +1,109 @@+{-# LANGUAGE RecordWildCards #-}+-- This module provides an interface for testing the output+-- of programs that expect to be run in a terminal.+module RunTTY (Invocation(..),+            runInvocation,+            assertInvocation,+            testI,+            setLang,+            setTerm,+            setLatin1,+            setUTF8+            ) where++import Control.Concurrent+import Data.ByteString as B+import System.IO+import System.Process+import Test.HUnit+import qualified Data.ByteString.Char8 as BC++import Pty+++data Invocation = Invocation {+            prog :: FilePath+            , progArgs :: [String]+            , runInTTY :: Bool+            , environment :: [(String,String)]+            }++setEnv :: String -> String -> Invocation -> Invocation+setEnv var val Invocation {..} = Invocation{+        environment = (var,val) : Prelude.filter ((/=var).fst) environment+        ,..+        }++setLang :: String -> Invocation -> Invocation+setLang = setEnv "LANG"+setTerm :: String -> Invocation -> Invocation+setTerm = setEnv "TERM"+++setUTF8 :: Invocation -> Invocation+setUTF8 = setLang "en_US.UTF-8"+setLatin1 :: Invocation -> Invocation+setLatin1 = setLang "en_US.ISO8859-1"+++runInvocation :: Invocation+        -> [B.ByteString] -- Input chunks.  (We pause after each chunk to+                        -- simulate real user input and prevent Haskeline+                        -- from coalescing the changes.)+        -> IO [B.ByteString]+runInvocation Invocation {..} inputs+    | runInTTY = runCommandInPty prog progArgs (Just environment) inputs+    | otherwise = do+    (Just inH, Just outH, Nothing, ph)+        <- createProcess (proc prog progArgs)+                            { env = Just environment+                            , std_in = CreatePipe+                            , std_out = CreatePipe+                            , std_err = Inherit+                            }+    hSetBuffering inH NoBuffering+    firstOutput <- getOutput outH+    outputs <- mapM (inputOutput inH outH) inputs+    hClose inH+    lastOutput <- getOutput outH -- output triggered by EOF, if any+    terminateProcess ph+    _ <- waitForProcess ph+    return $ firstOutput : outputs+                ++ if B.null lastOutput then [] else [lastOutput]++inputOutput :: Handle -> Handle -> B.ByteString -> IO B.ByteString+inputOutput inH outH input = do+    B.hPut inH input+    getOutput outH+++getOutput :: Handle -> IO B.ByteString+getOutput h = do+    threadDelay 20000+    B.hGetNonBlocking h 4096+++assertInvocation :: Invocation -> [B.ByteString] -> [B.ByteString]+                    -> Assertion+assertInvocation i input expectedOutput = do+    actualOutput <- runInvocation i input+    assertSameList expectedOutput $ fmap fixOutput actualOutput++-- Remove CRLFs from output, since tty translates all LFs into CRLF.+-- (TODO: I'd like to just unset ONLCR in the slave tty, but+-- System.Posix.Terminal doesn't support that flag.)+fixOutput :: B.ByteString -> B.ByteString+fixOutput = BC.pack . loop . BC.unpack+  where+    loop ('\r':'\n':rest) = '\n' : loop rest+    loop (c:cs) = c : loop cs+    loop [] = []++assertSameList :: (Show a, Eq a) => [a] -> [a] -> Assertion+assertSameList [] [] = return ()+assertSameList (x:xs) (y:ys)+    | x == y = assertSameList xs ys+assertSameList xs ys = xs @=? ys -- cause error to be thrown++testI :: Invocation -> [B.ByteString] -> [B.ByteString] -> Test+testI i inp outp = test $ assertInvocation i inp outp

@@ -0,0 +1,332 @@+{-# LANGUAGE OverloadedStrings #-}+-- Requirements:+-- - Empty ~/.haskeline (or set to defaults)+-- - On Mac OS X, the "dumb term" test may fail.+--   In particular, the line "* UTF-8" which makes locale_charset()+--   always return UTF-8; otherwise we can't test latin-1.+-- - NB: Window size isn't provided by screen so it's picked up from+--   terminfo or defaults (either way: 80x24), rather than the user's+--   terminal.+module Main where++import Control.Monad (when)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import Data.Word+import qualified Data.Text as T+import qualified Data.Text.Encoding as E+import Data.Monoid ((<>))+import System.Exit (exitFailure)+import System.Process (readProcess)+import Test.HUnit++import RunTTY++legacyEncoding :: Bool+legacyEncoding = False++-- Generally we want the legacy and new backends to perform the same.+-- The only two differences I'm aware of are:+-- 1. base decodes invalid bytes as '\65533', but legacy decodes them as '?'+-- 2. if there's an incomplete sequence and no more input immediately+--   available (but not eof), then base will pause to wait for more input,+--   whereas legacy will immediately stop.+whenLegacy :: BC.ByteString -> BC.ByteString+whenLegacy s = if legacyEncoding then s else B.empty++main :: IO ()+main = do+    -- forkProcess needs an absolute path to the binary.+    p <- head . lines <$> readProcess "which" ["haskeline-examples-Test"] ""+    let i = setTerm "xterm"+            Invocation {+                prog = p,+                progArgs = [],+                runInTTY = True,+                environment = []+            }+    result <- runTestTT $ test [interactionTests i, fileStyleTests i]+    when (errors result > 0 || failures result > 0) exitFailure++interactionTests :: Invocation -> Test+interactionTests i = "interaction" ~: test+    [ unicodeEncoding i+    , unicodeMovement i+    , tabCompletion i+    , incorrectInput i+    , historyTests i+    , inputChar $ setCharInput i+    , dumbTests $ setTerm "dumb" i+    ]++unicodeEncoding :: Invocation -> Test+unicodeEncoding i = "Unicode encoding (valid)" ~:+    [ utf8Test i [utf8 "xαβγy"]+        [prompt 0, utf8 "xαβγy"]+    , utf8Test i [utf8 "a\n", "quit\n"]+        [ prompt 0+        , utf8 "a" <> end+            <> output 0 (utf8 "a") <> prompt 1+        , utf8 "quit" <> end+        ]+    , utf8Test i [utf8 "xαβyψ안기q영\n", "quit\n"]+        [ prompt 0+        , utf8 "xαβyψ안기q영" <> end+            <> output 0 (utf8 "xαβyψ안기q영") <> prompt 1+        , utf8 "quit" <> end+        ]+    -- test buffering: 32 bytes is in middle of a char encoding,+    -- also test long paste+    , "multipleLines" ~: utf8Test i [l1 <> "\n" <> l1]+        [ prompt 0+        , l1 <> end <> output 0 l1 <> prompt 1 <> l1]+    ]+  where+    l1 = utf8 $ T.replicate 30 "안" -- three bytes, width 60++unicodeMovement :: Invocation -> Test+unicodeMovement i = "Unicode movement" ~:+    [ "separate" ~: utf8Test i [utf8 "α", utf8 "\ESC[Dx"]+        [prompt 0, utf8 "α", utf8 "\bxα\b"]+    , "coalesced" ~: utf8Test i [utf8 "α\ESC[Dx"]+        [prompt 0, utf8 "xα\b"]+    , "lineWrap" ~: utf8Test i+        [ utf8 longWideChar+        , raw [1]+        , raw [5]+        ]+        [prompt 0, utf8 lwc1 <> wrap <> utf8 lwc2 <> wrap <> utf8 lwc3+        , cr <> "\ESC[2A\ESC[2C"+        , cr <> nl <> nl <> "\ESC[22C"+        ]++    ]+  where+    longWideChar = T.concat $ replicate 30 $ "안기영"+    (lwc1,lwcs1) = T.splitAt ((80-2)`div`2) longWideChar+    (lwc2,lwcs2) = T.splitAt (80`div`2) lwcs1+    (lwc3,_lwcs3) = T.splitAt (80`div`2) lwcs2+    -- lwc3 has length 90 - (80-2)/2 - 80/2 = 11,+    -- so the last line as wide width 2*11=22.++tabCompletion :: Invocation -> Test+tabCompletion i = "tab completion" ~:+    [ utf8Test i [ utf8 "tests/dummy-μ\t\t" ]+        [ prompt 0, utf8 "tests/dummy-μασ/"+            <> nl <> utf8 "ςερτ  bar" <> nl+            <> prompt' 0 <> utf8 "tests/dummy-μασ/"+        ]+    ]++incorrectInput :: Invocation -> Test+incorrectInput i = "incorrect input" ~:+    [ utf8Test i [ utf8 "x" <> raw [206] ]  -- needs one more byte+        -- non-legacy encoder ignores the "206" since it's still waiting+        -- for more input.+        [ prompt 0, utf8 "x" <> whenLegacy err ]+    , utf8Test i [ raw [206] <> utf8 "x" ]+        -- 'x' is not valid after '\206', so both the legacy and+        -- non-legacy encoders should handle the "x" correctly.+        [ prompt 0, err <> utf8 "x"]+    , utf8Test i [ raw [236,149] <> utf8 "x" ] -- needs one more byte+        [prompt 0, err <> err <> utf8 "x"]+    ]++historyTests :: Invocation -> Test+historyTests i =  "history encoding" ~:+    [ utf8TestValidHist i [ "\ESC[A" ]+        [prompt 0, utf8 "abcα" ]+    , utf8TestInvalidHist i [ "\ESC[A" ]+        -- NB: this is decoded by either utf8-string or base;+        -- either way they produce \65533 instead of '?'.+        [prompt 0, utf8 "abcα\65533x\65533x\65533" ]+    -- In latin-1: read errors as utf-8 '\65533', display as '?'+    , latin1TestInvalidHist i  [ "\ESC[A" ]+        [prompt 0, utf8 "abc??x?x?" ]+    ]++invalidHist :: BC.ByteString+invalidHist =  utf8 "abcα"+              `B.append` raw [149] -- invalid start of UTF-8 sequence+              `B.append` utf8 "x"+              `B.append` raw [206] -- incomplete start+              `B.append` utf8 "x"+              -- incomplete at end of file+              `B.append` raw [206]++validHist :: BC.ByteString+validHist = utf8 "abcα"++inputChar :: Invocation -> Test+inputChar i = "getInputChar" ~:+    [ utf8Test i [utf8 "xαβ"]+        [ prompt 0, utf8 "x" <> end <> output 0 (utf8 "x")+          <> prompt 1 <> utf8 "α" <> end <> output 1 (utf8 "α")+          <> prompt 2 <> utf8 "β" <> end <> output 2 (utf8 "β")+          <> prompt 3+        ]+    , "bad encoding (separate)" ~:+        utf8Test i [utf8 "α", raw [149], utf8 "x", raw [206]]+        [ prompt 0, utf8 "α" <> end <> output 0 (utf8 "α") <> prompt 1+        , err <> end <> output 1 err <> prompt 2+        , utf8 "x" <> end <> output 2 (utf8 "x") <> prompt 3+        , whenLegacy (err <> end <> output 3 err <> prompt 4)+        ]+    , "bad encoding (together)" ~:+        utf8Test i [utf8 "α" <> raw [149] <> utf8 "x" <> raw [206]]+        [ prompt 0, utf8 "α" <> end <> output 0 (utf8 "α")+        <> prompt 1 <> err <> end <> output 1 err+        <> prompt 2 <> utf8 "x" <> end <> output 2 (utf8 "x")+        <> prompt 3 <> whenLegacy (err <> end <> output 3 err <> prompt 4)+        ]+    , utf8Test i [raw [206]] -- incomplete+        [ prompt 0, whenLegacy (utf8 "?" <> end <> output 0 (utf8 "?"))+        <> whenLegacy (prompt 1)+        ]+    ]++setCharInput :: Invocation -> Invocation+setCharInput i = i { progArgs = ["chars"] }+++fileStyleTests :: Invocation -> Test+fileStyleTests i = "file style" ~:+    [ "line input" ~: utf8Test iFile+        [utf8 "xαβyψ안기q영\nquit\n"]+        [ prompt' 0, output 0 (utf8 "xαβyψ안기q영") <> prompt' 1]+    , "char input" ~: utf8Test iFileChar+        [utf8 "xαβt"]+        [ prompt' 0+        , output 0 (utf8 "x")+            <> prompt' 1 <> output 1 (utf8 "α")+            <> prompt' 2 <> output 2 (utf8 "β")+            <> prompt' 3 <> output 3 (utf8 "t")+            <> prompt' 4]+    , "invalid line input" ~: utf8Test iFile+        -- NOTE: the 206 is an incomplete byte sequence,+        -- but we MUST not pause since we're at EOF, not just+        -- end of term.+        --+        -- Also recall GHC bug #5436 which caused a crash+        -- if the last byte started an incomplete sequence.+        [ utf8 "a" <> raw [149] <> utf8 "x" <> raw [206] ]+        [ prompt' 0+        , B.empty+        -- It only prompts after the EOF.+        , output 0 (utf8 "a" <> err <> utf8 "x" <> err) <> prompt' 1+        ]+    , "invalid char input (following a newline)" ~: utf8Test iFileChar+        [ utf8 "a\n" <> raw [149] <> utf8 "x\n" <> raw [206] ]+        $ [ prompt' 0+          , output 0 (utf8 "a")+             <> prompt' 1 <> output 1 err+             <> prompt' 2 <> output 2 (utf8 "x")+             <> prompt' 3+             <> whenLegacy (output 3 err <> prompt' 4)+          ] ++ if legacyEncoding then [] else [ output 3 err <> prompt' 4 ]+    , "invalid char file input (no preceding newline)" ~: utf8Test iFileChar+        [ utf8 "a" <> raw [149] <> utf8 "x" <> raw [206] ]+            -- make sure it tries to read a newline+            -- and instead gets the incomplete 206.+            -- This should *not* cause it to crash or block.+        $ [ prompt' 0+          , output 0 (utf8 "a")+             <> prompt' 1 <> output 1 err+             <> prompt' 2 <> output 2 (utf8 "x")+             <> prompt' 3+             <> whenLegacy (output 3 err <> prompt' 4)+          ] ++ if legacyEncoding then [] else [ output 3 err <> prompt' 4 ]+     ]+    -- also single char and buffer break and other stuff+  where+    iFile = i { runInTTY = False }+    iFileChar = setCharInput iFile++-- Test that the dumb terminal backend does encoding correctly.+-- If all the above tests work for the terminfo backend,+-- then we just need to make sure the dumb term plugs into everything+-- correctly, i.e., encodes the input/output and doesn't double-encode.+dumbTests :: Invocation -> Test+dumbTests i = "dumb term" ~:+    [ "line input" ~: utf8Test i+        [ utf8 "xαβγy" ]+        [ prompt' 0, utf8 "xαβγy" ]+    , "line input wide movement" ~: utf8Test i+        [ utf8 wideChar, raw [1], raw [5] ]+        [ prompt' 0, utf8 wideChar+        , utf8 (T.replicate 60 "\b")+        , utf8 wideChar+        ]+    , "line char input" ~: utf8Test (setCharInput i)+        [utf8 "xαβ"]+        [ prompt' 0, utf8 "x" <> nl <> output 0 (utf8 "x")+          <> prompt' 1 <> utf8 "α" <> nl <> output 1 (utf8 "α")+          <> prompt' 2 <> utf8 "β" <> nl <> output 2 (utf8 "β")+          <> prompt' 3+        ]+    ]+  where+    wideChar = T.concat $ replicate 10 $ "안기영"++-------------+-- Building blocks for expected input/output++smkx,rmkx :: B.ByteString+smkx = utf8 "\ESC[?1h\ESC="+rmkx = utf8 "\ESC[?1l\ESC>"++prompt, prompt' :: Int -> B.ByteString+prompt k = smkx <> prompt' k++prompt' k = utf8 (T.pack (show k ++ ":"))++end :: B.ByteString+end = nl <> rmkx++cr :: B.ByteString+cr = raw [13]++nl :: B.ByteString+nl = raw [13,10] -- NB: see fixNL: this is really [13,13,10]++output :: Int -> B.ByteString -> B.ByteString+output k s = utf8 (T.pack $ "line " ++ show k ++ ":")+                <> s <> raw [10]++wrap :: B.ByteString+wrap = utf8 " \b"++utf8 :: T.Text -> B.ByteString+utf8 = E.encodeUtf8++raw :: [Word8] -> B.ByteString+raw = B.pack++err :: B.ByteString+err = if legacyEncoding+                then utf8 "?"+                else utf8 "\65533"++----------------------++utf8Test ::+  Invocation -> [BC.ByteString] -> [BC.ByteString] -> Test+utf8Test = testI . setUTF8++utf8TestInvalidHist ::+  Invocation -> [BC.ByteString] -> [BC.ByteString] -> Test+utf8TestInvalidHist i input output' = test $ do+    B.writeFile "myhist" $ invalidHist+    assertInvocation (setUTF8 i) input output'++utf8TestValidHist ::+  Invocation -> [BC.ByteString] -> [BC.ByteString] -> Test+utf8TestValidHist i input output' = test $ do+    B.writeFile "myhist" validHist+    assertInvocation (setUTF8 i) input output'++latin1TestInvalidHist ::+  Invocation -> [BC.ByteString] -> [BC.ByteString] -> Test+latin1TestInvalidHist i input output' = test $ do+    B.writeFile "myhist" $ invalidHist+    assertInvocation (setLatin1 i) input output'