module FRP.Rhine.Clock.Trivial where

-- base
import Control.Arrow

-- rhine
import FRP.Rhine.Clock
import FRP.Rhine.Clock.Proxy (GetClockProxy)

-- | A clock that always returns the tick '()'.
data Trivial = Trivial

instance (Monad m) => Clock m Trivial where
  type Time Trivial = ()
  type Tag Trivial = ()
  initClock :: Trivial -> RunningClockInit m (Time Trivial) (Tag Trivial)
initClock Trivial
_ = (Automaton m () ((), ()), ()) -> m (Automaton m () ((), ()), ())
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((() -> ((), ())) -> Automaton m () ((), ())
forall b c. (b -> c) -> Automaton m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr ((() -> ((), ())) -> Automaton m () ((), ()))
-> (() -> ((), ())) -> Automaton m () ((), ())
forall a b. (a -> b) -> a -> b
$ ((), ()) -> () -> ((), ())
forall a b. a -> b -> a
const ((), ()), ())

instance GetClockProxy Trivial