Commit 8d36fd14 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺
Browse files

Merge http://code.haskell.org/haskeline into ghc-head

parents 40bcd6ac eb0ff26a
......@@ -28,7 +28,7 @@ import Data.List
import System.IO
import System.Environment
import System.Console.Haskeline.Monads
import System.Console.Haskeline.Monads hiding (Handler)
import System.Console.Haskeline.Key
import System.Console.Haskeline.Term as Term
import System.Console.Haskeline.Prefs
......@@ -48,7 +48,7 @@ import GHC.IOBase(haFD,FD)
import GHC.Handle (withHandle_)
#endif
#ifdef USE_TERMIOS_H
#if defined(USE_TERMIOS_H) || defined(__ANDROID__)
#include <termios.h>
#endif
#include <sys/ioctl.h>
......
......@@ -194,7 +194,9 @@ runActionT m = do
return x
output :: TermAction -> ActionM ()
output = Writer.tell
output t = Writer.tell t -- NB: explicit argument enables build with ghc-6.12.3
-- (Probably related to the monomorphism restriction;
-- see GHC ticket #1749).
outputText :: String -> ActionM ()
outputText str = do
......
......@@ -8,6 +8,8 @@ module System.Console.Haskeline.MonadException(
-- * Generalizations of Control.Exception
catch,
handle,
catches,
Handler(..),
finally,
throwIO,
throwTo,
......@@ -101,6 +103,18 @@ catch act handler = controlIO $ \(RunIO run) -> E.catch
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 handlers 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 handlers)
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
......
......@@ -11,8 +11,11 @@ import Control.Monad
runCommandLoop :: (CommandMonad m, MonadState Layout m, LineState s)
=> TermOps -> String -> KeyCommand m s a -> s -> m a
runCommandLoop tops@TermOps{evalTerm = EvalTerm eval liftE} prefix cmds initState
= eval $ withGetEvent tops
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
cmds
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment