-- | Utilities to run 'ClSF's at the speed of combined clocks
--   when they are defined only for a constituent clock.

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

module FRP.Rhine.ClSF.Upsample where

-- dunai
import Control.Monad.Trans.MSF.Reader

-- rhine
import FRP.Rhine.ClSF.Core
import FRP.Rhine.Schedule

-- | An 'MSF' can be given arbitrary other arguments
--   that cause it to tick without doing anything
--   and replicating the last output.
upsampleMSF :: Monad m => b -> MSF m a b -> MSF m (Either arbitrary a) b
upsampleMSF :: b -> MSF m a b -> MSF m (Either arbitrary a) b
upsampleMSF b
b MSF m a b
msf = MSF m a b -> MSF m (Either arbitrary a) (Either arbitrary b)
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right MSF m a b
msf MSF m (Either arbitrary a) (Either arbitrary b)
-> MSF m (Either arbitrary b) b -> MSF m (Either arbitrary a) b
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Either arbitrary b -> Either arbitrary b -> Either arbitrary b)
-> Either arbitrary b
-> MSF m (Either arbitrary b) (Either arbitrary b)
forall (m :: Type -> Type) a s.
Monad m =>
(a -> s -> s) -> s -> MSF m a s
accumulateWith Either arbitrary b -> Either arbitrary b -> Either arbitrary b
forall a. Semigroup a => a -> a -> a
(<>) (b -> Either arbitrary b
forall a b. b -> Either a b
Right b
b) MSF m (Either arbitrary b) (Either arbitrary b)
-> MSF m (Either arbitrary b) b -> MSF m (Either arbitrary b) b
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Either arbitrary b -> b) -> MSF m (Either arbitrary b) b
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Either arbitrary b -> b
forall a p. Either a p -> p
fromRight
  where
    fromRight :: Either a p -> p
