haskeline 0.6.2.4 → 0.6.3

raw patch · 21 files changed

+643/−316 lines, 21 filesdep ~containerssetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: containers

API changes (from Hackage documentation)

Files

• CHANGES +14/−0
• Setup.hs +8/−3
• System/Console/Haskeline.hs +97/−95
• System/Console/Haskeline/Backend.hs +35/−8
• System/Console/Haskeline/Backend/DumbTerm.hs +7/−6
• System/Console/Haskeline/Backend/Posix.hsc +94/−73
• System/Console/Haskeline/Backend/Terminfo.hs +11/−11
• System/Console/Haskeline/Backend/WCWidth.hs +2/−2
• System/Console/Haskeline/Backend/Win32.hsc +78/−58
• System/Console/Haskeline/Command.hs +1/−1
• System/Console/Haskeline/Command/History.hs +2/−2
• System/Console/Haskeline/Completion.hs +26/−9
• System/Console/Haskeline/InputT.hs +95/−12
• System/Console/Haskeline/LineState.hs +46/−8
• System/Console/Haskeline/Monads.hs +27/−1
• System/Console/Haskeline/Prefs.hs +1/−1
• System/Console/Haskeline/RunCommand.hs +13/−11
• System/Console/Haskeline/Term.hs +79/−12
• System/Console/Haskeline/Vi.hs +1/−1
• examples/Test.hs +4/−0
• haskeline.cabal +2/−2

@@ -1,3 +1,17 @@+Changed in version 0.6.3:+   * #111: Correct width calculations when the prompt contains newlines.++   * #109: Add function completeWordWithPrev.++   * #101, #44: Extend the API with Behaviors, which control the choice between+     terminal-style and file-style interaction.++   * #78: Correct width calculations for escape sequences ("\ESC...\STX")++   * Better warning message when -fterminfo doesn't work.++   * Added getPassword as a new input function.+ Changed in version 0.6.2.4:    * Added back a MonadException instance for mtl's StateT. 

@@ -106,6 +106,11 @@     , "}"     ]     -warnIfNotTerminfo flags = when (not (hasFlagSet flags (FlagName "terminfo"))) $-  putStrLn $-    "*** Warning: running on POSIX but not building the terminfo backend. ***"+warnIfNotTerminfo flags = when (not (hasFlagSet flags (FlagName "terminfo")))+    $ mapM_ putStrLn+    [ "*** Warning: running on POSIX but not building the terminfo backend. ***"+    , "You may need to install the terminfo package manually, e.g. with"+    , "\"cabal install terminfo\"; or, use \"-fterminfo\" when configuring or"+    , "installing this package."+    ,""+    ]

@@ -6,7 +6,7 @@ Users may customize the interface with a @~/.haskeline@ file; see <http://trac.haskell.org/haskeline/wiki/UserPrefs> for more information. -An example use of this library for a simple read-eval-print loop is the+An example use of this library for a simple read-eval-print loop (REPL) is the following:  > import System.Console.Haskeline@@ -27,27 +27,39 @@   module System.Console.Haskeline(-                    -- * Main functions+                    -- * Interactive sessions                     -- ** The InputT monad transformer                     InputT,                     runInputT,-                    runInputTWithPrefs,+                    haveTerminalUI,+                    -- ** Behaviors+                    Behavior,+                    runInputTBehavior,+                    defaultBehavior,+                    useFileHandle,+                    useFile,+                    preferTerm,+                    -- * User interaction functions                     -- ** Reading user input                     -- $inputfncs                     getInputLine,                     getInputChar,+                    getPassword,                     -- ** Outputting text                     -- $outputfncs                     outputStr,                     outputStrLn,-                    -- * Settings+                    -- * Customization+                    -- ** Settings                     Settings(..),                     defaultSettings,                     setComplete,-                    -- * User preferences+                    -- ** User preferences                     Prefs(),                     readPrefs,                     defaultPrefs,+                    runInputTWithPrefs,+                    runInputTBehaviorWithPrefs,                     -- * Ctrl-C handling                     -- $ctrlc                     Interrupt(..),@@ -73,9 +85,6 @@  import System.IO import Data.Char (isSpace, isPrint)-import Control.Monad-import qualified Data.ByteString.Char8 as B-import System.IO.Error (isEOFError)   -- | A useful default.  In particular:@@ -93,17 +102,17 @@                         autoAddHistory = True}  {- $outputfncs-The following functions allow cross-platform output of text that may contain+The following functions enable cross-platform output of text that may contain Unicode characters. -} --- | Write a string to the standard output.+-- | Write a Unicode string to the user's standard output. outputStr :: MonadIO m => String -> InputT m () outputStr xs = do     putter <- asks putStrOut     liftIO $ putter xs --- | Write a string to the standard output, followed by a newline.+-- | Write a string to the user's standard output, followed by a newline. outputStrLn :: MonadIO m => String -> InputT m () outputStrLn = outputStr . (++ "\n") @@ -111,43 +120,30 @@ {- $inputfncs The following functions read one line or character of input from the user. -If 'stdin' is connected to a terminal, then these functions perform all user interaction,-including display of the prompt text, on the user's output terminal (which may differ from-'stdout').-They return 'Nothing' if the user pressed @Ctrl-D@ when the-input text was empty.+When using terminal-style interaction, these functions return 'Nothing' if the user+pressed @Ctrl-D@ when the input text was empty. -If 'stdin' is not connected to a terminal or does not have echoing enabled,-then these functions print the prompt to 'stdout',-and they return 'Nothing' if an @EOF@ was encountered before any characters were read.+When using file-style interaction, these functions return 'Nothing' if+an @EOF@ was encountered before any characters were read. -}  -{- | Reads one line of input.  The final newline (if any) is removed.  Provides a rich-line-editing user interface if 'stdin' is a terminal.+{- | Reads one line of input.  The final newline (if any) is removed.  When using terminal-style interaction, this function provides a rich line-editing user interface.  If @'autoAddHistory' == 'True'@ and the line input is nonblank (i.e., is not all spaces), it will be automatically added to the history. -}-getInputLine :: forall m . MonadException m => String -- ^ The input prompt+getInputLine :: MonadException m => String -- ^ The input prompt                             -> InputT m (Maybe String)-getInputLine prefix = do-    -- If other parts of the program have written text, make sure that it -    -- appears before we interact with the user on the terminal.-    liftIO $ hFlush stdout-    rterm <- ask-    echo <- liftIO $ hGetEcho stdin-    case termOps rterm of-        Just tops | echo -> getInputCmdLine tops prefix-        _ -> simpleFileLoop prefix rterm+getInputLine = promptedInput getInputCmdLine $ unMaybeT . getLocaleLine  getInputCmdLine :: MonadException m => TermOps -> String -> InputT m (Maybe String) getInputCmdLine tops prefix = do     emode <- asks editMode     result <- runInputCmdT tops $ case emode of-                Emacs -> runCommandLoop tops prefix emacsCommands+                Emacs -> runCommandLoop tops prefix emacsCommands emptyIM                 Vi -> evalStateT' emptyViState $-                        runCommandLoop tops prefix viKeyCommands+                        runCommandLoop tops prefix viKeyCommands emptyIM     maybeAddHistory result     return result @@ -164,80 +160,33 @@                in modify (adder line)         _ -> return () -simpleFileLoop :: MonadIO m => String -> RunTerm -> m (Maybe String)-simpleFileLoop prefix rterm = liftIO $ do-    putStrOut rterm prefix-    atEOF <- hIsEOF stdin-    if atEOF-        then return Nothing-        else do-            -- It's more efficient to use B.getLine, but that function throws an-            -- error if stdin is set to NoBuffering.-            buff <- hGetBuffering stdin-            line <- case buff of-                        NoBuffering -> hWithBinaryMode stdin-                                $ fmap B.pack System.IO.getLine-                        _ -> B.getLine-            fmap Just $ decodeForTerm rterm line-- ----------  {- | Reads one character of input.  Ignores non-printable characters. -If stdin is a terminal, the character will be read without waiting for a newline.+When using terminal-style interaction, the character will be read without waiting+for a newline. -If stdin is not a terminal, a newline will be read if it is immediately+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                     -> InputT m (Maybe Char)-getInputChar prefix = do-    liftIO $ hFlush stdout-    rterm <- ask-    echo <- liftIO $ hGetEcho stdin-    case termOps rterm of-        Just tops | echo -> getInputCmdChar tops prefix-        _ -> simpleFileChar prefix rterm--simpleFileChar :: MonadIO m => String -> RunTerm -> m (Maybe Char)-simpleFileChar prefix rterm = liftIO $ do-    putStrOut rterm prefix-    c <- getPrintableChar-    maybeReadNewline-    return c-  where-    getPrintableChar = returnOnEOF Nothing $ do-                c <- getLocaleChar rterm-                if isPrint c-                    then return (Just c)-                    else getPrintableChar---- If another character is immediately available, and it is a newline, consume it.------ Note that in ghc-6.8.3 and earlier, hReady returns False at an EOF,--- whereas in ghc-6.10.1 and later it throws an exception.  (GHC trac #1063).--- This code handles both of those cases.------ Also note that on Windows with ghc<6.10, hReady may not behave correctly (#1198)--- The net result is that this might cause--- But this function will generally only be used when reading buffered input--- (since stdin isn't a terminal), so it should probably be OK.-maybeReadNewline :: IO ()-maybeReadNewline = returnOnEOF () $ do-    ready <- hReady stdin-    when ready $ do-        c <- hLookAhead stdin-        when (c == '\n') $ getChar >> return ()--returnOnEOF :: a -> IO a -> IO a-returnOnEOF x = handle $ \e -> if isEOFError e-                                then return x-                                else throwIO e+getInputChar = promptedInput getInputCmdChar $ \fops -> do+                        c <- getPrintableChar fops+                        maybeReadNewline fops+                        return c +getPrintableChar :: FileOps -> IO (Maybe Char)+getPrintableChar fops = do+    c <- unMaybeT $ getLocaleChar fops+    case fmap isPrint c of+        Just False -> getPrintableChar fops+        _ -> return c+         getInputCmdChar :: MonadException m => TermOps -> String -> InputT m (Maybe Char) getInputCmdChar tops prefix = runInputCmdT tops -        $ runCommandLoop tops prefix acceptOneChar+        $ runCommandLoop tops prefix acceptOneChar emptyIM  acceptOneChar :: Monad m => KeyCommand m InsertMode (Maybe Char) acceptOneChar = choiceCmd [useChar $ \c s -> change (insertChar c) s@@ -245,6 +194,59 @@                           , ctrlChar 'l' +> clearScreenCmd >|>                                         keyCommand acceptOneChar                           , ctrlChar 'd' +> failCmd]++----------+-- Passwords++{- | Reads one line of input, without displaying the input while it is being typed.+When using terminal-style interaction, the masking character (if given) will replace each typed character.++When using file-style interaction, this function turns off echoing while reading+the line of input.+-}+ +getPassword :: MonadException m => Maybe Char -- ^ A masking character; e.g., @Just \'*\'@+                            -> String -> InputT m (Maybe String)+getPassword x = promptedInput+                    (\tops prefix -> runInputCmdT tops+                                        $ runCommandLoop tops prefix loop+                                        $ Password [] x)+                    (\fops -> let h_in = inputHandle fops+                              in bracketSet (hGetEcho h_in) (hSetEcho h_in) False+                                  $ unMaybeT $ getLocaleLine fops)+ where+    loop = choiceCmd [ simpleChar '\n' +> finish+                     , simpleKey Backspace +> change deletePasswordChar+                                                >|> loop'+                     , useChar $ \c -> change (addPasswordChar c) >|> loop'+                     , ctrlChar 'd' +> \p -> if null (passwordState p)+                                                then failCmd p+                                                else finish p+                     , ctrlChar 'l' +> clearScreenCmd >|> loop'+                     ]+    loop' = keyCommand loop+                        +++-------+-- | Wrapper for input functions.+promptedInput :: MonadIO m => (TermOps -> String -> InputT m a)+                        -> (FileOps -> IO a)+                        -> String -> InputT m a+promptedInput doTerm doFile prompt = do+    -- If other parts of the program have written text, make sure that it+    -- appears before we interact with the user on the terminal.+    liftIO $ hFlush stdout+    rterm <- ask+    case termOps rterm of+        Right fops -> liftIO $ do+                        putStrOut rterm prompt+                        doFile fops+        Left tops -> do+            -- If the prompt contains newlines, print all but the last line.+            let (lastLine,rest) = break (`elem` "\r\n") $ reverse prompt+            outputStr $ reverse rest+            doTerm tops $ reverse lastLine  ------------ -- Interrupt

