{-# LANGUAGE Arrows #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

{- |
The core functionality of clocked signal functions,
supplying the type of clocked signal functions itself ('ClSF'),
behaviours (clock-independent/polymorphic signal functions),
and basic constructions of 'ClSF's that may use awareness of time as an effect.
-}
module FRP.Rhine.ClSF.Core (
  module FRP.Rhine.ClSF.Core,
  module Control.Arrow,
  module X,
)
where

-- base
import Control.Arrow

-- transformers
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader (ReaderT, mapReaderT, withReaderT)

-- automaton
import Data.Automaton as X

-- rhine
import FRP.Rhine.Clock

-- * Clocked signal functions and behaviours

{- | A (synchronous, clocked) automaton
   with the additional side effect of being time-aware,
   that is, reading the current 'TimeInfo' of the clock @cl@.
-}
type ClSF m cl a b = Automaton (ReaderT (TimeInfo cl) m) a b

{- | A clocked signal is a 'ClSF' with no input required.
   It produces its output on its own.
-}
type ClSignal m cl a = forall arbitrary. ClSF m cl arbitrary a

{- | A (side-effectful) behaviour is a time-aware stream
   that doesn't depend on a particular clock.
   @time@ denotes the 'TimeDomain'.
-}
type Behaviour m time a = forall cl. (time ~ Time cl) => ClSignal m cl a

-- | Compatibility to U.S. american spelling.
type Behavior m time a = Behaviour m time a

{- | A (side-effectful) behaviour function is a time-aware synchronous stream
   function that doesn't depend on a particular clock.
   @time@ denotes the 'TimeDomain'.
-}
type BehaviourF m time a b = forall cl. (time ~ Time cl) => ClSF m cl a b

-- | Compatibility to U.S. american spelling.
type BehaviorF m time a b = BehaviourF m time a b

-- * Utilities to create 'ClSF's from simpler data

-- | Hoist a 'ClSF' along a monad morphism.
hoistClSF ::
  (Monad m1, Monad m2) =>
  (forall c. m1 c -> m2 c) ->
  ClSF m1 cl a b ->
  ClSF m2 cl a b
hoistClSF :: forall (m1 :: Type -> Type) (m2 :: Type -> Type) cl a b.
(Monad m1, Monad m2) =>
(forall c. m1 c -> m2 c) -> ClSF m1 cl a b -> ClSF m2 cl a b
hoistClSF forall c. m1 c -> m2 c
hoist = (forall x.
 ReaderT (TimeInfo cl) m1 x -> ReaderT (TimeInfo cl) m2 x)
-> Automaton (ReaderT (TimeInfo cl) m1) a b
-> Automaton (ReaderT (TimeInfo cl) m2) a b
forall (m :: Type -> Type) (n :: Type -> Type) a b.
Monad m =>
(forall x. m x -> n x) -> Automaton m a b -> Automaton n a b
hoistS ((forall x.
  ReaderT (TimeInfo cl) m1 x -> ReaderT (TimeInfo cl) m2 x)
 -> Automaton (ReaderT (TimeInfo cl) m1) a b
 -> Automaton (ReaderT (TimeInfo cl) m2) a b)
-> (forall x.
    ReaderT (TimeInfo cl) m1 x -> ReaderT (TimeInfo cl) m2 x)
-> Automaton (ReaderT (TimeInfo cl) m1) a b
-> Automaton (ReaderT (TimeInfo cl) m2) a b
forall a b. (a -> b) -> a -> b
$ (m1 x -> m2 x)
-> ReaderT (TimeInfo cl) m1 x -> ReaderT (TimeInfo cl) m2 x
forall (m :: Type -> Type) a (n :: Type -> Type) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m1 x -> m2 x
forall c. m1 c -> m2 c
hoist

-- | Hoist a 'ClSF' and its clock along a monad morphism.
hoistClSFAndClock ::
  (Monad m1, Monad m2) =>
  (forall c. m1 c -> m2 c) ->
  ClSF m1 cl a b ->
  ClSF m2 (HoistClock m1 m2 cl) a b
hoistClSFAndClock :: forall (m1 :: Type -> Type) (m2 :: Type -> Type) cl a b.
(Monad m1, Monad m2) =>
(forall c. m1 c -> m2 c)
-> ClSF m1 cl a b -> ClSF m2 (HoistClock m1 m2 cl) a b
hoistClSFAndClock forall c. m1 c -> m2 c
hoist =
  (forall x.
 ReaderT (TimeInfo cl) m1 x
 -> ReaderT (TimeInfo (HoistClock m1 m2 cl)) m2 x)
-> Automaton (ReaderT (TimeInfo cl) m1) a b
-> Automaton (ReaderT (TimeInfo (HoistClock m1 m2 cl)) m2) a b
forall (m :: Type -> Type) (n :: Type -> Type) a b.
Monad m =>
(forall x. m x -> n x) -> Automaton m a b -> Automaton n a b
hoistS ((forall x.
  ReaderT (TimeInfo cl) m1 x
  -> ReaderT (TimeInfo (HoistClock m1 m2 cl)) m2 x)
 -> Automaton (ReaderT (TimeInfo cl) m1) a b
 -> Automaton (ReaderT (TimeInfo (HoistClock m1 m2 cl)) m2) a b)
-> (forall x.
    ReaderT (TimeInfo cl) m1 x
    -> ReaderT (TimeInfo (HoistClock m1 m2 cl)) m2 x)
-> Automaton (ReaderT (TimeInfo cl) m1) a b
-> Automaton (ReaderT (TimeInfo (HoistClock m1 m2 cl)) m2) a b
forall a b. (a -> b) -> a -> b
$ (TimeInfo (HoistClock m1 m2 cl) -> TimeInfo cl)
-> ReaderT (TimeInfo cl) m2 x
-> ReaderT (TimeInfo (HoistClock m1 m2 cl)) m2 x
forall r' r (m :: Type -> Type) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT ((Tag (HoistClock m1 m2 cl) -> Tag cl)
-> TimeInfo (HoistClock m1 m2 cl) -> TimeInfo cl
forall cl1 cl2.
(Time cl1 ~ Time cl2) =>
(Tag cl1 -> Tag cl2) -> TimeInfo cl1 -> TimeInfo cl2
retag Tag cl -> Tag cl
Tag (HoistClock m1 m2 cl) -> Tag cl
forall a. a -> a
id) (ReaderT (TimeInfo cl) m2 x
 -> ReaderT (TimeInfo (HoistClock m1 m2 cl)) m2 x)
