{-# 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 =
    (Point m -> m b) -> Dynamics m b
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m b) -> Dynamics m b)
-> (Point m -> m b) -> Dynamics m b
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) =
  (Run m -> m a) -> Simulation m a
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m a) -> Simulation m a)
-> (Run m -> m a) -> Simulation m a
forall a b. (a -> b) -> a -> b
$ Point m -> m a
m (Point m -> m a) -> (Run m -> Point m) -> Run m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> Point m
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) =
  (Run m -> m a) -> Simulation m a
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m a) -> Simulation m a)
-> (Run m -> m a) -> Simulation m a
forall a b. (a -> b) -> a -> b
$ Point m -> m a
m (Point m -> m a) -> (Run m -> Point m) -> Run m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> Point m
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) =
  (Run m -> m [m a]) -> Simulation m [m a]
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m [m a]) -> Simulation m [m a])
-> (Run m -> m [m a]) -> Simulation m [m a]
forall a b. (a -> b) -> a -> b
$ [m a] -> m [m a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([m a] -> m [m a]) -> (Run m -> [m a]) -> Run m -> m [m a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point m -> m a) -> [Point m] -> [m a]
forall a b. (a -> b) -> [a] -> [b]
map Point m -> m a
m ([Point m] -> [m a]) -> (Run m -> [Point m]) -> Run m -> [m a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> [Point m]
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) =
  (Run m -> m a) -> Simulation m a
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m a) -> Simulation m a)
-> (Run m -> m a) -> Simulation m a
forall a b. (a -> b) -> a -> b
$ \Run m
r -> Point m -> m a
m (Point m -> m a) -> Point m -> m a
forall a b. (a -> b) -> a -> b
$ Run m -> Double -> EventPriority -> Point m
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) =
  (Run m -> m [m a]) -> Simulation m [m a]
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m [m a]) -> Simulation m [m a])
-> (Run m -> m [m a]) -> Simulation m [m a]
forall a b. (a -> b) -> a -> b
$ \Run m
r -> [m a] -> m [m a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([m a] -> m [m a]) -> [m a] -> m [m a]
forall a b. (a -> b) -> a -> b
$ (Double -> m a) -> [Double] -> [m a]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
t -> Point m -> m a
m (Point m -> m a) -> Point m -> m a
forall a b. (a -> b) -> a -> b
$ Run m -> Double -> EventPriority -> Point m
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) = (Point m -> m b) -> Dynamics m b
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m b) -> Dynamics m b)
-> (Point m -> m b) -> Dynamics m b
forall a b. (a -> b) -> a -> b
$ \Point m
p -> (a -> b) -> m a -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b) -> m a -> m b
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 = (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (a -> Point m -> m a) -> a -> Dynamics m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Point m -> m a
forall a b. a -> b -> a
const (m a -> Point m -> m a) -> (a -> m a) -> a -> Point m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall a. a -> m a
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) = (Point m -> m b) -> Dynamics m b
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m b) -> Dynamics m b)
-> (Point m -> m b) -> Dynamics m b
forall a b. (a -> b) -> a -> b
$ \Point m
p -> Point m -> m (a -> b)
x Point m
p m (a -> b) -> m a -> m b
forall a b. m (a -> b) -> m a -> m b
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 = String -> Dynamics m a
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) =
  (Point m -> m b) -> Dynamics m b
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m b) -> Dynamics m b)
-> (Point m -> m b) -> Dynamics m b
forall a b. (a -> b) -> a -> b
$ \Point m
p -> do { a
a <- Point m -> m a
x Point m
p; b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
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) =
  (Point m -> m c) -> Dynamics m c
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m c) -> Dynamics m c)
-> (Point m -> m c) -> Dynamics m c
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; c -> m c
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> c -> m c
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 = (a -> a -> a) -> Dynamics m a -> Dynamics m a -> Dynamics m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Dynamics m a -> Dynamics m b -> Dynamics m c
liftM2D a -> a -> a
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 = (a -> a -> a) -> Dynamics m a -> Dynamics m a -> Dynamics m a
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 = (a -> a -> a) -> Dynamics m a -> Dynamics m a -> Dynamics m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Dynamics m a -> Dynamics m b -> Dynamics m c
liftM2D a -> a -> a
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 = (a -> a) -> Dynamics m a -> Dynamics m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD a -> a
forall a. Num a => a -> a
negate

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

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

  {-# INLINE fromInteger #-}
  fromInteger :: Integer -> Dynamics m a
fromInteger Integer
i = a -> Dynamics m a
forall a. a -> Dynamics m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Dynamics m a) -> a -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ Integer -> a
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 = (a -> a -> a) -> Dynamics m a -> Dynamics m a -> Dynamics m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Dynamics m a -> Dynamics m b -> Dynamics m c
liftM2D a -> a -> a
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 = (a -> a) -> Dynamics m a -> Dynamics m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD a -> a
forall a. Fractional a => a -> a
recip

  {-# INLINE fromRational #-}
  fromRational :: Rational -> Dynamics m a
fromRational Rational
t = a -> Dynamics m a
forall a. a -> Dynamics m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Dynamics m a) -> a -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ Rational -> a
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 = a -> Dynamics m a
forall a. a -> Dynamics m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Floating a => a
pi

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

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

  {-# INLINE sqrt #-}
  sqrt :: Dynamics m a -> Dynamics m a
sqrt = (a -> a) -> Dynamics m a -> Dynamics m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD a -> a
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 = (a -> a -> a) -> Dynamics m a -> Dynamics m a -> Dynamics m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Dynamics m a -> Dynamics m b -> Dynamics m c
liftM2D a -> a -> a
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 = (a -> a) -> Dynamics m a -> Dynamics m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD a -> a
forall a. Floating a => a -> a
sin

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

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

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

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

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

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

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

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

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

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

  {-# INLINE atanh #-}
  atanh :: Dynamics m a -> Dynamics m a
atanh = (a -> a) -> Dynamics m a -> Dynamics m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Dynamics m a -> Dynamics m b
liftMD a -> a
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 = (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (m a -> Point m -> m a) -> m a -> Dynamics m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Point m -> m a
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 = (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (IO a -> Point m -> m a) -> IO a -> Dynamics m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Point m -> m a
forall a b. a -> b -> a
const (m a -> Point m -> m a) -> (IO a -> m a) -> IO a -> Point m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
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 = (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (m a -> Point m -> m a) -> m a -> Dynamics m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Point m -> m a
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 = Dynamics m a -> Dynamics m a
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) = (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (Point m -> m a) -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ Run m -> m a
x (Run m -> m a) -> (Point m -> Run m) -> Point m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point m -> Run m
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) = (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (Point m -> m a) -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ Run m -> m a
x (Run m -> m a) -> (Point m -> Run m) -> Point m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point m -> Run m
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 =
  (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (Point m -> m a) -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ \Point m
p -> 
  m a -> (e -> m a) -> m a
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catchComp (Point m -> m a
m Point m
p) ((e -> m a) -> m a) -> (e -> m a) -> m a
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') =
  (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (Point m -> m a) -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  m a -> m b -> m a
forall a b. m a -> m b -> m a
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 =
  (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (Point m -> m a) -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  e -> m a
forall e a. Exception e => e -> m a
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 =
  (Point m -> m b) -> Dynamics m b
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m b) -> Dynamics m b)
-> (Point m -> m b) -> Dynamics m b
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  ((forall a. m a -> m a) -> m b) -> m b
forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u ->
  Point m -> Dynamics m b -> m b
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. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> (forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> Dynamics m a -> Dynamics m a
forall {m :: * -> *} {a} {a}.
(m a -> m a) -> Dynamics m a -> Dynamics m a
q m a -> m a
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) = (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics (m a -> m a
u (m a -> m a) -> (Point m -> m a) -> Point m -> m a
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 =
  (Point m -> m b) -> Dynamics m b
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m b) -> Dynamics m b)
-> (Point m -> m b) -> Dynamics m b
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  ((forall a. m a -> m a) -> m b) -> m b
forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
MC.uninterruptibleMask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u ->
  Point m -> Dynamics m b -> m b
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. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> (forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> Dynamics m a -> Dynamics m a
forall {m :: * -> *} {a} {a}.
(m a -> m a) -> Dynamics m a -> Dynamics m a
q m a -> m a
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) = (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics (m a -> m a
u (m a -> m a) -> (Point m -> m a) -> Point m -> m a
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 =
  (Point m -> m (b, c)) -> Dynamics m (b, c)
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m (b, c)) -> Dynamics m (b, c))
-> (Point m -> m (b, c)) -> Dynamics m (b, c)
forall a b. (a -> b) -> a -> b
$ \Point m
p -> do
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
MC.generalBracket
      (Point m -> Dynamics m a -> m a
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p Dynamics m a
acquire)
      (\a
resource ExitCase b
e -> Point m -> Dynamics m c -> m c
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p (Dynamics m c -> m c) -> Dynamics m c -> m c
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> Dynamics m c
release a
resource ExitCase b
e)
      (\a
resource -> Point m -> Dynamics m b -> m b
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p (Dynamics m b -> m b) -> Dynamics m b -> m b
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 = 
    (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (Point m -> m a) -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
    do { rec { a
a <- Point m -> Dynamics m a -> m a
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p (a -> Dynamics m a
f a
a) }; a -> m a
forall a. a -> m 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. (HasCallStack, Exception e) => e -> Dynamics m a
throwM = e -> Dynamics m a
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.
(HasCallStack, Exception e) =>
Dynamics m a -> (e -> Dynamics m a) -> Dynamics m a
catch = Dynamics m a -> (e -> Dynamics m a) -> Dynamics m a
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.
HasCallStack =>
((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
mask = ((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
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.
HasCallStack =>
((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
uninterruptibleMask = ((forall a. Dynamics m a -> Dynamics m a) -> Dynamics m b)
-> Dynamics m b
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.
HasCallStack =>
Dynamics m a
-> (a -> ExitCase b -> Dynamics m c)
-> (a -> Dynamics m b)
-> Dynamics m (b, c)
generalBracket = Dynamics m a
-> (a -> ExitCase b -> Dynamics m c)
-> (a -> Dynamics m b)
-> Dynamics m (b, c)
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 = (Point m -> m Double) -> Dynamics m Double
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m Double) -> Dynamics m Double)
-> (Point m -> m Double) -> Dynamics m Double
forall a b. (a -> b) -> a -> b
$ Double -> m Double
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> m Double) -> (Point m -> Double) -> Point m -> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point m -> Double
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 = (Point m -> m Bool) -> Dynamics m Bool
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m Bool) -> Dynamics m Bool)
-> (Point m -> m Bool) -> Dynamics m Bool
forall a b. (a -> b) -> a -> b
$ \Point m
p -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Point m -> EventPriority
forall (m :: * -> *). Point m -> EventPriority
pointPhase Point m
p EventPriority -> EventPriority -> Bool
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 = (Point m -> m EventPriority) -> Dynamics m EventPriority
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m EventPriority) -> Dynamics m EventPriority)
-> (Point m -> m EventPriority) -> Dynamics m EventPriority
forall a b. (a -> b) -> a -> b
$ EventPriority -> m EventPriority
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EventPriority -> m EventPriority)
-> (Point m -> EventPriority) -> Point m -> m EventPriority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point m -> EventPriority
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 = (Point m -> m EventPriority) -> Dynamics m EventPriority
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m EventPriority) -> Dynamics m EventPriority)
-> (Point m -> m EventPriority) -> Dynamics m EventPriority
forall a b. (a -> b) -> a -> b
$ EventPriority -> m EventPriority
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EventPriority -> m EventPriority)
-> (Point m -> EventPriority) -> Point m -> m EventPriority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point m -> EventPriority
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 =
  (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (Point m -> m a) -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  String -> m a -> m a
forall a. String -> a -> a
trace (String
"t = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
message) (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$
  Point m -> Dynamics m a -> m a
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p Dynamics m a
m