{- |
Module      :  Control.Monad.Trans.Indexed.Free.Wrap
Copyright   :  (C) 2024 Eitan Chatav
License     :  BSD 3-Clause License (see the file LICENSE)
Maintainer  :  Eitan Chatav <eitan.chatav@gmail.com>

An instance of the free indexed monad transformer.
-}

module Control.Monad.Trans.Indexed.Free.Wrap
  ( FreeIx (..)
  , WrapIx (..)
  ) where

import Control.Monad.Free
import Control.Monad.Trans
import Control.Monad.Trans.Indexed
import Control.Monad.Trans.Indexed.Free

data WrapIx f i j m x where
  Unwrap :: x -> WrapIx f i i m x
  Wrap :: f i j (FreeIx f j k m x) -> WrapIx f i k m x
instance (IxFunctor f, Monad m)
  => Functor (WrapIx f i j m) where
    fmap :: forall a b. (a -> b) -> WrapIx f i j m a -> WrapIx f i j m b
fmap a -> b
f = \case
      Unwrap a
x -> b -> WrapIx f i i m b
forall {k} x (f :: k -> k -> * -> *) (i :: k) (m :: * -> *).
x -> WrapIx f i i m x
Unwrap (b -> WrapIx f i i m b) -> b -> WrapIx f i i m b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
      Wrap f i j (FreeIx f j j m a)
fm -> f i j (FreeIx f j j m b) -> WrapIx f i j m b
forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) (k :: k)
       (m :: * -> *) x.
f i j (FreeIx f j k m x) -> WrapIx f i k m x
Wrap (f i j (FreeIx f j j m b) -> WrapIx f i j m b)
-> f i j (FreeIx f j j m b) -> WrapIx f i j m b
forall a b. (a -> b) -> a -> b
$ (FreeIx f j j m a -> FreeIx f j j m b)
-> f i j (FreeIx f j j m a) -> f i j (FreeIx f j j m b)
forall a b. (a -> b) -> f i j a -> f i j b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> FreeIx f j j m a -> FreeIx f j j m b
forall a b. (a -> b) -> FreeIx f j j m a -> FreeIx f j j m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) f i j (FreeIx f j j m a)
fm

newtype FreeIx f i j m x = FreeIx {forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) (m :: * -> *)
       x.
FreeIx f i j m x -> m (WrapIx f i j m x)
runFreeIx :: m (WrapIx f i j m x)}
instance (IxFunctor f, Monad m)
  => Functor (FreeIx f i j m) where
    fmap :: forall a b. (a -> b) -> FreeIx f i j m a -> FreeIx f i j m b
fmap a -> b
f (FreeIx m (WrapIx f i j m a)
m) = m (WrapIx f i j m b) -> FreeIx f i j m b
forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) (m :: * -> *)
       x.
m (WrapIx f i j m x) -> FreeIx f i j m x
FreeIx (m (WrapIx f i j m b) -> FreeIx f i j m b)
-> m (WrapIx f i j m b) -> FreeIx f i j m b
forall a b. (a -> b) -> a -> b
$ (WrapIx f i j m a -> WrapIx f i j m b)
-> m (WrapIx f i j m a) -> m (WrapIx f i j m b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> WrapIx f i j m a -> WrapIx f i j m b
forall a b. (a -> b) -> WrapIx f i j m a -> WrapIx f i j m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) m (WrapIx f i j m a)
m
instance (IxFunctor f, i ~ j, Monad m)
  => Applicative (FreeIx f i j m) where
    pure :: forall a. a -> FreeIx f i j m a
pure = m (WrapIx f i j m a) -> FreeIx f i j m a
forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) (m :: * -> *)
       x.