-> (ReaderT (TimeInfo cl) m1 x -> ReaderT (TimeInfo cl) m2 x)
-> ReaderT (TimeInfo cl) m1 x
-> ReaderT (TimeInfo (HoistClock m1 m2 cl)) m2 x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m1 x -> m2 x)
-> ReaderT (TimeInfo cl) m1 x -> ReaderT (TimeInfo cl) m2 x
forall (m :: Type -> Type) a (n :: Type -> Type) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m1 x -> m2 x
forall c. m1 c -> m2 c
hoist

-- | Lift a 'ClSF' into a monad transformer.
liftClSF ::
  (Monad m, MonadTrans t, Monad (t m)) =>
  ClSF m cl a b ->
  ClSF (t m) cl a b
liftClSF :: forall (m :: Type -> Type) (t :: (Type -> Type) -> Type -> Type) cl
       a b.
(Monad m, MonadTrans t, Monad (t m)) =>
ClSF m cl a b -> ClSF (t m) cl a b
liftClSF = (forall c. m c -> t m c) -> ClSF m cl a b -> ClSF (t m) cl a b
forall (m1 :: Type -> Type) (m2 :: Type -> Type) cl a b.
(Monad m1, Monad m2) =>
(forall c. m1 c -> m2 c) -> ClSF m1 cl a b -> ClSF m2 cl a b
hoistClSF m c -> t m c
forall c. m c -> t m c
forall (m :: Type -> Type) a. Monad m => m a -> t m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Lift a 'ClSF' and its clock into a monad transformer.
liftClSFAndClock ::
  (Monad m, MonadTrans t, Monad (t m)) =>
  ClSF m cl a b ->
  ClSF (t m) (LiftClock m t cl) a b
liftClSFAndClock :: forall (m :: Type -> Type) (t :: (Type -> Type) -> Type -> Type) cl
       a b.
