content: {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TypeFamilies #-}
  
  {- | Utilities to run 'ClSF's at the speed of combined clocks
     when they are defined only for a constituent clock.
  -}
  module FRP.Rhine.ClSF.Upsample where
  
  -- dunai
  import Data.Automaton.Trans.Reader
  
  -- rhine
  import FRP.Rhine.ClSF.Core
  import FRP.Rhine.Clock
  import FRP.Rhine.Schedule
  
  {- | An 'Automaton' can be given arbitrary other arguments
     that cause it to tick without doing anything
     and replicating the last output.
  -}
  upsampleAutomaton :: (Monad m) => b -> Automaton m a b -> Automaton m (Either arbitrary a) b
  upsampleAutomaton b automaton = right automaton >>> accumulateWith (<>) (Right b) >>> arr fromRight
    where
      fromRight (Right b') = b'
      fromRight (Left _) = error "fromRight: This case never occurs in upsampleAutomaton."
  
  -- 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 clL clR) a b
  upsampleR b clsf = readerS $ arr remap >>> upsampleAutomaton b (runReaderS clsf)
    where
      remap (TimeInfo {tag = Left tag}, _) = Left tag
      remap (TimeInfo {tag = Right tag, ..}, a) = Right (TimeInfo {..}, 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 clL clR) a b
  upsampleL b clsf = readerS $ arr remap >>> upsampleAutomaton b (runReaderS clsf)
    where
      remap (TimeInfo {tag = Right tag}, _) = Left tag
      remap (TimeInfo {tag = Left tag, ..}, a) = Right (TimeInfo {..}, a)
  