haskeline 0.7.4.0 → 0.7.4.1
raw patch · 5 files changed
+36/−35 lines, 5 filesdep +stmdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: stm
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- Changelog +5/−0
- System/Console/Haskeline/Backend/Posix.hsc +7/−6
- System/Console/Haskeline/Backend/Win32.hsc +5/−4
- System/Console/Haskeline/Term.hs +15/−21
- haskeline.cabal +4/−4
Changelog view
@@ -1,3 +1,8 @@+Changed in version 0.7.4.1:+ * Bump upper bound on base to support ghc-8.4+ * Use `TChan` from `stm` rather than `Chan`+ * Update the homepage since trac.haskell.org has shut down+ Changed in version 0.7.4.0: * Properly process Unicode key events on Windows. * Add an instance MonadExcept IdentityT.
System/Console/Haskeline/Backend/Posix.hsc view
@@ -18,6 +18,7 @@ import qualified Data.Map as Map import System.Posix.Terminal hiding (Interrupt) import Control.Monad+import Control.Concurrent.STM import Control.Concurrent hiding (throwTo) import Data.Maybe (catMaybes) import System.Posix.Signals.Exts@@ -201,16 +202,16 @@ ----------------------------- withPosixGetEvent :: (MonadException m, MonadReader Prefs m)- => Chan Event -> Handles -> [(String,Key)]+ => TChan Event -> Handles -> [(String,Key)] -> (m Event -> m a) -> m a withPosixGetEvent eventChan h termKeys f = wrapTerminalOps h $ do baseMap <- getKeySequences (ehIn h) termKeys withWindowHandler eventChan $ f $ liftIO $ getEvent (ehIn h) baseMap eventChan -withWindowHandler :: MonadException m => Chan Event -> m a -> m a+withWindowHandler :: MonadException m => TChan Event -> m a -> m a withWindowHandler eventChan = withHandler windowChange $- Catch $ writeChan eventChan WindowResize+ Catch $ atomically $ writeTChan eventChan WindowResize withSigIntHandler :: MonadException m => m a -> m a withSigIntHandler f = do@@ -224,7 +225,7 @@ old_handler <- liftIO $ installHandler signal handler Nothing f `finally` liftIO (installHandler signal old_handler Nothing) -getEvent :: Handle -> TreeMap Char Key -> Chan Event -> IO Event+getEvent :: Handle -> TreeMap Char Key -> TChan Event -> IO Event getEvent h baseMap = keyEventLoop $ do cs <- getBlockOfChars h return [KeyInput $ lexKeys baseMap cs]@@ -282,7 +283,7 @@ -> (forall m . (MonadException m, CommandMonad m) => EvalTerm (PosixT m)) -> IO RunTerm posixRunTerm hs layoutGetters keys wrapGetEvent evalBackend = do- ch <- newChan+ ch <- newTChanIO fileRT <- posixFileRunTerm hs return fileRT { termOps = Left TermOps@@ -293,7 +294,7 @@ , saveUnusedKeys = saveKeys ch , evalTerm = mapEvalTerm (runPosixT hs) lift evalBackend- , externalPrint = writeChan ch . ExternalPrint+ , externalPrint = atomically . writeTChan ch . ExternalPrint } , closeTerm = do flushEventQueue (putStrOut fileRT) ch
System/Console/Haskeline/Backend/Win32.hsc view
@@ -11,6 +11,7 @@ import System.Win32 hiding (multiByteToWideChar) import Graphics.Win32.Misc(getStdHandle, sTD_OUTPUT_HANDLE) import Data.List(intercalate)+import Control.Concurrent.STM import Control.Concurrent hiding (throwTo) import Data.Char(isPrint) import Data.Maybe(mapMaybe)@@ -45,7 +46,7 @@ $ c_GetNumberOfConsoleInputEvents h numEventsPtr fmap fromEnum $ peek numEventsPtr -getEvent :: HANDLE -> Chan Event -> IO Event+getEvent :: HANDLE -> TChan Event -> IO Event getEvent h = keyEventLoop (eventReader h) eventReader :: HANDLE -> IO [Event]@@ -377,7 +378,7 @@ win32Term :: MaybeT IO RunTerm win32Term = do hs <- consoleHandles- ch <- liftIO newChan+ ch <- liftIO newTChanIO fileRT <- liftIO $ fileRunTerm stdin return fileRT { termOps = Left TermOps {@@ -387,14 +388,14 @@ , saveUnusedKeys = saveKeys ch , evalTerm = EvalTerm (runReaderT' hs . runDraw) (Draw . lift)- , externalPrint = writeChan ch . ExternalPrint+ , externalPrint = atomically . writeTChan ch . ExternalPrint } , closeTerm = do flushEventQueue (putStrOut fileRT) ch closeHandles hs } -win32WithEvent :: MonadException m => Handles -> Chan Event+win32WithEvent :: MonadException m => Handles -> TChan Event -> (m Event -> m a) -> m a win32WithEvent h eventChan f = f $ liftIO $ getEvent (hIn h) eventChan
System/Console/Haskeline/Term.hs view
@@ -7,6 +7,7 @@ import System.Console.Haskeline.Completion(Completion) import Control.Concurrent+import Control.Concurrent.STM import Data.Word import Control.Exception (fromException, AsyncException(..),bracket_) import Data.Typeable@@ -50,12 +51,12 @@ -- Without it, if you are using another thread to process the logging -- and write on screen via exposed externalPrint, latest writes from -- this thread are not able to cross the thread boundary in time.-flushEventQueue :: (String -> IO ()) -> Chan Event -> IO ()+flushEventQueue :: (String -> IO ()) -> TChan Event -> IO () flushEventQueue print' eventChan = yield >> loopUntilFlushed where loopUntilFlushed = do- flushed <- isEmptyChan eventChan+ flushed <- atomically $ isEmptyTChan eventChan if flushed then return () else do- event <- readChan eventChan+ event <- atomically $ readTChan eventChan case event of ExternalPrint str -> do print' (str ++ "\n") >> loopUntilFlushed@@ -121,36 +122,29 @@ | ExternalPrint String deriving Show -keyEventLoop :: IO [Event] -> Chan Event -> IO Event+keyEventLoop :: IO [Event] -> TChan Event -> IO Event keyEventLoop readEvents eventChan = do -- first, see if any events are already queued up (from a key/ctrl-c -- event or from a previous call to getEvent where we read in multiple -- keys)- isEmpty <- isEmptyChan eventChan+ isEmpty <- atomically $ isEmptyTChan eventChan if not isEmpty- then readChan eventChan+ then atomically $ readTChan eventChan else do- lock <- newEmptyMVar- tid <- forkIO $ handleErrorEvent (readerLoop lock)- readChan eventChan `finally` do- putMVar lock ()- killThread tid+ tid <- forkIO $ handleErrorEvent readerLoop+ atomically (readTChan eventChan) `finally` killThread tid where- readerLoop lock = do+ readerLoop = do es <- readEvents if null es- then readerLoop lock- else -- Use the lock to work around the fact that writeList2Chan- -- isn't atomic. Otherwise, some events could be ignored if- -- the subthread is killed before it saves them in the chan.- bracket_ (putMVar lock ()) (takeMVar lock) $- writeList2Chan eventChan es+ then readerLoop+ else atomically $ mapM_ (writeTChan eventChan) es handleErrorEvent = handle $ \e -> case fromException e of Just ThreadKilled -> return ()- _ -> writeChan eventChan (ErrorEvent e)+ _ -> atomically $ writeTChan eventChan (ErrorEvent e) -saveKeys :: Chan Event -> [Key] -> IO ()-saveKeys ch = writeChan ch . KeyInput+saveKeys :: TChan Event -> [Key] -> IO ()+saveKeys ch = atomically . writeTChan ch . KeyInput data Layout = Layout {width, height :: Int} deriving (Show,Eq)
haskeline.cabal view
@@ -1,6 +1,6 @@ Name: haskeline Cabal-Version: >=1.10-Version: 0.7.4.0+Version: 0.7.4.1 Category: User Interfaces License: BSD3 License-File: LICENSE@@ -16,7 +16,7 @@ Haskell programs. . Haskeline runs both on POSIX-compatible systems and on Windows.-Homepage: http://trac.haskell.org/haskeline+Homepage: https://github.com/judah/haskeline Bug-Reports: https://github.com/judah/haskeline/issues Stability: Stable Build-Type: Simple@@ -43,10 +43,10 @@ -- We require ghc>=7.4.1 (base>=4.5) to use the base library encodings, even -- though it was implemented in earlier releases, due to GHC bug #5436 which -- wasn't fixed until 7.4.1- Build-depends: base >=4.5 && < 4.11, containers>=0.4 && < 0.6,+ Build-depends: base >=4.5 && < 4.12, containers>=0.4 && < 0.6, directory>=1.1 && < 1.4, bytestring>=0.9 && < 0.11, filepath >= 1.2 && < 1.5, transformers >= 0.2 && < 0.6,- process >= 1.0 && < 1.7+ process >= 1.0 && < 1.7, stm >= 2.4 && < 2.5 Default-Language: Haskell98 Default-Extensions: ForeignFunctionInterface, Rank2Types, FlexibleInstances,