immortal 0.2.2.1 → 0.3
raw patch · 4 files changed
+34/−75 lines, 4 filesdep +unliftio-coredep −lifted-basedep −monad-controldep −transformers-base
Dependencies added: unliftio-core
Dependencies removed: lifted-base, monad-control, transformers-base
Files
- CHANGELOG.md +7/−0
- immortal.cabal +5/−12
- src/Control/Immortal.hs +22/−32
- tests/test.hs +0/−31
CHANGELOG.md view
@@ -1,6 +1,13 @@ CHANGES ======= +Version 0.3+-----------++Replace monad-control with unliftio-core.+As a result, immortal will no longer work with stateful monads like StateT,+which is considered a feature.+ Version 0.2.2.1 ---------------
immortal.cabal view
@@ -1,8 +1,5 @@--- Initial immortal.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/- name: immortal-version: 0.2.2.1+version: 0.3 synopsis: Spawn threads that never die (unless told to do so) description: A small library to create threads that never die. @@ -13,7 +10,7 @@ license-file: LICENSE author: Roman Cheplyaka maintainer: roma@ro-che.info--- copyright: +-- copyright: category: Concurrency build-type: Simple extra-source-files:@@ -27,13 +24,10 @@ library exposed-modules: Control.Immortal- -- other-modules: build-depends: base >=4.5 && <5,- lifted-base >=0.2,- transformers-base >=0.4,- monad-control >=0.3,- stm+ stm,+ unliftio-core >=0.1.1.0 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall@@ -51,8 +45,7 @@ base >= 4 && < 5 , tasty >= 0.8 , tasty-hunit- , immortal , transformers+ , immortal , stm- , lifted-base ghc-options: -Wall
src/Control/Immortal.hs view
@@ -16,13 +16,12 @@ , onUnexpectedFinish ) where -import Control.Exception.Lifted-import Control.Monad.Base-import Control.Monad.Trans.Control-import Control.Concurrent.Lifted+import Control.Concurrent+import Control.Concurrent.STM+import Control.Exception+import Control.Monad.IO.Unlift import Data.IORef import GHC.Conc (labelThread)-import Control.Concurrent.STM -- | Immortal thread identifier (including its underlying 'ThreadId') data Thread = Thread ThreadId (IORef Bool) (TVar Bool)@@ -31,47 +30,38 @@ -- -- If the computation ever finishes (either normally or due to an exception), -- it will be restarted (in the same thread).------ The monadic «state» (captured by the 'MonadBaseControl' instance) will--- be preserved if the computation terminates normally, and reset when the--- exception is thrown, so be cautious when @m@ is stateful.--- It is completely safe, however, to instantiate @m@ with--- something like @ReaderT conf IO@ to pass configuration to the new--- thread. create- :: MonadBaseControl IO m+ :: MonadUnliftIO m => (Thread -> m ()) -> m Thread-create a = uninterruptibleMask $ \restore -> do+create a = withRunInIO $ \run -> uninterruptibleMask $ \restore -> do -- Why use uninterruptibleMask instead of just mask? We're not using any -- blocking operations so far, so there should be no difference. Still,- -- better be safe than sorry. Besides, we're using operations from- -- `MonadBaseControl` and related instances, and those could potentially- -- (though unlikely) block.- stopRef <- liftBase $ newIORef False- finishedRef <- liftBase $ newTVarIO False+ -- better be safe than sorry.+ stopRef <- newIORef False+ finishedRef <- newTVarIO False let go = do -- construct a thread object from within the thread itself pid <- myThreadId let thread = Thread pid stopRef finishedRef - handle (\(_ :: SomeException) -> return ()) (restore $ a thread)+ handle (\(_ :: SomeException) -> return ()) (restore $ run $ a thread) - stopNow <- liftBase $ readIORef stopRef+ stopNow <- readIORef stopRef if stopNow then- liftBase $ atomically $ writeTVar finishedRef True+ atomically $ writeTVar finishedRef True else go- pid <- fork go+ pid <- forkIO go return $ Thread pid stopRef finishedRef -- | Like 'create', but also apply the given label to the thread -- (using 'labelThread').-createWithLabel :: MonadBaseControl IO m => String -> (Thread -> m ()) -> m Thread+createWithLabel :: MonadUnliftIO m => String -> (Thread -> m ()) -> m Thread createWithLabel label a = do thread <- create a- liftBase $ labelThread (threadId thread) label+ liftIO $ labelThread (threadId thread) label return thread -- | Make a thread mortal. Next time a mortal thread attempts to finish,@@ -124,24 +114,24 @@ -- -- This is nothing more than a simple wrapper around 'try'. onFinish- :: MonadBaseControl IO m+ :: MonadUnliftIO m => (Either SomeException () -> m ()) -> m () -> m ()-onFinish cb a = try a >>= cb+onFinish cb a = withRunInIO $ \run -> try (run a) >>= run . cb -- | Like 'onFinish', but the callback does not run when the thread is -- mortalized (i.e. when the exit is expected). -- -- The 'Thread' argument is used to find out the mortality of the thread. onUnexpectedFinish- :: MonadBaseControl IO m+ :: MonadUnliftIO m => Thread -> (Either SomeException () -> m ()) -> m () -> m ()-onUnexpectedFinish (Thread _ stopRef _) cb a = do- r <- try a- expected <- liftBase $ readIORef stopRef+onUnexpectedFinish (Thread _ stopRef _) cb a = withRunInIO $ \run -> do+ r <- try $ run a+ expected <- readIORef stopRef if expected then return ()- else cb r+ else run $ cb r
tests/test.hs view
@@ -7,7 +7,6 @@ import Control.Exception import Control.Concurrent import Control.Concurrent.STM-import Control.Monad.Trans.State import Control.Monad.IO.Class import System.Timeout @@ -54,28 +53,6 @@ v <- atomically $ readTVar tv assertBool "Thread did not stop" (not v) - , testCase "state is preserved when there are no exceptions" $ do- tv <- atomically $ newTVar 0- pid <- flip evalStateT 0 $ Immortal.create $ const $ countToFive tv- (do- delay- v <- atomically $ readTVar tv- v @?= 5) `finally` Immortal.stop pid-- , testCase "state is reset when there are exceptions" $ do- tv <- atomically $ newTVar 0- let- computation = do- countToFive tv- liftIO delay- error "bah!"- pid <- flip evalStateT 0 $ Immortal.create $ const computation- (do- threadDelay (5*10^5)- v <- atomically $ readTVar tv- v @?= 0)- `finally` Immortal.stop pid- , testCase "onFinish detects normal exit" $ do tv <- atomically $ newTVar Nothing let@@ -214,11 +191,3 @@ delay :: IO () delay = threadDelay (10^5) -- 0.1 s--countToFive :: TVar Int -> StateT Int IO ()-countToFive tv = do- n <- get- liftIO $ atomically $ writeTVar tv n- if n == 5- then liftIO sleep- else put $! n+1