m (WrapIx f i j m x) -> FreeIx f i j m x
FreeIx (m (WrapIx f i j m a) -> FreeIx f i j m a)
-> (a -> m (WrapIx f i j m a)) -> a -> FreeIx f i j m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapIx f i j m a -> m (WrapIx f i j m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WrapIx f i j m a -> m (WrapIx f i j m a))
-> (a -> WrapIx f i j m a) -> a -> m (WrapIx f i j m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> WrapIx f i i m a
a -> WrapIx f i j m a
forall {k} x (f :: k -> k -> * -> *) (i :: k) (m :: * -> *).
x -> WrapIx f i i m x
Unwrap
    <*> :: forall a b.
FreeIx f i j m (a -> b) -> FreeIx f i j m a -> FreeIx f i j m b
(<*>) = FreeIx f i j m (a -> b) -> FreeIx f i j m a -> FreeIx f i j m b
FreeIx f i j m (a -> b) -> FreeIx f j j m a -> FreeIx f i j m b
forall k (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *) (i :: k)
       (j :: k) x y (k1 :: k).
(IxMonadTrans t, Monad m) =>
t i j m (x -> y) -> t j k1 m x -> t i k1 m y
forall (m :: * -> *) (i :: k) (j :: k) x y (k1 :: k).
Monad m =>
FreeIx f i j m (x -> y) -> FreeIx f j k1 m x -> FreeIx f i k1 m y
apIx
instance (IxFunctor f, i ~ j, Monad m)
  => Monad (FreeIx f i j m) where
    return :: forall a. a -> FreeIx f i j m a
return = a -> FreeIx f i j m a
forall a. a -> FreeIx f i j m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    >>= :: forall a b.
FreeIx f i j m a -> (a -> FreeIx f i j m b) -> FreeIx f i j m b
(>>=) = ((a -> FreeIx f i j m b) -> FreeIx f i j m a -> FreeIx f i j m b)
-> FreeIx f i j m a -> (a -> FreeIx f i j m b) -> FreeIx f i j m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> FreeIx f i j m b) -> FreeIx f i i m a -> FreeIx f i j m b
(a -> FreeIx f i j m b) -> FreeIx f i j m a -> FreeIx f i j m b
forall k (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *) x
       (j :: k) (k1 :: k) y (i :: k).
(IxMonadTrans t, Monad m) =>
(x -> t j k1 m y) -> t i j m x -> t i k1 m y
forall (m :: * -> *) x (j :: k) (k1 :: k) y (i :: k).
Monad m =>
(x -> FreeIx f j k1 m y) -> FreeIx f i j m x -> FreeIx f i k1 m y
bindIx
instance (IxFunctor f, i ~ j)
  => MonadTrans (FreeIx f i j) where
    lift :: forall (m :: * -> *) a. Monad m => m a -> FreeIx f i j m a
lift = m (WrapIx f i j m a) -> FreeIx f i j m a
forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) (m :: * -> *)
       x.
m (WrapIx f i j m x) -> FreeIx f i j m x
FreeIx (m (WrapIx f i j m a) -> FreeIx f i j m a)
-> (m a -> m (WrapIx f i j m a)) -> m a -> FreeIx f i j m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> WrapIx f i j m a) -> m a -> m (WrapIx f i j m a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> WrapIx f i i m a
a -> WrapIx f i j m a
forall {k} x (f :: k -> k -> * -> *) (i :: k) (m :: * -> *).
x -> WrapIx f i i m x
Unwrap
instance IxFunctor f
  => IxMonadTrans (FreeIx f) where
    joinIx :: forall (m :: * -> *) (i :: k) (j :: k) (k1 :: k) y.
Monad m =>
FreeIx f i j m (FreeIx f j k1 m y) -> FreeIx f i k1 m y
joinIx (FreeIx m (WrapIx f i j m (FreeIx f j k1 m y))
mm) = m (WrapIx f i k1 m y) -> FreeIx f i k1 m y
forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) (m :: * -> *)
       x.
m (WrapIx f i j m x) -> FreeIx f i j m x
FreeIx (m (WrapIx f i k1 m y) -> FreeIx f i k1 m y)
-> m (WrapIx f i k1 m y) -> FreeIx f i k1 m y
forall a b. (a -> b) -> a -> b
$ m (WrapIx f i j m (FreeIx f j k1 m y))
mm m (WrapIx f i j m (FreeIx f j k1 m y))
-> (WrapIx f i j m (FreeIx f j k1 m y) -> m (WrapIx f i k1 m y))
-> m (WrapIx f i k1 m y)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Unwrap (FreeIx m (WrapIx f j k1 m y)
m) -> m (WrapIx f i k1 m y)
m (WrapIx f j k1 m y)
m
      Wrap f i j (FreeIx f j j m (FreeIx f j k1 m y))
fm -> WrapIx f i k1 m y -> m (WrapIx f i k1 m y)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapIx f i k1 m y -> m (WrapIx f i k1 m y))
-> WrapIx f i k1 m y -> m (WrapIx f i k1 m y)
forall a b. (a -> b) -> a -> b
$ f i j (FreeIx f j k1 m y) -> WrapIx f i k1 m y
forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) (k :: k)
       (m :: * -> *) x.
f i j (FreeIx f j k m x) -> WrapIx f i k m x
Wrap (f i j (FreeIx f j k1 m y) -> WrapIx f i k1 m y)
-> f i j (FreeIx f j k1 m y) -> WrapIx f i k1 m y
forall a b. (a -> b) -> a -> b
$ (FreeIx f j j m (FreeIx f j k1 m y) -> FreeIx f j k1 m y)
-> f i j (FreeIx f j j m (FreeIx f j k1 m y))
-> f i j (FreeIx f j k1 m y)
forall a b. (a -> b) -> f i j a -> f i j b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FreeIx f j j m (FreeIx f j k1 m y) -> FreeIx f j k1 m y
forall k (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *) (i :: k)
       (j :: k) (k1 :: k) y.
