{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

{- |
Create and remove 'ReaderT' layers in 'ClSF's.
-}
module FRP.Rhine.ClSF.Reader where

-- base
import Data.Tuple (swap)

-- transformers
import Control.Monad.Trans.Reader

-- automaton
import Data.Automaton.Trans.Reader qualified as Automaton

-- rhine
import FRP.Rhine.ClSF.Core

-- | Commute two 'ReaderT' transformer layers past each other
commuteReaders :: ReaderT r1 (ReaderT r2 m) a -> ReaderT r2 (ReaderT r1 m) a
commuteReaders :: forall r1 r2 (m :: Type -> Type) a.
ReaderT r1 (ReaderT r2 m) a -> ReaderT r2 (ReaderT r1 m) a
commuteReaders ReaderT r1 (ReaderT r2 m) a
a =
  (r2 -> ReaderT r1 m a) -> ReaderT r2 (ReaderT r1 m) a
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((r2 -> ReaderT r1 m a) -> ReaderT r2 (ReaderT r1 m) a)
-> (r2 -> ReaderT r1 m a) -> ReaderT r2 (ReaderT r1 m) a
forall a b. (a -> b) -> a -> b
$ \r2
r1 -> (r1 -> m a) -> ReaderT r1 m a
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((r1 -> m a) -> ReaderT r1 m a) -> (r1 -> m a) -> ReaderT r1 m a
forall a b. (a -> b) -> a -> b
$ \r1
r2 -> ReaderT r2 m a -> r2 -> m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT r1 (ReaderT r2 m) a -> r1 -> ReaderT r2 m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r1 (ReaderT r2 m) a
a r1
r2) r2
r1
{-# INLINE commuteReaders #-}

{- | Create ("wrap") a 'ReaderT' layer in the monad stack of a behaviour.
   Each tick, the 'ReaderT' side effect is performed
   by passing the original behaviour the extra @r@ input.
-}
readerS ::
  (Monad m) =>
  ClSF m cl (a, r) b ->
  ClSF (ReaderT r m) cl a b
readerS :: forall (m :: Type -> Type) cl a r b.
Monad m =>
ClSF m cl (a, r) b -> ClSF (ReaderT r m) cl a b
readerS ClSF m cl (a, r) b
behaviour =
  (forall x.
 ReaderT r (ReaderT (TimeInfo cl) m) x
 -> ReaderT (TimeInfo cl) (ReaderT r m) x)
-> Automaton (ReaderT r (ReaderT (TimeInfo cl) m)) a b
-> Automaton (ReaderT (TimeInfo cl) (ReaderT r m)) 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 ReaderT r (ReaderT (TimeInfo cl) m) x
-> ReaderT (TimeInfo cl) (ReaderT r m) x
forall x.
ReaderT r (ReaderT (TimeInfo cl) m) x
-> ReaderT (TimeInfo cl) (ReaderT r m) x
forall r1 r2 (m :: Type -> Type) a.
ReaderT r1 (ReaderT r2 m) a -> ReaderT r2 (ReaderT r1 m) a
commuteReaders (Automaton (ReaderT r (ReaderT (TimeInfo cl) m)) a b
 -> Automaton (ReaderT (TimeInfo cl) (ReaderT r m)) a b)
-> Automaton (ReaderT r (ReaderT (TimeInfo cl) m)) a b
-> Automaton (ReaderT (TimeInfo cl) (ReaderT r m)) a b
forall a b. (a -> b) -> a -> b
$ Automaton (ReaderT (TimeInfo cl) m) (r, a) b
-> Automaton (ReaderT r (ReaderT (TimeInfo cl) m)) a b
forall (m :: Type -> Type) r a b.
Monad m =>
Automaton m (r, a) b -> Automaton (ReaderT r m) a b
Automaton.readerS (Automaton (ReaderT (TimeInfo cl) m) (r, a) b
 -> Automaton (ReaderT r (ReaderT (TimeInfo cl) m)) a b)
-> Automaton (ReaderT (TimeInfo cl) m) (r, a) b
-> Automaton (ReaderT r (ReaderT (TimeInfo cl) m)) a b
forall a b. (a -> b) -> a -> b
$ ((r, a) -> (a, r))
-> Automaton (ReaderT (TimeInfo cl) m) (r, a) (a, r)
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 (r, a) -> (a, r)
forall a b. (a, b) -> (b, a)
swap Automaton (ReaderT (TimeInfo cl) m) (r, a) (a, r)
-> ClSF m cl (a, r) b
-> Automaton (ReaderT (TimeInfo cl) m) (r, a) b
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ClSF m cl (a, r) b
behaviour
{-# INLINE readerS #-}

{- | Remove ("run") a 'ReaderT' layer from the monad stack
   by making it an explicit input to the behaviour.
-}
runReaderS ::
  (Monad m) =>
  ClSF (ReaderT r m) cl a b ->
  ClSF m cl (a, r) b
runReaderS :: forall (m :: Type -> Type) r cl a b.
Monad m =>
ClSF (ReaderT r m) cl a b -> ClSF m cl (a, r) b
runReaderS ClSF (ReaderT r m) cl a b
behaviour =
  ((a, r) -> (r, a))
-> Automaton (ReaderT (TimeInfo cl) m) (a, r) (r, a)
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 (a, r) -> (r, a)
forall a b. (a, b) -> (b, a)
swap Automaton (ReaderT (TimeInfo cl) m) (a, r) (r, a)
-> Automaton (ReaderT (TimeInfo cl) m) (r, a) b
-> Automaton (ReaderT (TimeInfo cl) m) (a, r) b
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Automaton (ReaderT r (ReaderT (TimeInfo cl) m)) a b
-> Automaton (ReaderT (TimeInfo cl) m) (r, a) b
forall (m :: Type -> Type) r a b.
Monad m =>
Automaton (ReaderT r m) a b -> Automaton m (r, a) b
Automaton.runReaderS ((forall x.
 ReaderT (TimeInfo cl) (ReaderT r m) x
 -> ReaderT r (ReaderT (TimeInfo cl) m) x)
-> ClSF (ReaderT r m) cl a b
-> Automaton (ReaderT r (ReaderT (TimeInfo cl) m)) 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 ReaderT (TimeInfo cl) (ReaderT r m) x
-> ReaderT r (ReaderT (TimeInfo cl) m) x
forall x.
ReaderT (TimeInfo cl) (ReaderT r m) x
-> ReaderT r (ReaderT (TimeInfo cl) m) x
forall r1 r2 (m :: Type -> Type) a.
ReaderT r1 (ReaderT r2 m) a -> ReaderT r2 (ReaderT r1 m) a
commuteReaders ClSF (ReaderT r m) cl a b
behaviour)
{-# INLINE runReaderS #-}

-- | Remove a 'ReaderT' layer by passing the readonly environment explicitly.
runReaderS_ ::
  (Monad m) =>
  ClSF (ReaderT r m) cl a b ->
  r ->
  ClSF m cl a b
runReaderS_ :: forall (m :: Type -> Type) r cl a b.
Monad m =>
ClSF (ReaderT r m) cl a b -> r -> ClSF m cl a b
runReaderS_ ClSF (ReaderT r m) cl a b
behaviour r
r = (a -> (a, r)) -> Automaton (ReaderT (TimeInfo cl) m) a (a, r)
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 (,r
r) Automaton (ReaderT (TimeInfo cl) m) a (a, r)
-> Automaton (ReaderT (TimeInfo cl) m) (a, r) b
-> Automaton (ReaderT (TimeInfo cl) m) a b
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ClSF (ReaderT r m) cl a b
-> Automaton (ReaderT (TimeInfo cl) m) (a, r) b
forall (m :: Type -> Type) r cl a b.
Monad m =>
ClSF (ReaderT r m) cl a b -> ClSF m cl (a, r) b
runReaderS ClSF (ReaderT r m) cl a b
behaviour
{-# INLINE runReaderS_ #-}