{-# LANGUAGE RecursiveDo, RankNTypes #-}

-- |
-- Module     : Simulation.Aivika.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
--
-- This is an internal implementation module that should never be used directly.
--
-- The module defines the 'Dynamics' monad representing a time varying polymorphic function. 
--
module Simulation.Aivika.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

import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Parameter
import Simulation.Aivika.Internal.Simulation

-- | A value in the 'Dynamics' monad represents a polymorphic time varying function.
newtype Dynamics a = Dynamics (Point -> IO a)

instance Monad Dynamics where
  return :: a -> Dynamics a
return  = a -> Dynamics a
forall a. a -> Dynamics a
returnD
  Dynamics a
m >>= :: Dynamics a -> (a -> Dynamics b) -> Dynamics b
>>= a -> Dynamics b
k = Dynamics a -> (a -> Dynamics b) -> Dynamics b
forall a b. Dynamics a -> (a -> Dynamics b) -> Dynamics b
bindD Dynamics a
m a -> Dynamics b
k

returnD :: a -> Dynamics a
{-# INLINE returnD #-}
returnD :: a -> Dynamics a
returnD a
a = (Point -> IO a) -> Dynamics a
forall a. (Point -> IO a) -> Dynamics a
Dynamics (\Point
p -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a)

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

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

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

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

-- | Run the 'Dynamics' computation in the specified time point.
runDynamicsInTime :: Double -> Dynamics a -> Simulation a
runDynamicsInTime :: Double -> Dynamics a -> Simulation a
runDynamicsInTime Double
t (Dynamics Point -> IO a
m) =
  (Run -> IO a) -> Simulation a
forall a. (Run -> IO a) -> Simulation a
Simulation ((Run -> IO a) -> Simulation a) -> (Run -> IO a) -> Simulation a
forall a b. (a -> b) -> a -> b
$ \Run
r -> Point -> IO a
m (Point -> IO a) -> Point -> IO a
forall a b. (a -> b) -> a -> b
$ Run -> Double -> Point
pointAt Run
r Double
t

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

instance Functor Dynamics where
  fmap :: (a -> b) -> Dynamics a -> Dynamics b
fmap = (a -> b) -> Dynamics a -> Dynamics b
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD

instance Applicative Dynamics where
  pure :: a -> Dynamics a
pure = a -> Dynamics a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: Dynamics (a -> b) -> Dynamics a -> Dynamics b
(<*>) = Dynamics (a -> b) -> Dynamics a -> Dynamics b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance MonadFail Dynamics where
  fail :: String -> Dynamics a
fail = String -> Dynamics a
forall a. HasCallStack => String -> a
error

instance Eq (Dynamics a) where
  Dynamics a
x == :: Dynamics a -> Dynamics a -> Bool
== Dynamics a
y = String -> Bool
forall a. HasCallStack => String -> a
error String
"Can't compare dynamics." 

instance Show (Dynamics a) where
  showsPrec :: Int -> Dynamics a -> ShowS
showsPrec Int
_ Dynamics a
x = String -> ShowS
showString String
"<< Dynamics >>"

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

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

instance (Num a) => Num (Dynamics a) where
  Dynamics a
x + :: Dynamics a -> Dynamics a -> Dynamics a
+ Dynamics a
y = (a -> a -> a) -> Dynamics a -> Dynamics a -> Dynamics a
forall a b c.
(a -> b -> c) -> Dynamics a -> Dynamics b -> Dynamics c
liftM2D a -> a -> a
forall a. Num a => a -> a -> a
(+) Dynamics a
x Dynamics a
y
  Dynamics a
x - :: Dynamics a -> Dynamics a -> Dynamics a
- Dynamics a
y = (a -> a -> a) -> Dynamics a -> Dynamics a -> Dynamics a
forall a b c.
(a -> b -> c) -> Dynamics a -> Dynamics b -> Dynamics c
liftM2D (-) Dynamics a
x Dynamics a
y
  Dynamics a
x * :: Dynamics a -> Dynamics a -> Dynamics a
* Dynamics a
y = (a -> a -> a) -> Dynamics a -> Dynamics a -> Dynamics a
forall a b c.
(a -> b -> c) -> Dynamics a -> Dynamics b -> Dynamics c
liftM2D a -> a -> a
forall a. Num a => a -> a -> a
(*) Dynamics a
x Dynamics a
y
  negate :: Dynamics a -> Dynamics a
negate = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Num a => a -> a
negate
  abs :: Dynamics a -> Dynamics a
abs = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Num a => a -> a
abs
  signum :: Dynamics a -> Dynamics a
signum = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Num a => a -> a
signum
  fromInteger :: Integer -> Dynamics a
fromInteger Integer
i = a -> Dynamics a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Dynamics a) -> a -> Dynamics a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i

instance (Fractional a) => Fractional (Dynamics a) where
  Dynamics a
x / :: Dynamics a -> Dynamics a -> Dynamics a
/ Dynamics a
y = (a -> a -> a) -> Dynamics a -> Dynamics a -> Dynamics a
forall a b c.
(a -> b -> c) -> Dynamics a -> Dynamics b -> Dynamics c
liftM2D a -> a -> a
forall a. Fractional a => a -> a -> a
(/) Dynamics a
x Dynamics a
y
  recip :: Dynamics a -> Dynamics a
recip = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Fractional a => a -> a
recip
  fromRational :: Rational -> Dynamics a
fromRational Rational
t = a -> Dynamics a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Dynamics a) -> a -> Dynamics a
forall a b. (a -> b) -> a -> b
$ Rational -> a
forall a. Fractional a => Rational -> a
fromRational Rational
t