(IxMonadTrans t, Monad m) =>
t i j m (t j k1 m y) -> t i k1 m y
forall (m :: * -> *) (i :: k) (j :: k) (k1 :: k) y.
Monad m =>
FreeIx f i j m (FreeIx f j k1 m y) -> FreeIx f i k1 m y
joinIx f i j (FreeIx f j j m (FreeIx f j k1 m y))
fm
instance
  ( IxFunctor f
  , Monad m
  , i ~ j
  ) => MonadFree (f i j) (FreeIx f i j m) where
    wrap :: forall a. f i j (FreeIx f i j m a) -> FreeIx f i j m a
wrap = m (WrapIx f i j m a) -> FreeIx f i j m a
forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) (m :: * -> *)
       x.
m (WrapIx f i j m x) -> FreeIx f i j m x
FreeIx (m (WrapIx f i j m a) -> FreeIx f i j m a)
-> (f i j (FreeIx f i j m a) -> m (WrapIx f i j m a))
-> f i j (FreeIx f i j m a)
-> FreeIx f i j m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapIx f i j m a -> m (WrapIx f i j m a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapIx f i j m a -> m (WrapIx f i j m a))
-> (f i j (FreeIx f i j m a) -> WrapIx f i j m a)
-> f i j (FreeIx f i j m a)
-> m (WrapIx f i j m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f i j (FreeIx f i j m a) -> WrapIx f i j m a
f i j (FreeIx f j j m a) -> WrapIx f i j m a
forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) (k :: k)
       (m :: * -> *) x.
f i j (FreeIx f j k m x) -> WrapIx f i k m x
Wrap
instance IxMonadTransFree FreeIx where
  liftFreeIx :: forall (f :: k -> k -> * -> *) (m :: * -> *) (i :: k) (j :: k) x.
(IxFunctor f, Monad m) =>
f i j x -> FreeIx f i j m x
liftFreeIx = m (WrapIx f i j m x) -> FreeIx f i j m x
forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) (m :: * -> *)
       x.
m (WrapIx f i j m x) -> FreeIx f i j m x
FreeIx (m (WrapIx f i j m x) -> FreeIx f i j m x)
-> (f i j x -> m (WrapIx f i j m x)) -> f i j x -> FreeIx f i j m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapIx f i j m x -> m (WrapIx f i j m x)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapIx f i j m x -> m (WrapIx f i j m x))
-> (f i j x -> WrapIx f i j m x) -> f i j x -> m (WrapIx f i j m x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f i j (FreeIx f j j m x) -> WrapIx f i j m x
forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) (k :: k)
       (m :: * -> *) x.
f i j (FreeIx f j k m x) -> WrapIx f i k m x
Wrap (f i j (FreeIx f j j m x) -> WrapIx f i j m x)
-> (f i j x -> f i j (FreeIx f j j m x))
-> f i j x
-> WrapIx f i j m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> FreeIx f j j m x) -> f i j x -> f i j (FreeIx f j j m x)
forall a b. (a -> b) -> f i j a -> f i j b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> FreeIx f j j m x
forall a. a -> FreeIx f j j m a
forall (m :: * -> *) a. Monad m => a -> m a
return
  hoistFreeIx :: forall (f :: k -> k -> * -> *) (g :: k -> k -> * -> *)
       (m :: * -> *) (i :: k) (j :: k) x.
(IxFunctor f, IxFunctor g, Monad m) =>
(forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> g i1 j1 x1)
-> FreeIx f i j m x -> FreeIx g i j m x
hoistFreeIx forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> g i1 j1 x1
f (FreeIx m (WrapIx f i j m x)
m) = m (WrapIx g i j m x) -> FreeIx g i j m x
forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) (m :: * -> *)
       x.
m (WrapIx f i j m x) -> FreeIx f i j m x
FreeIx ((WrapIx f i j m x -> WrapIx g i j m x)
-> m (WrapIx f i j m x) -> m (WrapIx g i j m x)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WrapIx f i j m x -> WrapIx g i j m x
hoist_f m (WrapIx f i j m x)
m)
    where
      hoist_f :: WrapIx f i j m x -> WrapIx g i j m x
hoist_f = \case
        Unwrap x
x -> x -> WrapIx g i i m x
forall {k} x (f :: k -> k -> * -> *) (i :: k) (m :: * -> *).
x -> WrapIx f i i m x
Unwrap x
x
        Wrap f i j (FreeIx f j j m x)
y -> g i j (FreeIx g j j m x) -> WrapIx g i j m x
forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) (k :: k)
       (m :: * -> *) x.
