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

-- | 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 :: ClSF m cl (a, r) b -> ClSF (ReaderT r m) cl a b
readerS ClSF m cl (a, r) b
behaviour
  = (forall c.
 ReaderT r (ReaderT (TimeInfo cl) m) c
 -> ReaderT (TimeInfo cl) (ReaderT r m) c)
-> MSF (ReaderT r (ReaderT (TimeInfo cl) m)) a b
-> ClSF (ReaderT r m) cl 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 c.
ReaderT r (ReaderT (TimeInfo cl) m) c
-> ReaderT (TimeInfo cl) (ReaderT r m) c
forall r1 r2 (m :: Type -> Type) a.
ReaderT r1 (ReaderT r2 m) a -> ReaderT r2 (ReaderT r1 m) a
commuteReaders (MSF (ReaderT r (ReaderT (TimeInfo cl) m)) a b
 -> ClSF (ReaderT r m) cl a b)
-> MSF (ReaderT r (ReaderT (TimeInfo cl) m)) a b
-> ClSF (ReaderT r m) cl a b
forall a b. (a -> b) -> a -> b
$ MSF (ReaderT (TimeInfo cl) m) (r, a) b
-> MSF (ReaderT r (ReaderT (TimeInfo cl) m)) a b
forall (m :: Type -> Type) r a b.
Monad m =>
MSF m (r, a) b -> MSF (ReaderT r m) a b
MSF.readerS (MSF (ReaderT (TimeInfo cl) m) (r, a) b
 -> MSF (ReaderT r (ReaderT (TimeInfo cl) m)) a b)
-> MSF (ReaderT (TimeInfo cl) m) (r, a) b
-> MSF (ReaderT r (ReaderT (TimeInfo cl) m)) a b
forall a b. (a -> b) -> a -> b
$ ((r, a) -> (a, r)) -> MSF (ReaderT (TimeInfo cl) m) (r, a) (a, r)
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 MSF (ReaderT (TimeInfo cl) m) (r, a) (a, r)
-> ClSF m cl (a, r) b -> MSF (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

-- | 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 :: 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)) -> MSF (ReaderT (TimeInfo cl) m) (a, r) (r, a)
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 MSF (ReaderT (TimeInfo cl) m) (a, r) (r, a)
-> MSF (ReaderT (TimeInfo cl) m) (r, a) b -> ClSF m cl (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
>>> (MSF (ReaderT r (ReaderT (TimeInfo cl) m)) a b
-> MSF (ReaderT (TimeInfo cl) m) (r, a) b
forall (m :: Type -> Type) r a b.
Monad m =>
MSF (ReaderT r m) a b -> MSF m (r, a) b
MSF.runReaderS (MSF (ReaderT r (ReaderT (TimeInfo cl) m)) a b
 -> MSF (ReaderT (TimeInfo cl) m) (r, a) b)
-> MSF (ReaderT r (ReaderT (TimeInfo cl) m)) a b
-> MSF (ReaderT (TimeInfo cl) m) (r, a) b
forall a b. (a -> b) -> a -> b
$ (forall c.
 ReaderT (TimeInfo cl) (ReaderT r m) c
 -> ReaderT r (ReaderT (TimeInfo cl) m) c)
-> ClSF (ReaderT r m) cl a b
-> MSF (ReaderT r (ReaderT (TimeInfo cl) m)) 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 c.
ReaderT (TimeInfo cl) (ReaderT r m) c
-> ReaderT r (ReaderT (TimeInfo cl) m) c
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_ :: 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)) -> MSF (ReaderT (TimeInfo cl) m) a (a, r)
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (, r
r) MSF (ReaderT (TimeInfo cl) m) a (a, r)
-> MSF (ReaderT (TimeInfo cl) m) (a, r) b -> ClSF m cl 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 -> MSF (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