{-# LANGUAGE RecursiveDo, RankNTypes #-}
module Simulation.Aivika.Internal.Dynamics
(
Dynamics(..),
DynamicsLift(..),
invokeDynamics,
runDynamicsInStartTime,
runDynamicsInStopTime,
runDynamicsInIntegTimes,
runDynamicsInTime,
runDynamicsInTimes,
catchDynamics,
finallyDynamics,
throwDynamics,
time,
isTimeInteg,
integIteration,
integPhase,
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
newtype Dynamics a = Dynamics (Point -> IO a)
instance Monad Dynamics where
Dynamics a
m >>= :: forall a b. 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 :: forall a. 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 a. 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 :: forall a b. 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
runDynamicsInStartTime :: Dynamics a -> Simulation a
runDynamicsInStartTime :: forall a. 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
runDynamicsInStopTime :: Dynamics a -> Simulation a
runDynamicsInStopTime :: forall a. 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
runDynamicsInIntegTimes :: Dynamics a -> Simulation [IO a]
runDynamicsInIntegTimes :: forall a. 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 a. a -> 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
runDynamicsInTime :: Double -> Dynamics a -> Simulation a
runDynamicsInTime :: forall a. 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 -> Int -> Point
pointAt Run
r Double
t Int
0
runDynamicsInTimes :: [Double] -> Dynamics a -> Simulation [IO a]
runDynamicsInTimes :: forall a. [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 a. a -> 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 (\Double
t -> Point -> IO a
m (Point -> IO a) -> Point -> IO a
forall a b. (a -> b) -> a -> b
$ Run -> Double -> Int -> Point
pointAt Run
r Double
t Int
0) [Double]
ts
instance Functor Dynamics where
fmap :: forall a b. (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 :: forall a. a -> Dynamics a
pure = a -> Dynamics a
forall a. a -> Dynamics a
returnD
<*> :: forall a b. 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 :: forall a. 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 :: forall a b. (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 a. a -> IO a
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 :: forall a b c.
(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 a. a -> IO a
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 a. 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 a. 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 a. 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 :: forall a. 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 :: forall a. Parameter a -> Dynamics a
liftParameter = Parameter a -> Dynamics a
forall a. Parameter a -> Dynamics a
liftDP
instance SimulationLift Dynamics where
liftSimulation :: forall a. Simulation a -> Dynamics a
liftSimulation = Simulation a -> Dynamics a
forall a. Simulation a -> Dynamics a
liftDS
liftDP :: Parameter a -> Dynamics a
{-# INLINE liftDP #-}
liftDP :: forall a. 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 :: forall a. 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
class DynamicsLift m where
liftDynamics :: Dynamics a -> m a
instance DynamicsLift Dynamics where
liftDynamics :: forall a. Dynamics a -> Dynamics a
liftDynamics = Dynamics a -> Dynamics a
forall a. a -> a
id
catchDynamics :: Exception e => Dynamics a -> (e -> Dynamics a) -> Dynamics a
catchDynamics :: forall e a.
Exception e =>
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
finallyDynamics :: Dynamics a -> Dynamics b -> Dynamics a
finallyDynamics :: forall a b. 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)
throwDynamics :: Exception e => e -> Dynamics a
throwDynamics :: forall e a. Exception e => e -> Dynamics a
throwDynamics = e -> Dynamics a
forall a e. Exception e => e -> a
throw
maskDynamics :: ((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
maskDynamics :: forall b.
((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 b.
HasCallStack =>
((forall a. IO a -> IO a) -> IO b) -> IO b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((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)
uninterruptibleMaskDynamics :: ((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
uninterruptibleMaskDynamics :: forall b.
((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 b.
HasCallStack =>
((forall a. IO a -> IO a) -> IO b) -> IO b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((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)
generalBracketDynamics :: Dynamics a
-> (a -> MC.ExitCase b -> Dynamics c)
-> (a -> Dynamics b)
-> Dynamics (b, c)
generalBracketDynamics :: forall a b c.
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 a b c.
HasCallStack =>
IO a -> (a -> ExitCase b -> IO c) -> (a -> IO b) -> IO (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 -> 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)
invokeDynamics :: Point -> Dynamics a -> IO a
{-# INLINE invokeDynamics #-}
invokeDynamics :: forall a. Point -> Dynamics a -> IO a
invokeDynamics Point
p (Dynamics Point -> IO a
m) = Point -> IO a
m Point
p
instance MonadFix Dynamics where
mfix :: forall a. (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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a }
instance MC.MonadThrow Dynamics where
throwM :: forall e a. (HasCallStack, Exception e) => e -> Dynamics a
throwM = e -> Dynamics a
forall e a. Exception e => e -> Dynamics a
throwDynamics
instance MC.MonadCatch Dynamics where
catch :: forall e a.
(HasCallStack, Exception e) =>
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 b.
HasCallStack =>
((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 b.
HasCallStack =>
((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 :: forall a b c.
HasCallStack =>
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
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 a. a -> IO a
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
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 a. a -> IO a
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
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 a. a -> IO a
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
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 a. a -> IO a
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
traceDynamics :: String -> Dynamics a -> Dynamics a
traceDynamics :: forall a. 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