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) = m b -> (b -> m --> m) -> Param m b
forall (m :: Type -> Type) a. m a -> (a -> m --> m) -> Param m a
MkParam ((a -> b) -> m a -> m b
forall a b. (a -> b) -> m a -> m b
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 = m () -> (() -> m --> m) -> Param m ()
forall (m :: Type -> Type) a. m a -> (a -> m --> m) -> Param m a
MkParam (() -> m ()
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()) (\() -> m a -> m a
forall a. a -> a
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 = m (a, b) -> ((a, b) -> m --> m) -> Param m (a, b)
forall (m :: Type -> Type) a. m a -> (a -> m --> m) -> Param m a
MkParam ((a -> b -> (a, b)) -> m a -> m b -> m (a, b)
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Param m a -> m a
forall (m :: Type -> Type) a. Param m a -> m a
paramAsk Param m a
pa) (Param m b -> m b
forall (m :: Type -> Type) a. Param m a -> m a
paramAsk Param m b
pb)) (\(a
a, b
b) -> Param m a -> a -> m --> m
forall (m :: Type -> Type) a. Param m a -> a -> m --> m
paramWith Param m a
pa a
a (m a -> m a) -> (m a -> m a) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Param m b -> b -> m --> m
forall (m :: Type -> Type) a. Param m a -> a -> m --> m
paramWith Param m b
pb b
b)

paramAsks ::
       forall m a b. Monad m
    => Param m a
    -> (a -> b)
    -> m b
paramAsks :: forall (m :: Type -> Type) a b.
Monad m =>
Param m a -> (a -> b) -> m b
paramAsks Param m a
param a -> b
ab = (a -> b) -> m a -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
ab (m a -> m b) -> m a -> m b
forall a b. (a -> b) -> a -> b
$ Param m a -> m a
forall (m :: Type -> Type) a. Param m a -> m a
paramAsk Param m a
param

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 <- Param m a -> m a
forall (m :: Type -> Type) a. Param m a -> m a
paramAsk Param m a
param
    a
a' <- a -> m a
f a
a
    Param m a -> a -> m --> m
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 = Param m a -> (a -> m a) -> m --> m
forall (m :: Type -> Type) a.
Monad m =>
Param m a -> (a -> m a) -> m --> m
paramLocalM Param m a
param (a -> m a
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a -> m a) -> (a -> a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
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' = (a -> b) -> m a -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> Const b a -> b
forall {k} a (b :: k). Const a b -> a
getConst (Const b a -> b) -> Const b a -> b
forall a b. (a -> b) -> a -> b
$ (b -> Const b b) -> a -> Const b a
Lens' a b
l b -> Const b b
forall {k} a (b :: k). a -> Const a b
Const a
a) (m a -> m b) -> m a -> m b
forall a b. (a -> b) -> a -> b
$ Param m a -> m a
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 <- Param m a -> m a
forall (m :: Type -> Type) a. Param m a -> m a
paramAsk Param m a
param
        Param m a -> a -> m --> m
forall (m :: Type -> Type) a. Param m a -> a -> m --> m
paramWith Param m a
param (Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ (b -> Identity b) -> a -> Identity a
Lens' a b
l (\b
_ -> b -> Identity b
forall a. a -> Identity a
Identity b
b) a
a) m a
mr
    in m b -> (b -> m --> m) -> Param m b
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) = t m a -> (a -> t m --> t m) -> Param (t m) a
forall (m :: Type -> Type) a. m a -> (a -> m --> m) -> Param m a
MkParam (m a -> t m a
forall (m :: Type -> Type) a. Monad m => m a -> t m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
a) ((a -> t m --> t m) -> Param (t m) a)
-> (a -> t m --> t m) -> Param (t m) a
forall a b. (a -> b) -> a -> b
$ \a
aa -> (m --> m) -> t m --> t m
forall (m1 :: Type -> Type) (m2 :: Type -> Type).
(Monad m1, Monad m2) =>
(m1 --> m2) -> t m1 --> t m2
forall (t :: TransKind) (m1 :: Type -> Type) (m2 :: Type -> Type).
(MonadTransHoist t, Monad m1, Monad m2) =>
(m1 --> m2) -> t m1 --> t m2
hoist ((m --> m) -> t m --> t m) -> (m --> m) -> t m --> t m
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 = ReaderT r m r
-> (r -> ReaderT r m --> ReaderT r m) -> Param (ReaderT r m) r
forall (m :: Type -> Type) a. m a -> (a -> m --> m) -> Param m a
MkParam ReaderT r m r
forall (m :: Type -> Type) r. Monad m => ReaderT r m r
ask ((r -> ReaderT r m --> ReaderT r m) -> Param (ReaderT r m) r)
-> (r -> ReaderT r m --> ReaderT r m) -> Param (ReaderT r m) r
forall a b. (a -> b) -> a -> b
$ \r
r -> r -> ReaderT r m a -> ReaderT r m a
forall r (m :: Type -> Type) a. r -> ReaderT r m a -> ReaderT r m a
with r
r