{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

{- |
Implements pure clocks ticking at
every multiple of a fixed number of steps,
and a deterministic schedule for such clocks.
-}
module FRP.Rhine.Clock.FixedStep where

-- base
import Data.Functor (($>))
import Data.Maybe (fromMaybe)
import GHC.TypeLits

-- vector-sized
import Data.Vector.Sized (Vector, fromList)

-- monad-schedule
import Control.Monad.Schedule.Class
import Control.Monad.Schedule.Trans (ScheduleT, wait)

-- rhine
import FRP.Rhine.Clock
import FRP.Rhine.Clock.Proxy
import FRP.Rhine.ResamplingBuffer
import FRP.Rhine.ResamplingBuffer.Collect
import FRP.Rhine.ResamplingBuffer.Util

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

-- | Extract the type-level natural number as an integer.
stepsize :: FixedStep n -> Integer
stepsize :: forall (n :: Nat). FixedStep n -> Integer
stepsize fixedStep :: FixedStep n
fixedStep@FixedStep n
FixedStep = forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal FixedStep n
fixedStep

instance (MonadSchedule m, Monad m) => Clock (ScheduleT Integer m) (FixedStep n) where
  type Time (FixedStep n) = Integer
  type Tag (FixedStep n) = ()
  initClock :: FixedStep n
-> RunningClockInit
     (ScheduleT Integer m) (Time (FixedStep n)) (Tag (FixedStep n))
initClock FixedStep n
cl =
    let step :: Integer
step = forall (n :: Nat). FixedStep n -> Integer
stepsize FixedStep n
cl
     in forall (m :: Type -> Type) a. Monad m => a -> m a
return
          ( forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (forall a b. a -> b -> a
const Integer
step)
              forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (m :: Type -> Type) a s.
Monad m =>
(a -> s -> s) -> s -> MSF m a s
accumulateWith forall a. Num a => a -> a -> a
(+) Integer
0
              forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> MSF m a b
arrM (\Integer
time -> forall (m :: Type -> Type) diff.
Monad m =>
diff -> ScheduleT diff m ()
wait Integer
step forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> (Integer
time, ()))
          , Integer
0
          )

instance GetClockProxy (FixedStep n)

-- | A singleton clock that counts the ticks.
type Count = FixedStep 1

{- | Resample into a 'FixedStep' clock that ticks @n@ times slower,
  by collecting all values into a vector.
-}
downsampleFixedStep ::
  (KnownNat n, Monad m) =>
  ResamplingBuffer m (FixedStep k) (FixedStep (n * k)) a (Vector n a)
downsampleFixedStep :: forall (n :: Nat) (m :: Type -> Type) (k :: Nat) a.
(KnownNat n, Monad m) =>
ResamplingBuffer m (FixedStep k) (FixedStep (n * k)) a (Vector n a)
downsampleFixedStep = forall (m :: Type -> Type) cl1 cl2 a.
Monad m =>
ResamplingBuffer m cl1 cl2 a [a]
collect forall (m :: Type -> Type) cl1 cl2 a b c.
Monad m =>
ResamplingBuffer m cl1 cl2 a b
-> ClSF m cl2 b c -> ResamplingBuffer m cl1 cl2 a c
>>-^ forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (forall (n :: Nat) a. KnownNat n => [a] -> Maybe (Vector n a)
fromList forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall {a}. Maybe a -> a
assumeSize)
  where
    assumeSize :: Maybe a -> a
assumeSize = forall a. a -> Maybe a -> a
fromMaybe forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"downsampleFixedStep: Internal error. Please report this as a bug: https://github.com/turion/rhine/issues"