aivika-transformers 5.6 → 5.7

raw patch · 12 files changed

+200/−25 lines, 12 filesdep +exceptionsdep ~aivikaPVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions

Dependency ranges changed: aivika

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• LICENSE +1/−1
• Simulation/Aivika/IO/Generator.hs +1/−0
• Simulation/Aivika/Trans/Concurrent/MVar.hs +12/−15
• Simulation/Aivika/Trans/Concurrent/MVar.hs-boot +2/−1
• Simulation/Aivika/Trans/Internal/Cont.hs +11/−0
• Simulation/Aivika/Trans/Internal/Dynamics.hs +38/−1
• Simulation/Aivika/Trans/Internal/Event.hs +38/−1
• Simulation/Aivika/Trans/Internal/Parameter.hs +39/−2
• Simulation/Aivika/Trans/Internal/Process.hs +11/−0
• Simulation/Aivika/Trans/Internal/Simulation.hs +38/−1
• aivika-transformers.cabal +4/−3

@@ -1,4 +1,9 @@ +Version 5.7+-----++* Implemented MonadMask and MonadCatch for basic simulation computations.+ Version 5.6 ----- 

@@ -1,4 +1,4 @@-Copyright (c) 2009-2017 David Sorokin <david.sorokin@gmail.com>+Copyright (c) 2009-2018 David Sorokin <david.sorokin@gmail.com>  All rights reserved. 

@@ -22,6 +22,7 @@  import Data.IORef import Data.Vector+import Data.Functor  import Simulation.Aivika.Trans.Generator import Simulation.Aivika.Trans.Generator.Primitive

@@ -14,12 +14,12 @@         withMVarParameter,         withMVarSimulation,         withMVarDynamics,-        withMVarEvent,-        withMVarProcess) where+        withMVarEvent) where  import Control.Concurrent.MVar import Control.Monad import Control.Monad.Trans+import qualified Control.Monad.Catch as MC  import Simulation.Aivika.Trans.Exception import Simulation.Aivika.Trans.Comp@@ -31,49 +31,46 @@ import Simulation.Aivika.Trans.Process  -- | Like 'withMVar' but operates within the specified computation.-withMVarComp :: (MonadComp m, MonadIO m) => MVar a -> (a -> m b) -> m b+withMVarComp :: (MonadComp m, MonadIO m, MC.MonadMask m) => MVar a -> (a -> m b) -> m b withMVarComp v f =+  MC.mask $ \restore ->   do a <- liftIO $ takeMVar v      finallyComp        (f a)        (liftIO $ putMVar v a)  -- | Like 'withMVar' but operates within the 'Parameter' computation.-withMVarParameter :: (MonadComp m, MonadIO m) => MVar a -> (a -> Parameter m b) -> Parameter m b+withMVarParameter :: (MonadComp m, MonadIO m, MC.MonadMask m) => MVar a -> (a -> Parameter m b) -> Parameter m b withMVarParameter v f =+  MC.mask $ \restore ->   do a <- liftIO $ takeMVar v      finallyParameter        (f a)        (liftIO $ putMVar v a)  -- | Like 'withMVar' but operates within the 'Simulation' computation.-withMVarSimulation :: (MonadComp m, MonadIO m) => MVar a -> (a -> Simulation m b) -> Simulation m b+withMVarSimulation :: (MonadComp m, MonadIO m, MC.MonadMask m) => MVar a -> (a -> Simulation m b) -> Simulation m b withMVarSimulation v f =+  MC.mask $ \restore ->   do a <- liftIO $ takeMVar v      finallySimulation        (f a)        (liftIO $ putMVar v a)  -- | Like 'withMVar' but operates within the 'Dynamics' computation.-withMVarDynamics :: (MonadComp m, MonadIO m) => MVar a -> (a -> Dynamics m b) -> Dynamics m b+withMVarDynamics :: (MonadComp m, MonadIO m, MC.MonadMask m) => MVar a -> (a -> Dynamics m b) -> Dynamics m b withMVarDynamics v f =+  MC.mask $ \restore ->   do a <- liftIO $ takeMVar v      finallyDynamics        (f a)        (liftIO $ putMVar v a)  -- | Like 'withMVar' but operates within the 'Event' computation.-withMVarEvent :: (MonadComp m, MonadIO m) => MVar a -> (a -> Event m b) -> Event m b+withMVarEvent :: (MonadComp m, MonadIO m, MC.MonadMask m) => MVar a -> (a -> Event m b) -> Event m b withMVarEvent v f =+  MC.mask $ \restore ->   do a <- liftIO $ takeMVar v      finallyEvent-       (f a)-       (liftIO $ putMVar v a)---- | Like 'withMVar' but operates within the 'Process' computation.-withMVarProcess :: (MonadDES m, MonadIO m) => MVar a -> (a -> Process m b) -> Process m b-withMVarProcess v f =-  do a <- liftIO $ takeMVar v-     finallyProcess        (f a)        (liftIO $ putMVar v a)