(Monad m, MonadTrans t, Monad (t m)) =>
ClSF m cl a b -> ClSF (t m) (LiftClock m t cl) a b
liftClSFAndClock = (forall c. m c -> t m c)
-> ClSF m cl a b -> ClSF (t m) (HoistClock m (t m) cl) a b
forall (m1 :: Type -> Type) (m2 :: Type -> Type) cl a b.
(Monad m1, Monad m2) =>
(forall c. m1 c -> m2 c)
-> ClSF m1 cl a b -> ClSF m2 (HoistClock m1 m2 cl) a b
hoistClSFAndClock m c -> t m c
forall c. m c -> t m c
forall (m :: Type -> Type) a. Monad m => m a -> t m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

{- | An automaton without dependency on time
   is a 'ClSF' for any clock.
-}
timeless :: (Monad m) => Automaton m a b -> ClSF m cl a b
timeless :: forall (m :: Type -> Type) a b cl.
Monad m =>
Automaton m a b -> ClSF m cl a b
timeless = Automaton m a b -> Automaton (ReaderT (TimeInfo cl) m) a b
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a
       b.
(MonadTrans t, Monad m, Functor (t m)) =>
Automaton m a b -> Automaton (t m) a b
liftS

-- | Utility to lift Kleisli arrows directly to 'ClSF's.
arrMCl :: (Monad m) => (a -> m b) -> ClSF m cl a b
arrMCl :: forall (m :: Type -> Type) a b cl.
Monad m =>
(a -> m b) -> ClSF m cl a b
arrMCl = Automaton m a b -> ClSF m cl a b
forall (m :: Type -> Type) a b cl.
Monad m =>
Automaton m a b -> ClSF m cl a b
timeless (Automaton m a b -> ClSF m cl a b)
-> ((a -> m b) -> Automaton m a b) -> (a -> m b) -> ClSF m cl a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m b) -> Automaton m a b
forall (m :: Type -> Type) a b.
Functor m =>
(a -> m b) -> Automaton m a b
arrM

-- | Version without input.
constMCl :: (Monad m) => m b -> ClSF m cl a b
constMCl :: forall (m :: Type -> Type) b cl a. Monad m => m b -> ClSF m cl a b
constMCl = Automaton m a b -> ClSF m cl a b
forall (m :: Type -> Type) a b cl.
Monad m =>
Automaton m a b -> ClSF m cl a b
timeless (Automaton m a b -> ClSF m cl a b)
-> (m b -> Automaton m a b) -> m b -> ClSF m cl a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> Automaton m a b
forall (m :: Type -> Type) b a. Functor m => m b -> Automaton m a b
constM

{- | Call a 'ClSF' every time the input is 'Just a'.

Caution: This will not change the time differences since the last tick.
For example,
while @integrate 1@ is approximately the same as @timeInfoOf sinceInit@,
@mapMaybe $ integrate 1@ is very different from
@mapMaybe $ timeInfoOf sinceInit@.
The former only integrates when the input is @Just 1@,
whereas the latter always returns the correct time since initialisation.
-}
mapMaybe ::
  (Monad m) =>
  ClSF m cl a b ->
  ClSF m cl (Maybe a) (Maybe b)
mapMaybe :: forall (m :: Type -> Type) cl a b.
Monad m =>
ClSF m cl a b -> ClSF m cl (Maybe a) (Maybe b)
mapMaybe ClSF m cl a b
behaviour = proc Maybe a
ma -> case Maybe a
ma of
  Maybe a
Nothing -> Automaton (ReaderT (TimeInfo cl) m) (Maybe b) (Maybe b)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< Maybe b
forall a. Maybe a
Nothing
  Just a
a -> (b -> Maybe b) -> Automaton (ReaderT (TimeInfo cl) m) b (Maybe b)
forall b c. (b -> c) -> Automaton (ReaderT (TimeInfo cl) m) b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr b -> Maybe b
forall a. a -> Maybe a
Just Automaton (ReaderT (TimeInfo cl) m) b (Maybe b)
-> ClSF m cl a b -> Automaton (ReaderT (TimeInfo cl) m) a (Maybe b)
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< ClSF m cl a b
behaviour -< a
a

-- TODO Consider integrating up the time deltas