{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module FRP.Rhine.Schedule where
import Control.Arrow
import Data.List.NonEmpty as N
import Control.Monad.Trans.Reader
import Control.Monad.Schedule.Class
import Data.Automaton
import Data.Automaton.Final (getFinal, toFinal)
import Data.Stream
import Data.Stream.Final qualified as StreamFinal
import Data.Stream.Optimized (OptimizedStreamT (..), toStreamT)
import Data.Stream.Result
import FRP.Rhine.Clock
scheduleList :: (Monad m, MonadSchedule m) => NonEmpty (Automaton m a b) -> Automaton m a (NonEmpty b)
scheduleList :: forall (m :: Type -> Type) a b.
(Monad m, MonadSchedule m) =>
NonEmpty (Automaton m a b) -> Automaton m a (NonEmpty b)
scheduleList NonEmpty (Automaton m a b)
automatons0 =
OptimizedStreamT (ReaderT a m) (NonEmpty b)
-> Automaton m a (NonEmpty b)
forall (m :: Type -> Type) a b.
OptimizedStreamT (ReaderT a m) b -> Automaton m a b
Automaton (OptimizedStreamT (ReaderT a m) (NonEmpty b)
-> Automaton m a (NonEmpty b))
-> OptimizedStreamT (ReaderT a m) (NonEmpty b)
-> Automaton m a (NonEmpty b)
forall a b. (a -> b) -> a -> b
$
StreamT (ReaderT a m) (NonEmpty b)
-> OptimizedStreamT (ReaderT a m) (NonEmpty b)
forall (m :: Type -> Type) a. StreamT m a -> OptimizedStreamT m a
Stateful (StreamT (ReaderT a m) (NonEmpty b)
-> OptimizedStreamT (ReaderT a m) (NonEmpty b))
-> StreamT (ReaderT a m) (NonEmpty b)
-> OptimizedStreamT (ReaderT a m) (NonEmpty b)
forall a b. (a -> b) -> a -> b
$
StreamT
{ state :: (NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
state = (Final m a b -> Final (ReaderT a m) b
forall (m :: Type -> Type) a b.
Final m a b -> Final (ReaderT a m) b
getFinal (Final m a b -> Final (ReaderT a m) b)
-> (Automaton m a b -> Final m a b)
-> Automaton m a b
-> Final (ReaderT a m) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Automaton m a b -> Final m a b
forall (m :: Type -> Type) a b.
Functor m =>
Automaton m a b -> Final m a b
toFinal (Automaton m a b -> Final (ReaderT a m) b)
-> NonEmpty (Automaton m a b) -> NonEmpty (Final (ReaderT a m) b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Automaton m a b)
automatons0, [])
, step :: (NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
-> ReaderT
a
m
(Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b))
step = \(NonEmpty (Final (ReaderT a m) b)
automatons, [m (Result (Final (ReaderT a m) b) b)]
running) -> (a
-> m (Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b)))
-> ReaderT
a
m
(Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b))
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((a
-> m (Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b)))
-> ReaderT
a
m
(Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b)))
-> (a
-> m (Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b)))
-> ReaderT
a
m
(Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b))
forall a b. (a -> b) -> a -> b
$ \a
a -> do
let bsAndConts :: NonEmpty (m (Result (Final (ReaderT a m) b) b))
bsAndConts = (Final (ReaderT a m) b
-> a -> m (Result (Final (ReaderT a m) b) b))
-> a
-> Final (ReaderT a m) b
-> m (Result (Final (ReaderT a m) b) b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ReaderT a m (Result (Final (ReaderT a m) b) b)
-> a -> m (Result (Final (ReaderT a m) b) b)
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT a m (Result (Final (ReaderT a m) b) b)
-> a -> m (Result (Final (ReaderT a m) b) b))
-> (Final (ReaderT a m) b
-> ReaderT a m (Result (Final (ReaderT a m) b) b))
-> Final (ReaderT a m) b
-> a
-> m (Result (Final (ReaderT a m) b) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Final (ReaderT a m) b
-> ReaderT a m (Result (Final (ReaderT a m) b) b)
forall (m :: Type -> Type) a. Final m a -> m (Result (Final m a) a)
StreamFinal.getFinal) a
a (Final (ReaderT a m) b -> m (Result (Final (ReaderT a m) b) b))
-> NonEmpty (Final (ReaderT a m) b)
-> NonEmpty (m (Result (Final (ReaderT a m) b) b))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Final (ReaderT a m) b)
automatons
(NonEmpty (Result (Final (ReaderT a m) b) b)
done, [m (Result (Final (ReaderT a m) b) b)]
running') <- NonEmpty (m (Result (Final (ReaderT a m) b) b))
-> m (NonEmpty (Result (Final (ReaderT a m) b) b),
[m (Result (Final (ReaderT a m) b) b)])
forall a. NonEmpty (m a) -> m (NonEmpty a, [m a])
forall (m :: Type -> Type) a.
MonadSchedule m =>
NonEmpty (m a) -> m (NonEmpty a, [m a])
schedule (NonEmpty (m (Result (Final (ReaderT a m) b) b))
-> m (Result (Final (ReaderT a m) b) b)
forall a. NonEmpty a -> a
N.head NonEmpty (m (Result (Final (ReaderT a m) b) b))
bsAndConts m (Result (Final (ReaderT a m) b) b)
-> [m (Result (Final (ReaderT a m) b) b)]
-> NonEmpty (m (Result (Final (ReaderT a m) b) b))
forall a. a -> [a] -> NonEmpty a
:| NonEmpty (m (Result (Final (ReaderT a m) b) b))
-> [m (Result (Final (ReaderT a m) b) b)]
forall a. NonEmpty a -> [a]
N.tail NonEmpty (m (Result (Final (ReaderT a m) b) b))
bsAndConts [m (Result (Final (ReaderT a m) b) b)]
-> [m (Result (Final (ReaderT a m) b) b)]
-> [m (Result (Final (ReaderT a m) b) b)]
forall a. [a] -> [a] -> [a]
++ [m (Result (Final (ReaderT a m) b) b)]
running)
Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b)
-> m (Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b)
-> m (Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b)))
-> Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b)
-> m (Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b))
forall a b. (a -> b) -> a -> b
$ (NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
-> NonEmpty b
-> Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b)
forall s a. s -> a -> Result s a
Result (Result (Final (ReaderT a m) b) b -> Final (ReaderT a m) b
forall s a. Result s a -> s
resultState (Result (Final (ReaderT a m) b) b -> Final (ReaderT a m) b)
-> NonEmpty (Result (Final (ReaderT a m) b) b)
-> NonEmpty (Final (ReaderT a m) b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Result (Final (ReaderT a m) b) b)
done, [m (Result (Final (ReaderT a m) b) b)]
running') (NonEmpty b
-> Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b))
-> NonEmpty b
-> Result
(NonEmpty (Final (ReaderT a m) b),
[m (Result (Final (ReaderT a m) b) b)])
(NonEmpty b)
forall a b. (a -> b) -> a -> b
$ Result (Final (ReaderT a m) b) b -> b
forall s a. Result s a -> a
output (Result (Final (ReaderT a m) b) b -> b)
-> NonEmpty (Result (Final (ReaderT a m) b) b) -> NonEmpty b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Result (Final (ReaderT a m) b) b)
done
}
schedulePair :: (Monad m, MonadSchedule m) => Automaton m a b -> Automaton m a b -> Automaton m a b
schedulePair :: forall (m :: Type -> Type) a b.
(Monad m, MonadSchedule m) =>
Automaton m a b -> Automaton m a b -> Automaton m a b
schedulePair (Automaton OptimizedStreamT (ReaderT a m) b
automatonL) (Automaton OptimizedStreamT (ReaderT a m) b
automatonR) = OptimizedStreamT (ReaderT a m) b -> Automaton m a b
forall (m :: Type -> Type) a b.
OptimizedStreamT (ReaderT a m) b -> Automaton m a b
Automaton (OptimizedStreamT (ReaderT a m) b -> Automaton m a b)
-> OptimizedStreamT (ReaderT a m) b -> Automaton m a b
forall a b. (a -> b) -> a -> b
$! StreamT (ReaderT a m) b -> OptimizedStreamT (ReaderT a m) b
forall (m :: Type -> Type) a. StreamT m a -> OptimizedStreamT m a
Stateful (StreamT (ReaderT a m) b -> OptimizedStreamT (ReaderT a m) b)
-> StreamT (ReaderT a m) b -> OptimizedStreamT (ReaderT a m) b
forall a b. (a -> b) -> a -> b
$! StreamT (ReaderT a m) b
-> StreamT (ReaderT a m) b -> StreamT (ReaderT a m) b
forall (m :: Type -> Type) b.
(Monad m, MonadSchedule m) =>
StreamT m b -> StreamT m b -> StreamT m b
scheduleStreams (OptimizedStreamT (ReaderT a m) b -> StreamT (ReaderT a m) b
forall (m :: Type -> Type) b.
Functor m =>
OptimizedStreamT m b -> StreamT m b
toStreamT OptimizedStreamT (ReaderT a m) b
automatonL) (OptimizedStreamT (ReaderT a m) b -> StreamT (ReaderT a m) b
forall (m :: Type -> Type) b.
Functor m =>
OptimizedStreamT m b -> StreamT m b
toStreamT OptimizedStreamT (ReaderT a m) b
automatonR)
where
scheduleStreams :: (Monad m, MonadSchedule m) => StreamT m b -> StreamT m b -> StreamT m b
scheduleStreams :: forall (m :: Type -> Type) b.
(Monad m, MonadSchedule m) =>
StreamT m b -> StreamT m b -> StreamT m b
scheduleStreams (StreamT s
stateL0 s -> m (Result s b)
stepL) (StreamT s
stateR0 s -> m (Result s b)
stepR) =
StreamT
{ state :: (m (Result s b), m (Result s b))
state = (s -> m (Result s b)
stepL s
stateL0, s -> m (Result s b)
stepR s
stateR0)
, (m (Result s b), m (Result s b))
-> m (Result (m (Result s b), m (Result s b)) b)
step :: (m (Result s b), m (Result s b))
-> m (Result (m (Result s b), m (Result s b)) b)
step :: (m (Result s b), m (Result s b))
-> m (Result (m (Result s b), m (Result s b)) b)
step
}
where
step :: (m (Result s b), m (Result s b))
-> m (Result (m (Result s b), m (Result s b)) b)
step (m (Result s b)
runningL, m (Result s b)
runningR) = do
Either (Result s b, m (Result s b)) (m (Result s b), Result s b)
result <- m (Result s b)
-> m (Result s b)
-> m (Either
(Result s b, m (Result s b)) (m (Result s b), Result s b))
forall (m :: Type -> Type) a b.
(Monad m, MonadSchedule m) =>
m a -> m b -> m (Either (a, m b) (m a, b))
race m (Result s b)
runningL m (Result s b)
runningR
case Either (Result s b, m (Result s b)) (m (Result s b), Result s b)
result of
Left (Result s
stateL' b
b, m (Result s b)
runningR') -> Result (m (Result s b), m (Result s b)) b
-> m (Result (m (Result s b), m (Result s b)) b)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result (m (Result s b), m (Result s b)) b
-> m (Result (m (Result s b), m (Result s b)) b))
-> Result (m (Result s b), m (Result s b)) b
-> m (Result (m (Result s b), m (Result s b)) b)
forall a b. (a -> b) -> a -> b
$ (m (Result s b), m (Result s b))
-> b -> Result (m (Result s b), m (Result s b)) b
forall s a. s -> a -> Result s a
Result (s -> m (Result s b)
stepL s
stateL', m (Result s b)
runningR') b
b
Right (m (Result s b)
runningL', Result s
stateR' b
b) -> Result (m (Result s b), m (Result s b)) b
-> m (Result (m (Result s b), m (Result s b)) b)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result (m (Result s b), m (Result s b)) b
-> m (Result (m (Result s b), m (Result s b)) b))
-> Result (m (Result s b), m (Result s b)) b
-> m (Result (m (Result s b), m (Result s b)) b)
forall a b. (a -> b) -> a -> b
$ (m (Result s b), m (Result s b))
-> b -> Result (m (Result s b), m (Result s b)) b
forall s a. s -> a -> Result s a
Result (m (Result s b)
runningL', s -> m (Result s b)
stepR s
stateR') b
b
runningSchedule ::
( Monad m
, MonadSchedule m
, Clock m cl1
, Clock m cl2
, Time cl1 ~ Time cl2
) =>
cl1 ->
cl2 ->
RunningClock m (Time cl1) (Tag cl1) ->
RunningClock m (Time cl2) (Tag cl2) ->
RunningClock m (Time cl1) (Either (Tag cl1) (Tag cl2))
runningSchedule :: forall (m :: Type -> Type) cl1 cl2.
(Monad m, MonadSchedule m, Clock m cl1, Clock m cl2,
Time cl1 ~ Time cl2) =>
cl1
-> cl2
-> RunningClock m (Time cl1) (Tag cl1)
-> RunningClock m (Time cl2) (Tag cl2)
-> RunningClock m (Time cl1) (Either (Tag cl1) (Tag cl2))
runningSchedule cl1
_ cl2
_ RunningClock m (Time cl1) (Tag cl1)
rc1 RunningClock m (Time cl2) (Tag cl2)
rc2 = Automaton m () (Time cl2, Either (Tag cl1) (Tag cl2))
-> Automaton m () (Time cl2, Either (Tag cl1) (Tag cl2))
-> Automaton m () (Time cl2, Either (Tag cl1) (Tag cl2))
forall (m :: Type -> Type) a b.
(Monad m, MonadSchedule m) =>
Automaton m a b -> Automaton m a b -> Automaton m a b
schedulePair (RunningClock m (Time cl1) (Tag cl1)
Automaton m () (Time cl2, Tag cl1)
rc1 Automaton m () (Time cl2, Tag cl1)
-> Automaton
m (Time cl2, Tag cl1) (Time cl2, Either (Tag cl1) (Tag cl2))
-> Automaton m () (Time cl2, Either (Tag cl1) (Tag cl2))
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Time cl2, Tag cl1) -> (Time cl2, Either (Tag cl1) (Tag cl2)))
-> Automaton
m (Time cl2, Tag cl1) (Time cl2, Either (Tag cl1) (Tag cl2))
forall b c. (b -> c) -> Automaton m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr ((Tag cl1 -> Either (Tag cl1) (Tag cl2))
-> (Time cl2, Tag cl1) -> (Time cl2, Either (Tag cl1) (Tag cl2))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Tag cl1 -> Either (Tag cl1) (Tag cl2)
forall a b. a -> Either a b
Left)) (RunningClock m (Time cl2) (Tag cl2)
rc2 RunningClock m (Time cl2) (Tag cl2)
-> Automaton
m (Time cl2, Tag cl2) (Time cl2, Either (Tag cl1) (Tag cl2))
-> Automaton m () (Time cl2, Either (Tag cl1) (Tag cl2))
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Time cl2, Tag cl2) -> (Time cl2, Either (Tag cl1) (Tag cl2)))
-> Automaton
m (Time cl2, Tag cl2) (Time cl2, Either (Tag cl1) (Tag cl2))
forall b c. (b -> c) -> Automaton m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr ((Tag cl2 -> Either (Tag cl1) (Tag cl2))
-> (Time cl2, Tag cl2) -> (Time cl2, Either (Tag cl1) (Tag cl2))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Tag cl2 -> Either (Tag cl1) (Tag cl2)
forall a b. b -> Either a b
Right))
initSchedule ::
( Time cl1 ~ Time cl2
, Monad m
, MonadSchedule m
, Clock m cl1
, Clock m cl2
) =>
cl1 ->
cl2 ->
RunningClockInit m (Time cl1) (Either (Tag cl1) (Tag cl2))
initSchedule :: forall cl1 cl2 (m :: Type -> Type).
(Time cl1 ~ Time cl2, Monad m, MonadSchedule m, Clock m cl1,
Clock m cl2) =>
cl1
-> cl2
-> RunningClockInit m (Time cl1) (Either (Tag cl1) (Tag cl2))
initSchedule cl1
cl1 cl2
cl2 = do
(RunningClock m (Time cl2) (Tag cl1)
runningClock1, Time cl2
initTime) <- cl1 -> RunningClockInit m (Time cl1) (Tag cl1)
forall (m :: Type -> Type) cl.
Clock m cl =>
cl -> RunningClockInit m (Time cl) (Tag cl)
initClock cl1
cl1
(RunningClock m (Time cl2) (Tag cl2)
runningClock2, Time cl2
_) <- cl2 -> m (RunningClock m (Time cl2) (Tag cl2), Time cl2)
forall (m :: Type -> Type) cl.
Clock m cl =>
cl -> RunningClockInit m (Time cl) (Tag cl)
initClock cl2
cl2
(RunningClock m (Time cl2) (Either (Tag cl1) (Tag cl2)), Time cl2)
-> m (RunningClock m (Time cl2) (Either (Tag cl1) (Tag cl2)),
Time cl2)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return
( cl1
-> cl2
-> RunningClock m (Time cl1) (Tag cl1)
-> RunningClock m (Time cl2) (Tag cl2)
-> RunningClock m (Time cl1) (Either (Tag cl1) (Tag cl2))
forall (m :: Type -> Type) cl1 cl2.
(Monad m, MonadSchedule m, Clock m cl1, Clock m cl2,
Time cl1 ~ Time cl2) =>
cl1
-> cl2
-> RunningClock m (Time cl1) (Tag cl1)
-> RunningClock m (Time cl2) (Tag cl2)
-> RunningClock m (Time cl1) (Either (Tag cl1) (Tag cl2))
runningSchedule cl1
cl1 cl2
cl2 RunningClock m (Time cl1) (Tag cl1)
RunningClock m (Time cl2) (Tag cl1)
runningClock1 RunningClock m (Time cl2) (Tag cl2)
runningClock2
, Time cl2
initTime
)
data SequentialClock cl1 cl2 = (Time cl1 ~ Time cl2) =>
SequentialClock
{ forall cl1 cl2. SequentialClock cl1 cl2 -> cl1
sequentialCl1 :: cl1
, forall cl1 cl2. SequentialClock cl1 cl2 -> cl2
sequentialCl2 :: cl2
}
type SeqClock cl1 cl2 = SequentialClock cl1 cl2
instance
(Monad m, MonadSchedule m, Clock m cl1, Clock m cl2) =>
Clock m (SequentialClock cl1 cl2)
where
type Time (SequentialClock cl1 cl2) = Time cl1
type Tag (SequentialClock cl1 cl2) = Either (Tag cl1) (Tag cl2)
initClock :: SequentialClock cl1 cl2
-> RunningClockInit
m (Time (SequentialClock cl1 cl2)) (Tag (SequentialClock cl1 cl2))
initClock SequentialClock {cl1
cl2
sequentialCl1 :: forall cl1 cl2. SequentialClock cl1 cl2 -> cl1
sequentialCl2 :: forall cl1 cl2. SequentialClock cl1 cl2 -> cl2
sequentialCl1 :: cl1
sequentialCl2 :: cl2
..} =
cl1
-> cl2
-> RunningClockInit m (Time cl1) (Either (Tag cl1) (Tag cl2))
forall cl1 cl2 (m :: Type -> Type).
(Time cl1 ~ Time cl2, Monad m, MonadSchedule m, Clock m cl1,
Clock m cl2) =>
cl1
-> cl2
-> RunningClockInit m (Time cl1) (Either (Tag cl1) (Tag cl2))
initSchedule cl1
sequentialCl1 cl2
sequentialCl2
data ParallelClock cl1 cl2 = (Time cl1 ~ Time cl2) =>
ParallelClock
{ forall cl1 cl2. ParallelClock cl1 cl2 -> cl1
parallelCl1 :: cl1
, forall cl1 cl2. ParallelClock cl1 cl2 -> cl2
parallelCl2 :: cl2
}
type ParClock cl1 cl2 = ParallelClock cl1 cl2
instance
(Monad m, MonadSchedule m, Clock m cl1, Clock m cl2) =>
Clock m (ParallelClock cl1 cl2)
where
type Time (ParallelClock cl1 cl2) = Time cl1
type Tag (ParallelClock cl1 cl2) = Either (Tag cl1) (Tag cl2)
initClock :: ParallelClock cl1 cl2
-> RunningClockInit
m (Time (ParallelClock cl1 cl2)) (Tag (ParallelClock cl1 cl2))
initClock ParallelClock {cl1
cl2
parallelCl1 :: forall cl1 cl2. ParallelClock cl1 cl2 -> cl1
parallelCl2 :: forall cl1 cl2. ParallelClock cl1 cl2 -> cl2
parallelCl1 :: cl1
parallelCl2 :: cl2
..} =
cl1
-> cl2
-> RunningClockInit m (Time cl1) (Either (Tag cl1) (Tag cl2))
forall cl1 cl2 (m :: Type -> Type).
(Time cl1 ~ Time cl2, Monad m, MonadSchedule m, Clock m cl1,
Clock m cl2) =>
cl1
-> cl2
-> RunningClockInit m (Time cl1) (Either (Tag cl1) (Tag cl2))
initSchedule cl1
parallelCl1 cl2
parallelCl2
type family In cl where
In (SequentialClock cl1 cl2) = In cl1
In (ParallelClock cl1 cl2) = ParallelClock (In cl1) (In cl2)
In cl = cl
type family Out cl where
Out (SequentialClock cl1 cl2) = Out cl2
Out (ParallelClock cl1 cl2) = ParallelClock (Out cl1) (Out cl2)
Out cl = cl
data LastTime cl where
SequentialLastTime ::
LastTime cl1 ->
LastTime cl2 ->
LastTime (SequentialClock cl1 cl2)
ParallelLastTime ::
LastTime cl1 ->
LastTime cl2 ->
LastTime (ParallelClock cl1 cl2)
LeafLastTime :: Time cl -> LastTime cl
data ParClockInclusion clS cl where
ParClockInL ::
ParClockInclusion (ParallelClock clL clR) cl ->
ParClockInclusion clL cl
ParClockInR ::
ParClockInclusion (ParallelClock clL clR) cl ->
ParClockInclusion clR cl
ParClockRefl :: ParClockInclusion cl cl
parClockTagInclusion :: ParClockInclusion clS cl -> Tag clS -> Tag cl
parClockTagInclusion :: forall clS cl. ParClockInclusion clS cl -> Tag clS -> Tag cl
parClockTagInclusion (ParClockInL ParClockInclusion (ParallelClock clS clR) cl
parClockInL) Tag clS
tag = ParClockInclusion (ParallelClock clS clR) cl
-> Tag (ParallelClock clS clR) -> Tag cl
forall clS cl. ParClockInclusion clS cl -> Tag clS -> Tag cl
parClockTagInclusion ParClockInclusion (ParallelClock clS clR) cl
parClockInL (Tag (ParallelClock clS clR) -> Tag cl)
-> Tag (ParallelClock clS clR) -> Tag cl
forall a b. (a -> b) -> a -> b
$ Tag clS -> Either (Tag clS) (Tag clR)
forall a b. a -> Either a b
Left Tag clS
tag
parClockTagInclusion (ParClockInR ParClockInclusion (ParallelClock clL clS) cl
parClockInR) Tag clS
tag = ParClockInclusion (ParallelClock clL clS) cl
-> Tag (ParallelClock clL clS) -> Tag cl
forall clS cl. ParClockInclusion clS cl -> Tag clS -> Tag cl
parClockTagInclusion ParClockInclusion (ParallelClock clL clS) cl
parClockInR (Tag (ParallelClock clL clS) -> Tag cl)
-> Tag (ParallelClock clL clS) -> Tag cl
forall a b. (a -> b) -> a -> b
$ Tag clS -> Either (Tag clL) (Tag clS)
forall a b. b -> Either a b
Right Tag clS
tag
parClockTagInclusion ParClockInclusion clS cl
ParClockRefl Tag clS
tag = Tag clS
Tag cl
tag