haskeline 0.8.4.1 → 0.8.5.0

raw patch · 13 files changed

+426/−89 lines, 13 filesdep +optparse-applicativePVP ok

version bump matches the API change (PVP)

Dependencies added: optparse-applicative

API changes (from Hackage documentation)

Files

• Changelog +14/−0
• System/Console/Haskeline.hs +5/−0
• System/Console/Haskeline/Backend.hs +17/−5
• System/Console/Haskeline/Backend/Posix.hsc +113/−28
• System/Console/Haskeline/Backend/Terminfo.hs +3/−3
• System/Console/Haskeline/InputT.hs +64/−0
• System/Console/Haskeline/Internal.hs +9/−1
• System/Console/Haskeline/Key.hs +2/−1
• System/Console/Haskeline/Prefs.hs +14/−2
• examples/Test.hs +123/−26
• haskeline.cabal +2/−2
• tests/RunTTY.hs +11/−4
• tests/Unit.hs +49/−17

@@ -1,3 +1,17 @@+Changed in version 8.4.5.0:++   * System.Console.Haskeline.Internal now exposes far more internals of+     Haskeline.++   * Added `useTermHandles` and `useTermHandlesWith` Behaviors for driving+     Haskeline against caller-supplied input/output handles (e.g. a serial+     console or a PTY pair other than the controlling terminal).  POSIX only.++   * On POSIX, fixed escape sequences breaking when their bytes arrive in+     separate reads (e.g. on slow serial links).  Added `keyseqTimeoutMs`+     to `Prefs` to configure the wait, mirroring GNU Readline's+     `keyseq-timeout`.+ Changed in version 0.8.4.1:     * Implemented ; and , movements and enabled them for d, c, and y actions.

@@ -39,6 +39,10 @@                     defaultBehavior,                     useFileHandle,                     useFile,+#ifndef MINGW+                    useTermHandles,+                    useTermHandlesWith,+#endif                     preferTerm,                     -- * User interaction functions                     -- ** Reading user input@@ -60,6 +64,7 @@                     setComplete,                     -- ** User preferences                     Prefs(),+                    keyseqTimeoutMs,                     readPrefs,                     defaultPrefs,                     runInputTWithPrefs,

@@ -23,27 +23,39 @@ terminalRunTerm :: IO RunTerm terminalRunTerm = directTTY `orElse` fileHandleRunTerm stdin +#ifndef MINGW+useTermHandlesRunTerm :: Maybe String -> Handle -> Handle -> IO RunTerm+useTermHandlesRunTerm termtype input output =+    explicitTTY termtype input output `orElse` fileHandleRunTerm input+#endif+ stdinTTY :: MaybeT IO RunTerm #ifdef MINGW stdinTTY = win32TermStdin #else-stdinTTY = stdinTTYHandles >>= runDraw+stdinTTY = stdinTTYHandles >>= runDraw Nothing #endif  directTTY :: MaybeT IO RunTerm #ifdef MINGW directTTY = win32Term #else-directTTY = ttyHandles >>= runDraw+directTTY = ttyHandles >>= runDraw Nothing #endif +#ifndef MINGW+explicitTTY :: Maybe String -> Handle -> Handle -> MaybeT IO RunTerm+explicitTTY termtype input output =+    explicitTTYHandles input output >>= runDraw termtype+#endif + #ifndef MINGW-runDraw :: Handles -> MaybeT IO RunTerm+runDraw :: Maybe String -> Handles -> MaybeT IO RunTerm #ifndef TERMINFO-runDraw = runDumbTerm+runDraw _termtype = runDumbTerm #else-runDraw h = runTerminfoDraw h `mplus` runDumbTerm h+runDraw termtype h = runTerminfoDraw termtype h `mplus` runDumbTerm h #endif #endif 

