{- |
Create and remove 'ReaderT' layers in 'ClSF's.
-}

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
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 a b. (a -> b) -> a -> b
$ 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