module Simulation.Aivika.Trans.Channel
(
Channel(..),
delayChannel,
delayChannelM,
sinkSignal,
traceChannel) where
import qualified Control.Category as C
import Control.Monad
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Simulation
import Simulation.Aivika.Trans.Dynamics
import Simulation.Aivika.Trans.Event
import Simulation.Aivika.Trans.Signal
import Simulation.Aivika.Trans.Composite
newtype Channel m a b =
Channel { forall (m :: * -> *) a b.
Channel m a b -> Signal m a -> Composite m (Signal m b)
runChannel :: Signal m a -> Composite m (Signal m b)
}
instance MonadDES m => C.Category (Channel m) where
{-# INLINE id #-}
id :: forall a. Channel m a a
id = (Signal m a -> Composite m (Signal m a)) -> Channel m a a
forall (m :: * -> *) a b.
(Signal m a -> Composite m (Signal m b)) -> Channel m a b
Channel Signal m a -> Composite m (Signal m a)
forall a. a -> Composite m a
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE (.) #-}
(Channel Signal m b -> Composite m (Signal m c)
g) . :: forall b c a. Channel m b c -> Channel m a b -> Channel m a c
. (Channel Signal m a -> Composite m (Signal m b)
f) =
(Signal m a -> Composite m (Signal m c)) -> Channel m a c
forall (m :: * -> *) a b.
(Signal m a -> Composite m (Signal m b)) -> Channel m a b
Channel ((Signal m a -> Composite m (Signal m c)) -> Channel m a c)
-> (Signal m a -> Composite m (Signal m c)) -> Channel m a c
forall a b. (a -> b) -> a -> b
$ \Signal m a
a -> Signal m a -> Composite m (Signal m b)
f Signal m a
a Composite m (Signal m b)
-> (Signal m b -> Composite m (Signal m c))
-> Composite m (Signal m c)
forall a b. Composite m a -> (a -> Composite m b) -> Composite m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Signal m b -> Composite m (Signal m c)
g
delayChannel :: MonadDES m
=> Double
-> Channel m a a
{-# INLINABLE delayChannel #-}
delayChannel :: forall (m :: * -> *) a. MonadDES m => Double -> Channel m a a
delayChannel Double
delay =
(Signal m a -> Composite m (Signal m a)) -> Channel m a a
forall (m :: * -> *) a b.
(Signal m a -> Composite m (Signal m b)) -> Channel m a b
Channel ((Signal m a -> Composite m (Signal m a)) -> Channel m a a)
-> (Signal m a -> Composite m (Signal m a)) -> Channel m a a
forall a b. (a -> b) -> a -> b
$ \Signal m a
a -> Signal m a -> Composite m (Signal m a)
forall a. a -> Composite m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal m a -> Composite m (Signal m a))
-> Signal m a -> Composite m (Signal m a)
forall a b. (a -> b) -> a -> b
$ Double -> Signal m a -> Signal m a
forall (m :: * -> *) a.
MonadDES m =>
Double -> Signal m a -> Signal m a
delaySignal Double
delay Signal m a
a
delayChannelM :: MonadDES m
=> Event m Double
-> Channel m a a
{-# INLINABLE delayChannelM #-}
delayChannelM :: forall (m :: * -> *) a.
MonadDES m =>
Event m Double -> Channel m a a
delayChannelM Event m Double
delay =
(Signal m a -> Composite m (Signal m a)) -> Channel m a a
forall (m :: * -> *) a b.
(Signal m a -> Composite m (Signal m b)) -> Channel m a b
Channel ((Signal m a -> Composite m (Signal m a)) -> Channel m a a)
-> (Signal m a -> Composite m (Signal m a)) -> Channel m a a
forall a b. (a -> b) -> a -> b
$ \Signal m a
a -> Signal m a -> Composite m (Signal m a)
forall a. a -> Composite m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal m a -> Composite m (Signal m a))
-> Signal m a -> Composite m (Signal m a)
forall a b. (a -> b) -> a -> b
$ Event m Double -> Signal m a -> Signal m a
forall (m :: * -> *) a.
MonadDES m =>
Event m Double -> Signal m a -> Signal m a
delaySignalM Event m Double
delay Signal m a
a
sinkSignal :: MonadDES m => Signal m a -> Composite m ()
{-# INLINABLE sinkSignal #-}
sinkSignal :: forall (m :: * -> *) a. MonadDES m => Signal m a -> Composite m ()
sinkSignal Signal m a
a =
do DisposableEvent m
h <- Event m (DisposableEvent m) -> Composite m (DisposableEvent m)
forall a. Event m a -> Composite m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m (DisposableEvent m) -> Composite m (DisposableEvent m))
-> Event m (DisposableEvent m) -> Composite m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
a ((a -> Event m ()) -> Event m (DisposableEvent m))
-> (a -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
Event m () -> a -> Event m ()
forall a b. a -> b -> a
const (Event m () -> a -> Event m ()) -> Event m () -> a -> Event m ()
forall a b. (a -> b) -> a -> b
$ () -> Event m ()
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DisposableEvent m -> Composite m ()
forall (m :: * -> *).
Monad m =>
DisposableEvent m -> Composite m ()
disposableComposite DisposableEvent m
h
traceChannel :: MonadDES m => String -> Channel m a b -> Channel m a b
{-# INLINABLE traceChannel #-}
traceChannel :: forall (m :: * -> *) a b.
MonadDES m =>
String -> Channel m a b -> Channel m a b
traceChannel String
message (Channel Signal m a -> Composite m (Signal m b)
f) =
(Signal m a -> Composite m (Signal m b)) -> Channel m a b
forall (m :: * -> *) a b.
(Signal m a -> Composite m (Signal m b)) -> Channel m a b
Channel ((Signal m a -> Composite m (Signal m b)) -> Channel m a b)
-> (Signal m a -> Composite m (Signal m b)) -> Channel m a b
forall a b. (a -> b) -> a -> b
$ \Signal m a
a ->
do Signal m b
b <- Signal m a -> Composite m (Signal m b)
f Signal m a
a
Signal m b -> Composite m (Signal m b)
forall a. a -> Composite m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal m b -> Composite m (Signal m b))
-> Signal m b -> Composite m (Signal m b)
forall a b. (a -> b) -> a -> b
$
String -> Signal m b -> Signal m b
forall (m :: * -> *) a.
MonadDES m =>
String -> Signal m a -> Signal m a
traceSignal String
message Signal m b
b