@@ -11,6 +11,7 @@                         mapLines,                         stdinTTYHandles,                         ttyHandles,+                        explicitTTYHandles,                         posixRunTerm,                         fileRunTerm                  ) where@@ -201,16 +202,55 @@             = metaKey k : ks lexKeys baseMap (c:cs) = simpleChar c : lexKeys baseMap cs -lookupChars :: TreeMap Char Key -> [Char] -> Maybe (Key,[Char])-lookupChars _ [] = Nothing-lookupChars (TreeMap tm) (c:cs) = case Map.lookup c tm of-    Nothing -> Nothing-    Just (Nothing,t) -> lookupChars t cs-    Just (Just k, t@(TreeMap tm2))-                | not (null cs) && not (Map.null tm2) -- ?? lookup d tm2?-                    -> lookupChars t cs-                | otherwise -> Just (k, cs)+-- | Walk @cs@ through the tree, returning the /longest/ key found along+-- the path together with whatever bytes follow it.+--+-- If a longer match is attempted but doesn't pan out (the next byte+-- isn't in the deeper subtree), we fall back to the most recent shorter+-- key we passed.  This avoids the well-known sharp edge where input+-- like @\\ESC[AC@ — with @\\ESC[A@ registered (up-arrow) and the @A@+-- node having children that don't include @C@ — would previously be+-- reported as no match at all, instead of @up-arrow + 'C'@.+--+-- 'Nothing' is returned only when no key is reached anywhere along the+-- walk.+lookupChars :: TreeMap Char Key -> [Char] -> Maybe (Key, [Char])+lookupChars _    [] = Nothing+lookupChars tree cs = go Nothing tree cs+  where+    -- 'best' holds the longest committed match so far (or Nothing if+    -- we haven't passed a key node yet).  When the next byte doesn't+    -- extend the path we return 'best'.+    go best (TreeMap m) (c:cs') = case Map.lookup c m of+        Nothing          -> best+        Just (mKey, sub) ->+            let best' = maybe best (\k -> Just (k, cs')) mKey+            in case cs' of+                _:_ -> go best' sub cs'+                []  -> best'+    go best _ [] = best  -- unreachable: top-level [] handled above +-- | Greedily peel complete keys off the front of @cs@.  Returns the+-- decoded keys (in forward order) and the leftover bytes that didn't+-- (yet) form a complete tree match.+peelCompleteKeys :: TreeMap Char Key -> [Char] -> ([Key], [Char])+peelCompleteKeys tree = go id+  where+    go acc cs = case lookupChars tree cs of+        Just (k, rest) -> go (acc . (k:)) rest+        Nothing        -> (acc [], cs)++-- | True if @cs@ matches a /strict/ (non-terminal) prefix of some path+-- in the @TreeMap@ — i.e. it could still be extended into a complete+-- key sequence if more bytes arrive.+isStrictTreePrefix :: TreeMap Char b -> [Char] -> Bool+isStrictTreePrefix _ [] = False+isStrictTreePrefix (TreeMap m) (c:cs) = case Map.lookup c m of+    Nothing                    -> False+    Just (_, sub@(TreeMap sm)) -> case cs of+        [] -> not (Map.null sm)+        _  -> isStrictTreePrefix sub cs+ -----------------------------  withPosixGetEvent :: (MonadIO m, MonadMask m, MonadReader Prefs m)@@ -218,8 +258,9 @@                 -> (m Event -> m a) -> m a withPosixGetEvent eventChan h termKeys f = wrapTerminalOps h $ do     baseMap <- getKeySequences (ehIn h) termKeys+    timeoutMs <- asks (fromIntegral . keyseqTimeoutMs :: Prefs -> Int)     withWindowHandler eventChan-        $ f $ liftIO $ getEvent (ehIn h) baseMap eventChan+        $ f $ liftIO $ getEvent (ehIn h) timeoutMs baseMap eventChan  withWindowHandler :: (MonadIO m, MonadMask m) => TChan Event -> m a -> m a withWindowHandler eventChan = withHandler windowChange $@@ -237,27 +278,62 @@     old_handler <- liftIO $ installHandler signal handler Nothing     f `finally` liftIO (installHandler signal old_handler Nothing) -getEvent :: Handle -> TreeMap Char Key -> TChan Event -> IO Event-getEvent h baseMap = keyEventLoop $ do-        cs <- getBlockOfChars h-        return [KeyInput $ lexKeys baseMap cs]+getEvent :: Handle -> Int -> TreeMap Char Key -> TChan Event -> IO Event+getEvent h timeoutMs baseMap = keyEventLoop $ do+        ks <- getBlockOfKeys h baseMap timeoutMs+        return [KeyInput ks] --- Read at least one character of input, and more if immediately--- available.  In particular the characters making up a control sequence--- will all be available at once, so they can be processed together--- (with Posix.lexKeys).-getBlockOfChars :: Handle -> IO String-getBlockOfChars h = do+-- | Read at least one key of input, and more if available.+--+-- A multi-byte control sequence (e.g. @\\ESC[A@ for arrow-up) may not+-- arrive in a single read on a slow link such as a low-bandwidth serial+-- port: the @\\ESC@ can land before the @[A@.  When the buffer ends in+-- bytes that are a strict prefix of some known key sequence, we wait up+-- to @timeoutMs@ for the rest before returning.  Otherwise we return as+-- soon as nothing more is buffered.  This mirrors GNU Readline's+-- @keyseq-timeout@.+--+-- The loop tracks bytes and decoded keys side by side: every time we+-- run out of immediately-available input we peel complete keys from the+-- front of the byte buffer and shrink it down to just its trailing+-- (possibly partial) prefix.  That keeps the per-decision work bounded+-- by the size of the in-flight sequence rather than the whole accrued+-- buffer, which matters when bytes trickle in slowly.+--+-- Win32 is unaffected: that backend reads structured @INPUT_RECORD@+-- key events rather than raw bytes, so escape sequences are never+-- fragmented in the first place.+getBlockOfKeys :: Handle -> TreeMap Char Key -> Int -> IO [Key]+getBlockOfKeys h baseMap timeoutMs = do     c <- hGetChar h-    loop [c]+    loop [c] []   where-    loop cs = do-        isReady <- hReady h-        if not isReady-            then return $ reverse cs-            else do-                    c <- hGetChar h-                    loop (c:cs)+    -- Both lists hold values in reverse (newest first) so that consing a+    -- new element is O(1).  We reverse only at decision points or on+    -- return.+    loop bytesRev keysRev = do+        ready <- hWaitForInput h 0+        if ready+            then do+                c <- hGetChar h+                loop (c:bytesRev) keysRev+            else+                -- Drain whatever complete keys are sitting at the head of+                -- the byte buffer; what's left is either empty (done) or a+                -- still-in-flight partial sequence.+                let (peeled, partial) = peelCompleteKeys baseMap (reverse bytesRev)+                    keysRev'          = reverse peeled ++ keysRev+                in if null partial+                    then pure (reverse keysRev')+                    else if isStrictTreePrefix baseMap partial+                        then do+                            arrived <- hWaitForInput h timeoutMs+                            if arrived+                                then do+                                    c <- hGetChar h+                                    loop (c : reverse partial) keysRev'+                                else pure (reverse keysRev' ++ lexKeys baseMap partial)+                        else pure (reverse keysRev' ++ lexKeys baseMap partial)  stdinTTYHandles, ttyHandles :: MaybeT IO Handles stdinTTYHandles = do@@ -286,6 +362,15 @@ openTerm mode = handle (\(_::IOException) -> mzero)             $ liftIO $ openInCodingMode "/dev/tty" mode +explicitTTYHandles :: Handle -> Handle -> MaybeT IO Handles+explicitTTYHandles h_in h_out = do+    isInTerm <- liftIO $ hIsTerminalDevice h_in+    guard isInTerm+    return Handles+            { hIn = externalHandle h_in+            , hOut = externalHandle h_out+            , closeHandles = return ()+            }  posixRunTerm ::     Handles

@@ -125,9 +125,9 @@                             . unDraw    -runTerminfoDraw :: Handles -> MaybeT IO RunTerm-runTerminfoDraw h = do-    mterm <- liftIO $ Exception.try setupTermFromEnv+runTerminfoDraw :: Maybe String -> Handles -> MaybeT IO RunTerm+runTerminfoDraw termtype h = do+    mterm <- liftIO $ Exception.try $ maybe setupTermFromEnv setupTerm termtype     case mterm of         Left (_::SetupTermError) -> mzero         Right term -> do

@@ -216,6 +216,70 @@ preferTerm :: Behavior preferTerm = Behavior terminalRunTerm +#ifndef MINGW+-- | Use terminal-style interaction on the given input and output handles,+-- taking the terminal type from the @TERM@ environment variable.+--+-- This behavior is for driving Haskeline against a terminal that is not the+-- process's controlling terminal — for example, a serial console, a PTY pair+-- you opened yourself, or a socket-backed TTY.  The caller is responsible for+-- closing @input@ and @output@ after use.  Not available on Windows.+--+-- See 'useTermHandlesWith' to override the terminal type.+useTermHandles :: Handle -> Handle -> Behavior+useTermHandles input output =+    Behavior $ useTermHandlesRunTerm Nothing input output++-- | Like 'useTermHandles', but with the terminal type given explicitly+-- (e.g. @\"xterm-256color\"@ or @\"vt100\"@) instead of read from the @TERM@+-- environment variable.+--+-- The terminal type is only consulted when haskeline is built with terminfo+-- support; in non-terminfo builds it is ignored and a dumb terminal is used.+--+-- ==== __Example: a Haskeline session over a WebSocket__+--+-- Bridge a WebSocket to the master end of a PTY pair and run Haskeline+-- against the slave end.  Uses the @websockets@ and @unix@ packages.+-- Pair this with a browser-side terminal emulator such as+-- <https://xtermjs.org/ Xterm.js> for an in-browser shell.+--+-- > import qualified Network.WebSockets as WS+-- > import System.Posix.Terminal (openPseudoTerminal)+-- > import System.Posix.IO (dup, fdToHandle)+-- > import Control.Applicative ((<|>))+-- > import Control.Concurrent.Async (Concurrently(..), runConcurrently)+-- > import Control.Monad (forever)+-- > import qualified Data.ByteString as BS+-- > import System.IO (hSetBuffering, BufferMode(..))+-- > import System.Console.Haskeline+-- >+-- > websocketUI :: WS.Connection -> IO ()+-- > websocketUI conn = do+-- >     (master, slave) <- openPseudoTerminal+-- >     slaveDup <- dup slave+-- >     masterH  <- fdToHandle master+-- >     slaveIn  <- fdToHandle slave+-- >     slaveOut <- fdToHandle slaveDup+-- >     hSetBuffering masterH NoBuffering+-- >     -- Whichever of the three actions finishes first cancels the others.+-- >     runConcurrently+-- >         $   Concurrently (forever $ WS.receiveData conn >>= BS.hPut masterH)+-- >         <|> Concurrently (forever $ BS.hGetSome masterH 4096 >>= WS.sendBinaryData conn)+-- >         <|> Concurrently (runInputTBehavior+-- >                              (useTermHandlesWith "vt100" slaveIn slaveOut)+-- >                              defaultSettings loop)+-- >   where+-- >     loop = do+-- >         minput <- getInputLine "% "+-- >         case minput of+-- >             Nothing     -> return ()+-- >             Just "quit" -> return ()+-- >             Just s      -> outputStrLn ("got: " ++ s) >> loop+useTermHandlesWith :: String -> Handle -> Handle -> Behavior+useTermHandlesWith termtype input output =+    Behavior $ useTermHandlesRunTerm (Just termtype) input output+#endif  -- | Read 'Prefs' from @$XDG_CONFIG_HOME/haskeline/haskeline@ if present -- ortherwise @~/.haskeline.@ If there is an error reading the file,

@@ -1,5 +1,12 @@+-- | A module containing semi-public internals. The functions here are not+-- stable. module System.Console.Haskeline.Internal-    ( debugTerminalKeys ) where+    ( module System.Console.Haskeline.Monads+    , module System.Console.Haskeline.Term+    , module System.Console.Haskeline.Key+    , module System.Console.Haskeline.LineState+    , Behavior (..)+    , debugTerminalKeys ) where  import System.Console.Haskeline (defaultSettings, outputStrLn) import System.Console.Haskeline.Command@@ -8,6 +15,7 @@ import System.Console.Haskeline.Monads import System.Console.Haskeline.RunCommand import System.Console.Haskeline.Term+import System.Console.Haskeline.Key  import Control.Monad ((>=>)) 

@@ -8,7 +8,8 @@             ctrlChar,             metaKey,             ctrlKey,-            parseKey+            parseKey,+            setControlBits             ) where  import Data.Bits

