{-# LANGUAGE GADTs #-}
module Yaya.Fold where
import Control.Applicative
import Control.Arrow
import Control.Comonad
import Control.Comonad.Cofree
import Control.Comonad.Trans.Env
import Control.Lens hiding ((:<))
import Control.Monad
import Control.Monad.Trans.Free
import Data.Bitraversable
import Data.Either.Combinators
import Data.Foldable
import Data.Functor.Classes
import Data.Functor.Day
import Data.List.NonEmpty (NonEmpty (..))
import Data.Void
import Numeric.Natural
import Yaya.Fold.Common
import Yaya.Functor
import Yaya.Pattern
type Algebra c f a = f a `c` a
type GAlgebra c w f a = f (w a) `c` a
type ElgotAlgebra c w f a = w (f a) `c` a
type AlgebraM c m f a = f a `c` m a
type GAlgebraM c m w f a = f (w a) `c` m a
type ElgotAlgebraM c m w f a = w (f a) `c` m a
type Coalgebra c f a = a `c` f a
type GCoalgebra c m f a = a `c` f (m a)
type ElgotCoalgebra c m f a = a `c` m (f a)
type CoalgebraM c m f a = a `c` m (f a)
type GCoalgebraM c m n f a = a `c` m (f (n a))
class Projectable c t f | t -> f where
project :: Coalgebra c f t
class Projectable c t f => Steppable c t f | t -> f where
embed :: Algebra c f t
class Recursive c t f | t -> f where
cata :: Algebra c f a -> t `c` a
class Corecursive c t f | t -> f where
ana :: Coalgebra c f a -> a `c` t
recursiveEq ::
(Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f, Eq1 f) =>
t ->
u ->
Bool
recursiveEq :: t -> u -> Bool
recursiveEq = Algebra (->) (Day f f) Bool -> t -> u -> Bool
forall t (f :: * -> *) u (g :: * -> *) a.
(Recursive (->) t f, Projectable (->) u g) =>
Algebra (->) (Day f g) a -> t -> u -> a
cata2 Algebra (->) (Day f f) Bool
forall (f :: * -> *).
(Functor f, Foldable f, Eq1 f) =>
Day f f Bool -> Bool
equal
recursiveShowsPrec :: (Recursive (->) t f, Show1 f) => Int -> t -> ShowS
recursiveShowsPrec :: Int -> t -> ShowS
recursiveShowsPrec Int
prec =
Algebra (->) f ShowS -> t -> ShowS
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata (Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> Algebra (->) f ShowS -> Algebra (->) f ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ShowS -> ShowS)
-> ([ShowS] -> ShowS) -> Int -> Algebra (->) f ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec ((ShowS -> ShowS) -> Int -> ShowS -> ShowS
forall a b. a -> b -> a
const ShowS -> ShowS
forall a. a -> a
id) [ShowS] -> ShowS
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Int
prec)
newtype Mu f = Mu (forall a. Algebra (->) f a -> a)
instance Functor f => Projectable (->) (Mu f) f where
project :: Coalgebra (->) f (Mu f)
project = Coalgebra (->) f (Mu f)
forall t (f :: * -> *).
(Steppable (->) t f, Recursive (->) t f, Functor f) =>
Coalgebra (->) f t
lambek
instance Functor f => Steppable (->) (Mu f) f where
embed :: Algebra (->) f (Mu f)
embed f (Mu f)
m = (forall a. Algebra (->) f a -> a) -> Mu f
forall (f :: * -> *). (forall a. Algebra (->) f a -> a) -> Mu f
Mu (\Algebra (->) f a
f -> Algebra (->) f a
f ((Mu f -> a) -> f (Mu f) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Algebra (->) f a -> Mu f -> a
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata Algebra (->) f a
f) f (Mu f)
m))
instance Recursive (->) (Mu f) f where
cata :: Algebra (->) f a -> Mu f -> a
cata Algebra (->) f a
φ (Mu forall a. Algebra (->) f a -> a
f) = Algebra (->) f a -> a
forall a. Algebra (->) f a -> a
f Algebra (->) f a
φ
instance DFunctor Mu where
dmap :: (forall x. f x -> g x) -> Mu f -> Mu g
dmap forall x. f x -> g x
f (Mu forall a. Algebra (->) f a -> a
run) = (forall a. Algebra (->) g a -> a) -> Mu g
forall (f :: * -> *). (forall a. Algebra (->) f a -> a) -> Mu f
Mu (\Algebra (->) g a
φ -> Algebra (->) f a -> a
forall a. Algebra (->) f a -> a
run (Algebra (->) g a
φ Algebra (->) g a -> (f a -> g a) -> Algebra (->) f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> g a
forall x. f x -> g x
f))
instance Show1 f => Show (Mu f) where
showsPrec :: Int -> Mu f -> ShowS
showsPrec = Int -> Mu f -> ShowS
forall t (f :: * -> *).
(Recursive (->) t f, Show1 f) =>
Int -> t -> ShowS
recursiveShowsPrec
instance (Functor f, Foldable f, Eq1 f) => Eq (Mu f) where
== :: Mu f -> Mu f -> Bool
(==) = Mu f -> Mu f -> Bool
forall t (f :: * -> *) u.
(Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f,
Eq1 f) =>
t -> u -> Bool
recursiveEq
data Nu f where Nu :: Coalgebra (->) f a -> a -> Nu f
instance Functor f => Projectable (->) (Nu f) f where
project :: Coalgebra (->) f (Nu f)
project (Nu Coalgebra (->) f a
f a
a) = Coalgebra (->) f a -> a -> Nu f
forall (f :: * -> *) a. Coalgebra (->) f a -> a -> Nu f
Nu Coalgebra (->) f a
f (a -> Nu f) -> f a -> f (Nu f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Coalgebra (->) f a
f a
a
instance Functor f => Steppable (->) (Nu f) f where
embed :: Algebra (->) f (Nu f)
embed = Algebra (->) f (Nu f)
forall t (f :: * -> *).
(Projectable (->) t f, Corecursive (->) t f, Functor f) =>
Algebra (->) f t
colambek
instance Corecursive (->) (Nu f) f where
ana :: Coalgebra (->) f a -> a -> Nu f
ana = Coalgebra (->) f a -> a -> Nu f
forall (f :: * -> *) a. Coalgebra (->) f a -> a -> Nu f
Nu
instance DFunctor Nu where
dmap :: (forall x. f x -> g x) -> Nu f -> Nu g
dmap forall x. f x -> g x
f (Nu Coalgebra (->) f a
φ a
a) = Coalgebra (->) g a -> a -> Nu g
forall (f :: * -> *) a. Coalgebra (->) f a -> a -> Nu f
Nu (f a -> g a
forall x. f x -> g x
f (f a -> g a) -> Coalgebra (->) f a -> Coalgebra (->) g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coalgebra (->) f a
φ) a
a
instance Projectable (->) [a] (XNor a) where
project :: Coalgebra (->) (XNor a) [a]
project [] = XNor a [a]
forall a b. XNor a b
Neither
project (a
h : [a]
t) = a -> Coalgebra (->) (XNor a) [a]
forall a b. a -> b -> XNor a b
Both a
h [a]
t
instance Steppable (->) [a] (XNor a) where
embed :: Algebra (->) (XNor a) [a]
embed XNor a [a]
Neither = []
embed (Both a
h [a]
t) = a
h a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
t
instance Projectable (->) (NonEmpty a) (AndMaybe a) where
project :: Coalgebra (->) (AndMaybe a) (NonEmpty a)
project (a
a :| []) = a -> AndMaybe a (NonEmpty a)
forall a b. a -> AndMaybe a b
Only a
a
project (a
a :| a
b : [a]
bs) = a -> Coalgebra (->) (AndMaybe a) (NonEmpty a)
forall a b. a -> b -> AndMaybe a b
Indeed a
a (a
b a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
bs)
instance Steppable (->) (NonEmpty a) (AndMaybe a) where
embed :: Algebra (->) (AndMaybe a) (NonEmpty a)
embed (Only a
a) = a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []
embed (Indeed a
a NonEmpty a
b) = a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty a
b
instance Projectable (->) Natural Maybe where
project :: Coalgebra (->) Maybe Natural
project Natural
0 = Maybe Natural
forall a. Maybe a
Nothing
project Natural
n = Coalgebra (->) Maybe Natural
forall a. a -> Maybe a
Just (Natural -> Natural
forall a. Enum a => a -> a
pred Natural
n)
instance Steppable (->) Natural Maybe where
embed :: Algebra (->) Maybe Natural
embed = Natural -> (Natural -> Natural) -> Algebra (->) Maybe Natural
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Natural
0 Natural -> Natural
forall a. Enum a => a -> a
succ
instance Projectable (->) Void Identity where
project :: Coalgebra (->) Identity Void
project = Coalgebra (->) Identity Void
forall a. a -> Identity a
Identity
instance Steppable (->) Void Identity where
embed :: Algebra (->) Identity Void
embed = Algebra (->) Identity Void
forall a. Identity a -> a
runIdentity
instance Recursive (->) Void Identity where
cata :: Algebra (->) Identity a -> Void -> a
cata Algebra (->) Identity a
_ = Void -> a
forall a. Void -> a
absurd
instance Projectable (->) (Cofree f a) (EnvT a f) where
project :: Coalgebra (->) (EnvT a f) (Cofree f a)
project (a
a :< f (Cofree f a)
ft) = a -> f (Cofree f a) -> EnvT a f (Cofree f a)
forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT a
a f (Cofree f a)
ft
instance Steppable (->) (Cofree f a) (EnvT a f) where
embed :: Algebra (->) (EnvT a f) (Cofree f a)
embed (EnvT a
a f (Cofree f a)
ft) = a
a a -> f (Cofree f a) -> Cofree f a
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< f (Cofree f a)
ft
instance Projectable (->) (Free f a) (FreeF f a) where
project :: Coalgebra (->) (FreeF f a) (Free f a)
project = Coalgebra (->) (FreeF f a) (Free f a)
forall (f :: * -> *) a. Coalgebra (->) (FreeF f a) (Free f a)
runFree
instance Steppable (->) (Free f a) (FreeF f a) where
embed :: Algebra (->) (FreeF f a) (Free f a)
embed = Algebra (->) (FreeF f a) (Free f a)
forall (f :: * -> *) a. Algebra (->) (FreeF f a) (Free f a)
free
zipAlgebras :: Functor f => Algebra (->) f a -> Algebra (->) f b -> Algebra (->) f (a, b)
zipAlgebras :: Algebra (->) f a -> Algebra (->) f b -> Algebra (->) f (a, b)
zipAlgebras Algebra (->) f a
f Algebra (->) f b
g = Algebra (->) f a
f Algebra (->) f a -> (f (a, b) -> f a) -> f (a, b) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> a) -> f (a, b) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst (f (a, b) -> a) -> (f (a, b) -> b) -> Algebra (->) f (a, b)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Algebra (->) f b
g Algebra (->) f b -> (f (a, b) -> f b) -> f (a, b) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> b) -> f (a, b) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd
zipAlgebraMs ::
(Applicative m, Functor f) =>
AlgebraM (->) m f a ->
AlgebraM (->) m f b ->
AlgebraM (->) m f (a, b)
zipAlgebraMs :: AlgebraM (->) m f a
-> AlgebraM (->) m f b -> AlgebraM (->) m f (a, b)
zipAlgebraMs AlgebraM (->) m f a
f AlgebraM (->) m f b
g = (m a -> m b -> m (a, b)) -> (m a, m b) -> m (a, b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> b -> (a, b)) -> m a -> m b -> m (a, b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)) ((m a, m b) -> m (a, b))
-> (f (a, b) -> (m a, m b)) -> AlgebraM (->) m f (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlgebraM (->) m f a
f AlgebraM (->) m f a -> (f (a, b) -> f a) -> f (a, b) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> a) -> f (a, b) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst (f (a, b) -> m a) -> (f (a, b) -> m b) -> f (a, b) -> (m a, m b)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& AlgebraM (->) m f b
g AlgebraM (->) m f b -> (f (a, b) -> f b) -> f (a, b) -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> b) -> f (a, b) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd)
lowerDay :: Projectable (->) t g => Algebra (->) (Day f g) a -> Algebra (->) f (t -> a)
lowerDay :: Algebra (->) (Day f g) a -> Algebra (->) f (t -> a)
lowerDay Algebra (->) (Day f g) a
φ f (t -> a)
fta t
t = Algebra (->) (Day f g) a
φ (f (t -> a) -> g t -> ((t -> a) -> t -> a) -> Day f g a
forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> Day f g a
Day f (t -> a)
fta (Coalgebra (->) g t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Projectable c t f =>
Coalgebra c f t
project t
t) (t -> a) -> t -> a
forall a b. (a -> b) -> a -> b
($))
cata2 :: (Recursive (->) t f, Projectable (->) u g) => Algebra (->) (Day f g) a -> t -> u -> a
cata2 :: Algebra (->) (Day f g) a -> t -> u -> a
cata2 = Algebra (->) f (u -> a) -> t -> u -> a
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata (Algebra (->) f (u -> a) -> t -> u -> a)
-> (Algebra (->) (Day f g) a -> Algebra (->) f (u -> a))
-> Algebra (->) (Day f g) a
-> t
-> u
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Algebra (->) (Day f g) a -> Algebra (->) f (u -> a)
forall t (g :: * -> *) (f :: * -> *) a.
Projectable (->) t g =>
Algebra (->) (Day f g) a -> Algebra (->) f (t -> a)
lowerDay
lowerAlgebra ::
(Functor f, Comonad w) =>
DistributiveLaw (->) f w ->
GAlgebra (->) w f a ->
Algebra (->) f (w a)
lowerAlgebra :: DistributiveLaw (->) f w
-> GAlgebra (->) w f a -> Algebra (->) f (w a)
lowerAlgebra DistributiveLaw (->) f w
k GAlgebra (->) w f a
φ = GAlgebra (->) w f a -> w (f (w a)) -> w a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GAlgebra (->) w f a
φ (w (f (w a)) -> w a)
-> (f (w a) -> w (f (w a))) -> Algebra (->) f (w a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (w (w a)) -> w (f (w a))
DistributiveLaw (->) f w
k (f (w (w a)) -> w (f (w a)))
-> (f (w a) -> f (w (w a))) -> f (w a) -> w (f (w a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w a -> w (w a)) -> f (w a) -> f (w (w a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap w a -> w (w a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate
lowerAlgebraM ::
(Applicative m, Traversable f, Comonad w, Traversable w) =>
DistributiveLaw (->) f w ->
GAlgebraM (->) m w f a ->
AlgebraM (->) m f (w a)
lowerAlgebraM :: DistributiveLaw (->) f w
-> GAlgebraM (->) m w f a -> AlgebraM (->) m f (w a)
lowerAlgebraM DistributiveLaw (->) f w
k GAlgebraM (->) m w f a
φ = GAlgebraM (->) m w f a -> w (f (w a)) -> m (w a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse GAlgebraM (->) m w f a
φ (w (f (w a)) -> m (w a))
-> (f (w a) -> w (f (w a))) -> AlgebraM (->) m f (w a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (w (w a)) -> w (f (w a))
DistributiveLaw (->) f w
k (f (w (w a)) -> w (f (w a)))
-> (f (w a) -> f (w (w a))) -> f (w a) -> w (f (w a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w a -> w (w a)) -> f (w a) -> f (w (w a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap w a -> w (w a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate
lowerCoalgebra ::
(Functor f, Monad m) =>
DistributiveLaw (->) m f ->
GCoalgebra (->) m f a ->
Coalgebra (->) f (m a)
lowerCoalgebra :: DistributiveLaw (->) m f
-> GCoalgebra (->) m f a -> Coalgebra (->) f (m a)
lowerCoalgebra DistributiveLaw (->) m f
k GCoalgebra (->) m f a
ψ = (m (m a) -> m a) -> f (m (m a)) -> f (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (f (m (m a)) -> f (m a))
-> (m a -> f (m (m a))) -> Coalgebra (->) f (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (f (m a)) -> f (m (m a))
DistributiveLaw (->) m f
k (m (f (m a)) -> f (m (m a)))
-> (m a -> m (f (m a))) -> m a -> f (m (m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GCoalgebra (->) m f a -> m a -> m (f (m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GCoalgebra (->) m f a
ψ
lowerCoalgebraM ::
(Applicative m, Traversable f, Monad n, Traversable n) =>
DistributiveLaw (->) n f ->
GCoalgebraM (->) m n f a ->
CoalgebraM (->) m f (n a)
lowerCoalgebraM :: DistributiveLaw (->) n f
-> GCoalgebraM (->) m n f a -> CoalgebraM (->) m f (n a)
lowerCoalgebraM DistributiveLaw (->) n f
k GCoalgebraM (->) m n f a
ψ = (n (f (n a)) -> f (n a)) -> m (n (f (n a))) -> m (f (n a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((n (n a) -> n a) -> f (n (n a)) -> f (n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n (n a) -> n a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (f (n (n a)) -> f (n a))
-> (n (f (n a)) -> f (n (n a))) -> n (f (n a)) -> f (n a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n (f (n a)) -> f (n (n a))
DistributiveLaw (->) n f
k) (m (n (f (n a))) -> m (f (n a)))
-> (n a -> m (n (f (n a)))) -> CoalgebraM (->) m f (n a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GCoalgebraM (->) m n f a -> n a -> m (n (f (n a)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse GCoalgebraM (->) m n f a
ψ
gcata ::
(Recursive (->) t f, Functor f, Comonad w) =>
DistributiveLaw (->) f w ->
GAlgebra (->) w f a ->
t ->
a
gcata :: DistributiveLaw (->) f w -> GAlgebra (->) w f a -> t -> a
gcata DistributiveLaw (->) f w
k GAlgebra (->) w f a
φ = w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w a -> a) -> (t -> w a) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Algebra (->) f (w a) -> t -> w a
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata (DistributiveLaw (->) f w
-> GAlgebra (->) w f a -> Algebra (->) f (w a)
forall (f :: * -> *) (w :: * -> *) a.
(Functor f, Comonad w) =>
DistributiveLaw (->) f w
-> GAlgebra (->) w f a -> Algebra (->) f (w a)
lowerAlgebra DistributiveLaw (->) f w
k GAlgebra (->) w f a
φ)
elgotCata ::
(Recursive (->) t f, Functor f, Comonad w) =>
DistributiveLaw (->) f w ->
ElgotAlgebra (->) w f a ->
t ->
a
elgotCata :: DistributiveLaw (->) f w -> ElgotAlgebra (->) w f a -> t -> a
elgotCata DistributiveLaw (->) f w
k ElgotAlgebra (->) w f a
φ = ElgotAlgebra (->) w f a
φ ElgotAlgebra (->) w f a -> (t -> w (f a)) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Algebra (->) f (w (f a)) -> t -> w (f a)
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata (f (w a) -> w (f a)
DistributiveLaw (->) f w
k (f (w a) -> w (f a))
-> (f (w (f a)) -> f (w a)) -> Algebra (->) f (w (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w (f a) -> w a) -> f (w (f a)) -> f (w a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ElgotAlgebra (->) w f a -> w (f a) -> w a
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend ElgotAlgebra (->) w f a
φ))
gcataM ::
(Monad m, Recursive (->) t f, Traversable f, Comonad w, Traversable w) =>
DistributiveLaw (->) f w ->
GAlgebraM (->) m w f a ->
t ->
m a
gcataM :: DistributiveLaw (->) f w -> GAlgebraM (->) m w f a -> t -> m a
gcataM DistributiveLaw (->) f w
w GAlgebraM (->) m w f a
φ = (w a -> a) -> m (w a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (m (w a) -> m a) -> (t -> m (w a)) -> t -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Algebra (->) f (m (w a)) -> t -> m (w a)
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata (DistributiveLaw (->) f w
-> GAlgebraM (->) m w f a -> AlgebraM (->) m f (w a)
forall (m :: * -> *) (f :: * -> *) (w :: * -> *) a.
(Applicative m, Traversable f, Comonad w, Traversable w) =>
DistributiveLaw (->) f w
-> GAlgebraM (->) m w f a -> AlgebraM (->) m f (w a)
lowerAlgebraM DistributiveLaw (->) f w
w GAlgebraM (->) m w f a
φ AlgebraM (->) m f (w a)
-> (f (m (w a)) -> m (f (w a))) -> Algebra (->) f (m (w a))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< f (m (w a)) -> m (f (w a))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA)
elgotCataM ::
(Monad m, Recursive (->) t f, Traversable f, Comonad w, Traversable w) =>
DistributiveLaw (->) f w ->
ElgotAlgebraM (->) m w f a ->
t ->
m a
elgotCataM :: DistributiveLaw (->) f w -> ElgotAlgebraM (->) m w f a -> t -> m a
elgotCataM DistributiveLaw (->) f w
w ElgotAlgebraM (->) m w f a
φ = ElgotAlgebraM (->) m w f a
φ ElgotAlgebraM (->) m w f a -> (t -> m (w (f a))) -> t -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Algebra (->) f (m (w (f a))) -> t -> m (w (f a))
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata ((f (w a) -> w (f a)) -> m (f (w a)) -> m (w (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (w a) -> w (f a)
DistributiveLaw (->) f w
w (m (f (w a)) -> m (w (f a)))
-> (f (w (f a)) -> m (f (w a))) -> f (w (f a)) -> m (w (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w (f a) -> m (w a)) -> f (w (f a)) -> m (f (w a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (w (m a) -> m (w a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (w (m a) -> m (w a)) -> (w (f a) -> w (m a)) -> w (f a) -> m (w a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElgotAlgebraM (->) m w f a -> w (f a) -> w (m a)
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend ElgotAlgebraM (->) m w f a
φ) (f (w (f a)) -> m (w (f a)))
-> (f (m (w (f a))) -> m (f (w (f a))))
-> Algebra (->) f (m (w (f a)))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< f (m (w (f a))) -> m (f (w (f a)))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA)
ezygoM ::
(Monad m, Recursive (->) t f, Traversable f) =>
AlgebraM (->) m f b ->
ElgotAlgebraM (->) m ((,) b) f a ->
t ->
m a
ezygoM :: AlgebraM (->) m f b -> ElgotAlgebraM (->) m ((,) b) f a -> t -> m a
ezygoM AlgebraM (->) m f b
φ' ElgotAlgebraM (->) m ((,) b) f a
φ =
((b, a) -> a) -> m (b, a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, a) -> a
forall a b. (a, b) -> b
snd
(m (b, a) -> m a) -> (t -> m (b, a)) -> t -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Algebra (->) f (m (b, a)) -> t -> m (b, a)
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata
( (\x :: (b, f a)
x@(b
b, f a
_) -> (b
b,) (a -> (b, a)) -> m a -> m (b, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElgotAlgebraM (->) m ((,) b) f a
φ (b, f a)
x)
((b, f a) -> m (b, a))
-> (f (m (b, a)) -> m (b, f a)) -> Algebra (->) f (m (b, a))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (m b, m (f a)) -> m (b, f a)
forall (t :: * -> * -> *) (f :: * -> *) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequence ((m b, m (f a)) -> m (b, f a))
-> (f (b, a) -> (m b, m (f a))) -> f (b, a) -> m (b, f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlgebraM (->) m f b
φ' AlgebraM (->) m f b -> (f (b, a) -> f b) -> f (b, a) -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a) -> b) -> f (b, a) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, a) -> b
forall a b. (a, b) -> a
fst (f (b, a) -> m b)
-> (f (b, a) -> m (f a)) -> f (b, a) -> (m b, m (f a))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& f a -> m (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a -> m (f a)) -> (f (b, a) -> f a) -> f (b, a) -> m (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a) -> a) -> f (b, a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, a) -> a
forall a b. (a, b) -> b
snd)
(f (b, a) -> m (b, f a))
-> (f (m (b, a)) -> m (f (b, a))) -> f (m (b, a)) -> m (b, f a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< f (m (b, a)) -> m (f (b, a))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
)
gana ::
(Corecursive (->) t f, Functor f, Monad m) =>
DistributiveLaw (->) m f ->
GCoalgebra (->) m f a ->
a ->
t
gana :: DistributiveLaw (->) m f -> GCoalgebra (->) m f a -> a -> t
gana DistributiveLaw (->) m f
k GCoalgebra (->) m f a
ψ = Coalgebra (->) f (m a) -> m a -> t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
ana (DistributiveLaw (->) m f
-> GCoalgebra (->) m f a -> Coalgebra (->) f (m a)
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
DistributiveLaw (->) m f
-> GCoalgebra (->) m f a -> Coalgebra (->) f (m a)
lowerCoalgebra DistributiveLaw (->) m f
k GCoalgebra (->) m f a
ψ) (m a -> t) -> (a -> m a) -> a -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
elgotAna ::
(Corecursive (->) t f, Functor f, Monad m) =>
DistributiveLaw (->) m f ->
ElgotCoalgebra (->) m f a ->
a ->
t
elgotAna :: DistributiveLaw (->) m f -> ElgotCoalgebra (->) m f a -> a -> t
elgotAna DistributiveLaw (->) m f
k ElgotCoalgebra (->) m f a
ψ = Coalgebra (->) f (m (f a)) -> m (f a) -> t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
ana ((m a -> m (f a)) -> f (m a) -> f (m (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m a -> ElgotCoalgebra (->) m f a -> m (f a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ElgotCoalgebra (->) m f a
ψ) (f (m a) -> f (m (f a)))
-> (m (f a) -> f (m a)) -> Coalgebra (->) f (m (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (f a) -> f (m a)
DistributiveLaw (->) m f
k) (m (f a) -> t) -> ElgotCoalgebra (->) m f a -> a -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElgotCoalgebra (->) m f a
ψ
lambek :: (Steppable (->) t f, Recursive (->) t f, Functor f) => Coalgebra (->) f t
lambek :: Coalgebra (->) f t
lambek = Algebra (->) f (f t) -> Coalgebra (->) f t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata ((f t -> t) -> Algebra (->) f (f t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f t -> t
forall k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed)
colambek :: (Projectable (->) t f, Corecursive (->) t f, Functor f) => Algebra (->) f t
colambek :: Algebra (->) f t
colambek = Coalgebra (->) f (f t) -> Algebra (->) f t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
ana ((t -> f t) -> Coalgebra (->) f (f t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t -> f t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Projectable c t f =>
Coalgebra c f t
project)
type DistributiveLaw c f g = forall a. f (g a) `c` g (f a)
distIdentity :: Functor f => DistributiveLaw (->) f Identity
distIdentity :: DistributiveLaw (->) f Identity
distIdentity = f a -> Identity (f a)
forall a. a -> Identity a
Identity (f a -> Identity (f a))
-> (f (Identity a) -> f a) -> f (Identity a) -> Identity (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identity a -> a) -> f (Identity a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity a -> a
forall a. Identity a -> a
runIdentity
seqIdentity :: Functor f => DistributiveLaw (->) Identity f
seqIdentity :: DistributiveLaw (->) Identity f
seqIdentity = (a -> Identity a) -> f a -> f (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity (f a -> f (Identity a))
-> (Identity (f a) -> f a) -> Identity (f a) -> f (Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (f a) -> f a
forall a. Identity a -> a
runIdentity
distTuple :: Functor f => Algebra (->) f a -> DistributiveLaw (->) f ((,) a)
distTuple :: Algebra (->) f a -> DistributiveLaw (->) f ((,) a)
distTuple Algebra (->) f a
φ = Algebra (->) f a
φ Algebra (->) f a -> (f (a, a) -> f a) -> f (a, a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> a) -> f (a, a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, a) -> a
forall a b. (a, b) -> a
fst (f (a, a) -> a) -> (f (a, a) -> f a) -> f (a, a) -> (a, f a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((a, a) -> a) -> f (a, a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, a) -> a
forall a b. (a, b) -> b
snd
distEnvT ::
Functor f =>
Algebra (->) f a ->
DistributiveLaw (->) f w ->
DistributiveLaw (->) f (EnvT a w)
distEnvT :: Algebra (->) f a
-> DistributiveLaw (->) f w -> DistributiveLaw (->) f (EnvT a w)
distEnvT Algebra (->) f a
φ DistributiveLaw (->) f w
k = (a -> w (f a) -> EnvT a w (f a)) -> (a, w (f a)) -> EnvT a w (f a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> w (f a) -> EnvT a w (f a)
forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT ((a, w (f a)) -> EnvT a w (f a))
-> (f (EnvT a w a) -> (a, w (f a)))
-> f (EnvT a w a)
-> EnvT a w (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Algebra (->) f a
φ Algebra (->) f a -> (f (EnvT a w a) -> f a) -> f (EnvT a w a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnvT a w a -> a) -> f (EnvT a w a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EnvT a w a -> a
forall e (w :: * -> *) a. EnvT e w a -> e
ask (f (EnvT a w a) -> a)
-> (f (EnvT a w a) -> w (f a)) -> f (EnvT a w a) -> (a, w (f a))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& f (w a) -> w (f a)
DistributiveLaw (->) f w
k (f (w a) -> w (f a))
-> (f (EnvT a w a) -> f (w a)) -> f (EnvT a w a) -> w (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnvT a w a -> w a) -> f (EnvT a w a) -> f (w a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EnvT a w a -> w a
forall e (w :: * -> *) a. EnvT e w a -> w a
lowerEnvT)
seqEither :: Functor f => Coalgebra (->) f a -> DistributiveLaw (->) (Either a) f
seqEither :: Coalgebra (->) f a -> DistributiveLaw (->) (Either a) f
seqEither Coalgebra (->) f a
ψ = (a -> Either a a) -> f a -> f (Either a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a a
forall a b. a -> Either a b
Left (f a -> f (Either a a))
-> Coalgebra (->) f a -> a -> f (Either a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coalgebra (->) f a
ψ (a -> f (Either a a))
-> (f a -> f (Either a a)) -> Either a (f a) -> f (Either a a)
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| (a -> Either a a) -> f a -> f (Either a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a a
forall a b. b -> Either a b
Right
attributeAlgebra ::
(Steppable (->) t (EnvT a f), Functor f) =>
Algebra (->) f a ->
Algebra (->) f t
attributeAlgebra :: Algebra (->) f a -> Algebra (->) f t
attributeAlgebra Algebra (->) f a
φ f t
ft = Algebra (->) (EnvT a f) t
forall k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed Algebra (->) (EnvT a f) t -> Algebra (->) (EnvT a f) t
forall a b. (a -> b) -> a -> b
$ a -> f t -> EnvT a f t
forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT (Algebra (->) f a
φ ((t -> a) -> f t -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, f t) -> a
forall a b. (a, b) -> a
fst ((a, f t) -> a) -> (t -> (a, f t)) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnvT a f t -> (a, f t)
forall e (w :: * -> *) a. EnvT e w a -> (e, w a)
runEnvT (EnvT a f t -> (a, f t)) -> (t -> EnvT a f t) -> t -> (a, f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> EnvT a f t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Projectable c t f =>
Coalgebra c f t
project) f t
ft)) f t
ft
attributeCoalgebra :: Coalgebra (->) f a -> Coalgebra (->) (EnvT a f) a
attributeCoalgebra :: Coalgebra (->) f a -> Coalgebra (->) (EnvT a f) a
attributeCoalgebra Coalgebra (->) f a
ψ = (a -> f a -> EnvT a f a) -> (a, f a) -> EnvT a f a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> f a -> EnvT a f a
forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT ((a, f a) -> EnvT a f a)
-> (a -> (a, f a)) -> Coalgebra (->) (EnvT a f) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a
forall a. a -> a
id (a -> a) -> Coalgebra (->) f a -> a -> (a, f a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Coalgebra (->) f a
ψ)
ignoringAttribute :: Algebra (->) f a -> Algebra (->) (EnvT b f) a
ignoringAttribute :: Algebra (->) f a -> Algebra (->) (EnvT b f) a
ignoringAttribute Algebra (->) f a
φ = Algebra (->) f a
φ Algebra (->) f a
-> (EnvT b f a -> f a) -> Algebra (->) (EnvT b f) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnvT b f a -> f a
forall e (w :: * -> *) a. EnvT e w a -> w a
lowerEnvT
unFree :: Steppable (->) t f => Algebra (->) (FreeF f t) t
unFree :: Algebra (->) (FreeF f t) t
unFree = \case
Pure t
t -> t
t
Free f t
ft -> Algebra (->) f t
forall k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed f t
ft
constEmbed :: Algebra (->) (Const a) a
constEmbed :: Algebra (->) (Const a) a
constEmbed = Algebra (->) (Const a) a
forall a k (b :: k). Const a b -> a
getConst
constProject :: Coalgebra (->) (Const a) a
constProject :: Coalgebra (->) (Const a) a
constProject = Coalgebra (->) (Const a) a
forall k a (b :: k). a -> Const a b
Const
constCata :: Algebra (->) (Const b) a -> b -> a
constCata :: Algebra (->) (Const b) a -> b -> a
constCata Algebra (->) (Const b) a
φ = Algebra (->) (Const b) a
φ Algebra (->) (Const b) a -> (b -> Const b a) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Const b a
forall k a (b :: k). a -> Const a b
Const
constAna :: Coalgebra (->) (Const b) a -> a -> b
constAna :: Coalgebra (->) (Const b) a -> a -> b
constAna Coalgebra (->) (Const b) a
ψ = Const b a -> b
forall a k (b :: k). Const a b -> a
getConst (Const b a -> b) -> Coalgebra (->) (Const b) a -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coalgebra (->) (Const b) a
ψ
instance Projectable (->) (Either a b) (Const (Either a b)) where
project :: Coalgebra (->) (Const (Either a b)) (Either a b)
project = Coalgebra (->) (Const (Either a b)) (Either a b)
forall a. Coalgebra (->) (Const a) a
constProject
instance Steppable (->) (Either a b) (Const (Either a b)) where
embed :: Algebra (->) (Const (Either a b)) (Either a b)
embed = Algebra (->) (Const (Either a b)) (Either a b)
forall a. Algebra (->) (Const a) a
constEmbed
instance Recursive (->) (Either a b) (Const (Either a b)) where
cata :: Algebra (->) (Const (Either a b)) a -> Either a b -> a
cata = Algebra (->) (Const (Either a b)) a -> Either a b -> a
forall b a. Algebra (->) (Const b) a -> b -> a
constCata
instance Corecursive (->) (Either a b) (Const (Either a b)) where
ana :: Coalgebra (->) (Const (Either a b)) a -> a -> Either a b
ana = Coalgebra (->) (Const (Either a b)) a -> a -> Either a b
forall b a. Coalgebra (->) (Const b) a -> a -> b
constAna
instance Projectable (->) (Maybe a) (Const (Maybe a)) where
project :: Coalgebra (->) (Const (Maybe a)) (Maybe a)
project = Coalgebra (->) (Const (Maybe a)) (Maybe a)
forall a. Coalgebra (->) (Const a) a
constProject
instance Steppable (->) (Maybe a) (Const (Maybe a)) where
embed :: Algebra (->) (Const (Maybe a)) (Maybe a)
embed = Algebra (->) (Const (Maybe a)) (Maybe a)
forall a. Algebra (->) (Const a) a
constEmbed
instance Recursive (->) (Maybe a) (Const (Maybe a)) where
cata :: Algebra (->) (Const (Maybe a)) a -> Maybe a -> a
cata = Algebra (->) (Const (Maybe a)) a -> Maybe a -> a
forall b a. Algebra (->) (Const b) a -> b -> a
constCata
instance Corecursive (->) (Maybe a) (Const (Maybe a)) where
ana :: Coalgebra (->) (Const (Maybe a)) a -> a -> Maybe a
ana = Coalgebra (->) (Const (Maybe a)) a -> a -> Maybe a
forall b a. Coalgebra (->) (Const b) a -> a -> b
constAna
type BialgebraIso f a = Iso' (f a) a
type AlgebraPrism f a = Prism' (f a) a
type CoalgebraPrism f a = Prism' a (f a)
steppableIso :: Steppable (->) t f => BialgebraIso f t
steppableIso :: BialgebraIso f t
steppableIso = (f t -> t) -> (t -> f t) -> BialgebraIso f t
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso f t -> t
forall k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed t -> f t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Projectable c t f =>
Coalgebra c f t
project
birecursiveIso ::
(Recursive (->) t f, Corecursive (->) t f) =>
BialgebraIso f a ->
Iso' t a
birecursiveIso :: BialgebraIso f a -> Iso' t a
birecursiveIso BialgebraIso f a
alg = (t -> a) -> (a -> t) -> Iso' t a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (Algebra (->) f a -> t -> a
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata (Getting a (f a) a -> Algebra (->) f a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting a (f a) a
BialgebraIso f a
alg)) (Coalgebra (->) f a -> a -> t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
ana (AReview (f a) a -> Coalgebra (->) f a
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview (f a) a
BialgebraIso f a
alg))
recursivePrism ::
(Recursive (->) t f, Corecursive (->) t f, Traversable f) =>
AlgebraPrism f a ->
Prism' t a
recursivePrism :: AlgebraPrism f a -> Prism' t a
recursivePrism AlgebraPrism f a
alg =
(a -> t) -> (t -> Either t a) -> Prism' t a
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
(Coalgebra (->) f a -> a -> t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
ana (AReview (f a) a -> Coalgebra (->) f a
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview (f a) a
AlgebraPrism f a
alg))
(\t
t -> (f a -> t) -> Either (f a) a -> Either t a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (t -> f a -> t
forall a b. a -> b -> a
const t
t) (Either (f a) a -> Either t a) -> Either (f a) a -> Either t a
forall a b. (a -> b) -> a -> b
$ Algebra (->) f (Either (f a) a) -> t -> Either (f a) a
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata (APrism (f a) (f a) a a -> f a -> Either (f a) a
forall s t a b. APrism s t a b -> s -> Either t a
matching APrism (f a) (f a) a a
AlgebraPrism f a
alg (f a -> Either (f a) a)
-> (f (Either (f a) a) -> Either (f a) (f a))
-> Algebra (->) f (Either (f a) a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< f (Either (f a) a) -> Either (f a) (f a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA) t
t)