@@ -1,28 +1,55 @@ module System.Console.Haskeline.Backend where  import System.Console.Haskeline.Term+import System.Console.Haskeline.Monads+import Control.Monad+import System.IO (stdin, hGetEcho, Handle)  #ifdef MINGW import System.Console.Haskeline.Backend.Win32 as Win32 #else+import System.Console.Haskeline.Backend.Posix as Posix #ifdef TERMINFO import System.Console.Haskeline.Backend.Terminfo as Terminfo #endif import System.Console.Haskeline.Backend.DumbTerm as DumbTerm #endif -myRunTerm :: IO RunTerm +defaultRunTerm :: IO RunTerm+defaultRunTerm = (liftIO (hGetEcho stdin) >>= guard >> stdinTTY)+                    `orElse` fileHandleRunTerm stdin++terminalRunTerm :: IO RunTerm+terminalRunTerm = directTTY `orElse` fileHandleRunTerm stdin++stdinTTY :: MaybeT IO RunTerm #ifdef MINGW-myRunTerm = win32Term+stdinTTY = win32TermStdin #else+stdinTTY = stdinTTYHandles >>= runDraw+#endif++directTTY :: MaybeT IO RunTerm+#ifdef MINGW+directTTY = win32Term+#else+directTTY = ttyHandles >>= runDraw+#endif+++#ifndef MINGW+runDraw :: Handles -> MaybeT IO RunTerm #ifndef TERMINFO-myRunTerm = runDumbTerm+runDraw = runDumbTerm #else-myRunTerm = do-    mRun <- runTerminfoDraw-    case mRun of -        Nothing -> runDumbTerm-        Just run -> return run+runDraw h = runTerminfoDraw h `mplus` runDumbTerm h #endif+#endif++fileHandleRunTerm :: Handle -> IO RunTerm+#ifdef MINGW+fileHandleRunTerm = Win32.fileRunTerm+#else+fileHandleRunTerm = Posix.fileRunTerm #endif