@@ -14,6 +14,7 @@ import Data.Char(isSpace,toLower) import Data.List(foldl') import qualified Data.Map as Map+import Data.Word (Word) import System.Console.Haskeline.Key  {- |@@ -48,7 +49,16 @@                         -- presses @TAB@ again.                      customBindings :: Map.Map Key [Key],                         -- (termName, keysequence, key)-                     customKeySequences :: [(Maybe String, String,Key)]+                     customKeySequences :: [(Maybe String, String,Key)],+                     keyseqTimeoutMs :: !Word+                        -- ^ After an @ESC@ byte is read, how long to wait+                        -- (in milliseconds) for the rest of an escape+                        -- sequence before treating the @ESC@ as a+                        -- standalone keypress.  Matters on slow links+                        -- (e.g. low-bandwidth serial), where the bytes of+                        -- a sequence such as @\\ESC[A@ may not arrive in+                        -- a single read.  Mirrors GNU Readline's+                        -- @keyseq-timeout@.                      }                         deriving Show @@ -77,7 +87,8 @@                       listCompletionsImmediately = True,                       historyDuplicates = AlwaysAdd,                       customBindings = Map.empty,-                      customKeySequences = []+                      customKeySequences = [],+                      keyseqTimeoutMs = 50                     }  mkSettor :: Read a => (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs@@ -98,6 +109,7 @@           ,("completionpromptlimit", mkSettor $ \x p -> p {completionPromptLimit = x})           ,("listcompletionsimmediately", mkSettor $ \x p -> p {listCompletionsImmediately = x})           ,("historyduplicates", mkSettor $ \x p -> p {historyDuplicates = x})+          ,("keyseqtimeoutms", mkSettor $ \x p -> p {keyseqTimeoutMs = x})           ,("bind", addCustomBinding)           ,("keyseq", addCustomKeySequence)           ]