instance (Floating a) => Floating (Dynamics a) where
  pi :: Dynamics a
pi = a -> Dynamics a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Floating a => a
pi
  exp :: Dynamics a -> Dynamics a
exp = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
exp
  log :: Dynamics a -> Dynamics a
log = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
log
  sqrt :: Dynamics a -> Dynamics a
sqrt = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
sqrt
  Dynamics a
x ** :: Dynamics a -> Dynamics a -> Dynamics a
** Dynamics a
y = (a -> a -> a) -> Dynamics a -> Dynamics a -> Dynamics a
forall a b c.
(a -> b -> c) -> Dynamics a -> Dynamics b -> Dynamics c
liftM2D a -> a -> a
forall a. Floating a => a -> a -> a
(**) Dynamics a
x Dynamics a
y
  sin :: Dynamics a -> Dynamics a
sin = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
sin
  cos :: Dynamics a -> Dynamics a
cos = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
cos
  tan :: Dynamics a -> Dynamics a
tan = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
tan
  asin :: Dynamics a -> Dynamics a
asin = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
asin
  acos :: Dynamics a -> Dynamics a
acos = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
acos
  atan :: Dynamics a -> Dynamics a
atan = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
atan
  sinh :: Dynamics a -> Dynamics a
sinh = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
sinh
  cosh :: Dynamics a -> Dynamics a
cosh = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
cosh
  tanh :: Dynamics a -> Dynamics a
tanh = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
tanh
  asinh :: Dynamics a -> Dynamics a
asinh = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
asinh
  acosh :: Dynamics a -> Dynamics a
acosh = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
acosh
  atanh :: Dynamics a -> Dynamics a
atanh = (a -> a) -> Dynamics a -> Dynamics a
forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD a -> a
forall a. Floating a => a -> a
atanh

instance MonadIO Dynamics where
  liftIO :: IO a -> Dynamics a
liftIO IO a
m = (Point -> IO a) -> Dynamics a
forall a. (Point -> IO a) -> Dynamics a
Dynamics ((Point -> IO a) -> Dynamics a) -> (Point -> IO a) -> Dynamics a
forall a b. (a -> b) -> a -> b
$ IO a -> Point -> IO a
forall a b. a -> b -> a
const IO a
m

instance ParameterLift Dynamics where
  liftParameter :: Parameter a -> Dynamics a
liftParameter = Parameter a -> Dynamics a
forall a. Parameter a -> Dynamics a
liftDP

