Browse Source

Use bracketOnError to properly clean up Haskeline

tags/v0.1.0.0
Peter J. Jones 4 years ago
parent
commit
3f98ff8203
5 changed files with 20 additions and 11 deletions
  1. 2
    1
      TODO
  2. 1
    0
      byline.cabal
  3. 1
    0
      default.nix
  4. 12
    9
      src/System/Console/Byline/Internal/Byline.hs
  5. 4
    1
      src/System/Console/Byline/Primary.hs

+ 2
- 1
TODO View File

@@ -2,7 +2,8 @@
#+title: To-Do List

* Before First Release
** TODO Restore exception safety in `runByline` and `withCompletionFunc`
** DONE Restore exception safety in `runByline` and `withCompletionFunc`
CLOSED: [2015-05-18 Mon 19:55]
- I'm not using `runInputT` anymore so we don't get MonadException either
** DONE When rendering colors directly via `ask`, don't use color codes on Windows
CLOSED: [2015-05-18 Mon 18:02]

+ 1
- 0
byline.cabal View File

@@ -64,6 +64,7 @@ library
, ansi-terminal >= 0.6 && < 0.7
, colour >= 2.3 && < 2.4
, containers >= 0.5 && < 0.6
, exceptions >= 0.8 && < 0.9
, haskeline >= 0.7 && < 0.8
, mtl >= 2.1 && < 2.2
, terminfo-hs >= 0.1 && < 0.2

+ 1
- 0
default.nix View File

@@ -10,6 +10,7 @@ let
ansi-terminal
base
colour
exceptions
haskeline
mtl
terminfo-hs

+ 12
- 9
src/System/Console/Byline/Internal/Byline.hs View File

@@ -24,6 +24,7 @@ module System.Console.Byline.Internal.Byline

--------------------------------------------------------------------------------
import Control.Applicative
import Control.Monad.Catch
import Control.Monad.Reader
import Control.Monad.Trans.Maybe
import Data.IORef
@@ -51,7 +52,7 @@ data Env = Env
--------------------------------------------------------------------------------
-- | Reader environment for Byline.
newtype Byline m a = Byline {unByline :: ReaderT Env (MaybeT m) a}
deriving (Functor, Applicative, Monad, MonadIO, MonadReader Env)
deriving (Functor, Applicative, Monad, MonadReader Env, MonadIO)

--------------------------------------------------------------------------------
defRenderMode :: H.InputT IO (RenderMode, RenderMode)
@@ -104,16 +105,18 @@ liftInputT input = do
liftIO (H.queryInput state $ H.withInterrupt input)

--------------------------------------------------------------------------------
runByline :: (MonadIO m) => Byline m a -> m (Maybe a)
runByline :: (MonadIO m, MonadMask m) => Byline m a -> m (Maybe a)
runByline (Byline byline) = do
comp <- liftIO (newIORef Nothing)

let settings = H.setComplete (runCompletionFunction comp) H.defaultSettings
state <- liftIO (H.initializeInput settings)
modes <- liftIO (H.queryInput state defRenderMode)

output <- runMaybeT $ runReaderT byline (defEnv state modes comp)
liftIO (H.closeInput state)
bracketOnError (liftIO $ H.initializeInput settings) -- Acquire.
(liftIO . H.cancelInput) -- Release.
(go comp) -- Use.
where
go comp state = do
modes <- liftIO (H.queryInput state defRenderMode)
output <- runMaybeT $ runReaderT byline (defEnv state modes comp)

-- FIXME: Use a bracket in here
return output
liftIO (H.closeInput state)
return output

+ 4
- 1
src/System/Console/Byline/Primary.hs View File

@@ -142,9 +142,12 @@ withCompletionFunc comp byline = do
compref <- Reader.asks compFunc
current <- liftIO (readIORef compref)

-- FIXME: Use a bracket in here.
-- Temporally change the completion function.
-- Exceptions will be dealt with in 'runByline'.
liftIO (writeIORef compref (Just comp))
output <- byline

-- Reset the completion function and return the result.
liftIO (writeIORef compref current)
return output


Loading…
Cancel
Save