@@ -1,41 +1,138 @@+{-# LANGUAGE CPP #-} module Main where  import System.Console.Haskeline-import System.Environment+import Options.Applicative+import Data.Monoid ((<>))+#ifndef MINGW+import System.IO (openFile, hClose, IOMode(..))+#endif  {-- Testing the line-input functions and their interaction with ctrl-c signals.  Usage:-./Test          (line input)-./Test chars    (character input)-./Test password (no masking characters)-./Test password \*-./Test initial  (use initial text in the prompt)+  ./Test                                  (line input, default Behavior)+  ./Test chars                            (character input)+  ./Test password                         (no masking)+  ./Test password \*                      (masking with '*')+  ./Test initial                          (initial text in the prompt)++  ./Test --mode useTermHandles            (POSIX only)+  ./Test --mode useTermHandlesWith --term-type vt100+                                          (POSIX only)++The --mode flag selects the haskeline Behavior; positional INPUT_ARG+selects which prompt function to use, and works with any --mode. --} +data Mode+    = UseTerm                    -- ^ defaultBehavior+    | UseTermHandles             -- ^ useTermHandles on /dev/tty+    | UseTermHandlesWith String  -- ^ useTermHandlesWith TERM on /dev/tty++data InputMode+    = LineInput+    | CharInput+    | PasswordInput (Maybe Char)+    | InitialInput++data Opts = Opts { optMode :: Mode, optInput :: InputMode }+ mySettings :: Settings IO mySettings = defaultSettings {historyFile = Just "myhist"}  main :: IO () main = do-        args <- getArgs-        let inputFunc = case args of-                ["chars"] -> fmap (fmap (\c -> [c])) . getInputChar-                ["password"] -> getPassword Nothing-                ["password", [c]] -> getPassword (Just c)-                ["initial"] -> flip getInputLineWithInitial ("left ", "right")-                _ -> getInputLine-        runInputT mySettings $ withInterrupt $ loop inputFunc 0-    where-        loop :: (String -> InputT IO (Maybe String)) -> Int -> InputT IO ()-        loop inputFunc n = do-            minput <-  handleInterrupt (return (Just "Caught interrupted"))-                        $ inputFunc (show n ++ ":")-            case minput of-                Nothing -> return ()-                Just "quit" -> return ()-                Just "q" -> return ()-                Just s -> do-                            outputStrLn ("line " ++ show n ++ ":" ++ s)-                            loop inputFunc (n+1)+    Opts {optMode = m, optInput = im} <- execParser optsInfo+    case m of+        UseTerm ->+            runInputT mySettings (runAction im)+#ifndef MINGW+        UseTermHandles ->+            runWithHandles Nothing im+        UseTermHandlesWith t ->+            runWithHandles (Just t) im+#else+        _ -> error "useTermHandles[With] is not available on Windows"+#endif++runAction :: InputMode -> InputT IO ()+runAction im = withInterrupt $ loop (inputFunc im) 0++inputFunc :: InputMode -> String -> InputT IO (Maybe String)+inputFunc LineInput          = getInputLine+inputFunc CharInput          = fmap (fmap (\c -> [c])) . getInputChar+inputFunc (PasswordInput mc) = getPassword mc+inputFunc InitialInput       = flip getInputLineWithInitial ("left ", "right")++loop :: (String -> InputT IO (Maybe String)) -> Int -> InputT IO ()+loop f n = do+    minput <- handleInterrupt (return (Just "Caught interrupted"))+                $ f (show n ++ ":")+    case minput of+        Nothing     -> return ()+        Just "quit" -> return ()+        Just "q"    -> return ()+        Just s      -> do+            outputStrLn ("line " ++ show n ++ ":" ++ s)+            loop f (n+1)++#ifndef MINGW+-- Drive Haskeline against /dev/tty (the controlling terminal) via the+-- useTermHandles[With] Behaviors.  This still happens to be the controlling+-- tty in our test setup, but it goes through the new code path.+runWithHandles :: Maybe String -> InputMode -> IO ()+runWithHandles mTerm im = do+    input  <- openFile "/dev/tty" ReadMode+    output <- openFile "/dev/tty" WriteMode+    let beh = case mTerm of+            Nothing -> useTermHandles input output+            Just t  -> useTermHandlesWith t input output+    runInputTBehavior beh mySettings (runAction im)+    hClose input+    hClose output+#endif++----------------------------------------------------------------+-- Command-line parsing++optsInfo :: ParserInfo Opts+optsInfo = info (optsP <**> helper)+                (fullDesc <> progDesc "Haskeline test program")++optsP :: Parser Opts+optsP = Opts <$> modeP <*> inputModeP++modeP :: Parser Mode+modeP = mkMode+    <$> strOption+            ( long "mode"+           <> value "useTerm"+           <> showDefault+           <> metavar "MODE"+           <> help "useTerm | useTermHandles | useTermHandlesWith" )+    <*> optional+            (strOption+                ( long "term-type"+               <> metavar "TERM"+               <> help "term type for --mode useTermHandlesWith" ))+  where+    mkMode "useTerm"            _         = UseTerm+    mkMode "useTermHandles"     _         = UseTermHandles+    mkMode "useTermHandlesWith" (Just t)  = UseTermHandlesWith t+    mkMode "useTermHandlesWith" Nothing   =+        error "--mode useTermHandlesWith requires --term-type"+    mkMode other                _         =+        error ("unknown --mode: " ++ other)++inputModeP :: Parser InputMode+inputModeP = mkInput <$> many (argument str (metavar "INPUT_ARG"))+  where+    mkInput []                  = LineInput+    mkInput ["chars"]           = CharInput+    mkInput ["password"]        = PasswordInput Nothing+    mkInput ["password", [c]]   = PasswordInput (Just c)+    mkInput ["initial"]         = InitialInput+    mkInput xs                  =+        error ("unrecognized positional args: " ++ show xs)

@@ -1,6 +1,6 @@ Name:           haskeline Cabal-Version:  >=1.10-Version:        0.8.4.1+Version:        0.8.5.0 Category:       User Interfaces License:        BSD3 License-File:   LICENSE@@ -169,7 +169,7 @@     if !flag(examples) {         buildable: False     }-    Build-depends: base, containers, haskeline+    Build-depends: base, containers, haskeline, optparse-applicative     Default-Language: Haskell2010     hs-source-dirs: examples     Main-Is: Test.hs

@@ -23,11 +23,18 @@  data Invocation = Invocation {             prog :: FilePath-            , progArgs :: [String]+              -- | Mode-selection flags passed before any positional args+              -- (e.g. @[\"--mode\", \"useTermHandles\"]@).+            , progModeArgs :: [String]+              -- | Positional input-mode args (e.g. @[\"chars\"]@).+            , progInputArgs :: [String]             , runInTTY :: Bool             , environment :: [(String,String)]             } +progArgs :: Invocation -> [String]+progArgs Invocation{..} = progModeArgs ++ progInputArgs+ setEnv :: String -> String -> Invocation -> Invocation setEnv var val Invocation {..} = Invocation{         environment = (var,val) : Prelude.filter ((/=var).fst) environment@@ -51,11 +58,11 @@                         -- simulate real user input and prevent Haskeline                         -- from coalescing the changes.)         -> IO [B.ByteString]-runInvocation Invocation {..} inputs-    | runInTTY = runCommandInPty prog progArgs (Just environment) inputs+runInvocation inv@Invocation {..} inputs+    | runInTTY = runCommandInPty prog (progArgs inv) (Just environment) inputs     | otherwise = do     (Just inH, Just outH, Nothing, ph)-        <- createProcess (proc prog progArgs)+        <- createProcess (proc prog (progArgs inv))                             { env = Just environment                             , std_in = CreatePipe                             , std_out = CreatePipe

@@ -49,24 +49,55 @@     let i = setTerm "xterm"             Invocation {                 prog = p,-                progArgs = [],+                progModeArgs = [],+                progInputArgs = [],                 runInTTY = True,                 environment = []             }     makeTestFiles-    result <- runTestTT $ test [interactionTests i, fileStyleTests i]+    result <- runTestTT $ test+        [ interactionTests UseTerm i+        , interactionTests UseTermHandles i+        , interactionTests (UseTermHandlesWith "xterm") i+        -- dumbTests sets TERM=dumb in env to drive Haskeline into the dumb+        -- backend.  That works for UseTerm and UseTermHandles (both consult+        -- env), but not for UseTermHandlesWith — it ignores env and uses its+        -- explicit term type — so we skip it for that mode.+        , dumbTests UseTerm i+        , dumbTests UseTermHandles 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+-- | Which haskeline Behavior the test program should run under.+data Mode+    = UseTerm                     -- ^ runInputT (defaultBehavior)+    | UseTermHandles              -- ^ useTermHandles on /dev/tty+    | UseTermHandlesWith String   -- ^ useTermHandlesWith TERM on /dev/tty++modeName :: Mode -> String+modeName UseTerm                 = "useTerm"+modeName UseTermHandles          = "useTermHandles"+modeName (UseTermHandlesWith t)  = "useTermHandlesWith=" ++ t++setMode :: Mode -> Invocation -> Invocation+setMode m i = i { progModeArgs = modeArgs m }+  where+    modeArgs UseTerm                 = []+    modeArgs UseTermHandles          = ["--mode", "useTermHandles"]+    modeArgs (UseTermHandlesWith t)  = ["--mode", "useTermHandlesWith", "--term-type", t]++interactionTests :: Mode -> Invocation -> Test+interactionTests m i = ("interaction (" ++ modeName m ++ ")") ~: test+    [ unicodeEncoding ii+    , unicodeMovement ii+    , tabCompletion ii+    , incorrectInput ii+    , historyTests ii+    , inputChar $ setCharInput ii     ]+  where+    ii = setMode m i  unicodeEncoding :: Invocation -> Test unicodeEncoding i = "Unicode encoding (valid)" ~:@@ -195,7 +226,7 @@     ]  setCharInput :: Invocation -> Invocation-setCharInput i = i { progArgs = ["chars"] }+setCharInput i = i { progInputArgs = ["chars"] }   fileStyleTests :: Invocation -> Test@@ -255,18 +286,18 @@ -- 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+dumbTests :: Mode -> Invocation -> Test+dumbTests m i = ("dumb term (" ++ modeName m ++ ")") ~:+    [ "line input" ~: utf8Test ii         [ utf8 "xαβγy" ]         [ prompt' 0, utf8 "xαβγy" ]-    , "line input wide movement" ~: utf8Test i+    , "line input wide movement" ~: utf8Test ii         [ utf8 wideChar, raw [1], raw [5] ]         [ prompt' 0, utf8 wideChar         , utf8 (T.replicate 60 "\b")         , utf8 wideChar         ]-    , "line char input" ~: utf8Test (setCharInput i)+    , "line char input" ~: utf8Test (setCharInput ii)         [utf8 "xαβ"]         [ prompt' 0, utf8 "x" <> dumbnl <> output 0 (utf8 "x")           <> prompt' 1 <> utf8 "α" <> dumbnl <> output 1 (utf8 "α")@@ -275,6 +306,7 @@         ]     ]   where+    ii = setMode m $ setTerm "dumb" i     dumbnl = raw [13,10]     wideChar = T.concat $ replicate 10 $ "안기영"