@@ -15,7 +15,8 @@ import Control.Concurrent.MVar import Control.Monad import Control.Monad.Trans+import qualified Control.Monad.Catch as MC  import Simulation.Aivika.Trans.Comp -withMVarComp :: (MonadComp m, MonadIO m) => MVar a -> (a -> m b) -> m b+withMVarComp :: (MonadComp m, MonadIO m, MC.MonadMask m) => MVar a -> (a -> m b) -> m b

@@ -60,6 +60,7 @@ import Control.Exception import Control.Monad import Control.Monad.Trans+import qualified Control.Monad.Catch as MC import Control.Applicative  import Debug.Trace (trace)@@ -368,6 +369,16 @@    {-# INLINE (<*>) #-}   (<*>) = ap++instance MonadDES m => MC.MonadThrow (Cont m) where++  {-# INLINE throwM #-}+  throwM = throwCont++instance MonadDES m => MC.MonadCatch (Cont m) where++  {-# INLINE catch #-}+  catch = catchCont  -- | Invoke the computation. invokeCont :: ContParams m a -> Cont m a -> Event m ()

@@ -1,5 +1,5 @@ -{-# LANGUAGE RecursiveDo, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE RecursiveDo, MultiParamTypeClasses, FlexibleInstances, RankNTypes #-}  -- | -- Module     : Simulation.Aivika.Trans.Internal.Dynamics@@ -37,6 +37,7 @@ import Control.Monad import Control.Monad.Trans import Control.Monad.Fix+import qualified Control.Monad.Catch as MC import Control.Applicative  import Debug.Trace (trace)@@ -258,12 +259,48 @@   Dynamics $ \p ->   throwComp e +-- | Runs an action with asynchronous exceptions disabled.+maskDynamics :: MC.MonadMask m => ((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b) -> Dynamics m b+{-# INLINABLE maskDynamics #-}+maskDynamics a =+  Dynamics $ \p ->+  MC.mask $ \u ->+  invokeDynamics p (a $ q u)+  where q u (Dynamics b) = Dynamics (u . b)++-- | Like 'maskDynamics', but the masked computation is not interruptible.+uninterruptibleMaskDynamics :: MC.MonadMask m => ((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b) -> Dynamics m b+{-# INLINABLE uninterruptibleMaskDynamics #-}+uninterruptibleMaskDynamics a =+  Dynamics $ \p ->+  MC.uninterruptibleMask $ \u ->+  invokeDynamics p (a $ q u)+  where q u (Dynamics b) = Dynamics (u . b)+ instance MonadFix m => MonadFix (Dynamics m) where    {-# INLINE mfix #-}   mfix f =      Dynamics $ \p ->     do { rec { a <- invokeDynamics p (f a) }; return a }++instance MonadException m => MC.MonadThrow (Dynamics m) where++  {-# INLINE throwM #-}+  throwM = throwDynamics++instance MonadException m => MC.MonadCatch (Dynamics m) where++  {-# INLINE catch #-}+  catch = catchDynamics++instance (MonadException m, MC.MonadMask m) => MC.MonadMask (Dynamics m) where++  {-# INLINE mask #-}+  mask = maskDynamics+  +  {-# INLINE uninterruptibleMask #-}+  uninterruptibleMask = uninterruptibleMaskDynamics  -- | Computation that returns the current simulation time. time :: Monad m => Dynamics m Double

@@ -1,5 +1,5 @@ -{-# LANGUAGE RecursiveDo, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, MonoLocalBinds #-}+{-# LANGUAGE RecursiveDo, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, MonoLocalBinds, RankNTypes #-}  -- | -- Module     : Simulation.Aivika.Trans.Internal.Event@@ -62,6 +62,7 @@ import Control.Monad import Control.Monad.Trans import Control.Monad.Fix+import qualified Control.Monad.Catch as MC import Control.Applicative  import Debug.Trace (trace)@@ -164,12 +165,48 @@   Event $ \p ->   throwComp e +-- | Runs an action with asynchronous exceptions disabled.+maskEvent :: MC.MonadMask m => ((forall a. Event m a -> Event m a) -> Event m b) -> Event m b+{-# INLINABLE maskEvent #-}+maskEvent a =+  Event $ \p ->+  MC.mask $ \u ->+  invokeEvent p (a $ q u)+  where q u (Event b) = Event (u . b)++-- | Like 'maskEvent', but the masked computation is not interruptible.+uninterruptibleMaskEvent :: MC.MonadMask m => ((forall a. Event m a -> Event m a) -> Event m b) -> Event m b+{-# INLINABLE uninterruptibleMaskEvent #-}+uninterruptibleMaskEvent a =+  Event $ \p ->+  MC.uninterruptibleMask $ \u ->+  invokeEvent p (a $ q u)+  where q u (Event b) = Event (u . b)+ instance MonadFix m => MonadFix (Event m) where    {-# INLINE mfix #-}   mfix f =      Event $ \p ->     do { rec { a <- invokeEvent p (f a) }; return a }++instance MonadException m => MC.MonadThrow (Event m) where++  {-# INLINE throwM #-}+  throwM = throwEvent++instance MonadException m => MC.MonadCatch (Event m) where++  {-# INLINE catch #-}+  catch = catchEvent++instance (MonadException m, MC.MonadMask m) => MC.MonadMask (Event m) where++  {-# INLINE mask #-}+  mask = maskEvent+  +  {-# INLINE uninterruptibleMask #-}+  uninterruptibleMask = uninterruptibleMaskEvent  -- | Run the 'Event' computation in the start time involving all -- pending 'CurrentEvents' in the processing too.

@@ -1,5 +1,5 @@ -{-# LANGUAGE RecursiveDo, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE RecursiveDo, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, RankNTypes #-}  -- | -- Module     : Simulation.Aivika.Trans.Internal.Parameter@@ -45,6 +45,7 @@ import Control.Monad import Control.Monad.Trans import Control.Monad.Fix+import qualified Control.Monad.Catch as MC import Control.Applicative  import Data.IORef@@ -274,6 +275,24 @@   Parameter $ \r ->   throwComp e +-- | Runs an action with asynchronous exceptions disabled.+maskParameter :: MC.MonadMask m => ((forall a. Parameter m a -> Parameter m a) -> Parameter m b) -> Parameter m b+{-# INLINABLE maskParameter #-}+maskParameter a =+  Parameter $ \r ->+  MC.mask $ \u ->+  invokeParameter r (a $ q u)+  where q u (Parameter b) = Parameter (u . b)++-- | Like 'maskParameter', but the masked computation is not interruptible.+uninterruptibleMaskParameter :: MC.MonadMask m => ((forall a. Parameter m a -> Parameter m a) -> Parameter m b) -> Parameter m b+{-# INLINABLE uninterruptibleMaskParameter #-}+uninterruptibleMaskParameter a =+  Parameter $ \r ->+  MC.uninterruptibleMask $ \u ->+  invokeParameter r (a $ q u)+  where q u (Parameter b) = Parameter (u . b)+ instance MonadFix m => MonadFix (Parameter m) where    {-# INLINE mfix #-}@@ -281,11 +300,29 @@     Parameter $ \r ->     do { rec { a <- invokeParameter r (f a) }; return a } +instance MonadException m => MC.MonadThrow (Parameter m) where++  {-# INLINE throwM #-}+  throwM = throwParameter++instance MonadException m => MC.MonadCatch (Parameter m) where++  {-# INLINE catch #-}+  catch = catchParameter++instance (MonadException m, MC.MonadMask m) => MC.MonadMask (Parameter m) where++  {-# INLINE mask #-}+  mask = maskParameter+  +  {-# INLINE uninterruptibleMask #-}+  uninterruptibleMask = uninterruptibleMaskParameter+ -- | Memoize the 'Parameter' computation, always returning the same value -- within a simulation run. However, the value will be recalculated for other -- simulation runs. Also it is thread-safe when different simulation runs -- are executed in parallel on physically different operating system threads.-memoParameter :: (MonadComp m, MonadIO m) => Parameter m a -> m (Parameter m a)+memoParameter :: (MonadComp m, MonadIO m, MC.MonadMask m) => Parameter m a -> m (Parameter m a) memoParameter x =    do lock <- liftIO $ newMVar ()      dict <- liftIO $ newIORef M.empty

@@ -100,6 +100,7 @@ import Control.Exception import Control.Monad import Control.Monad.Trans+import qualified Control.Monad.Catch as MC import Control.Applicative  import Simulation.Aivika.Trans.Ref.Base@@ -528,6 +529,16 @@    {-# INLINE liftProcess #-}   liftProcess = id++instance MonadDES m => MC.MonadThrow (Process m) where++  {-# INLINE throwM #-}+  throwM = throwProcess++instance MonadDES m => MC.MonadCatch (Process m) where++  {-# INLINE catch #-}+  catch = catchProcess  -- | Exception handling within 'Process' computations. catchProcess :: (MonadDES m, Exception e) => Process m a -> (e -> Process m a) -> Process m a

@@ -1,5 +1,5 @@ -{-# LANGUAGE RecursiveDo, TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE RecursiveDo, TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances, RankNTypes #-}  -- | -- Module     : Simulation.Aivika.Trans.Internal.Simulation@@ -33,6 +33,7 @@ import Control.Monad import Control.Monad.Trans import Control.Monad.Fix+import qualified Control.Monad.Catch as MC import Control.Applicative  import Simulation.Aivika.Trans.Exception@@ -174,9 +175,45 @@   Simulation $ \r ->   throwComp e +-- | Runs an action with asynchronous exceptions disabled.+maskSimulation :: MC.MonadMask m => ((forall a. Simulation m a -> Simulation m a) -> Simulation m b) -> Simulation m b+{-# INLINABLE maskSimulation #-}+maskSimulation a =+  Simulation $ \r ->+  MC.mask $ \u ->+  invokeSimulation r (a $ q u)+  where q u (Simulation b) = Simulation (u . b)++-- | Like 'maskSimulation', but the masked computation is not interruptible.+uninterruptibleMaskSimulation :: MC.MonadMask m => ((forall a. Simulation m a -> Simulation m a) -> Simulation m b) -> Simulation m b+{-# INLINABLE uninterruptibleMaskSimulation #-}+uninterruptibleMaskSimulation a =+  Simulation $ \r ->+  MC.uninterruptibleMask $ \u ->+  invokeSimulation r (a $ q u)+  where q u (Simulation b) = Simulation (u . b)+ instance MonadFix m => MonadFix (Simulation m) where    {-# INLINE mfix #-}   mfix f =      Simulation $ \r ->     do { rec { a <- invokeSimulation r (f a) }; return a }++instance MonadException m => MC.MonadThrow (Simulation m) where++  {-# INLINE throwM #-}+  throwM = throwSimulation++instance MonadException m => MC.MonadCatch (Simulation m) where++  {-# INLINE catch #-}+  catch = catchSimulation++instance (MonadException m, MC.MonadMask m) => MC.MonadMask (Simulation m) where++  {-# INLINE mask #-}+  mask = maskSimulation+  +  {-# INLINE uninterruptibleMask #-}+  uninterruptibleMask = uninterruptibleMaskSimulation

@@ -1,5 +1,5 @@ name:            aivika-transformers-version:         5.6+version:         5.7 synopsis:        Transformers for the Aivika simulation library description:     This package is a generalization of the aivika [1] simulation library@@ -27,7 +27,7 @@ category:        Simulation license:         BSD3 license-file:    LICENSE-copyright:       (c) 2009-2017. David Sorokin <david.sorokin@gmail.com>+copyright:       (c) 2009-2018. David Sorokin <david.sorokin@gmail.com> author:          David Sorokin maintainer:      David Sorokin <david.sorokin@gmail.com> homepage:        http://www.aivikasoft.com@@ -176,7 +176,8 @@                      mwc-random >= 0.13.0.0,                      vector >= 0.10.0.1,                      semigroups >= 0.10,-                     aivika >= 5.6+                     exceptions >= 0.6,+                     aivika >= 5.7      other-extensions:   FlexibleContexts,                         FlexibleInstances,