@@ -9,6 +9,7 @@ import System.IO import qualified Data.ByteString as B import Control.Concurrent.Chan+import Control.Monad(liftM)  -- TODO:  ---- Put "<" and ">" at end of term if scrolls off.@@ -23,17 +24,17 @@ newtype DumbTerm m a = DumbTerm {unDumbTerm :: StateT Window (PosixT m) a}                 deriving (Monad, MonadIO, MonadException,                           MonadState Window,-                          MonadReader Handle, MonadReader Encoders)+                          MonadReader Handles, MonadReader Encoders)  type DumbTermM a = forall m . (MonadIO m, MonadReader Layout m) => DumbTerm m a  instance MonadTrans DumbTerm where     lift = DumbTerm . lift . lift . lift -runDumbTerm :: IO RunTerm-runDumbTerm = do-    ch <- newChan-    posixRunTerm $ \enc h ->+runDumbTerm :: Handles -> MaybeT IO RunTerm+runDumbTerm h = do+    ch <- liftIO newChan+    posixRunTerm h $ \enc ->                 TermOps {                         getLayout = tryGetLayouts (posixLayouts h)                         , withGetEvent = withPosixGetEvent ch h enc []@@ -55,7 +56,7 @@        printText :: MonadIO m => String -> DumbTerm m () printText str = do-    h <- ask+    h <- liftM hOut ask     posixEncode str >>= liftIO . B.hPutStr h     liftIO $ hFlush h 

@@ -4,10 +4,14 @@                         tryGetLayouts,                         PosixT,                         runPosixT,+                        Handles(..),                         Encoders(),                         posixEncode,                         mapLines,-                        posixRunTerm+                        stdinTTYHandles,+                        ttyHandles,+                        posixRunTerm,+                        fileRunTerm                  ) where  import Foreign@@ -18,16 +22,15 @@ import Control.Concurrent hiding (throwTo) import Data.Maybe (catMaybes) import System.Posix.Signals.Exts-import System.Posix.IO(stdInput)+import System.Posix.Types(Fd(..)) import Data.List import System.IO import qualified Data.ByteString as B-import Data.ByteString.Char8 as Char8 (pack) import System.Environment  import System.Console.Haskeline.Monads import System.Console.Haskeline.Key-import System.Console.Haskeline.Term+import System.Console.Haskeline.Term as Term import System.Console.Haskeline.Prefs  import System.Console.Haskeline.Backend.IConv@@ -50,13 +53,18 @@ #endif #include <sys/ioctl.h> +-----------------------------------------------+-- Input/output handles+data Handles = Handles {hIn, hOut :: Handle,+                        closeHandles :: IO ()}+ ------------------- -- Window size  foreign import ccall ioctl :: FD -> CULong -> Ptr a -> IO CInt -posixLayouts :: Handle -> [IO (Maybe Layout)]-posixLayouts h = [ioctlLayout h, envLayout]+posixLayouts :: Handles -> [IO (Maybe Layout)]+posixLayouts h = [ioctlLayout $ hOut h, envLayout]  ioctlLayout :: Handle -> IO (Maybe Layout) ioctlLayout h = allocaBytes (#size struct winsize) $ \ws -> do@@ -101,9 +109,9 @@ -- Key sequences  getKeySequences :: (MonadIO m, MonadReader Prefs m)-        => [(String,Key)] -> m (TreeMap Char Key)-getKeySequences tinfos = do-    sttys <- liftIO sttyKeys+        => Handles -> [(String,Key)] -> m (TreeMap Char Key)+getKeySequences h tinfos = do+    sttys <- liftIO $ sttyKeys h     customKeySeqs <- getCustomKeySeqs     -- note ++ acts as a union; so the below favors sttys over tinfos     return $ listToTree@@ -142,9 +150,10 @@             ]  -sttyKeys :: IO [(String, Key)]-sttyKeys = do-    attrs <- getTerminalAttributes stdInput+sttyKeys :: Handles -> IO [(String, Key)]+sttyKeys h = do+    fd <- unsafeHandleToFD $ hIn h+    attrs <- getTerminalAttributes (Fd fd)     let getStty (k,c) = do {str <- controlChar attrs k; return ([str],c)}     return $ catMaybes $ map getStty [(Erase,simpleKey Backspace),(Kill,simpleKey KillLine)]                         @@ -199,12 +208,12 @@ -----------------------------  withPosixGetEvent :: (MonadException m, MonadReader Prefs m) -        => Chan Event -> Handle -> Encoders -> [(String,Key)]+        => Chan Event -> Handles -> Encoders -> [(String,Key)]                 -> (m Event -> m a) -> m a withPosixGetEvent eventChan h enc termKeys f = wrapTerminalOps h $ do-    baseMap <- getKeySequences termKeys+    baseMap <- getKeySequences h termKeys     withWindowHandler eventChan-        $ f $ liftIO $ getEvent enc baseMap eventChan+        $ f $ liftIO $ getEvent h enc baseMap eventChan  withWindowHandler :: MonadException m => Chan Event -> m a -> m a withWindowHandler eventChan = withHandler windowChange $ @@ -222,82 +231,92 @@     old_handler <- liftIO $ installHandler signal handler Nothing     f `finally` liftIO (installHandler signal old_handler Nothing) -getEvent :: Encoders -> TreeMap Char Key -> Chan Event -> IO Event-getEvent enc baseMap = keyEventLoop readKeyEvents+getEvent :: Handles -> Encoders -> TreeMap Char Key -> Chan Event -> IO Event+getEvent Handles {hIn=h} enc baseMap = keyEventLoop readKeyEvents   where     bufferSize = 32     readKeyEvents = do         -- Read at least one character of input, and more if available.         -- In particular, the characters making up a control sequence will all         -- be available at once, so we can process them together with lexKeys.-        blockUntilInput-        bs <- B.hGetNonBlocking stdin bufferSize-        cs <- convert (localeToUnicode enc) bs+        blockUntilInput h+        bs <- B.hGetNonBlocking h bufferSize+        cs <- convert h (localeToUnicode enc) bs         return [KeyInput $ lexKeys baseMap cs]  -- Different versions of ghc work better using different functions.-blockUntilInput :: IO ()+blockUntilInput :: Handle -> IO () #if __GLASGOW_HASKELL__ >= 611 -- threadWaitRead doesn't work with the new ghc IO library, -- because it keeps a buffer even when NoBuffering is set.-blockUntilInput = hWaitForInput stdin (-1) >> return ()+blockUntilInput h = hWaitForInput h (-1) >> return () #else -- hWaitForInput doesn't work with -threaded on ghc < 6.10 -- (#2363 in ghc's trac)-blockUntilInput = threadWaitRead stdInput+blockUntilInput h = unsafeHandleToFd h >>= threadWaitRead #endif  -- try to convert to the locale encoding using iconv. -- if the buffer has an incomplete shift sequence, -- read another byte of input and try again.-convert :: (B.ByteString -> IO (String,Result)) -> B.ByteString -> IO String-convert decoder bs = do+convert :: Handle -> (B.ByteString -> IO (String,Result))+            -> B.ByteString -> IO String+convert h decoder bs = do     (cs,result) <- decoder bs     case result of         Incomplete rest -> do-                    extra <- B.hGetNonBlocking stdin 1+                    extra <- B.hGetNonBlocking h 1                     if B.null extra                         then return (cs ++ "?")-                        else fmap (cs ++) $ convert decoder (rest `B.append` extra)-        Invalid rest -> fmap ((cs ++) . ('?':)) $ convert decoder (B.drop 1 rest)+                        else fmap (cs ++)+                                $ convert h decoder (rest `B.append` extra)+        Invalid rest -> fmap ((cs ++) . ('?':)) $ convert h decoder (B.drop 1 rest)         _ -> return cs -getMultiByteChar :: (B.ByteString -> IO (String,Result)) -> IO Char-getMultiByteChar decoder = hWithBinaryMode stdin $ do-    b <- getChar-    cs <- convert decoder (Char8.pack [b])+getMultiByteChar :: Handle -> (B.ByteString -> IO (String,Result))+                        -> MaybeT IO Char+getMultiByteChar h decoder = hWithBinaryMode h $ do+    b <- hGetByte h+    cs <- liftIO $ convert h decoder (B.pack [b])     case cs of         [] -> return '?' -- shouldn't happen, but doesn't hurt to be careful.         (c:_) -> return c  --- fails if stdin is not a handle or if we couldn't access /dev/tty.-openTTY :: IO (Maybe Handle)-openTTY = do-    inIsTerm <- hIsTerminalDevice stdin-    if inIsTerm-        then handle (\(_::IOException) -> return Nothing) $ do+stdinTTYHandles, ttyHandles :: MaybeT IO Handles+stdinTTYHandles = do+    isInTerm <- liftIO $ hIsTerminalDevice stdin+    guard isInTerm+    h <- openTerm WriteMode+    -- Don't close stdin, since a different part of the program may use it later.+    return Handles { hIn = stdin, hOut = h, closeHandles = hClose h }++ttyHandles = do+    -- Open the input and output separately, since they need different buffering.+    h_in <- openTerm ReadMode+    h_out <- openTerm WriteMode+    return Handles { hIn = h_in, hOut = h_out,+                     closeHandles = hClose h_in >> hClose h_out }++openTerm :: IOMode -> MaybeT IO Handle+openTerm mode = handle (\(_::IOException) -> mzero)             -- NB: we open the tty as a binary file since otherwise the terminfo             -- backend, which writes output as Chars, would double-encode on ghc-6.12.-                h <- openBinaryFile "/dev/tty" WriteMode-                return (Just h)-        else return Nothing+            $ liftIO $ openBinaryFile "/dev/tty" mode -posixRunTerm :: (Encoders -> Handle -> TermOps) -> IO RunTerm-posixRunTerm tOps = do-    fileRT <- fileRunTerm+posixRunTerm :: MonadIO m => Handles -> (Encoders -> TermOps) -> m RunTerm+posixRunTerm hs tOps = liftIO $ do     codeset <- getCodeset-    ttyH <- openTTY-    encoders <- liftM2 Encoders (openEncoder codeset) (openPartialDecoder codeset)-    case ttyH of-        Nothing -> return fileRT-        Just h -> return fileRT {-                    closeTerm = closeTerm fileRT >> hClose h,-                    -- NOTE: could also alloc Encoders once for each call to wrapRunTerm-                    termOps = Just $ tOps encoders h-                }+    encoders <- liftM2 Encoders (openEncoder codeset)+                                         (openPartialDecoder codeset)+    fileRT <- fileRunTerm $ hIn hs+    return fileRT {+                closeTerm = closeTerm fileRT >> closeHandles hs,+                -- NOTE: could also alloc Encoders once for each call to wrapRunTerm+                termOps = Left $ tOps encoders+            } -type PosixT m = ReaderT Encoders (ReaderT Handle m)+type PosixT m = ReaderT Encoders (ReaderT Handles m)  data Encoders = Encoders {unicodeToLocale :: String -> IO B.ByteString,                           localeToUnicode :: B.ByteString -> IO (String, Result)}@@ -307,42 +326,44 @@     encoder <- asks unicodeToLocale     liftIO $ encoder str -runPosixT :: Monad m => Encoders -> Handle -> PosixT m a -> m a+runPosixT :: Monad m => Encoders -> Handles -> PosixT m a -> m a runPosixT enc h = runReaderT' h . runReaderT' enc -putTerm :: B.ByteString -> IO ()-putTerm str = B.putStr str >> hFlush stdout+putTerm :: Handle -> B.ByteString -> IO ()+putTerm h str = B.hPutStr h str >> hFlush h -fileRunTerm :: IO RunTerm-fileRunTerm = do+fileRunTerm :: Handle -> IO RunTerm+fileRunTerm h_in = do+    let h_out = stdout     oldLocale <- setLocale (Just "")     codeset <- getCodeset     let encoder str = join $ fmap ($ str) $ openEncoder codeset     let decoder str = join $ fmap ($ str) $ openDecoder codeset     decoder' <- openPartialDecoder codeset-    return RunTerm {putStrOut = \str -> encoder str >>= putTerm,+    return RunTerm {putStrOut = encoder >=> putTerm h_out,                 closeTerm = setLocale oldLocale >> return (),                 wrapInterrupt = withSigIntHandler,                 encodeForTerm = encoder,                 decodeForTerm = decoder,-                getLocaleChar = getMultiByteChar decoder',-                termOps = Nothing+                termOps = Right FileOps {+                            inputHandle = h_in,+                            getLocaleChar = getMultiByteChar h_in decoder',+                            maybeReadNewline = hMaybeReadNewline h_in,+                            getLocaleLine = Term.hGetLine h_in+                                                >>= liftIO . decoder+                        }+                 }  -- 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 => Handle -> m a -> m a-wrapTerminalOps outH =-    bracketSet (hGetBuffering stdin) (hSetBuffering stdin) NoBuffering+wrapTerminalOps :: MonadException m => Handles -> m a -> m a+wrapTerminalOps Handles {hIn = h_in, hOut = h_out} = +    bracketSet (hGetBuffering h_in) (hSetBuffering h_in) NoBuffering     -- TODO: block buffering?  Certain \r and \n's are causing flicker...     -- - moving to the right     -- - breaking line after offset widechar?-    . bracketSet (hGetBuffering outH) (hSetBuffering outH) LineBuffering-    . bracketSet (hGetEcho stdin) (hSetEcho stdin) False-    . hWithBinaryMode stdin--bracketSet :: (Eq a, MonadException m) => IO a -> (a -> IO ()) -> a -> m b -> m b-bracketSet getState set newState f = bracket (liftIO getState)-                            (liftIO . set)-                            (\_ -> liftIO (set newState) >> f)+    . bracketSet (hGetBuffering h_out) (hSetBuffering h_out) LineBuffering+    . bracketSet (hGetEcho h_in) (hSetEcho h_in) False+    . hWithBinaryMode h_in

