Improving error handling.

Etage.cabal

@@ -1,5 +1,5 @@
 Name:                Etage
-Version:             0.1.3
+Version:             0.1.4
 Synopsis:            A general data-flow framework
 Description:         A general data-flow framework featuring nondeterminism, laziness and neurological pseudo-terminology. It can be
                      used for example for data-flow computations or event propagation networks. It tries hard to aide type checking and to
@@ -21,7 +21,7 @@ License-file:        LICENSE
 Author:              Mitar Milutinovic
 Maintainer:          mitar.haskell@tnode.com
 Copyright:           (c) 2010 Mitar Milutinovic
-Category:            Control
+Category:            Control, AI
 Build-type:          Simple
 Cabal-version:       >= 1.8
 Stability:           experimental

lib/Control/Etage/Externals.hs

@@ -56,8 +56,7 @@ module Control.Etage.Externals (
   prepareEnvironment,
   getCurrentImpulseTime,
   impulseEq,
-  impulseCompare,
-  bracketOnErrorUnmasked
+  impulseCompare
 ) where
 
 import Prelude hiding (catch)
@@ -68,6 +67,7 @@ import Data.Function
 import Data.List
 import Control.Exception
 import Data.Time.Clock.POSIX
+import GHC.IO (unsafeUnmask)
 import GHC.Conc (forkOnIO, numCapabilities)
 import System.IO
 import System.Posix.Signals
@@ -295,13 +295,14 @@ exception. In the later case it rethrows an exception in the parent 'Neuron' (or
 has 'dissolve'd for 'detachAndWait' and 'detachManyAndWait'.
 -}
 attach' :: Neuron n => (NeuronOptions n -> NeuronOptions n) -> Nerve (NeuronFromImpulse n) fromConductivity (NeuronForImpulse n) forConductivity -> IO LiveNeuron
-attach' optionsSetter nerve = mask $ \restore -> do
+attach' optionsSetter nerve = mask_ $ do
   currentThread <- myThreadId
   dissolved <- newEmptySampleVar
   defOptions <- mkDefaultOptions
   let options = optionsSetter defOptions
   nid <- divideNeuron options $
-           bracket (grow options) dissolve (restore . live nerve) `catches` [
+           -- TODO: Remove unsafeUnmask in favor of forkIOWithUnmask when it will be available
+           bracket (grow options) dissolve (unsafeUnmask . live nerve) `catches` [
                Handler (\(_ :: DissolveException) -> return ()), -- we ignore DissolveException
                Handler (\(e :: SomeException) -> uninterruptible $ throwTo currentThread e)
              ] `finally` uninterruptible (writeSampleVar dissolved ())
@@ -429,12 +430,3 @@ Useful for 'Neuron's which operate on all types of 'Impulse's and want 'Ord' def
 -}
 impulseCompare :: (Impulse i, Impulse j) => i -> j -> Ordering
 impulseCompare a b = (impulseTime a, impulseValue a) `compare` (impulseTime b, impulseValue b)
-
-{-|
-Similar to 'bracketOnError' only that the first computation does not have asynchronous exceptions masked.
--}
-bracketOnErrorUnmasked :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
-bracketOnErrorUnmasked before after thing =
-  mask $ \restore -> do
-    a <- restore before
-    restore (thing a) `onException` after a

lib/Control/Etage/Incubator.hs

@@ -54,15 +54,15 @@ module Control.Etage.Incubator (
   -- > grow options = do
   -- >   ...
   -- >   nerve <- growNerve
-  -- >   bracketOnErrorUnmasked (attach defaultOptions nerve) detachAndWait $ \neuron -> do
+  -- >   bracketOnError (attach defaultOptions nerve) detachAndWait $ \neuron -> do
   -- >     ...
   -- >     return $ YourNeuron ... neuron nerve
   -- >
   -- > dissolve (YourNeuron ... neuron _) = do
   -- >   detachAndWait neuron
   -- >   ...
   --
-  -- We use 'bracketOnErrorUnmasked' there to be sure that 'Neuron' is properly 'dissolve'd even if there is an exception later on in
+  -- We use 'bracketOnError' there to be sure that 'Neuron' is properly 'dissolve'd even if there is an exception later on in
   -- 'grow'ing the parent 'Neuron'. And we use 'detachAndWait' so that we give time for child 'Neuron' to 'dissolve' properly.
   -- Which 'Neuron' you want is in this case inferred from the type of the 'Nerve' you defined.
   growNerve,
@@ -117,7 +117,7 @@ interpret neurons chans attached = viewT >=> eval neurons chans attached
           eval ns cs ats (NeuronOperation optionsSetter :>>= is) = do
             nerve <- liftIO growNerve
             let c = getFromChan nerve
-            bracketOnErrorUnmasked (attach optionsSetter nerve) detachAndWait $ \n -> interpret (n:ns) (c ++ cs) ats . is $ nerve
+            bracketOnError (attach optionsSetter nerve) detachAndWait $ \n -> interpret (n:ns) (c ++ cs) ats . is $ nerve
           eval ns cs ats (AttachOperation from for :>>= is) = do
             let c = head . getFromChan $ from -- we know there exists from chan as type checking assures that (from is conductive)
             (from', ats') <- if c `notElem` ats