{-# LANGUAGE RecursiveDo, MultiParamTypeClasses, FlexibleInstances, RankNTypes #-}

-- |
-- Module     : Simulation.Aivika.Trans.Internal.Dynamics
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- The module defines the 'Dynamics' monad transformer representing a time varying polymorphic function. 
--
module Simulation.Aivika.Trans.Internal.Dynamics
       (-- * Dynamics
        Dynamics(..),
        DynamicsLift(..),
        invokeDynamics,
        runDynamicsInStartTime,
        runDynamicsInStopTime,
        runDynamicsInIntegTimes,
        runDynamicsInTime,
        runDynamicsInTimes,
        -- * Error Handling
        catchDynamics,
        finallyDynamics,
        throwDynamics,
        -- * Simulation Time
        time,
        isTimeInteg,
        integIteration,
        integPhase,
        -- * Debugging
        traceDynamics) where

import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Fix
import Control.Monad.Fail
import qualified Control.Monad.Catch as MC
import Control.Applicative

import Debug.Trace (trace)

import Simulation.Aivika.Trans.Exception
import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.Internal.Types
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Parameter
import Simulation.Aivika.Trans.Internal.Simulation

instance Monad m => Monad (Dynamics m) where

  {-# INLINE (>>=) #-}
  (Dynamics Point m -> m a
m) >>= :: forall a b. Dynamics m a -> (a -> Dynamics m b) -> Dynamics m b
>>= a -> Dynamics m b
k =
    forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p -> 
    do a
a <- Point m -> m a
m Point m
p
       let Dynamics Point m -> m b
m' = a -> Dynamics m b
k a
a
       Point m -> m b
m' Point m
p

-- | Run the 'Dynamics' computation in the initial time point.
runDynamicsInStartTime :: Dynamics m a -> Simulation m a
{-# INLINABLE runDynamicsInStartTime #-}
runDynamicsInStartTime :: forall (m :: * -> *) a. Dynamics m a -> Simulation m a
runDynamicsInStartTime (Dynamics Point m -> m a
m) =
  forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation forall a b. (a -> b) -> a -> b
$ Point m -> m a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Run m -> Point m
integStartPoint

-- | Run the 'Dynamics' computation in the final time point.
runDynamicsInStopTime :: Dynamics m a -> Simulation m a
{-# INLINABLE runDynamicsInStopTime #-}
runDynamicsInStopTime :: forall (m :: * -> *) a. Dynamics m a -> Simulation m a
runDynamicsInStopTime (Dynamics Point m -> m a
m) =
  forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation forall a b. (a -> b) -> a -> b
$ Point m -> m a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Run m -> Point m
simulationStopPoint

-- | Run the 'Dynamics' computation in all integration time points.
runDynamicsInIntegTimes :: Monad m => Dynamics m a -> Simulation m [m a]
{-# INLINABLE runDynamicsInIntegTimes #-}
runDynamicsInIntegTimes :: forall (m :: * -> *) a.
Monad m =>
Dynamics m a -> Simulation m [m a]
runDynamicsInIntegTimes (Dynamics Point m -> m a
m) =
  forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Point m -> m a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Run m -> [Point m]
integPoints

-- | Run the 'Dynamics' computation in the specified time point.
runDynamicsInTime :: Double -> Dynamics m a -> Simulation m a
{-# INLINABLE runDynamicsInTime #-}
runDynamicsInTime :: forall (m :: * -> *) a. Double -> Dynamics m a -> Simulation m a
runDynamicsInTime Double
t (Dynamics Point m -> m a
m) =
  forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation forall a b. (a -> b) -> a -> b
$ \Run m
r -> Point m -> m a
m forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Run m -> Double -> EventPriority -> Point m
pointAt Run m
r Double
t EventPriority
0

-- | Run the 'Dynamics' computation in the specified time points.
runDynamicsInTimes :: Monad m => [Double] -> Dynamics m a -> Simulation m [m a]
{-# INLINABLE runDynamicsInTimes #-}
runDynamicsInTimes :: forall (m :: * -> *) a.
Monad m =>
[Double] -> Dynamics m a -> Simulation m [m a]
runDynamicsInTimes [Double]
ts (Dynamics Point m -> m a
m) =
  forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation forall a b. (a -> b) -> a -> b
$ \Run m
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Double
t -> Point m -> m a
m forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Run m -> Double -> EventPriority -> Point m
pointAt Run m
r Double
t EventPriority
0) [Double]
ts 

instance Functor m => Functor (Dynamics m) where
  
  {-# INLINE fmap #-}
  fmap :: forall a b. (a -> b) -> Dynamics m a -> Dynamics m b
fmap a -> b
f (Dynamics Point m -> m a
x) = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall a b. (a -> b) -> a -> b
$ Point m -> m a
x Point m
p

instance Applicative m => Applicative (Dynamics m) where
  
  {-# INLINE pure #-}
  pure :: forall a. a -> Dynamics m a
pure = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  
  {-# INLINE (<*>) #-}
  (Dynamics Point m -> m (a -> b)
x) <*> :: forall a b. Dynamics m (a -> b) -> Dynamics m a -> Dynamics m b
<*> (Dynamics Point m -> m a
y) = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p -> Point m -> m (a -> b)
x Point m
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point m -> m a
y Point m
p

instance Monad m => MonadFail (Dynamics m) where

  {-# INLINE fail #-}
  fail :: forall a. String -> Dynamics m a
fail = forall a. HasCallStack => String -> a
error

liftMD :: Monad m => (a -> b) -> Dynamics m a -> Dynamics m b
{-# INLINE liftMD #-}
liftMD :: forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD a -> b
f (Dynamics Point m -> m a
x) =
  forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p -> do { a
a <- Point m -> m a
x Point m
p; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> b
f a
a }

liftM2D :: Monad m => (a -> b -> c) -> Dynamics m a -> Dynamics m b -> Dynamics m c
{-# INLINE liftM2D #-}
liftM2D :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Dynamics m a -> Dynamics m b -> Dynamics m c
liftM2D a -> b -> c
f (Dynamics Point m -> m a
x) (Dynamics Point m -> m b
y) =
  forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p -> do { a
a <- Point m -> m a
x Point m
p; b
b <- Point m -> m b
y Point m
p; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
a b
b }

instance (Num a, Monad m) => Num (Dynamics m a) where

  {-# INLINE (+) #-}
  Dynamics m a
x + :: Dynamics m a -> Dynamics m a -> Dynamics m a
+ Dynamics m a
y = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Dynamics m a -> Dynamics m b -> Dynamics m c
liftM2D forall a. Num a => a -> a -> a
(+) Dynamics m a
x Dynamics m a
y

  {-# INLINE (-) #-}
  Dynamics m a
x - :: Dynamics m a -> Dynamics m a -> Dynamics m a
- Dynamics m a
y = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Dynamics m a -> Dynamics m b -> Dynamics m c
liftM2D (-) Dynamics m a
x Dynamics m a
y

  {-# INLINE (*) #-}
  Dynamics m a
x * :: Dynamics m a -> Dynamics m a -> Dynamics m a
* Dynamics m a
y = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Dynamics m a -> Dynamics m b -> Dynamics m c
liftM2D forall a. Num a => a -> a -> a
(*) Dynamics m a
x Dynamics m a
y

  {-# INLINE negate #-}
  negate :: Dynamics m a -> Dynamics m a
negate = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Num a => a -> a
negate

  {-# INLINE abs #-}
  abs :: Dynamics m a -> Dynamics m a
abs = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Num a => a -> a
abs

  {-# INLINE signum #-}
  signum :: Dynamics m a -> Dynamics m a
signum = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Num a => a -> a
signum

  {-# INLINE fromInteger #-}
  fromInteger :: Integer -> Dynamics m a
fromInteger Integer
i = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
i

instance (Fractional a, Monad m) => Fractional (Dynamics m a) where

  {-# INLINE (/) #-}
  Dynamics m a
x / :: Dynamics m a -> Dynamics m a -> Dynamics m a
/ Dynamics m a
y = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Dynamics m a -> Dynamics m b -> Dynamics m c
liftM2D forall a. Fractional a => a -> a -> a
(/) Dynamics m a
x Dynamics m a
y

  {-# INLINE recip #-}
  recip :: Dynamics m a -> Dynamics m a
recip = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Fractional a => a -> a
recip

  {-# INLINE fromRational #-}
  fromRational :: Rational -> Dynamics m a
fromRational Rational
t = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
t

instance (Floating a, Monad m) => Floating (Dynamics m a) where

  {-# INLINE pi #-}
  pi :: Dynamics m a
pi = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Floating a => a
pi

  {-# INLINE exp #-}
  exp :: Dynamics m a -> Dynamics m a
exp = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
exp

  {-# INLINE log #-}
  log :: Dynamics m a -> Dynamics m a
log = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
log

  {-# INLINE sqrt #-}
  sqrt :: Dynamics m a -> Dynamics m a
sqrt = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
sqrt

  {-# INLINE (**) #-}
  Dynamics m a
x ** :: Dynamics m a -> Dynamics m a -> Dynamics m a
** Dynamics m a
y = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Dynamics m a -> Dynamics m b -> Dynamics m c
liftM2D forall a. Floating a => a -> a -> a
(**) Dynamics m a
x Dynamics m a
y

  {-# INLINE sin #-}
  sin :: Dynamics m a -> Dynamics m a
sin = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
sin

  {-# INLINE cos #-}
  cos :: Dynamics m a -> Dynamics m a
cos = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
cos

  {-# INLINE tan #-}
  tan :: Dynamics m a -> Dynamics m a
tan = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
tan

  {-# INLINE asin #-}
  asin :: Dynamics m a -> Dynamics m a
asin = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
asin

  {-# INLINE acos #-}
  acos :: Dynamics m a -> Dynamics m a
acos = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
acos

  {-# INLINE atan #-}
  atan :: Dynamics m a -> Dynamics m a
atan = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
atan

  {-# INLINE sinh #-}
  sinh :: Dynamics m a -> Dynamics m a
sinh = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
sinh

  {-# INLINE cosh #-}
  cosh :: Dynamics m a -> Dynamics m a
cosh = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
cosh

  {-# INLINE tanh #-}
  tanh :: Dynamics m a -> Dynamics m a
tanh = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
tanh

  {-# INLINE asinh #-}
  asinh :: Dynamics m a -> Dynamics m a
asinh = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
asinh

  {-# INLINE acosh #-}
  acosh :: Dynamics m a -> Dynamics m a
acosh = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
acosh

  {-# INLINE atanh #-}
  atanh :: Dynamics m a -> Dynamics m a
atanh = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD forall a. Floating a => a -> a
atanh

instance MonadTrans Dynamics where

  {-# INLINE lift #-}
  lift :: forall (m :: * -> *) a. Monad m => m a -> Dynamics m a
lift = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

instance MonadIO m => MonadIO (Dynamics m) where
  
  {-# INLINE liftIO #-}
  liftIO :: forall a. IO a -> Dynamics m a
liftIO = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance Monad m => MonadCompTrans Dynamics m where

  {-# INLINE liftComp #-}
  liftComp :: forall a. m a -> Dynamics m a
liftComp = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

-- | A type class to lift the 'Dynamics' computations into other computations.
class DynamicsLift t m where
  
  -- | Lift the specified 'Dynamics' computation into another computation.
  liftDynamics :: Dynamics m a -> t m a

instance Monad m => DynamicsLift Dynamics m where
  
  {-# INLINE liftDynamics #-}
  liftDynamics :: forall a. Dynamics m a -> Dynamics m a
liftDynamics = forall a. a -> a
id

instance Monad m => SimulationLift Dynamics m where

  {-# INLINE liftSimulation #-}
  liftSimulation :: forall a. Simulation m a -> Dynamics m a
liftSimulation (Simulation Run m -> m a
x) = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ Run m -> m a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Point m -> Run m
pointRun 

instance Monad m => ParameterLift Dynamics m where

  {-# INLINE liftParameter #-}
  liftParameter :: forall a. Parameter m a -> Dynamics m a
liftParameter (Parameter Run m -> m a
x) = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ Run m -> m a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Point m -> Run m
pointRun
  
-- | Exception handling within 'Dynamics' computations.
catchDynamics :: (MonadException m, Exception e) => Dynamics m a -> (e -> Dynamics m a) -> Dynamics m a
{-# INLINABLE catchDynamics #-}
catchDynamics :: forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Dynamics m a -> (e -> Dynamics m a) -> Dynamics m a
catchDynamics (Dynamics Point m -> m a
m) e -> Dynamics m a
h =
  forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p -> 
  forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catchComp (Point m -> m a
m Point m
p) forall a b. (a -> b) -> a -> b
$ \e
e ->
  let Dynamics Point m -> m a
m' = e -> Dynamics m a
h e
e in Point m -> m a
m' Point m
p
                           
-- | A computation with finalization part like the 'finally' function.
finallyDynamics :: MonadException m => Dynamics m a -> Dynamics m b -> Dynamics m a
{-# INLINABLE finallyDynamics #-}
finallyDynamics :: forall (m :: * -> *) a b.
MonadException m =>
Dynamics m a -> Dynamics m b -> Dynamics m a
finallyDynamics (Dynamics Point m -> m a
m) (Dynamics Point m -> m b
m') =
  forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  forall (m :: * -> *) a b. MonadException m => m a -> m b -> m a
finallyComp (Point m -> m a
m Point m
p) (Point m -> m b
m' Point m
p)

-- | Like the standard 'throw' function.
throwDynamics :: (MonadException m, Exception e) => e -> Dynamics m a
{-# INLINABLE throwDynamics #-}
throwDynamics :: forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Dynamics m a
throwDynamics e
e =
  forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp e
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 :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
maskDynamics (forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b
a =
  forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u ->
  forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p ((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b
a forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a} {a}.
(m a -> m a) -> Dynamics m a -> Dynamics m a
q forall a. m a -> m a
u)
  where q :: (m a -> m a) -> Dynamics m a -> Dynamics m a
q m a -> m a
u (Dynamics Point m -> m a
b) = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics (m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point m -> m a
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 :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
uninterruptibleMaskDynamics (forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b
a =
  forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u ->
  forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p ((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b
a forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a} {a}.
(m a -> m a) -> Dynamics m a -> Dynamics m a
q forall a. m a -> m a
u)
  where q :: (m a -> m a) -> Dynamics m a -> Dynamics m a
q m a -> m a
u (Dynamics Point m -> m a
b) = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics (m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point m -> m a
b)

-- | An implementation of 'generalBracket'.
generalBracketDynamics :: MC.MonadMask m
                          => Dynamics m a
                          -> (a -> MC.ExitCase b -> Dynamics m c)
                          -> (a -> Dynamics m b)
                          -> Dynamics m (b, c)
{-# INLINABLE generalBracketDynamics #-}
generalBracketDynamics :: forall (m :: * -> *) a b c.
MonadMask m =>
Dynamics m a
-> (a -> ExitCase b -> Dynamics m c)
-> (a -> Dynamics m b)
-> Dynamics m (b, c)
generalBracketDynamics Dynamics m a
acquire a -> ExitCase b -> Dynamics m c
release a -> Dynamics m b
use =
  forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p -> do
    forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
MC.generalBracket
      (forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p Dynamics m a
acquire)
      (\a
resource ExitCase b
e -> forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> Dynamics m c
release a
resource ExitCase b
e)
      (\a
resource -> forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p forall a b. (a -> b) -> a -> b
$ a -> Dynamics m b
use a
resource)

instance MonadFix m => MonadFix (Dynamics m) where

  {-# INLINE mfix #-}
  mfix :: forall a. (a -> Dynamics m a) -> Dynamics m a
mfix a -> Dynamics m a
f = 
    forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p ->
    do { rec { a
a <- forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p (a -> Dynamics m a
f a
a) }; forall (m :: * -> *) a. Monad m => a -> m a
return a
a }

instance MonadException m => MC.MonadThrow (Dynamics m) where

  {-# INLINE throwM #-}
  throwM :: forall e a. Exception e => e -> Dynamics m a
throwM = forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Dynamics m a
throwDynamics

instance MonadException m => MC.MonadCatch (Dynamics m) where

  {-# INLINE catch #-}
  catch :: forall e a.
Exception e =>
Dynamics m a -> (e -> Dynamics m a) -> Dynamics m a
catch = forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Dynamics m a -> (e -> Dynamics m a) -> Dynamics m a
catchDynamics

instance (MonadException m, MC.MonadMask m) => MC.MonadMask (Dynamics m) where

  {-# INLINE mask #-}
  mask :: forall b.
((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
mask = forall (m :: * -> *) b.
MonadMask m =>
((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
maskDynamics
  
  {-# INLINE uninterruptibleMask #-}
  uninterruptibleMask :: forall b.
((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
uninterruptibleMask = forall (m :: * -> *) b.
MonadMask m =>
((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
uninterruptibleMaskDynamics
  
  {-# INLINE generalBracket #-}
  generalBracket :: forall a b c.
Dynamics m a
-> (a -> ExitCase b -> Dynamics m c)
-> (a -> Dynamics m b)
-> Dynamics m (b, c)
generalBracket = forall (m :: * -> *) a b c.
MonadMask m =>
Dynamics m a
-> (a -> ExitCase b -> Dynamics m c)
-> (a -> Dynamics m b)
-> Dynamics m (b, c)
generalBracketDynamics

-- | Computation that returns the current simulation time.
time :: Monad m => Dynamics m Double
{-# INLINE time #-}
time :: forall (m :: * -> *). Monad m => Dynamics m Double
time = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Point m -> Double
pointTime 

-- | Whether the current time is an integration time.
isTimeInteg :: Monad m => Dynamics m Bool
{-# INLINE isTimeInteg #-}
isTimeInteg :: forall (m :: * -> *). Monad m => Dynamics m Bool
isTimeInteg = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Point m -> EventPriority
pointPhase Point m
p forall a. Ord a => a -> a -> Bool
>= EventPriority
0

-- | Return the integration iteration closest to the current simulation time.
integIteration :: Monad m => Dynamics m Int
{-# INLINE integIteration #-}
integIteration :: forall (m :: * -> *). Monad m => Dynamics m EventPriority
integIteration = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Point m -> EventPriority
pointIteration

-- | Return the integration phase for the current simulation time.
-- It is @(-1)@ for non-integration time points.
integPhase :: Monad m => Dynamics m Int
{-# INLINE integPhase #-}
integPhase :: forall (m :: * -> *). Monad m => Dynamics m EventPriority
integPhase = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Point m -> EventPriority
pointPhase

-- | Show the debug message with the current simulation time.
traceDynamics :: Monad m => String -> Dynamics m a -> Dynamics m a
{-# INLINABLE traceDynamics #-}
traceDynamics :: forall (m :: * -> *) a.
Monad m =>
String -> Dynamics m a -> Dynamics m a
traceDynamics String
message Dynamics m a
m =
  forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  forall a. String -> a -> a
trace (String
"t = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
message) forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p Dynamics m a
m