{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
module Control.Algebra.Free2
(
FreeAlgebra2 (..)
, Proof (..)
, AlgebraType0
, AlgebraType
, wrapFree2
, foldFree2
, unFoldNatFree2
, hoistFree2
, hoistFreeH2
, joinFree2
, bindFree2
, assocFree2
) where
import Control.Monad (join)
import Data.Kind (Type)
import Data.Algebra.Free (AlgebraType, AlgebraType0, Proof (..))
class FreeAlgebra2 (m :: (k -> k -> Type) -> k -> k -> Type) where
{-# MINIMAL liftFree2, foldNatFree2 #-}
liftFree2 :: AlgebraType0 m f
=> f a b
-> m f a b
foldNatFree2 :: forall (d :: k -> k -> Type)
(f :: k -> k -> Type) a b .
( AlgebraType m d
, AlgebraType0 m f
)
=> (forall x y. f x y -> d x y)
-> (m f a b -> d a b)
codom2 :: forall (f :: k -> k -> Type).
AlgebraType0 m f
=> Proof (AlgebraType m (m f)) (m f)
default codom2 :: forall a. AlgebraType m (m a)
=> Proof (AlgebraType m (m a)) (m a)
codom2 = Proof (AlgebraType m (m a)) (m a)
forall {l} (c :: Constraint) (a :: l). c => Proof c a
Proof
forget2 :: forall (f :: k -> k -> Type).
AlgebraType m f
=> Proof (AlgebraType0 m f) (m f)
default forget2 :: forall a. AlgebraType0 m a
=> Proof (AlgebraType0 m a) (m a)
forget2 = Proof (AlgebraType0 m a) (m a)
forall {l} (c :: Constraint) (a :: l). c => Proof c a
Proof
wrapFree2 :: forall (m :: (Type -> Type -> Type) -> Type -> Type -> Type)
(f :: Type -> Type -> Type)
a b .
( AlgebraType0 m f
, FreeAlgebra2 m
, Monad (m f a)
)
=> f a (m f a b)
-> m f a b
wrapFree2 :: forall (m :: (* -> * -> *) -> * -> * -> *) (f :: * -> * -> *) a b.
(AlgebraType0 m f, FreeAlgebra2 m, Monad (m f a)) =>
f a (m f a b) -> m f a b
wrapFree2 = m f a (m f a b) -> m f a b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m f a (m f a b) -> m f a b)
-> (f a (m f a b) -> m f a (m f a b)) -> f a (m f a b) -> m f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a (m f a b) -> m f a (m f a b)
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType0 m f) =>
f a b -> m f a b
forall (f :: * -> * -> *) a b. AlgebraType0 m f => f a b -> m f a b
liftFree2
{-# INLINABLE wrapFree2 #-}
foldFree2 :: forall k
(m :: (k -> k -> Type) -> k -> k -> Type)
(f :: k -> k -> Type)
a b .
( FreeAlgebra2 m
, AlgebraType m f
)
=> m f a b
-> f a b
foldFree2 :: forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType m f) =>
m f a b -> f a b
foldFree2 = case Proof (AlgebraType0 m f) (m f)
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *).
(FreeAlgebra2 m, AlgebraType m f) =>
Proof (AlgebraType0 m f) (m f)
forall (f :: k -> k -> *).
AlgebraType m f =>
Proof (AlgebraType0 m f) (m f)
forget2 :: Proof (AlgebraType0 m f) (m f) of
Proof (AlgebraType0 m f) (m f)
Proof -> (forall (x :: k) (y :: k). f x y -> f x y) -> m f a b -> f a b
forall k (m :: (k -> k -> *) -> k -> k -> *) (d :: k -> k -> *)
(f :: k -> k -> *) (a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType m d, AlgebraType0 m f) =>
(forall (x :: k) (y :: k). f x y -> d x y) -> m f a b -> d a b
forall (d :: k -> k -> *) (f :: k -> k -> *) (a :: k) (b :: k).
(AlgebraType m d, AlgebraType0 m f) =>
(forall (x :: k) (y :: k). f x y -> d x y) -> m f a b -> d a b
foldNatFree2 f x y -> f x y
forall (x :: k) (y :: k). f x y -> f x y
forall a. a -> a
id
{-# INLINABLE foldFree2 #-}
unFoldNatFree2
:: forall k
(m :: (k -> k -> Type) -> k -> k -> Type)
(f :: k -> k -> Type)
d a b.
( FreeAlgebra2 m
, AlgebraType0 m f
)
=> (forall x y. m f x y -> d x y)
-> f a b -> d a b
unFoldNatFree2 :: forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(d :: k -> k -> *) (a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType0 m f) =>
(forall (x :: k) (y :: k). m f x y -> d x y) -> f a b -> d a b
unFoldNatFree2 forall (x :: k) (y :: k). m f x y -> d x y
nat = m f a b -> d a b
forall (x :: k) (y :: k). m f x y -> d x y
nat (m f a b -> d a b) -> (f a b -> m f a b) -> f a b -> d a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a b -> m f a b
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType0 m f) =>
f a b -> m f a b
forall (f :: k -> k -> *) (a :: k) (b :: k).
AlgebraType0 m f =>
f a b -> m f a b
liftFree2
{-# INLINABLE unFoldNatFree2 #-}
hoistFree2 :: forall k
(m :: (k -> k -> Type) -> k -> k -> Type)
(f :: k -> k -> Type)
g a b .
( FreeAlgebra2 m
, AlgebraType0 m g
, AlgebraType0 m f
)
=> (forall x y. f x y -> g x y)
-> m f a b
-> m g a b
hoistFree2 :: forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(g :: k -> k -> *) (a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType0 m g, AlgebraType0 m f) =>
(forall (x :: k) (y :: k). f x y -> g x y) -> m f a b -> m g a b
hoistFree2 forall (x :: k) (y :: k). f x y -> g x y
nat = case Proof (AlgebraType m (m g)) (m g)
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *).
(FreeAlgebra2 m, AlgebraType0 m f) =>
Proof (AlgebraType m (m f)) (m f)
forall (f :: k -> k -> *).
AlgebraType0 m f =>
Proof (AlgebraType m (m f)) (m f)
codom2 :: Proof (AlgebraType m (m g)) (m g) of
Proof (AlgebraType m (m g)) (m g)
Proof -> (forall (x :: k) (y :: k). f x y -> m g x y) -> m f a b -> m g a b
forall k (m :: (k -> k -> *) -> k -> k -> *) (d :: k -> k -> *)
(f :: k -> k -> *) (a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType m d, AlgebraType0 m f) =>
(forall (x :: k) (y :: k). f x y -> d x y) -> m f a b -> d a b
forall (d :: k -> k -> *) (f :: k -> k -> *) (a :: k) (b :: k).
(AlgebraType m d, AlgebraType0 m f) =>
(forall (x :: k) (y :: k). f x y -> d x y) -> m f a b -> d a b
foldNatFree2 (g x y -> m g x y
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType0 m f) =>
f a b -> m f a b
forall (f :: k -> k -> *) (a :: k) (b :: k).
AlgebraType0 m f =>
f a b -> m f a b
liftFree2 (g x y -> m g x y) -> (f x y -> g x y) -> f x y -> m g x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x y -> g x y
forall (x :: k) (y :: k). f x y -> g x y
nat)
{-# INLINABLE [1] hoistFree2 #-}
{-# RULES
"hositFree2/foldNatFree2"
forall (nat :: forall x y. g x y -> c x y)
(nat0 :: forall x y. f x y -> g x y)
(f :: m f a b).
foldNatFree2 nat (hoistFree2 nat0 f) = foldNatFree2 (nat . nat0) f
#-}
hoistFreeH2 :: forall m n f a b .
( FreeAlgebra2 m
, FreeAlgebra2 n
, AlgebraType0 m f
, AlgebraType0 n f
, AlgebraType m (n f)
)
=> m f a b
-> n f a b
hoistFreeH2 :: forall {k} (m :: (k -> k -> *) -> k -> k -> *)
(n :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *) (a :: k)
(b :: k).
(FreeAlgebra2 m, FreeAlgebra2 n, AlgebraType0 m f,
AlgebraType0 n f, AlgebraType m (n f)) =>
m f a b -> n f a b
hoistFreeH2 = (forall (x :: k) (y :: k). f x y -> n f x y) -> m f a b -> n f a b
forall k (m :: (k -> k -> *) -> k -> k -> *) (d :: k -> k -> *)
(f :: k -> k -> *) (a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType m d, AlgebraType0 m f) =>
(forall (x :: k) (y :: k). f x y -> d x y) -> m f a b -> d a b
forall (d :: k -> k -> *) (f :: k -> k -> *) (a :: k) (b :: k).
(AlgebraType m d, AlgebraType0 m f) =>
(forall (x :: k) (y :: k). f x y -> d x y) -> m f a b -> d a b
foldNatFree2 f x y -> n f x y
forall (x :: k) (y :: k). f x y -> n f x y
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType0 m f) =>
f a b -> m f a b
forall (f :: k -> k -> *) (a :: k) (b :: k).
AlgebraType0 n f =>
f a b -> n f a b
liftFree2
{-# INLINABLE [1] hoistFreeH2 #-}
{-# RULES
"hoistFreeH2/foldNatFree2" forall (nat :: forall x y. f x y -> c x y)
(f :: AlgebraType m c => m f a b).
foldNatFree2 nat (hoistFreeH2 f) = foldNatFree2 nat f
#-}
joinFree2 :: forall k
(m :: (k -> k -> Type) -> k -> k -> Type)
(f :: k -> k -> Type)
a b .
( FreeAlgebra2 m
, AlgebraType0 m f
)
=> m (m f) a b
-> m f a b
joinFree2 :: forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType0 m f) =>
m (m f) a b -> m f a b
joinFree2 = case Proof (AlgebraType m (m f)) (m f)
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *).
(FreeAlgebra2 m, AlgebraType0 m f) =>
Proof (AlgebraType m (m f)) (m f)
forall (f :: k -> k -> *).
AlgebraType0 m f =>
Proof (AlgebraType m (m f)) (m f)
codom2 :: Proof (AlgebraType m (m f)) (m f) of
Proof (AlgebraType m (m f)) (m f)
Proof -> case Proof (AlgebraType0 m (m f)) (m (m f))
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *).
(FreeAlgebra2 m, AlgebraType m f) =>
Proof (AlgebraType0 m f) (m f)
forall (f :: k -> k -> *).
AlgebraType m f =>
Proof (AlgebraType0 m f) (m f)
forget2 :: Proof (AlgebraType0 m (m f)) (m (m f)) of
Proof (AlgebraType0 m (m f)) (m (m f))
Proof -> m (m f) a b -> m f a b
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType m f) =>
m f a b -> f a b
foldFree2
{-# INLINABLE joinFree2 #-}
bindFree2 :: forall m f g a b .
( FreeAlgebra2 m
, AlgebraType0 m g
, AlgebraType0 m f
)
=> m f a b
-> (forall x y . f x y -> m g x y)
-> m g a b
bindFree2 :: forall {k} (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(g :: k -> k -> *) (a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType0 m g, AlgebraType0 m f) =>
m f a b -> (forall (x :: k) (y :: k). f x y -> m g x y) -> m g a b
bindFree2 m f a b
mfa forall (x :: k) (y :: k). f x y -> m g x y
nat = case Proof (AlgebraType m (m g)) (m g)
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *).
(FreeAlgebra2 m, AlgebraType0 m f) =>
Proof (AlgebraType m (m f)) (m f)
forall (f :: k -> k -> *).
AlgebraType0 m f =>
Proof (AlgebraType m (m f)) (m f)
codom2 :: Proof (AlgebraType m (m g)) (m g) of
Proof (AlgebraType m (m g)) (m g)
Proof -> (forall (x :: k) (y :: k). f x y -> m g x y) -> m f a b -> m g a b
forall k (m :: (k -> k -> *) -> k -> k -> *) (d :: k -> k -> *)
(f :: k -> k -> *) (a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType m d, AlgebraType0 m f) =>
(forall (x :: k) (y :: k). f x y -> d x y) -> m f a b -> d a b
forall (d :: k -> k -> *) (f :: k -> k -> *) (a :: k) (b :: k).
(AlgebraType m d, AlgebraType0 m f) =>
(forall (x :: k) (y :: k). f x y -> d x y) -> m f a b -> d a b
foldNatFree2 f x y -> m g x y
forall (x :: k) (y :: k). f x y -> m g x y
nat m f a b
mfa
{-# INLINABLE bindFree2 #-}
assocFree2 :: forall (m :: (Type -> Type -> Type) -> Type -> Type -> Type)
(f :: Type -> Type -> Type)
a b .
( FreeAlgebra2 m
, AlgebraType m f
, Functor (m (m f) a)
)
=> m f a (m f a b)
-> m (m f) a (f a b)
assocFree2 :: forall (m :: (* -> * -> *) -> * -> * -> *) (f :: * -> * -> *) a b.
(FreeAlgebra2 m, AlgebraType m f, Functor (m (m f) a)) =>
m f a (m f a b) -> m (m f) a (f a b)
assocFree2 = case Proof (AlgebraType0 m f) (m f)
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *).
(FreeAlgebra2 m, AlgebraType m f) =>
Proof (AlgebraType0 m f) (m f)
forall (f :: * -> * -> *).
AlgebraType m f =>
Proof (AlgebraType0 m f) (m f)
forget2 :: Proof (AlgebraType0 m f) (m f) of
Proof (AlgebraType0 m f) (m f)
Proof -> case Proof (AlgebraType m (m f)) (m f)
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *).
(FreeAlgebra2 m, AlgebraType0 m f) =>
Proof (AlgebraType m (m f)) (m f)
forall (f :: * -> * -> *).
AlgebraType0 m f =>
Proof (AlgebraType m (m f)) (m f)
codom2 :: Proof (AlgebraType m (m f)) (m f) of
Proof (AlgebraType m (m f)) (m f)
Proof -> case Proof (AlgebraType0 m (m f)) (m (m f))
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *).
(FreeAlgebra2 m, AlgebraType m f) =>
Proof (AlgebraType0 m f) (m f)
forall (f :: * -> * -> *).
AlgebraType m f =>
Proof (AlgebraType0 m f) (m f)
forget2 :: Proof (AlgebraType0 m (m f)) (m (m f)) of
Proof (AlgebraType0 m (m f)) (m (m f))
Proof -> case Proof (AlgebraType m (m (m f))) (m (m f))
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *).
(FreeAlgebra2 m, AlgebraType0 m f) =>
Proof (AlgebraType m (m f)) (m f)
forall (f :: * -> * -> *).
AlgebraType0 m f =>
Proof (AlgebraType m (m f)) (m f)
codom2 :: Proof (AlgebraType m (m (m f))) (m (m f)) of
Proof (AlgebraType m (m (m f))) (m (m f))
Proof -> (m f a b -> f a b) -> m (m f) a (m f a b) -> m (m f) a (f a b)
forall a b. (a -> b) -> m (m f) a a -> m (m f) a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m f a b -> f a b
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType m f) =>
m f a b -> f a b
foldFree2 (m (m f) a (m f a b) -> m (m f) a (f a b))
-> (m f a (m f a b) -> m (m f) a (m f a b))
-> m f a (m f a b)
-> m (m f) a (f a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x y. f x y -> m (m f) x y)
-> m f a (m f a b) -> m (m f) a (m f a b)
forall k (m :: (k -> k -> *) -> k -> k -> *) (d :: k -> k -> *)
(f :: k -> k -> *) (a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType m d, AlgebraType0 m f) =>
(forall (x :: k) (y :: k). f x y -> d x y) -> m f a b -> d a b
forall (d :: * -> * -> *) (f :: * -> * -> *) a b.
(AlgebraType m d, AlgebraType0 m f) =>
(forall x y. f x y -> d x y) -> m f a b -> d a b
foldNatFree2 ((forall x y. f x y -> m f x y) -> m f x y -> m (m f) x y
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(g :: k -> k -> *) (a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType0 m g, AlgebraType0 m f) =>
(forall (x :: k) (y :: k). f x y -> g x y) -> m f a b -> m g a b
hoistFree2 f x y -> m f x y
forall x y. f x y -> m f x y
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType0 m f) =>
f a b -> m f a b
forall (f :: * -> * -> *) a b. AlgebraType0 m f => f a b -> m f a b
liftFree2 (m f x y -> m (m f) x y)
-> (f x y -> m f x y) -> f x y -> m (m f) x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x y -> m f x y
forall k (m :: (k -> k -> *) -> k -> k -> *) (f :: k -> k -> *)
(a :: k) (b :: k).
(FreeAlgebra2 m, AlgebraType0 m f) =>
f a b -> m f a b
forall (f :: * -> * -> *) a b. AlgebraType0 m f => f a b -> m f a b
liftFree2)
{-# INLINABLE assocFree2 #-}