{-# 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

-- dunai
import qualified Control.Monad.Trans.MSF.Reader as MSF

-- 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 =
  forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r2
r1 -> forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r1
r2 -> forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT (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

{- | 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 (m2 :: Type -> Type) (m1 :: Type -> Type) a b.
(Monad m2, Monad m1) =>
(forall c. m1 c -> m2 c) -> MSF m1 a b -> MSF m2 a b
morphS forall r1 r2 (m :: Type -> Type) a.
ReaderT r1 (ReaderT r2 m) a -> ReaderT r2 (ReaderT r1 m) a
commuteReaders forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) r a b.
Monad m =>
MSF m (r, a) b -> MSF (ReaderT r m) a b
MSF.readerS forall a b. (a -> b) -> a -> b
$ forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr forall a b. (a, b) -> (b, a)
swap 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

{- | 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 =
  forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr forall a b. (a, b) -> (b, a)
swap 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) r a b.
Monad m =>
MSF (ReaderT r m) a b -> MSF m (r, a) b
MSF.runReaderS (forall (m2 :: Type -> Type) (m1 :: Type -> Type) a b.
(Monad m2, Monad m1) =>
(forall c. m1 c -> m2 c) -> MSF m1 a b -> MSF m2 a b
morphS 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)

-- | 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 = forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (,r
r) 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) 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