rhine-0.2.0.0: src/FRP/Rhine/Clock/Step.hs

{-# LANGUAGE Arrows                #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
module FRP.Rhine.Clock.Step where


-- base
import GHC.TypeLits

-- dunai
import Data.MonadicStreamFunction.Async (concatS)

-- rhine
import FRP.Rhine


-- | A pure (side effect free) clock ticking at multiples of 'n'.
--   The tick rate is in the type signature,
--   which prevents composition of signals at different rates.
data Step (n :: Nat) where
  Step :: KnownNat n => Step n -- TODO Does the constraint bring any benefit?

-- | Extract the type-level natural number as an integer.
stepsize :: Step n -> Integer
stepsize step@Step = natVal step

instance Monad m => Clock m (Step n) where
  type TimeDomainOf (Step n) = Integer
  type Tag          (Step n) = ()
  startClock cl = return
    ( count >>> arr (* stepsize cl)
      &&& arr (const ())
    , 0
    )


-- | Two 'Step' clocks can always be scheduled without side effects.
scheduleStep
  :: Monad m
  => Schedule m (Step n1) (Step n2)
scheduleStep = Schedule f where
  f cl1 cl2 = return (msf, 0)
    where
      n1 = stepsize cl1
      n2 = stepsize cl2
      msf = concatS $ proc _ -> do
        k <- arr (+1) <<< count -< ()
        returnA                 -< [ (k, Left  ()) | k `mod` n1 == 0 ]
                                ++ [ (k, Right ()) | k `mod` n2 == 0 ]