f i j (FreeIx f j k m x) -> WrapIx f i k m x
Wrap (f i j (FreeIx g j j m x) -> g i j (FreeIx g j j m x)
forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> g i1 j1 x1
f ((FreeIx f j j m x -> FreeIx g j j m x)
-> f i j (FreeIx f j j m x) -> f i j (FreeIx g j j m x)
forall a b. (a -> b) -> f i j a -> f i j b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> g i1 j1 x1)
-> FreeIx f j j m x -> FreeIx g j j m x
forall {k}
       (freeIx :: (k -> k -> * -> *) -> k -> k -> (* -> *) -> * -> *)
       (f :: k -> k -> * -> *) (g :: k -> k -> * -> *) (m :: * -> *)
       (i :: k) (j :: k) x.
(IxMonadTransFree freeIx, IxFunctor f, IxFunctor g, Monad m) =>
(forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> g i1 j1 x1)
-> freeIx f i j m x -> freeIx g i j m x
forall (f :: k -> k -> * -> *) (g :: k -> k -> * -> *)
       (m :: * -> *) (i :: k) (j :: k) x.
(IxFunctor f, IxFunctor g, Monad m) =>
(forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> g i1 j1 x1)
-> FreeIx f i j m x -> FreeIx g i j m x
hoistFreeIx f i1 j1 x1 -> g i1 j1 x1
forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> g i1 j1 x1
f) f i j (FreeIx f j j m x)
y))
  foldFreeIx :: forall (f :: k -> k -> * -> *) (t :: k -> k -> (* -> *) -> * -> *)
       (m :: * -> *) (i :: k) (j :: k) x.
(IxFunctor f, IxMonadTrans t, Monad m) =>
(forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> t i1 j1 m x1)
-> FreeIx f i j m x -> t i j m x
foldFreeIx forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> t i1 j1 m x1
f (FreeIx m (WrapIx f i j m x)
m) = (WrapIx f i j m x -> t i j m x)
-> t i i m (WrapIx f i j m x) -> t i j m x
forall k (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *) x
       (j :: k) (k1 :: k) y (i :: k).
(IxMonadTrans t, Monad m) =>
(x -> t j k1 m y) -> t i j m x -> t i k1 m y
forall (m :: * -> *) x (j :: k) (k1 :: k) y (i :: k).
Monad m =>
(x -> t j k1 m y) -> t i j m x -> t i k1 m y
bindIx WrapIx f i j m x -> t i j m x
foldMap_f (m (WrapIx f i j m x) -> t i i m (WrapIx f i j m x)
forall (m :: * -> *) a. Monad m => m a -> t i i m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (WrapIx f i j m x)
m)
    where
      foldMap_f :: WrapIx f i j m x -> t i j m x
foldMap_f = \case
        Unwrap x
x -> x -> t i i m x
forall a. a -> t i i m a
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
        Wrap f i j (FreeIx f j j m x)
y -> (FreeIx f j j m x -> t j j m x)
-> t i j m (FreeIx f j j m x) -> t i j m x
forall k (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *) x
       (j :: k) (k1 :: k) y (i :: k).
(IxMonadTrans t, Monad m) =>
(x -> t j k1 m y) -> t i j m x -> t i k1 m y
forall (m :: * -> *) x (j :: k) (k1 :: k) y (i :: k).
Monad m =>
(x -> t j k1 m y) -> t i j m x -> t i k1 m y
bindIx ((forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> t i1 j1 m x1)
-> FreeIx f j j m x -> t j j m x
forall {k}
       (freeIx :: (k -> k -> * -> *) -> k -> k -> (* -> *) -> * -> *)
       (f :: k -> k -> * -> *) (t :: k -> k -> (* -> *) -> * -> *)
       (m :: * -> *) (i :: k) (j :: k) x.
(IxMonadTransFree freeIx, IxFunctor f, IxMonadTrans t, Monad m) =>
(forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> t i1 j1 m x1)
-> freeIx f i j m x -> t i j m x
forall (f :: k -> k -> * -> *) (t :: k -> k -> (* -> *) -> * -> *)
       (m :: * -> *) (i :: k) (j :: k) x.
(IxFunctor f, IxMonadTrans t, Monad m) =>
(forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> t i1 j1 m x1)
-> FreeIx f i j m x -> t i j m x
foldFreeIx f i1 j1 x1 -> t i1 j1 m x1
forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> t i1 j1 m x1
f) (f i j (FreeIx f j j m x) -> t i j m (FreeIx f j j m x)
forall (i1 :: k) (j1 :: k) x1. f i1 j1 x1 -> t i1 j1 m x1
f f i j (FreeIx f j j m x)
y)