{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}

module FRP.Rhine.Clock.Proxy where

-- base
import Data.Kind (Type)

-- rhine
import FRP.Rhine.Clock
import FRP.Rhine.Schedule

{- | Witnesses the structure of a clock type,
   in particular whether 'SequentialClock's or 'ParallelClock's are involved.
-}
data ClockProxy cl where
  LeafProxy ::
    (cl ~ In cl, cl ~ Out cl) =>
    ClockProxy cl
  SequentialProxy ::
    ClockProxy cl1 ->
    ClockProxy cl2 ->
    ClockProxy (SequentialClock cl1 cl2)
  ParallelProxy ::
    ClockProxy clL ->
    ClockProxy clR ->
    ClockProxy (ParallelClock clL clR)

inProxy :: ClockProxy cl -> ClockProxy (In cl)
inProxy :: forall cl. ClockProxy cl -> ClockProxy (In cl)
inProxy ClockProxy cl
LeafProxy = forall cl. (cl ~ In cl, cl ~ Out cl) => ClockProxy cl
LeafProxy
inProxy (SequentialProxy ClockProxy cl1
p1 ClockProxy cl2
_) = forall cl. ClockProxy cl -> ClockProxy (In cl)
inProxy ClockProxy cl1
p1
inProxy (ParallelProxy ClockProxy clL
pL ClockProxy clR
pR) = forall cl1 cl2.
ClockProxy cl1
-> ClockProxy cl2 -> ClockProxy (ParallelClock cl1 cl2)
ParallelProxy (forall cl. ClockProxy cl -> ClockProxy (In cl)
inProxy ClockProxy clL
pL) (forall cl. ClockProxy cl -> ClockProxy (In cl)
inProxy ClockProxy clR
pR)

outProxy :: ClockProxy cl -> ClockProxy (Out cl)
outProxy :: forall cl. ClockProxy cl -> ClockProxy (Out cl)
outProxy ClockProxy cl
LeafProxy = forall cl. (cl ~ In cl, cl ~ Out cl) => ClockProxy cl
LeafProxy
outProxy (SequentialProxy ClockProxy cl1
_ ClockProxy cl2
p2) = forall cl. ClockProxy cl -> ClockProxy (Out cl)
outProxy ClockProxy cl2
p2
outProxy (ParallelProxy ClockProxy clL
pL ClockProxy clR
pR) = forall cl1 cl2.
ClockProxy cl1
-> ClockProxy cl2 -> ClockProxy (ParallelClock cl1 cl2)
ParallelProxy (forall cl. ClockProxy cl -> ClockProxy (Out cl)
outProxy ClockProxy clL
pL) (forall cl. ClockProxy cl -> ClockProxy (Out cl)
outProxy ClockProxy clR
pR)

{- | Return the incoming tag, assuming that the incoming clock is ticked,
   and 'Nothing' otherwise.
-}
inTag :: ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
inTag :: forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
inTag (SequentialProxy ClockProxy cl1
p1 ClockProxy cl2
_) (Left Tag cl1
tag1) = forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
inTag ClockProxy cl1
p1 Tag cl1
tag1
inTag (SequentialProxy ClockProxy cl1
_ ClockProxy cl2
_) (Right Tag cl2
_) = forall a. Maybe a
Nothing
inTag (ParallelProxy ClockProxy clL
pL ClockProxy clR
_) (Left Tag clL
tagL) = forall a b. a -> Either a b
Left forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
inTag ClockProxy clL
pL Tag clL
tagL
inTag (ParallelProxy ClockProxy clL
_ ClockProxy clR
pR) (Right Tag clR
tagR) = forall a b. b -> Either a b
Right forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (In cl))
inTag ClockProxy clR
pR Tag clR
tagR
inTag ClockProxy cl
LeafProxy Tag cl
tag = forall a. a -> Maybe a
Just Tag cl
tag

{- | Return the incoming tag, assuming that the outgoing clock is ticked,
   and 'Nothing' otherwise.
-}
outTag :: ClockProxy cl -> Tag cl -> Maybe (Tag (Out cl))
outTag :: forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (Out cl))
outTag (SequentialProxy ClockProxy cl1
_ ClockProxy cl2
_) (Left Tag cl1
_) = forall a. Maybe a
Nothing
outTag (SequentialProxy ClockProxy cl1
_ ClockProxy cl2
p2) (Right Tag cl2
tag2) = forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (Out cl))
outTag ClockProxy cl2
p2 Tag cl2
tag2
outTag (ParallelProxy ClockProxy clL
pL ClockProxy clR
_) (Left Tag clL
tagL) = forall a b. a -> Either a b
Left forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (Out cl))
outTag ClockProxy clL
pL Tag clL
tagL
outTag (ParallelProxy ClockProxy clL
_ ClockProxy clR
pR) (Right Tag clR
tagR) = forall a b. b -> Either a b
Right forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cl. ClockProxy cl -> Tag cl -> Maybe (Tag (Out cl))
outTag ClockProxy clR
pR Tag clR
tagR
outTag ClockProxy cl
LeafProxy Tag cl
tag = forall a. a -> Maybe a
Just Tag cl
tag

-- TODO Should this be a superclass with default implementation of clocks? But then we have a circular dependency...
-- No we don't, Schedule should not depend on clock (the type).

-- | Clocks should be able to automatically generate a proxy for themselves.
class GetClockProxy cl where
  getClockProxy :: ClockProxy cl
  default getClockProxy ::
    (cl ~ In cl, cl ~ Out cl) =>
    ClockProxy cl
  getClockProxy = forall cl. (cl ~ In cl, cl ~ Out cl) => ClockProxy cl
LeafProxy

instance (GetClockProxy cl1, GetClockProxy cl2) => GetClockProxy (SequentialClock cl1 cl2) where
  getClockProxy :: ClockProxy (SequentialClock cl1 cl2)
getClockProxy = forall cl1 cl2.
ClockProxy cl1
-> ClockProxy cl2 -> ClockProxy (SequentialClock cl1 cl2)
SequentialProxy forall cl. GetClockProxy cl => ClockProxy cl
getClockProxy forall cl. GetClockProxy cl => ClockProxy cl
getClockProxy

instance (GetClockProxy cl1, GetClockProxy cl2) => GetClockProxy (ParallelClock cl1 cl2) where
  getClockProxy :: ClockProxy (ParallelClock cl1 cl2)
getClockProxy = forall cl1 cl2.
ClockProxy cl1
-> ClockProxy cl2 -> ClockProxy (ParallelClock cl1 cl2)
ParallelProxy forall cl. GetClockProxy cl => ClockProxy cl
getClockProxy forall cl. GetClockProxy cl => ClockProxy cl
getClockProxy

instance GetClockProxy cl => GetClockProxy (HoistClock m1 m2 cl)
instance GetClockProxy cl => GetClockProxy (RescaledClock cl time)
instance GetClockProxy cl => GetClockProxy (RescaledClockM m cl time)
instance GetClockProxy cl => GetClockProxy (RescaledClockS m cl time tag)

-- | Extract a clock proxy from a type.
class ToClockProxy a where
  type Cl a :: Type

  toClockProxy :: a -> ClockProxy (Cl a)
  default toClockProxy ::
    GetClockProxy (Cl a) =>
    a ->
    ClockProxy (Cl a)
  toClockProxy a
_ = forall cl. GetClockProxy cl => ClockProxy cl
getClockProxy