@@ -131,26 +131,26 @@     deriving (Monad, MonadIO, MonadException,               MonadReader Actions, MonadReader Terminal, MonadState TermPos,               MonadState TermRows,-              MonadReader Handle, MonadReader Encoders)+              MonadReader Handles, MonadReader Encoders)  type DrawM a = forall m . (MonadReader Layout m, MonadIO m) => Draw m a  instance MonadTrans Draw where     lift = Draw . lift . lift . lift . lift . lift . lift     -runTerminfoDraw :: IO (Maybe RunTerm)-runTerminfoDraw = do-    mterm <- Exception.try setupTermFromEnv-    ch <- newChan+runTerminfoDraw :: Handles -> MaybeT IO RunTerm+runTerminfoDraw h = do+    mterm <- liftIO $ Exception.try setupTermFromEnv+    ch <- liftIO newChan     case mterm of-        Left (_::SetupTermError) -> return Nothing-        Right term -> case getCapability term getActions of-            Nothing -> return Nothing-            Just actions -> fmap Just $ posixRunTerm $ \enc h ->+        Left (_::SetupTermError) -> mzero+        Right term -> do+            actions <- MaybeT $ return $ getCapability term getActions+            posixRunTerm h $ \enc ->                 TermOps {                     getLayout = tryGetLayouts (posixLayouts h                                                 ++ [tinfoLayout term])-                    , withGetEvent = wrapKeypad h term+                    , withGetEvent = wrapKeypad (hOut h) term                                         . withPosixGetEvent ch h enc                                             (terminfoKeys term)                     , runTerm = \(RunTermType f) -> @@ -201,7 +201,7 @@ output f = do     toutput <- asks f     term <- ask-    ttyh <- ask+    ttyh <- liftM hOut ask     liftIO $ hRunTermOutput ttyh term toutput  

@@ -17,8 +17,8 @@  wcwidth :: Char -> Int wcwidth c = case mk_wcwidth $ toEnum $ fromEnum c of-                -1 -> 0 -- shouldn't happen, since control characters-                        -- aren't turned into graphemes; but better to be safe.+                -1 -> 0 -- Control characters have zero width.  (Used by the+                        -- "\SOH...\STX" hack in LineState.stringToGraphemes.)                 w -> w  gWidth :: Grapheme -> Int

@@ -1,5 +1,7 @@ module System.Console.Haskeline.Backend.Win32(
-                win32Term
+                win32Term,
+                win32TermStdin,
+                fileRunTerm
                 )where
 
 
@@ -7,7 +9,7 @@ import Foreign
 import Foreign.C
 import System.Win32 hiding (multiByteToWideChar)
-import Graphics.Win32.Misc(getStdHandle, sTD_INPUT_HANDLE, sTD_OUTPUT_HANDLE)
+import Graphics.Win32.Misc(getStdHandle, sTD_OUTPUT_HANDLE)
 import Data.List(intercalate)
 import Control.Concurrent hiding (throwTo)
 import Data.Char(isPrint)
@@ -17,7 +19,7 @@ import System.Console.Haskeline.Key
 import System.Console.Haskeline.Monads
 import System.Console.Haskeline.LineState
-import System.Console.Haskeline.Term
+import System.Console.Haskeline.Term as Term
 
 import Data.ByteString.Internal (createAndTrim)
 import qualified Data.ByteString as B
@@ -53,13 +55,19 @@         else do
             es <- readEvents h
             return $ mapMaybe processEvent es
-                       
-getConOut :: IO (Maybe HANDLE)
-getConOut = handle (\(_::IOException) -> return Nothing) $ fmap Just
-    $ createFile "CONOUT$" (gENERIC_READ .|. gENERIC_WRITE)
+
+consoleHandles :: MaybeT IO Handles
+consoleHandles = do
+    h_in <- open "CONIN$"
+    h_out <- open "CONOUT$"
+    return Handles { hIn = h_in, hOut = h_out }
+  where
+   open file = handle (\(_::IOException) -> mzero) $ liftIO
+                $ createFile file (gENERIC_READ .|. gENERIC_WRITE)
                         (fILE_SHARE_READ .|. fILE_SHARE_WRITE) Nothing
-                    oPEN_EXISTING 0 Nothing
+                        oPEN_EXISTING 0 Nothing
 
+                       
 processEvent :: InputEvent -> Maybe Event
 processEvent KeyEvent {keyDown = True, unicodeChar = c, virtualKeyCode = vc,
                     controlKeyState = cstate}
@@ -215,9 +223,9 @@ foreign import stdcall "windows.h SetConsoleMode" c_SetConsoleMode
     :: HANDLE -> DWORD -> IO Bool
 
-withWindowMode :: MonadException m => m a -> m a
-withWindowMode f = do
-    h <- liftIO $ getStdHandle sTD_INPUT_HANDLE
+withWindowMode :: MonadException m => Handles -> m a -> m a
+withWindowMode hs f = do
+    let h = hIn hs
     bracket (getConsoleMode h) (setConsoleMode h)
             $ \m -> setConsoleMode h (m .|. (#const ENABLE_WINDOW_INPUT)) >> f
   where
@@ -229,25 +237,30 @@ ----------------------------
 -- Drawing
 
-newtype Draw m a = Draw {runDraw :: ReaderT HANDLE m a}
-    deriving (Monad,MonadIO,MonadException, MonadReader HANDLE)
+data Handles = Handles { hIn, hOut :: HANDLE }
 
+closeHandles :: Handles -> IO ()
+closeHandles hs = closeHandle (hIn hs) >> closeHandle (hOut hs)
+
+newtype Draw m a = Draw {runDraw :: ReaderT Handles m a}
+    deriving (Monad,MonadIO,MonadException, MonadReader Handles)
+
 type DrawM a = (MonadIO m, MonadReader Layout m) => Draw m ()
 
 instance MonadTrans Draw where
     lift = Draw . lift
 
 getPos :: MonadIO m => Draw m Coord
-getPos = ask >>= liftIO . getPosition
+getPos = asks hOut >>= liftIO . getPosition
     
 setPos :: MonadIO m => Coord -> Draw m ()
 setPos c = do
-    h <- ask
+    h <- asks hOut
     liftIO (setPosition h c)
 
 printText :: MonadIO m => String -> Draw m ()
 printText txt = do
-    h <- ask
+    h <- asks hOut
     liftIO (writeConsole h txt)
     
 printAfter :: String -> DrawM ()
@@ -278,7 +291,9 @@ crlf = "\r\n"
 
 instance (MonadException m, MonadReader Layout m) => Term (Draw m) where
-    drawLineDiff = drawLineDiffWin
+    drawLineDiff (xs1,ys1) (xs2,ys2) = let
+        fixEsc = filter ((/= '\ESC') . baseChar)
+        in drawLineDiffWin (fixEsc xs1, fixEsc ys1) (fixEsc xs2, fixEsc ys2)
     -- TODO now that we capture resize events.
     -- first, looks like the cursor stays on the same line but jumps
     -- to the beginning if cut off.
@@ -300,46 +315,52 @@     ringBell True = liftIO messageBeep
     ringBell False = return () -- TODO
 
-win32Term :: IO RunTerm
+win32TermStdin :: MaybeT IO RunTerm
+win32TermStdin = do
+    liftIO (hIsTerminalDevice stdin) >>= guard
+    win32Term
+
+win32Term :: MaybeT IO RunTerm
 win32Term = do
-    fileRT <- fileRunTerm
-    inIsTerm <- hIsTerminalDevice stdin
-    if not inIsTerm
-        then return fileRT
-        else do
-            oterm <- getConOut
-            case oterm of
-                Nothing -> return fileRT
-                Just h -> do
-                        ch <- newChan
-                        return fileRT {
-                            wrapInterrupt = withWindowMode . withCtrlCHandler,
-                            termOps = Just TermOps {
-                                getLayout = getBufferSize h
-                                , withGetEvent = win32WithEvent ch
+    hs <- consoleHandles
+    ch <- liftIO newChan
+    fileRT <- liftIO $ fileRunTerm stdin
+    return fileRT {
+                            termOps = Left TermOps {
+                                getLayout = getBufferSize (hOut hs)
+                                , withGetEvent = withWindowMode hs
+                                                    . win32WithEvent hs ch
                                 , runTerm = \(RunTermType f) ->
-                                        runReaderT' h $ runDraw f
+                                        runReaderT' hs $ runDraw f
                                 },
-                            closeTerm = closeHandle h}
+                            closeTerm = closeHandles hs
+                        }
 
-win32WithEvent :: MonadException m => Chan Event -> (m Event -> m a) -> m a
-win32WithEvent eventChan f = do
-    inH <- liftIO $ getStdHandle sTD_INPUT_HANDLE
-    f $ liftIO $ getEvent inH eventChan
+win32WithEvent :: MonadException m => Handles -> Chan Event
+                                        -> (m Event -> m a) -> m a
+win32WithEvent h eventChan f = f $ liftIO $ getEvent (hIn h) eventChan
 
 -- stdin is not a terminal, but we still need to check the right way to output unicode to stdout.
-fileRunTerm :: IO RunTerm
-fileRunTerm = do
+fileRunTerm :: Handle -> IO RunTerm
+fileRunTerm h_in = do
     putter <- putOut
     cp <- getCodePage
-    return RunTerm {termOps = Nothing,
+    return RunTerm {
                     closeTerm = return (),
                     putStrOut = putter,
                     encodeForTerm = unicodeToCodePage cp,
                     decodeForTerm = codePageToUnicode cp,
-                    getLocaleChar = getMultiByteChar cp,
-                    wrapInterrupt = withCtrlCHandler}
+                    wrapInterrupt = withCtrlCHandler,
+                    termOps = Right FileOps {
+                                inputHandle = h_in,
+                                getLocaleChar = getMultiByteChar cp h_in,
+                                maybeReadNewline = hMaybeReadNewline h_in,
+                                getLocaleLine = Term.hGetLine h_in
+                                            >>= liftIO . codePageToUnicode cp
+                            }
 
+                    }
+
 -- On Windows, Unicode written to the console must be written with the WriteConsole API call.
 -- And to make the API cross-platform consistent, Unicode to a file should be UTF-8.
 putOut :: IO (String -> IO ())
@@ -352,9 +373,9 @@         else do
             cp <- getCodePage
             return $ \str -> unicodeToCodePage cp str >>= B.putStr >> hFlush stdout
-                
-    
 
+
+
 type Handler = DWORD -> IO BOOL
 
 foreign import ccall "wrapper" wrapHandler :: Handler -> IO (FunPtr Handler)
@@ -420,16 +441,15 @@ foreign import stdcall "IsDBCSLeadByteEx" c_IsDBCSLeadByteEx
         :: CodePage -> BYTE -> BOOL
 
-getMultiByteChar :: CodePage -> IO Char
-getMultiByteChar cp = hWithBinaryMode stdin $ do
-    b1 <- getByte
-    bs <- if c_IsDBCSLeadByteEx cp b1
-            then getByte >>= \b2 -> return [b1,b2]
-            else return [b1]
-    cs <- codePageToUnicode cp (B.pack bs)
-    case cs of
-        [] -> getMultiByteChar cp
-        (c:_) -> return c
+getMultiByteChar :: CodePage -> Handle -> MaybeT IO Char
+getMultiByteChar cp h = hWithBinaryMode h loop
   where
-    -- NOTE: relies on getChar returning an 8-bit Char.
-    getByte = fmap (toEnum . fromEnum) getChar
+    loop = do
+        b1 <- hGetByte h
+        bs <- if c_IsDBCSLeadByteEx cp b1
+                then hGetByte h >>= \b2 -> return [b1,b2]
+                else return [b1]
+        cs <- liftIO $ codePageToUnicode cp (B.pack bs)
+        case cs of
+            [] -> loop
+            (c:_) -> return c

@@ -34,7 +34,7 @@ import System.Console.Haskeline.LineState import System.Console.Haskeline.Key -data Effect = LineChange (String -> LineChars)+data Effect = LineChange (Prefix -> LineChars)               | PrintLines [String]               | ClearScreen               | RingBell

@@ -87,8 +87,8 @@ instance LineState SearchMode where     beforeCursor _ sm = beforeCursor prefix (foundHistory sm)         where -            prefix = "(" ++ directionName (direction sm) ++ ")`" -                            ++ graphemesToString (searchTerm sm) ++ "': "+            prefix = stringToGraphemes ("(" ++ directionName (direction sm) ++ ")`")+                            ++ searchTerm sm ++ stringToGraphemes "': "     afterCursor = afterCursor . foundHistory  instance Result SearchMode where

@@ -1,11 +1,12 @@ module System.Console.Haskeline.Completion(                             CompletionFunc,                             Completion(..),-                            completeWord,-                            completeQuotedWord,-                            -- * Building 'CompletionFunc's                             noCompletion,                             simpleCompletion,+                            -- * Word completion+                            completeWord,+                            completeWordWithPrev,+                            completeQuotedWord,                             -- * Filename completion                             completeFilename,                             listFiles,@@ -47,17 +48,33 @@ -------------- -- Word break functions --- | The following function creates a custom 'CompletionFunc' for use in the 'Settings.'+-- | A custom 'CompletionFunc' which completes the word immediately to the left of the cursor.+--+-- A word begins either at the start of the line or after an unescaped whitespace character. completeWord :: Monad m => Maybe Char          -- ^ An optional escape character-        -> String -- ^ List of characters which count as whitespace+        -> [Char]-- ^ Characters which count as whitespace         -> (String -> m [Completion]) -- ^ Function to produce a list of possible completions         -> CompletionFunc m-completeWord esc ws f (line, _) = do+completeWord esc ws = completeWordWithPrev esc ws . const++-- | A custom 'CompletionFunc' which completes the word immediately to the left of the cursor,+-- and takes into account the line contents to the left of the word.+--+-- A word begins either at the start of the line or after an unescaped whitespace character.+completeWordWithPrev :: Monad m => Maybe Char+        -- ^ An optional escape character+        -> [Char]-- ^ Characters which count as whitespace+        -> (String ->  String -> m [Completion])+            -- ^ Function to produce a list of possible completions.  The first argument is the+            -- line contents to the left of the word, reversed.  The second argument is the word+            -- to be completed.+        -> CompletionFunc m+completeWordWithPrev esc ws f (line, _) = do     let (word,rest) = case esc of                         Nothing -> break (`elem` ws) line                         Just e -> escapedBreak e line-    completions <- f (reverse word)+    completions <- f rest (reverse word)     return (rest,map (escapeReplacement esc ws) completions)   where     escapedBreak e (c:d:cs) | d == e && c `elem` (e:ws)@@ -65,7 +82,7 @@     escapedBreak e (c:cs) | notElem c ws             = let (xs,ys) = escapedBreak e cs in (c:xs,ys)     escapedBreak _ cs = ("",cs)-    + -- | Create a finished completion out of the given word. simpleCompletion :: String -> Completion simpleCompletion = completion@@ -100,7 +117,7 @@ --------- -- Quoted completion completeQuotedWord :: Monad m => Maybe Char -- ^ An optional escape character-                            -> String -- ^ List of characters which set off quotes+                            -> [Char] -- ^ Characters which set off quotes                             -> (String -> m [Completion]) -- ^ Function to produce a list of possible completions                             -> CompletionFunc m -- ^ Alternate completion to perform if the                                              -- cursor is not at a quoted word

@@ -15,6 +15,7 @@ import System.FilePath import Control.Applicative import qualified Control.Monad.State as State+import System.IO  -- | Application-specific customizations to the user interface. data Settings m = Settings {complete :: CompletionFunc m, -- ^ Custom tab completion.@@ -73,20 +74,102 @@         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 prefs settings (InputT f) = bracket (liftIO myRunTerm)-    (liftIO . closeTerm)-    $ \run -> runReaderT' settings $ runReaderT' prefs -        $ runKillRing-        $ runHistoryFromFile (historyFile settings) (maxHistorySize prefs) -        $ runReaderT f run-        --- | Run a line-reading application, reading user 'Prefs' from --- @~/.haskeline@+runInputTWithPrefs = runInputTBehaviorWithPrefs defaultBehavior++-- | Run a line-reading application.  This function should suffice for most applications.+--+-- This function is equivalent to @'runInputTBehavior' 'defaultBehavior'@.  It +-- uses terminal-style interaction if 'stdin' is connected to a terminal and has+-- echoing enabled.  Otherwise (e.g., if 'stdin' is a pipe), it uses file-style interaction.+--+-- If it uses terminal-style interaction, 'Prefs' will be read from the user's @~/.haskeline@ file+-- (if present).+-- If it uses file-style interaction, 'Prefs' are not relevant and will not be read. runInputT :: MonadException m => Settings m -> InputT m a -> m a-runInputT settings f = do-    prefs <- liftIO readPrefsFromHome-    runInputTWithPrefs prefs settings f+runInputT = runInputTBehavior defaultBehavior++-- | Returns 'True' if the current session uses terminal-style interaction.  (See 'Behavior'.)+haveTerminalUI :: Monad m => InputT m Bool+haveTerminalUI = asks isTerminalStyle+++{- | Haskeline has two ways of interacting with the user:++ * \"Terminal-style\" interaction provides an rich user interface by connecting+   to the user's terminal (which may be different than 'stdin' or 'stdout').  + + * \"File-style\" interaction treats the input as a simple stream of characters, for example+    when reading from a file or pipe.  Input functions (e.g., @getInputLine@) print the prompt to 'stdout'.+ + A 'Behavior' is a method for deciding at run-time which type of interaction to use.  + + For most applications (e.g., a REPL), 'defaultBehavior' should have the correct effect.+-}+data Behavior = Behavior (IO RunTerm)++-- | 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 (Behavior run) f = bracket (liftIO run) (liftIO . closeTerm) f++-- | Run a line-reading application according to the given behavior.+--+-- If it uses terminal-style interaction, 'Prefs' will be read from the+-- user's @~/.haskeline@ file (if present).+-- If it uses file-style interaction, 'Prefs' are not relevant and will not be read.+runInputTBehavior :: MonadException m => Behavior -> Settings m -> InputT m a -> m a+runInputTBehavior behavior settings f = withBehavior behavior $ \run -> do+    prefs <- if isTerminalStyle run+                then liftIO readPrefsFromHome+                else return defaultPrefs+    execInputT prefs settings run f++-- | Run a line-reading application.+runInputTBehaviorWithPrefs :: MonadException 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+                -> InputT m a -> m a+execInputT prefs settings run (InputT f)+    = runReaderT' settings $ runReaderT' prefs+            $ runKillRing+            $ runHistoryFromFile (historyFile settings) (maxHistorySize prefs)+            $ runReaderT f run+++-- | Read input from 'stdin'.  +-- Use terminal-style interaction if 'stdin' is connected to+-- a terminal and has echoing enabled.  Otherwise (e.g., if 'stdin' is a pipe), use+-- file-style interaction.+--+-- This behavior should suffice for most applications.  +defaultBehavior :: Behavior+defaultBehavior = Behavior defaultRunTerm++-- | Use file-style interaction, reading input from the given 'Handle'.  +useFileHandle :: Handle -> Behavior+useFileHandle = Behavior . fileHandleRunTerm++-- | Use file-style interaction, reading input from the given file.+useFile :: FilePath -> Behavior+useFile file = Behavior $ do+            h <- openBinaryFile file ReadMode+            rt <- fileHandleRunTerm h+            return rt { closeTerm = closeTerm rt >> hClose h}++-- | Use terminal-style interaction whenever possible, even if 'stdin' and/or 'stdout' are not+-- terminals.+--+-- If it cannot open the user's terminal, use file-style interaction, reading input from 'stdin'.+preferTerm :: Behavior+preferTerm = Behavior terminalRunTerm+  -- | Read 'Prefs' from @~/.haskeline.@   If there is an error reading the file, -- the 'defaultPrefs' will be returned.

@@ -11,6 +11,7 @@                     mapBaseChars,                     -- * Line State class                     LineState(..),+                    Prefix,                     -- ** Convenience functions for the drawing backends                     LineChars,                     lineChars,@@ -62,6 +63,9 @@                     applyCmdArg,                     -- ** Other line state types                     Message(..),+                    Password(..),+                    addPasswordChar,+                    deletePasswordChar,                     ) where  import Data.Char@@ -106,6 +110,15 @@ stringToGraphemes = mkString . dropWhile isCombiningChar     where         mkString [] = []+        -- Minor hack: "\ESC...\STX" or "\SOH\ESC...\STX", where "\ESC..." is some+        -- control sequence (e.g., ANSI colors), is represented as a grapheme+        -- of zero length with '\ESC' as the base character.+        -- Note that this won't round-trip correctly with graphemesToString.+        -- In practice, however, that's fine since control characters can only occur+        -- in the prompt.+        mkString ('\SOH':cs) = stringToGraphemes cs+        mkString ('\ESC':cs) | (ctrl,'\STX':rest) <- break (=='\STX') cs+                    = Grapheme '\ESC' ctrl : stringToGraphemes rest         mkString (c:cs) = Grapheme c (takeWhile isCombiningChar cs)                                 : mkString (dropWhile isCombiningChar cs) @@ -115,18 +128,20 @@ -- | This class abstracts away the internal representations of the line state, -- for use by the drawing actions.  Line state is generally stored in a zipper format. class LineState s where-    beforeCursor :: String -- ^ The input prefix.+    beforeCursor :: Prefix -- ^ The input prefix.                     -> s -- ^ The current line state.-                    -> [Grapheme] -- ^ The text to the left of the cursor, reversed.  (This -                                  -- includes the prefix.)+                    -> [Grapheme] -- ^ The text to the left of the cursor+                                  -- (including the prefix).     afterCursor :: s -> [Grapheme] -- ^ The text under and to the right of the cursor. +type Prefix = [Grapheme]+ -- | The characters in the line (with the cursor in the middle).  NOT in a zippered format; -- both lists are in the order left->right that appears on the screen. type LineChars = ([Grapheme],[Grapheme])  -- | Accessor function for the various backends.-lineChars :: LineState s => String -> s -> LineChars+lineChars :: LineState s => Prefix -> s -> LineChars lineChars prefix s = (beforeCursor prefix s, afterCursor s)  -- | Compute the number of characters under and to the right of the cursor.@@ -155,7 +170,7 @@                     deriving (Show, Eq)  instance LineState InsertMode where-    beforeCursor prefix (IMode xs _) = stringToGraphemes prefix ++ reverse xs+    beforeCursor prefix (IMode xs _) = prefix ++ reverse xs     afterCursor (IMode _ ys) = ys  instance Result InsertMode where@@ -232,8 +247,8 @@                     deriving Show  instance LineState CommandMode where-    beforeCursor prefix CEmpty = stringToGraphemes prefix-    beforeCursor prefix (CMode xs _ _) = stringToGraphemes prefix ++ reverse xs+    beforeCursor prefix CEmpty = prefix+    beforeCursor prefix (CMode xs _ _) = prefix ++ reverse xs     afterCursor CEmpty = []     afterCursor (CMode _ c ys) = c:ys @@ -310,7 +325,7 @@     fmap f am = am {argState = f (argState am)}  instance LineState s => LineState (ArgMode s) where-    beforeCursor _ am = let pre = "(arg: " ++ show (arg am) ++ ") "+    beforeCursor _ am = let pre = map baseGrapheme $ "(arg: " ++ show (arg am) ++ ") "                              in beforeCursor pre (argState am)      afterCursor = afterCursor . argState @@ -347,6 +362,29 @@ instance LineState (Message s) where     beforeCursor _ = stringToGraphemes . messageText     afterCursor _ = []++----------------++data Password = Password {passwordState :: [Char], -- ^ reversed+                          passwordChar :: Maybe Char}++instance LineState Password where+    beforeCursor prefix p+        = prefix ++ (stringToGraphemes+                      $ case passwordChar p of+                        Nothing -> []+                        Just c -> replicate (length $ passwordState p) c)+    afterCursor _ = []++instance Result Password where+    toResult = reverse . passwordState++addPasswordChar :: Char -> Password -> Password+addPasswordChar c p = p {passwordState = c : passwordState p}++deletePasswordChar :: Password -> Password+deletePasswordChar (Password (_:cs) m) = Password cs m+deletePasswordChar p = p  ----------------- atStart, atEnd :: (Char -> Bool) -> InsertMode -> Bool

@@ -11,7 +11,9 @@                 modify,                 update,                 MonadReader(..),-                MonadState(..)+                MonadState(..),+                MaybeT(..),+                orElse                 ) where  import Control.Monad.Trans@@ -94,3 +96,27 @@     unblock m = StateT $ \s -> unblock $ getStateTFunc m s     catch f h = StateT $ \s -> catch (getStateTFunc f s)                             $ \e -> getStateTFunc (h e) s++newtype MaybeT m a = MaybeT { unMaybeT :: m (Maybe a) }++instance Monad m => Monad (MaybeT m) where+    return x = MaybeT $ return $ Just x+    MaybeT f >>= g = MaybeT $ f >>= maybe (return Nothing) (unMaybeT . g)++instance MonadIO m => MonadIO (MaybeT m) where+    liftIO = lift . liftIO++instance MonadTrans MaybeT where+    lift = MaybeT . liftM Just++instance MonadException m => MonadException (MaybeT m) where+    block = MaybeT . block . unMaybeT+    unblock = MaybeT . unblock . unMaybeT+    catch f h = MaybeT $ catch (unMaybeT f) $ unMaybeT . h++orElse :: Monad m => MaybeT m a -> m a -> m a+orElse (MaybeT f) g = f >>= maybe g return++instance Monad m => MonadPlus (MaybeT m) where+    mzero = MaybeT $ return Nothing+    MaybeT f `mplus` MaybeT g = MaybeT $ f >>= maybe g (return . Just)

@@ -16,7 +16,7 @@ import System.Console.Haskeline.Key  {- |-'Prefs' allow the user to customize the line-editing interface.  They are+'Prefs' allow the user to customize the terminal-style line-editing interface.  They are read by default from @~/.haskeline@; to override that behavior, use 'readPrefs' and @runInputTWithPrefs@. 

@@ -9,18 +9,20 @@  import Control.Monad -runCommandLoop :: (MonadException m, CommandMonad m, MonadState Layout m)-    => TermOps -> String -> KeyCommand m InsertMode a -> m a-runCommandLoop tops prefix cmds = runTerm tops $ -    RunTermType (withGetEvent tops $ runCommandLoop' tops prefix cmds)+runCommandLoop :: (MonadException m, CommandMonad m, MonadState Layout m,+                    LineState s)+    => TermOps -> String -> KeyCommand m s a -> s -> m a+runCommandLoop tops prefix cmds initState = runTerm tops $ +    RunTermType (withGetEvent tops+        $ runCommandLoop' tops (stringToGraphemes prefix) initState cmds) -runCommandLoop' :: forall t m a . (MonadTrans t, Term (t m), CommandMonad (t m),-        MonadState Layout m, MonadReader Prefs m)-        => TermOps -> String -> KeyCommand m InsertMode a -> t m Event -> t m a-runCommandLoop' tops prefix cmds getEvent = do-    let s = lineChars prefix emptyIM+runCommandLoop' :: forall t m s a . (MonadTrans t, Term (t m), CommandMonad (t m),+        MonadState Layout m, MonadReader Prefs m, LineState s)+        => TermOps -> Prefix -> s -> KeyCommand m s a -> t m Event -> t m a+runCommandLoop' tops prefix initState cmds getEvent = do+    let s = lineChars prefix initState     drawLine s-    readMoreKeys s (fmap ($ emptyIM) cmds)+    readMoreKeys s (fmap ($ initState) cmds)   where     readMoreKeys :: LineChars -> KeyMap (CmdM m a) -> t m a     readMoreKeys s next = do@@ -49,7 +51,7 @@   drawEffect :: (MonadTrans t, Term (t m), MonadReader Prefs m)-    => String -> LineChars -> Effect -> t m LineChars+    => Prefix -> LineChars -> Effect -> t m LineChars drawEffect prefix s (LineChange ch) = do     let t = ch prefix     drawLineDiff s t

@@ -8,13 +8,13 @@  import Control.Concurrent import Data.Typeable-import Data.ByteString (ByteString)+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as B+import Data.Word import Control.Exception.Extensible (fromException, AsyncException(..),bracket_)-import System.IO(Handle)--#if __GLASGOW_HASKELL__ >= 611-import System.IO (hGetEncoding, hSetEncoding, hSetBinaryMode)-#endif+import System.IO+import Control.Monad(liftM,when,guard)+import System.IO.Error (isEOFError)  class (MonadReader Layout m, MonadException m) => Term m where     reposition :: Layout -> LineChars -> m ()@@ -29,18 +29,17 @@  clearLine = flip drawLineDiff ([],[])     --- putStrOut is the right way to send unicode chars to stdout.--- termOps being Nothing means we should read the input as a UTF-8 file. data RunTerm = RunTerm {+            -- | Write unicode characters to stdout.             putStrOut :: String -> IO (),             encodeForTerm :: String -> IO ByteString,             decodeForTerm :: ByteString -> IO String,-            getLocaleChar :: IO Char,-            termOps :: Maybe TermOps,+            termOps :: Either TermOps FileOps,             wrapInterrupt :: MonadException m => m a -> m a,             closeTerm :: IO ()     } +-- | Operations needed for terminal-style interaction. data TermOps = TermOps {             getLayout :: IO Layout             , withGetEvent :: (MonadException m, CommandMonad m)@@ -48,6 +47,20 @@             , runTerm :: (MonadException m, CommandMonad m) => RunTermType m a -> m a         } +-- | Operations needed for file-style interaction.+data FileOps = FileOps {+            inputHandle :: Handle, -- ^ e.g. for turning off echoing.+            getLocaleLine :: MaybeT IO String,+            getLocaleChar :: MaybeT IO Char,+            maybeReadNewline :: IO ()+        }++-- | Are we using terminal-style interaction?+isTerminalStyle :: RunTerm -> Bool+isTerminalStyle r = case termOps r of+                    Left TermOps{} -> True+                    _ -> False+ -- Generic terminal actions which are independent of the Term being used. -- Wrapped in a newtype so that we don't need RankNTypes. newtype RunTermType m a = RunTermType (forall t . @@ -108,8 +121,10 @@ data Layout = Layout {width, height :: Int}                     deriving (Show,Eq) ------------ Utility function since we're not using the new IO library yet.+-----------------------------------+-- 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 #if __GLASGOW_HASKELL__ >= 611 hWithBinaryMode h = bracket (liftIO $ hGetEncoding h)@@ -118,3 +133,55 @@ #else hWithBinaryMode _ = id #endif++-- | Utility function for changing a property of a terminal for the duration of+-- a computation.+bracketSet :: (Eq a, MonadException m) => IO a -> (a -> IO ()) -> a -> m b -> m b+bracketSet getState set newState f = bracket (liftIO getState)+                            (liftIO . set)+                            (\_ -> liftIO (set newState) >> f)+++-- | Returns one 8-bit word.  Needs to be wrapped by hWithBinaryMode.+hGetByte :: Handle -> MaybeT IO Word8+hGetByte h = do+    eof <- liftIO $ hIsEOF h+    guard (not eof)+    liftIO $ liftM (toEnum . fromEnum) $ hGetChar h+++-- | Utility function to correctly get a ByteString line of input.+hGetLine :: Handle -> MaybeT IO ByteString+hGetLine h = do+    atEOF <- liftIO $ hIsEOF h+    guard (not atEOF)+    -- It's more efficient to use B.getLine, but that function throws an+    -- error if the Handle (e.g., stdin) is set to NoBuffering.+    buff <- liftIO $ hGetBuffering h+    liftIO $ if buff == NoBuffering+        then hWithBinaryMode h $ fmap B.pack $ System.IO.hGetLine h+        else B.hGetLine h++-- If another character is immediately available, and it is a newline, consume it.+--+-- Two portability fixes:+-- +-- 1) Note that in ghc-6.8.3 and earlier, hReady returns False at an EOF,+-- whereas in ghc-6.10.1 and later it throws an exception.  (GHC trac #1063).+-- This code handles both of those cases.+--+-- 2) Also note that on Windows with ghc<6.10, hReady may not behave correctly (#1198)+-- The net result is that this might cause+-- But this function will generally only be used when reading buffered input+-- (since stdin isn't a terminal), so it should probably be OK.+hMaybeReadNewline :: Handle -> IO ()+hMaybeReadNewline h = returnOnEOF () $ do+    ready <- hReady h+    when ready $ do+        c <- hLookAhead h+        when (c == '\n') $ getChar >> return ()++returnOnEOF :: MonadException m => a -> m a -> m a+returnOnEOF x = handle $ \e -> if isEOFError e+                                then return x+                                else throwIO e

@@ -406,7 +406,7 @@ searchText SearchEntry {entryState = IMode xs ys} = reverse xs ++ ys  instance LineState SearchEntry where-    beforeCursor prefix se = beforeCursor (prefix ++ [searchChar se])+    beforeCursor prefix se = beforeCursor (prefix ++ stringToGraphemes [searchChar se])                                 (entryState se)     afterCursor = afterCursor . entryState 

@@ -9,6 +9,8 @@ Usage: ./Test          (line input) ./Test chars    (character input)+./Test password (no masking characters)+./Test password \* --}  mySettings :: Settings IO@@ -19,6 +21,8 @@         args <- getArgs         let inputFunc = case args of                 ["chars"] -> fmap (fmap (\c -> [c])) . getInputChar+                ["password"] -> getPassword Nothing+                ["password", [c]] -> getPassword (Just c)                 _ -> getInputLine         runInputT mySettings $ withInterrupt $ loop inputFunc 0     where

@@ -1,6 +1,6 @@ Name:           haskeline Cabal-Version:  >=1.6-Version:        0.6.2.4+Version:        0.6.3 Category:       User Interfaces License:        BSD3 License-File:   LICENSE@@ -50,7 +50,7 @@     }     else {         if impl(ghc>=6.11) {-            Build-depends: base >=4.1 && < 4.4, containers>=0.1 && < 0.4, directory==1.0.*,+            Build-depends: base >=4.1 && < 4.4, containers>=0.1 && < 0.5, directory==1.0.*,                            bytestring==0.9.*         }         else {