packages feed

slave-thread (empty) → 0.1.0

raw patch · 5 files changed

+294/−0 lines, 5 filesdep +HTFdep +HUnitdep +QuickChecksetup-changed

Dependencies added: HTF, HUnit, QuickCheck, base, base-prelude, list-t, mmorph, partial-handler, quickcheck-instances, slave-thread, stm-containers, transformers

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2014, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ library/SlaveThread.hs view
@@ -0,0 +1,74 @@+module SlaveThread+(+  fork,+  forkFinally,+)+where++import BasePrelude hiding (forkFinally)+import Control.Monad.Trans.Reader+import Control.Monad.Morph+import qualified STMContainers.Multimap as Multimap+import qualified PartialHandler+import qualified ListT+++-- |+-- A global registry of all slave threads by their masters.+slaves :: Multimap.Multimap ThreadId ThreadId+slaves =+  unsafePerformIO $ Multimap.newIO++-- |+-- Fork a slave thread to run a computation on.+fork :: IO a -> IO ThreadId+fork main =+  forkFinally (return ()) main++-- |+-- Fork a slave thread with a finalizer action to run a computation on.+-- The finalizer gets executed when the thread dies for whatever reason:+-- due to being killed or an uncaught exception, or a normal termination.+-- +-- Note the order of arguments:+-- >forkFinally finalizer computation+forkFinally :: IO a -> IO b -> IO ThreadId+forkFinally finalizer computation =+  do+    masterThread <- myThreadId+    -- Ensures that the thread gets registered before this function returns.+    semaphore <- newEmptyMVar+    slaveThread <-+      mask $ \restore -> forkIO $ do+        slaveThread <- myThreadId+        atomically $ Multimap.insert slaveThread masterThread slaves+        putMVar semaphore ()+        r <- try $ restore computation+        -- Context management:+        killSlaves slaveThread+        waitForSlavesToDie slaveThread+        -- Finalization and rethrowing of exceptions into the master thread:+        forM_ (left r) $ +          PartialHandler.totalizeRethrowingTo_ masterThread $ +            PartialHandler.onThreadKilled (return ())+        try finalizer >>= \r ->+          forM_ (left r) $ PartialHandler.totalizeRethrowingTo_ masterThread $ mempty+        -- Unregister from the global state,+        -- thus informing the master of this thread's death.+        atomically $ Multimap.delete slaveThread masterThread slaves+    takeMVar semaphore+    return slaveThread+  where+    left = either Just (const Nothing)++killSlaves :: ThreadId -> IO ()+killSlaves thread =+  ListT.traverse_ killThread $ hoist atomically $ Multimap.streamByKey thread slaves++waitForSlavesToDie :: ThreadId -> IO ()+waitForSlavesToDie thread =+  atomically $ do+    null <- ListT.null $ Multimap.streamByKey thread slaves+    if null+      then return ()+      else retry
+ slave-thread.cabal view
@@ -0,0 +1,119 @@+name:+  slave-thread+version:+  0.1.0+synopsis:+  A solution to ghost threads and silent exceptions+description:+  Vanilla thread management in Haskell is low level and +  it does not approach the problems related to thread deaths.+  When it's used naively the following typical problems arise:+  .+  * When a forked thread dies due to an uncaught exception,+  the exception does not get raised in the main thread,+  which is why the program continues to run as if nothing happened,+  i.e., with the presumption that the already dead thread is running normally.+  It does not need an explanation +  that this may bring your program to a chaotic state.+  .+  * Another issue is that one thread dying does not+  affect any of the threads forked from it.+  That's why your program may be accumulating ghost threads.+  .+  * Ever dealt with your program ignoring the \<Ctrl-C\> strikes?+  .+  This library solves all the issues above with a concept of a slave thread.+  A slave thread has the following properties:+  .+  1. When it dies for whatever reason (exception or finishing normally)+  it kills all the slave threads that were forked from it.+  This protects you from ghost threads.+  .+  2. It waits for all slaves to die and execute their finalizers +  before executing its own finalizer and getting released itself.+  This gives you hierarchical releasing of resources.+  .+  3. When a slave thread dies with an uncaught exception+  it reraises it in the parent thread.+  This protects you from silent exceptions.+  If your program is brought to an erroneous state +  you can be sure of getting informed.+category:+  Concurrency, Concurrent, Error Handling, Exceptions, Failure+homepage:+  https://github.com/nikita-volkov/slave-thread +bug-reports:+  https://github.com/nikita-volkov/slave-thread/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2014, Nikita Volkov+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/nikita-volkov/slave-thread.git+++library+  hs-source-dirs:+    library+  other-modules:+  exposed-modules:+    SlaveThread+  build-depends:+    -- data:+    stm-containers >= 0.2.0 && < 0.3,+    -- control:+    partial-handler >= 0.1.0 && < 0.2,+    list-t >= 0.2.4 && < 0.3,+    mmorph >= 1.0.4 && < 1.1,+    transformers >= 0.3 && < 0.5,+    -- general:+    base-prelude >= 0.1.3 && < 0.2,+    base >= 4.5 && < 4.8+  ghc-options:+    -funbox-strict-fields+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+++test-suite tests+  type:             +    exitcode-stdio-1.0+  hs-source-dirs:   +    tests+  main-is:          +    Main.hs+  build-depends:+    slave-thread,+    -- testing:+    HTF == 0.12.*,+    quickcheck-instances == 0.3.*,+    QuickCheck == 2.7.*,+    HUnit == 1.2.*,+    -- data:+    base-prelude >= 0.1.3 && < 0.2,+    base >= 4.5 && < 4.8+  ghc-options:+    -threaded+    "-with-rtsopts=-N"+    -funbox-strict-fields+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010
+ tests/Main.hs view
@@ -0,0 +1,77 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+module Main where++import BasePrelude+import Test.Framework+import Test.QuickCheck.Instances+import qualified SlaveThread as S+++main = +  htfMain $ htf_thisModulesTests+++test_forkedThreadsRunFine = +  replicateM 100 $ do+    var <- newIORef 0+    let increment = modifyIORef var (+1)+    S.fork $ do+      increment+      S.fork $ do+        increment+      S.fork $ do+        increment+      threadDelay $ 10^5+    threadDelay $ 20 * 10^3+    assertEqual 3 =<< readIORef var++test_killingAThreadKillsDeepSlaves = +  replicateM 1000 $ do+    var <- newIORef 0+    let increment = modifyIORef var (+1)+    thread <- +      S.fork $ do+        S.fork $ do+          S.fork $ do+            threadDelay $ 10^5+            increment+          S.fork $ do+            increment+          threadDelay $ 10^6+        threadDelay $ 10^6+    threadDelay $ 10^4+    killThread thread+    assertEqual 1 =<< readIORef var++test_dyingNormallyKillsSlaves = +  replicateM 100 $ do+    var <- newIORef 0+    let increment = modifyIORef var (+1)+    S.fork $ do+      S.fork $ do+        threadDelay $ 10^4+        increment+      S.fork $ do+        threadDelay $ 10^4+        increment+    threadDelay $ 10^5+    assertEqual 0 =<< readIORef var++test_finalizationOrder = +  replicateM 1000 $ do+    var <- newIORef 0+    S.forkFinally (modifyIORef var (*2)) $ do+      S.forkFinally (modifyIORef var (+1)) $ return ()+      S.forkFinally (modifyIORef var (+1)) $ return ()+    threadDelay $ 10^4+    assertEqual 4 =<< readIORef var++test_exceptionsDontGetLost = +  replicateM 100 $ do+    assertThrowsSomeIO $ do+      S.fork $ do+        S.fork $ do+          error "!"+        threadDelay $ 10^4+      threadDelay $ 10^4+