instance SimulationLift Dynamics where
  liftSimulation :: Simulation a -> Dynamics a
liftSimulation = Simulation a -> Dynamics a
forall a. Simulation a -> Dynamics a
liftDS
    
liftDP :: Parameter a -> Dynamics a
{-# INLINE liftDP #-}
liftDP :: Parameter a -> Dynamics a
liftDP (Parameter Run -> IO a
m) =
  (Point -> IO a) -> Dynamics a
forall a. (Point -> IO a) -> Dynamics a
Dynamics ((Point -> IO a) -> Dynamics a) -> (Point -> IO a) -> Dynamics a
forall a b. (a -> b) -> a -> b
$ \Point
p -> Run -> IO a
m (Run -> IO a) -> Run -> IO a
forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p
    
liftDS :: Simulation a -> Dynamics a
{-# INLINE liftDS #-}
liftDS :: Simulation a -> Dynamics a
liftDS (Simulation Run -> IO a
m) =
  (Point -> IO a) -> Dynamics a
forall a. (Point -> IO a) -> Dynamics a
Dynamics ((Point -> IO a) -> Dynamics a) -> (Point -> IO a) -> Dynamics a
forall a b. (a -> b) -> a -> b
$ \Point
p -> Run -> IO a
m (Run -> IO a) -> Run -> IO a
forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p

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

instance DynamicsLift Dynamics where
  liftDynamics :: Dynamics a -> Dynamics a
liftDynamics = Dynamics a -> Dynamics a
forall a. a -> a
id
  
-- | Exception handling within 'Dynamics' computations.
catchDynamics :: Exception e => Dynamics a -> (e -> Dynamics a) -> Dynamics a
catchDynamics :: Dynamics a -> (e -> Dynamics a) -> Dynamics a
catchDynamics (Dynamics Point -> IO a
m) e -> Dynamics a
h =
  (Point -> IO a) -> Dynamics a
forall a. (Point -> IO a) -> Dynamics a
Dynamics ((Point -> IO a) -> Dynamics a) -> (Point -> IO a) -> Dynamics a
forall a b. (a -> b) -> a -> b
$ \Point
p -> 
  IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Point -> IO a
m Point
p) ((e -> IO a) -> IO a) -> (e -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \e
e ->
  let Dynamics Point -> IO a
m' = e -> Dynamics a
h e
e in Point -> IO a
m' Point
p
                           
-- | A computation with finalization part like the 'finally' function.
finallyDynamics :: Dynamics a -> Dynamics b -> Dynamics a
finallyDynamics :: Dynamics a -> Dynamics b -> Dynamics a
finallyDynamics (Dynamics Point -> IO a
m) (Dynamics Point -> IO b
m') =
  (Point -> IO a) -> Dynamics a
forall a. (Point -> IO a) -> Dynamics a
Dynamics ((Point -> IO a) -> Dynamics a) -> (Point -> IO a) -> Dynamics a
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  IO a -> IO b -> IO a
forall a b. IO a -> IO b -> IO a
finally (Point -> IO a
m Point
p) (Point -> IO b
m' Point
p)

-- | Like the standard 'throw' function.
throwDynamics :: Exception e => e -> Dynamics a
throwDynamics :: e -> Dynamics a
throwDynamics = e -> Dynamics a
forall a e. Exception e => e -> a
throw

-- | Runs an action with asynchronous exceptions disabled.
maskDynamics :: ((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
maskDynamics :: ((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
maskDynamics (forall a. Dynamics a -> Dynamics a) -> Dynamics b
a =
  (Point -> IO b) -> Dynamics b
forall a. (Point -> IO a) -> Dynamics a
Dynamics ((Point -> IO b) -> Dynamics b) -> (Point -> IO b) -> Dynamics b
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  ((forall a. IO a -> IO a) -> IO b) -> IO b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
u ->
  Point -> Dynamics b -> IO b
forall a. Point -> Dynamics a -> IO a
invokeDynamics Point
p ((forall a. Dynamics a -> Dynamics a) -> Dynamics b
a ((forall a. Dynamics a -> Dynamics a) -> Dynamics b)
-> (forall a. Dynamics a -> Dynamics a) -> Dynamics b
forall a b. (a -> b) -> a -> b
$ (IO a -> IO a) -> Dynamics a -> Dynamics a
forall a a. (IO a -> IO a) -> Dynamics a -> Dynamics a
q IO a -> IO a
forall a. IO a -> IO a
u)
  where q :: (IO a -> IO a) -> Dynamics a -> Dynamics a
q IO a -> IO a
u (Dynamics Point -> IO a
b) = (Point -> IO a) -> Dynamics a
forall a. (Point -> IO a) -> Dynamics a
Dynamics (IO a -> IO a
u (IO a -> IO a) -> (Point -> IO a) -> Point -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> IO a
b)

-- | Like 'maskDynamics', but the masked computation is not interruptible.
uninterruptibleMaskDynamics :: ((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
uninterruptibleMaskDynamics :: ((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
uninterruptibleMaskDynamics (forall a. Dynamics a -> Dynamics a) -> Dynamics b
a =
  (Point -> IO b) -> Dynamics b
forall a. (Point -> IO a) -> Dynamics a
Dynamics ((Point -> IO b) -> Dynamics b) -> (Point -> IO b) -> Dynamics b
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  ((forall a. IO a -> IO a) -> IO b) -> IO b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.uninterruptibleMask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
u ->
  Point -> Dynamics b -> IO b
forall a. Point -> Dynamics a -> IO a
invokeDynamics Point
p ((forall a. Dynamics a -> Dynamics a) -> Dynamics b
a ((forall a. Dynamics a -> Dynamics a) -> Dynamics b)
-> (forall a. Dynamics a -> Dynamics a) -> Dynamics b
forall a b. (a -> b) -> a -> b
$ (IO a -> IO a) -> Dynamics a -> Dynamics a
forall a a. (IO a -> IO a) -> Dynamics a -> Dynamics a
q IO a -> IO a
forall a. IO a -> IO a
u)
  where q :: (IO a -> IO a) -> Dynamics a -> Dynamics a
q IO a -> IO a
u (Dynamics Point -> IO a
b) = (Point -> IO a) -> Dynamics a
forall a. (Point -> IO a) -> Dynamics a
Dynamics (IO a -> IO a
u (IO a -> IO a) -> (Point -> IO a) -> Point -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> IO a
b)

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

-- | Invoke the 'Dynamics' computation.
invokeDynamics :: Point -> Dynamics a -> IO a
{-# INLINE invokeDynamics #-}
invokeDynamics :: Point -> Dynamics a -> IO a
invokeDynamics Point
p (Dynamics Point -> IO a
m) = Point -> IO a
m Point
p

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

instance MC.MonadThrow Dynamics where
  throwM :: e -> Dynamics a
throwM = e -> Dynamics a
forall e a. Exception e => e -> Dynamics a
throwDynamics

instance MC.MonadCatch Dynamics where
  catch :: Dynamics a -> (e -> Dynamics a) -> Dynamics a
catch = Dynamics a -> (e -> Dynamics a) -> Dynamics a
forall e a.
Exception e =>
Dynamics a -> (e -> Dynamics a) -> Dynamics a
catchDynamics

instance MC.MonadMask Dynamics where
  mask :: ((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
mask = ((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
forall b.
((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
maskDynamics
  uninterruptibleMask :: ((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
uninterruptibleMask = ((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
forall b.
((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
uninterruptibleMaskDynamics
  generalBracket :: Dynamics a
-> (a -> ExitCase b -> Dynamics c)
-> (a -> Dynamics b)
-> Dynamics (b, c)
generalBracket = Dynamics a
-> (a -> ExitCase b -> Dynamics c)
-> (a -> Dynamics b)
-> Dynamics (b, c)
forall a b c.
Dynamics a
-> (a -> ExitCase b -> Dynamics c)
-> (a -> Dynamics b)
-> Dynamics (b, c)
generalBracketDynamics

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

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

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

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

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