{-# 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 = 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 = forall a. (Point -> IO a) -> Dynamics a
Dynamics (\Point
p -> 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 =
forall a. (Point -> IO a) -> Dynamics a
Dynamics 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) =
forall a. (Run -> IO a) -> Simulation a
Simulation forall a b. (a -> b) -> a -> b
$ Point -> IO a
m 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) =
forall a. (Run -> IO a) -> Simulation a
Simulation forall a b. (a -> b) -> a -> b
$ Point -> IO a
m 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) =
forall a. (Run -> IO a) -> Simulation 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 -> IO a
m 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) =
forall a. (Run -> IO a) -> Simulation a
Simulation forall a b. (a -> b) -> a -> b
$ \Run
r -> Point -> IO a
m 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) =
forall a. (Run -> IO a) -> Simulation a
Simulation forall a b. (a -> b) -> a -> b
$ \Run
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 -> IO a
m 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 = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD
instance Applicative Dynamics where
pure :: forall a. a -> Dynamics a
pure = forall a. a -> Dynamics a
returnD
<*> :: forall a 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 = forall a. HasCallStack => String -> a
error
instance Eq (Dynamics a) where
Dynamics a
x == :: Dynamics a -> Dynamics a -> Bool
== Dynamics a
y = 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) =
forall a. (Point -> IO a) -> Dynamics a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point
p -> do { a
a <- Point -> IO a
x Point
p; forall (m :: * -> *) a. Monad m => a -> m a
return 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) =
forall a. (Point -> IO a) -> Dynamics a
Dynamics 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; 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) => Num (Dynamics a) where
Dynamics a
x + :: Dynamics a -> Dynamics a -> Dynamics a
+ Dynamics a
y = forall a b c.
(a -> b -> c) -> Dynamics a -> Dynamics b -> Dynamics c
liftM2D 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 = 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 = forall a b c.
(a -> b -> c) -> Dynamics a -> Dynamics b -> Dynamics c
liftM2D forall a. Num a => a -> a -> a
(*) Dynamics a
x Dynamics a
y
negate :: Dynamics a -> Dynamics a
negate = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Num a => a -> a
negate
abs :: Dynamics a -> Dynamics a
abs = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Num a => a -> a
abs
signum :: Dynamics a -> Dynamics a
signum = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Num a => a -> a
signum
fromInteger :: Integer -> Dynamics 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) => Fractional (Dynamics a) where
Dynamics a
x / :: Dynamics a -> Dynamics a -> Dynamics a
/ Dynamics a
y = forall a b c.
(a -> b -> c) -> Dynamics a -> Dynamics b -> Dynamics c
liftM2D forall a. Fractional a => a -> a -> a
(/) Dynamics a
x Dynamics a
y
recip :: Dynamics a -> Dynamics a
recip = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Fractional a => a -> a
recip
fromRational :: Rational -> Dynamics 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) => Floating (Dynamics a) where
pi :: Dynamics a
pi = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Floating a => a
pi
exp :: Dynamics a -> Dynamics a
exp = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
exp
log :: Dynamics a -> Dynamics a
log = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
log
sqrt :: Dynamics a -> Dynamics a
sqrt = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
sqrt
Dynamics a
x ** :: Dynamics a -> Dynamics a -> Dynamics a
** Dynamics a
y = forall a b c.
(a -> b -> c) -> Dynamics a -> Dynamics b -> Dynamics c
liftM2D forall a. Floating a => a -> a -> a
(**) Dynamics a
x Dynamics a
y
sin :: Dynamics a -> Dynamics a
sin = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
sin
cos :: Dynamics a -> Dynamics a
cos = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
cos
tan :: Dynamics a -> Dynamics a
tan = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
tan
asin :: Dynamics a -> Dynamics a
asin = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
asin
acos :: Dynamics a -> Dynamics a
acos = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
acos
atan :: Dynamics a -> Dynamics a
atan = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
atan
sinh :: Dynamics a -> Dynamics a
sinh = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
sinh
cosh :: Dynamics a -> Dynamics a
cosh = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
cosh
tanh :: Dynamics a -> Dynamics a
tanh = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
tanh
asinh :: Dynamics a -> Dynamics a
asinh = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
asinh
acosh :: Dynamics a -> Dynamics a
acosh = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
acosh
atanh :: Dynamics a -> Dynamics a
atanh = forall a b. (a -> b) -> Dynamics a -> Dynamics b
liftMD forall a. Floating a => a -> a
atanh
instance MonadIO Dynamics where
liftIO :: forall a. IO a -> Dynamics a
liftIO IO a
m = forall a. (Point -> IO a) -> Dynamics a
Dynamics forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const IO a
m
instance ParameterLift Dynamics where
liftParameter :: forall a. Parameter a -> Dynamics a
liftParameter = forall a. Parameter a -> Dynamics a
liftDP
instance SimulationLift Dynamics where
liftSimulation :: forall a. Simulation a -> Dynamics a
liftSimulation = 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) =
forall a. (Point -> IO a) -> Dynamics a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point
p -> Run -> IO a
m 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) =
forall a. (Point -> IO a) -> Dynamics a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point
p -> Run -> IO a
m 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 = 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 =
forall a. (Point -> IO a) -> Dynamics a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point
p ->
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Point -> IO a
m Point
p) 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') =
forall a. (Point -> IO a) -> Dynamics a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point
p ->
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 = 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 =
forall a. (Point -> IO a) -> Dynamics a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point
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. IO a -> IO a
u ->
forall a. Point -> Dynamics a -> IO a
invokeDynamics Point
p ((forall a. Dynamics a -> Dynamics a) -> Dynamics b
a forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (IO a -> IO a) -> Dynamics a -> Dynamics a
q 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) = forall a. (Point -> IO a) -> Dynamics a
Dynamics (IO a -> IO a
u 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 =
forall a. (Point -> IO a) -> Dynamics a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point
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. IO a -> IO a
u ->
forall a. Point -> Dynamics a -> IO a
invokeDynamics Point
p ((forall a. Dynamics a -> Dynamics a) -> Dynamics b
a forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (IO a -> IO a) -> Dynamics a -> Dynamics a
q 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) = forall a. (Point -> IO a) -> Dynamics a
Dynamics (IO a -> IO a
u 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 =
forall a. (Point -> IO a) -> Dynamics a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point
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 a. Point -> Dynamics a -> IO a
invokeDynamics Point
p Dynamics a
acquire)
(\a
resource ExitCase b
e -> forall a. Point -> Dynamics a -> IO a
invokeDynamics Point
p forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> Dynamics c
release a
resource ExitCase b
e)
(\a
resource -> forall a. Point -> Dynamics a -> IO a
invokeDynamics Point
p 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 =
forall a. (Point -> IO a) -> Dynamics a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point
p ->
do { rec { a
a <- forall a. Point -> Dynamics a -> IO a
invokeDynamics Point
p (a -> Dynamics a
f a
a) }; forall (m :: * -> *) a. Monad m => a -> m a
return a
a }
instance MC.MonadThrow Dynamics where
throwM :: forall e a. Exception e => e -> Dynamics a
throwM = forall e a. Exception e => e -> Dynamics a
throwDynamics
instance MC.MonadCatch Dynamics where
catch :: forall e a.
Exception e =>
Dynamics a -> (e -> Dynamics a) -> Dynamics a
catch = forall e a.
Exception e =>
Dynamics a -> (e -> Dynamics a) -> Dynamics a
catchDynamics
instance MC.MonadMask Dynamics where
mask :: forall b.
((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
mask = forall b.
((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
maskDynamics
uninterruptibleMask :: forall b.
((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
uninterruptibleMask = forall b.
((forall a. Dynamics a -> Dynamics a) -> Dynamics b) -> Dynamics b
uninterruptibleMaskDynamics
generalBracket :: forall a b c.
Dynamics a
-> (a -> ExitCase b -> Dynamics c)
-> (a -> Dynamics b)
-> Dynamics (b, c)
generalBracket = 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 = forall a. (Point -> IO a) -> Dynamics 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
. Point -> Double
pointTime
isTimeInteg :: Dynamics Bool
isTimeInteg :: Dynamics Bool
isTimeInteg = forall a. (Point -> IO a) -> Dynamics a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point
p -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Point -> Int
pointPhase Point
p forall a. Ord a => a -> a -> Bool
>= Int
0
integIteration :: Dynamics Int
integIteration :: Dynamics Int
integIteration = forall a. (Point -> IO a) -> Dynamics 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
. Point -> Int
pointIteration
integPhase :: Dynamics Int
integPhase :: Dynamics Int
integPhase = forall a. (Point -> IO a) -> Dynamics 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
. Point -> Int
pointPhase
traceDynamics :: String -> Dynamics a -> Dynamics a
traceDynamics :: forall a. String -> Dynamics a -> Dynamics a
traceDynamics String
message Dynamics a
m =
forall a. (Point -> IO a) -> Dynamics a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point
p ->
forall a. String -> a -> a
trace (String
"t = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Point -> Double
pointTime Point
p) forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
message) forall a b. (a -> b) -> a -> b
$
forall a. Point -> Dynamics a -> IO a
invokeDynamics Point
p Dynamics a
m