fromRight (Right p
b') = p
b'
    fromRight (Left  a
_ ) = [Char] -> p
forall a. HasCallStack => [Char] -> a
error [Char]
"fromRight: This case never occurs in upsampleMSF."
-- Note that the Semigroup instance of Either a arbitrary
-- updates when the first argument is Right.


-- | Upsample a 'ClSF' to a parallel clock.
--   The given 'ClSF' is only called when @clR@ ticks,
--   otherwise the last output is replicated
--   (with the given @b@ as initialisation).
upsampleR
  :: (Monad m, Time clL ~ Time clR)
  => b -> ClSF m clR a b -> ClSF m (ParallelClock m clL clR) a b
upsampleR :: b -> ClSF m clR a b -> ClSF m (ParallelClock m clL clR) a b
upsampleR b
b ClSF m clR a b
clsf = MSF m (TimeInfo (ParallelClock m clL clR), a) b
-> ClSF m (ParallelClock m clL clR) a b
forall (m :: Type -> Type) r a b.
Monad m =>
MSF m (r, a) b -> MSF (ReaderT r m) a b
readerS (MSF m (TimeInfo (ParallelClock m clL clR), a) b
 -> ClSF m (ParallelClock m clL clR) a b)
-> MSF m (TimeInfo (ParallelClock m clL clR), a) b
-> ClSF m (ParallelClock m clL clR) a b
forall a b. (a -> b) -> a -> b
$ ((TimeInfo (ParallelClock m clL clR), a)
 -> Either (Tag clL) (TimeInfo clR, a))
-> MSF
     m
     (TimeInfo (ParallelClock m clL clR), a)
     (Either (Tag clL) (TimeInfo clR, a))
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (TimeInfo (ParallelClock m clL clR), a)
-> Either (Tag clL) (TimeInfo clR, a)
forall cl a cl b.
(Tag cl ~ Either a (Tag cl), Diff (Time cl) ~ Diff (Time cl),
 Time cl ~ Time cl) =>
(TimeInfo cl, b) -> Either a (TimeInfo cl, b)
remap MSF
  m
  (TimeInfo (ParallelClock m clL clR), a)
  (Either (Tag clL) (TimeInfo clR, a))
-> MSF m (Either (Tag clL) (TimeInfo clR, a)) b
-> MSF m (TimeInfo (ParallelClock m clL clR), a) b
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> b
-> MSF m (TimeInfo clR, a) b
-> MSF m (Either (Tag clL) (TimeInfo clR, a)) b
forall (m :: Type -> Type) b a arbitrary.
Monad m =>
b -> MSF m a b -> MSF m (Either arbitrary a) b
upsampleMSF b
b (ClSF m clR a b -> MSF m (TimeInfo clR, a) b
forall (m :: Type -> Type) r a b.
Monad m =>
MSF (ReaderT r m) a b -> MSF m (r, a) b
runReaderS ClSF m clR a b
clsf)
  where
    remap :: (TimeInfo cl, b) -> Either a (TimeInfo cl, b)
remap (TimeInfo { tag :: forall cl. TimeInfo cl -> Tag cl
tag = Left  tag     }, b
_) = a -> Either a (TimeInfo cl, b)
forall a b. a -> Either a b
Left a
tag
    remap (TimeInfo { tag :: forall cl. TimeInfo cl -> Tag cl
tag = Right tag, Diff (Time cl)
Time cl
absolute :: forall cl. TimeInfo cl -> Time cl
sinceInit :: forall cl. TimeInfo cl -> Diff (Time cl)
sinceLast :: forall cl. TimeInfo cl -> Diff (Time cl)
absolute :: Time cl
sinceInit :: Diff (Time cl)
sinceLast :: Diff (Time cl)
.. }, b
a) = (TimeInfo cl, b) -> Either a (TimeInfo cl, b)
forall a b. b -> Either a b
Right (TimeInfo :: forall cl.
Diff (Time cl)
-> Diff (Time cl) -> Time cl -> Tag cl -> TimeInfo cl
TimeInfo { Diff (Time cl)
Diff (Time cl)
Time cl
Time cl
Tag cl
absolute :: Time cl
sinceInit :: Diff (Time cl)
sinceLast :: Diff (Time cl)
absolute :: Time cl
sinceInit :: Diff (Time cl)
sinceLast :: Diff (Time cl)
tag :: Tag cl
tag :: Tag cl
.. }, b
a)


-- | Upsample a 'ClSF' to a parallel clock.
--   The given 'ClSF' is only called when @clL@ ticks,
--   otherwise the last output is replicated
--   (with the given @b@ as initialisation).
upsampleL
  :: (Monad m, Time clL ~ Time clR)
  => b -> ClSF m clL a b -> ClSF m (ParallelClock m clL clR) a b
upsampleL :: b -> ClSF m clL a b -> ClSF m (ParallelClock m clL clR) a b
upsampleL b
b ClSF m clL a b
clsf = MSF m (TimeInfo (ParallelClock m clL clR), a) b
-> ClSF m (ParallelClock m clL clR) a b
forall (m :: Type -> Type) r a b.
Monad m =>
MSF m (r, a) b -> MSF (ReaderT r m) a b
readerS (MSF m (TimeInfo (ParallelClock m clL clR), a) b
 -> ClSF m (ParallelClock m clL clR) a b)
-> MSF m (TimeInfo (ParallelClock m clL clR), a) b
-> ClSF m (ParallelClock m clL clR) a b
forall a b. (a -> b) -> a -> b
$ ((TimeInfo (ParallelClock m clL clR), a)
 -> Either (Tag clR) (TimeInfo clL, a))
-> MSF
     m
     (TimeInfo (ParallelClock m clL clR), a)
     (Either (Tag clR) (TimeInfo clL, a))
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (TimeInfo (ParallelClock m clL clR), a)
-> Either (Tag clR) (TimeInfo clL, a)
forall cl cl b b.
(Tag cl ~ Either (Tag cl) b, Diff (Time cl) ~ Diff (Time cl),
 Time cl ~ Time cl) =>
(TimeInfo cl, b) -> Either b (TimeInfo cl, b)
remap MSF
  m
  (TimeInfo (ParallelClock m clL clR), a)
  (Either (Tag clR) (TimeInfo clL, a))
-> MSF m (Either (Tag clR) (TimeInfo clL, a)) b
-> MSF m (TimeInfo (ParallelClock m clL clR), a) b
forall k (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> b
-> MSF m (TimeInfo clL, a) b
-> MSF m (Either (Tag clR) (TimeInfo clL, a)) b
forall (m :: Type -> Type) b a arbitrary.
Monad m =>
b -> MSF m a b -> MSF m (Either arbitrary a) b
upsampleMSF b
b (ClSF m clL a b -> MSF m (TimeInfo clL, a) b
forall (m :: Type -> Type) r a b.
Monad m =>
MSF (ReaderT r m) a b -> MSF m (r, a) b
runReaderS ClSF m clL a b
clsf)
  where
    remap :: (TimeInfo cl, b) -> Either b (TimeInfo cl, b)
remap (TimeInfo { tag :: forall cl. TimeInfo cl -> Tag cl
tag = Right tag     }, b
_) = b -> Either b (TimeInfo cl, b)
forall a b. a -> Either a b
Left b
tag
    remap (TimeInfo { tag :: forall cl. TimeInfo cl -> Tag cl
tag = Left  tag, Diff (Time cl)
Time cl
absolute :: Time cl
sinceInit :: Diff (Time cl)
sinceLast :: Diff (Time cl)
absolute :: forall cl. TimeInfo cl -> Time cl
sinceInit :: forall cl. TimeInfo cl -> Diff (Time cl)
sinceLast :: forall cl. TimeInfo cl -> Diff (Time cl)
.. }, b
a) = (TimeInfo cl, b) -> Either b (TimeInfo cl, b)
forall a b. b -> Either a b
Right (TimeInfo :: forall cl.
Diff (Time cl)
-> Diff (Time cl) -> Time cl -> Tag cl -> TimeInfo cl
TimeInfo { Diff (Time cl)
Diff (Time cl)
Time cl
Time cl
Tag cl
absolute :: Time cl
sinceInit :: Diff (Time cl)
sinceLast :: Diff (Time cl)
tag :: Tag cl
absolute :: Time cl
sinceInit :: Diff (Time cl)
sinceLast :: Diff (Time cl)
tag :: Tag cl
.. }, b
a)