module Control.Monad.Ology.Data.Param where

import Control.Monad.Ology.General
import Control.Monad.Ology.Specific.ReaderT
import Import

-- | borrowed from the lens package
type Lens' a b = forall f. Functor f => (b -> f b) -> a -> f a

-- | A parameter of a monad (as in 'ReaderT').
data Param m a = MkParam
    { forall (m :: Type -> Type) a. Param m a -> m a
paramAsk :: m a
    , forall (m :: Type -> Type) a. Param m a -> a -> m --> m
paramWith :: a -> m --> m
    }

instance Functor m => Invariant (Param m) where
    invmap :: forall a b. (a -> b) -> (b -> a) -> Param m a -> Param m b
invmap a -> b
f b -> a
g (MkParam m a
a a -> m --> m
w) = forall (m :: Type -> Type) a. m a -> (a -> m --> m) -> Param m a
MkParam (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f m a
a) (\b
b m a
mr -> a -> m --> m
w (b -> a
g b
b) m a
mr)

instance Applicative m => Productable (Param m) where
    rUnit :: Param m ()
rUnit = forall (m :: Type -> Type) a. m a -> (a -> m --> m) -> Param m a
MkParam (forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()) (\() -> forall {k} (cat :: k -> k -> Type) (a :: k).
Category cat =>
cat a a
id)
    Param m a
pa <***> :: forall a b. Param m a -> Param m b -> Param m (a, b)
<***> Param m b
pb = forall (m :: Type -> Type) a. m a -> (a -> m --> m) -> Param m a
MkParam (forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (forall (m :: Type -> Type) a. Param m a -> m a
paramAsk Param m a
pa) (forall (m :: Type -> Type) a. Param m a -> m a
paramAsk Param m b
pb)) (\(a
a, b
b) -> forall (m :: Type -> Type) a. Param m a -> a -> m --> m
paramWith Param m a
pa a
a forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: Type -> Type) a. Param m a -> a -> m --> m
paramWith Param m b
pb b
b)

paramLocalM ::
       forall m a. Monad m
    => Param m a
    -> (a -> m a)
    -> m --> m
paramLocalM :: forall (m :: Type -> Type) a.
Monad m =>
Param m a -> (a -> m a) -> m --> m
paramLocalM Param m a
param a -> m a
f m a
mr = do
    a
a <- forall (m :: Type -> Type) a. Param m a -> m a
paramAsk Param m a
param
    a
a' <- a -> m a
f a
a
    forall (m :: Type -> Type) a. Param m a -> a -> m --> m
paramWith Param m a
param a
a' m a
mr

paramLocal ::
       forall m a. Monad m
    => Param m a
    -> (a -> a)
    -> m --> m
paramLocal :: forall (m :: Type -> Type) a.
Monad m =>
Param m a -> (a -> a) -> m --> m
paramLocal Param m a
param a -> a
f m a
mr = forall (m :: Type -> Type) a.
Monad m =>
Param m a -> (a -> m a) -> m --> m
paramLocalM Param m a
param (forall (m :: Type -> Type) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
f) m a
mr

lensMapParam ::
       forall m a b. Monad m
    => Lens' a b
    -> Param m a
    -> Param m b
lensMapParam :: forall (m :: Type -> Type) a b.
Monad m =>
Lens' a b -> Param m a -> Param m b
lensMapParam Lens' a b
l Param m a
param = let
    paramAsk' :: m b
paramAsk' = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> forall {k} a (b :: k). Const a b -> a
getConst forall a b. (a -> b) -> a -> b
$ Lens' a b
l forall {k} a (b :: k). a -> Const a b
Const a
a) forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. Param m a -> m a
paramAsk Param m a
param
    paramWith' :: b -> m --> m
    paramWith' :: b -> m --> m
paramWith' b
b m a
mr = do
        a
a <- forall (m :: Type -> Type) a. Param m a -> m a
paramAsk Param m a
param
        forall (m :: Type -> Type) a. Param m a -> a -> m --> m
paramWith Param m a
param (forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ Lens' a b
l (\b
_ -> forall a. a -> Identity a
Identity b
b) a
a) m a
mr
    in forall (m :: Type -> Type) a. m a -> (a -> m --> m) -> Param m a
MkParam m b
paramAsk' b -> m --> m
paramWith'

liftParam :: (MonadTransTunnel t, Monad m) => Param m --> Param (t m)
liftParam :: forall (t :: TransKind) (m :: Type -> Type).
(MonadTransTunnel t, Monad m) =>
Param m --> Param (t m)
liftParam (MkParam m a
a a -> m --> m
l) = forall (m :: Type -> Type) a. m a -> (a -> m --> m) -> Param m a
MkParam (forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
a) forall a b. (a -> b) -> a -> b
$ \a
aa -> forall (t :: TransKind) (m1 :: Type -> Type) (m2 :: Type -> Type).
(MonadTransHoist t, Monad m1, Monad m2) =>
(m1 --> m2) -> t m1 --> t m2
hoist forall a b. (a -> b) -> a -> b
$ a -> m --> m
l a
aa

readerParam ::
       forall m r. Monad m
    => Param (ReaderT r m) r
readerParam :: forall (m :: Type -> Type) r. Monad m => Param (ReaderT r m) r
readerParam = forall (m :: Type -> Type) a. m a -> (a -> m --> m) -> Param m a
MkParam forall (m :: Type -> Type) r. Monad m => ReaderT r m r
ask forall a b. (a -> b) -> a -> b
$ \r
r -> forall r (m :: Type -> Type) a. r -> ReaderT r m a -> ReaderT r m a
with r
r