{-# LANGUAGE TypeFamilies #-}
module Simulation.Aivika.Trans.Internal.Types
(Specs(..),
Method(..),
Run(..),
Point(..),
Parameter(..),
Simulation(..),
Dynamics(..),
Event(..),
EventProcessing(..),
EventPriority(..),
EventQueueing(..),
invokeParameter,
invokeSimulation,
invokeDynamics,
invokeEvent) where
import Simulation.Aivika.Trans.Generator
data Specs m = Specs { forall (m :: * -> *). Specs m -> Double
spcStartTime :: Double,
forall (m :: * -> *). Specs m -> Double
spcStopTime :: Double,
forall (m :: * -> *). Specs m -> Double
spcDT :: Double,
forall (m :: * -> *). Specs m -> Method
spcMethod :: Method,
forall (m :: * -> *). Specs m -> GeneratorType m
spcGeneratorType :: GeneratorType m
}
data Method = Euler
| RungeKutta2
| RungeKutta4
| RungeKutta4b
deriving (Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
/= :: Method -> Method -> Bool
Eq, Eq Method
Eq Method =>
(Method -> Method -> Ordering)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Method)
-> (Method -> Method -> Method)
-> Ord Method
Method -> Method -> Bool
Method -> Method -> Ordering
Method -> Method -> Method
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Method -> Method -> Ordering
compare :: Method -> Method -> Ordering
$c< :: Method -> Method -> Bool
< :: Method -> Method -> Bool
$c<= :: Method -> Method -> Bool
<= :: Method -> Method -> Bool
$c> :: Method -> Method -> Bool
> :: Method -> Method -> Bool
$c>= :: Method -> Method -> Bool
>= :: Method -> Method -> Bool
$cmax :: Method -> Method -> Method
max :: Method -> Method -> Method
$cmin :: Method -> Method -> Method
min :: Method -> Method -> Method
Ord, Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Method -> ShowS
showsPrec :: Int -> Method -> ShowS
$cshow :: Method -> String
show :: Method -> String
$cshowList :: [Method] -> ShowS
showList :: [Method] -> ShowS
Show)
data Run m = Run { forall (m :: * -> *). Run m -> Specs m
runSpecs :: Specs m,
forall (m :: * -> *). Run m -> Int
runIndex :: Int,
forall (m :: * -> *). Run m -> Int
runCount :: Int,
forall (m :: * -> *). Run m -> EventQueue m
runEventQueue :: EventQueue m,
forall (m :: * -> *). Run m -> Generator m
runGenerator :: Generator m
}
data Point m = Point { forall (m :: * -> *). Point m -> Specs m
pointSpecs :: Specs m,
forall (m :: * -> *). Point m -> Run m
pointRun :: Run m,
forall (m :: * -> *). Point m -> Double
pointTime :: Double,
forall (m :: * -> *). Point m -> Int
pointPriority :: EventPriority,
forall (m :: * -> *). Point m -> Int
pointIteration :: Int,
forall (m :: * -> *). Point m -> Int
pointPhase :: Int
}
newtype Parameter m a = Parameter (Run m -> m a)
newtype Simulation m a = Simulation (Run m -> m a)
newtype Dynamics m a = Dynamics (Point m -> m a)
newtype Event m a = Event (Point m -> m a)
invokeParameter :: Run m -> Parameter m a -> m a
{-# INLINE invokeParameter #-}
invokeParameter :: forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r (Parameter Run m -> m a
m) = Run m -> m a
m Run m
r
invokeSimulation :: Run m -> Simulation m a -> m a
{-# INLINE invokeSimulation #-}
invokeSimulation :: forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation Run m -> m a
m) = Run m -> m a
m Run m
r
invokeDynamics :: Point m -> Dynamics m a -> m a
{-# INLINE invokeDynamics #-}
invokeDynamics :: forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p (Dynamics Point m -> m a
m) = Point m -> m a
m Point m
p
invokeEvent :: Point m -> Event m a -> m a
{-# INLINE invokeEvent #-}
invokeEvent :: forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event Point m -> m a
m) = Point m -> m a
m Point m
p
data EventProcessing = CurrentEvents
| EarlierEvents
| CurrentEventsOrFromPast
| EarlierEventsOrFromPast
deriving (EventProcessing -> EventProcessing -> Bool
(EventProcessing -> EventProcessing -> Bool)
-> (EventProcessing -> EventProcessing -> Bool)
-> Eq EventProcessing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventProcessing -> EventProcessing -> Bool
== :: EventProcessing -> EventProcessing -> Bool
$c/= :: EventProcessing -> EventProcessing -> Bool
/= :: EventProcessing -> EventProcessing -> Bool
Eq, Eq EventProcessing
Eq EventProcessing =>
(EventProcessing -> EventProcessing -> Ordering)
-> (EventProcessing -> EventProcessing -> Bool)
-> (EventProcessing -> EventProcessing -> Bool)
-> (EventProcessing -> EventProcessing -> Bool)
-> (EventProcessing -> EventProcessing -> Bool)
-> (EventProcessing -> EventProcessing -> EventProcessing)
-> (EventProcessing -> EventProcessing -> EventProcessing)
-> Ord EventProcessing
EventProcessing -> EventProcessing -> Bool
EventProcessing -> EventProcessing -> Ordering
EventProcessing -> EventProcessing -> EventProcessing
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EventProcessing -> EventProcessing -> Ordering
compare :: EventProcessing -> EventProcessing -> Ordering
$c< :: EventProcessing -> EventProcessing -> Bool
< :: EventProcessing -> EventProcessing -> Bool
$c<= :: EventProcessing -> EventProcessing -> Bool
<= :: EventProcessing -> EventProcessing -> Bool
$c> :: EventProcessing -> EventProcessing -> Bool
> :: EventProcessing -> EventProcessing -> Bool
$c>= :: EventProcessing -> EventProcessing -> Bool
>= :: EventProcessing -> EventProcessing -> Bool
$cmax :: EventProcessing -> EventProcessing -> EventProcessing
max :: EventProcessing -> EventProcessing -> EventProcessing
$cmin :: EventProcessing -> EventProcessing -> EventProcessing
min :: EventProcessing -> EventProcessing -> EventProcessing
Ord, Int -> EventProcessing -> ShowS
[EventProcessing] -> ShowS
EventProcessing -> String
(Int -> EventProcessing -> ShowS)
-> (EventProcessing -> String)
-> ([EventProcessing] -> ShowS)
-> Show EventProcessing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventProcessing -> ShowS
showsPrec :: Int -> EventProcessing -> ShowS
$cshow :: EventProcessing -> String
show :: EventProcessing -> String
$cshowList :: [EventProcessing] -> ShowS
showList :: [EventProcessing] -> ShowS
Show)
type EventPriority = Int
class EventQueueing m where
data EventQueue m :: *
newEventQueue :: Specs m -> m (EventQueue m)
enqueueEventWithPriority :: Double -> EventPriority -> Event m () -> Event m ()
enqueueEvent :: Double -> Event m () -> Event m ()
{-# INLINE enqueueEvent #-}
enqueueEvent Double
t Event m ()
m =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Double -> Int -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Int -> Event m () -> Event m ()
enqueueEventWithPriority Double
t (Point m -> Int
forall (m :: * -> *). Point m -> Int
pointPriority Point m
p) Event m ()
m
runEvent :: Event m a -> Dynamics m a
{-# INLINE runEvent #-}
runEvent = EventProcessing -> Event m a -> Dynamics m a
forall a. EventProcessing -> Event m a -> Dynamics m a
forall (m :: * -> *) a.
EventQueueing m =>
EventProcessing -> Event m a -> Dynamics m a
runEventWith EventProcessing
CurrentEvents
runEventWith :: EventProcessing -> Event m a -> Dynamics m a
eventQueueCount :: Event m Int