{-# LANGUAGE GADTs #-}
{-# LANGUAGE Safe #-}

module Yaya.Fold
  ( Algebra,
    AlgebraM,
    AlgebraPrism,
    BialgebraIso,
    Coalgebra,
    CoalgebraM,
    CoalgebraPrism,
    Corecursive (ana),
    DistributiveLaw,
    ElgotAlgebra,
    ElgotAlgebraM,
    ElgotCoalgebra,
    GAlgebra,
    GAlgebraM,
    GCoalgebra,
    GCoalgebraM,
    Mu (Mu),
    Nu (Nu),
    Projectable (project),
    Recursive (cata),
    Steppable (embed),
    attributeAlgebra,
    attributeCoalgebra,
    birecursiveIso,
    cata2,
    colambek,
    constAna,
    constCata,
    constEmbed,
    constProject,
    distEnvT,
    distIdentity,
    distTuple,
    elgotAna,
    elgotCata,
    elgotCataM,
    ezygoM,
    gana,
    gcata,
    gcataM,
    ignoringAttribute,
    lambek,
    lowerAlgebra,
    lowerAlgebraM,
    lowerCoalgebra,
    lowerCoalgebraM,
    lowerDay,
    recursiveEq,
    recursivePrism,
    recursiveShowsPrec,
    seqEither,
    seqIdentity,
    steppableIso,
    unFree,
    zipAlgebraMs,
    zipAlgebras,
  )
where

import "base" Control.Applicative (Applicative (pure))
import "base" Control.Category (Category (id, (.)))
import "base" Control.Monad (Monad, join, (<=<), (=<<))
import "base" Data.Bifunctor (Bifunctor (bimap, first, second))
import "base" Data.Bitraversable (bisequence)
import "base" Data.Bool (Bool (True))
import "base" Data.Eq (Eq ((==)))
import "base" Data.Foldable (Foldable (fold, toList))
import "base" Data.Function (const, ($))
import "base" Data.Functor (Functor (fmap), (<$>))
import "base" Data.Functor.Classes (Eq1, Show1 (liftShowsPrec))
import "base" Data.Int (Int)
import "base" Data.List.NonEmpty (NonEmpty ((:|)))
import "base" Data.Traversable (sequenceA)
import "base" Data.Void (Void, absurd)
import "base" Numeric.Natural (Natural)
import "base" Text.Show (Show (showsPrec), ShowS, showParen)
import "comonad" Control.Comonad (Comonad (duplicate, extend, extract))
import "comonad" Control.Comonad.Trans.Env
  ( EnvT (EnvT),
    ask,
    lowerEnvT,
    runEnvT,
  )
import "free" Control.Comonad.Cofree (Cofree ((:<)))
import "free" Control.Monad.Trans.Free (Free, FreeF (Free, Pure), free, runFree)
import "kan-extensions" Data.Functor.Day (Day (Day))
import "lens" Control.Lens
  ( Const (Const, getConst),
    Identity (Identity, runIdentity),
    Iso',
    Prism',
    Traversable (traverse),
    iso,
    matching,
    prism,
    review,
    view,
  )
import "strict" Data.Strict.Classes (Strict (toStrict))
import "this" Yaya.Fold.Common (diagonal, equal, fromEither)
import "this" Yaya.Functor (DFunctor (dmap))
import "this" Yaya.Pattern
  ( AndMaybe (Indeed, Only),
    Either (Left, Right),
    Maybe (Just, Nothing),
    Pair ((:!:)),
    XNor (Both, Neither),
    fst,
    maybe,
    snd,
    uncurry,
  )
import "base" Prelude (Enum (pred, succ))

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)

-- | Note that using a `CoalgebraM` “directly” is partial (e.g., with
--  `Yaya.Unsafe.Fold.anaM`). However, @ana . Compose@ can accept a `CoalgebraM`
--   and produce something like an effectful stream.
type CoalgebraM c m f a = a `c` m (f a)

type GCoalgebraM c m n f a = a `c` m (f (n a))

-- | This type class is lawless on its own, but there exist types that can’t
--   implement the corresponding `embed` operation. Laws are induced by
--   implementing either `Steppable` (which extends this) or `Corecursive`
--  (which doesn’t).
class Projectable c t f | t -> f where
  project :: Coalgebra c f t

-- | Structures you can walk through step-by-step.
class (Projectable c t f) => Steppable c t f | t -> f where
  embed :: Algebra c f t

-- | Inductive structures that can be reasoned about in the way we usually do –
--   with pattern matching.
class Recursive c t f | t -> f where
  cata :: Algebra c f a -> t `c` a

-- | Coinductive (potentially-infinite) structures that guarantee _productivity_
--   rather than termination.
class Corecursive c t f | t -> f where
  ana :: Coalgebra c f a -> a `c` t

-- | An implementation of `Eq` for any `Recursive` instance. Note that this is
--   actually more general than `Eq`, as it can compare between different
--   fixed-point representations of the same functor.
recursiveEq ::
  (Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f, Eq1 f) =>
  t ->
  u ->
  Bool
recursiveEq :: forall t (f :: * -> *) u.
(Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f,
 Eq1 f) =>
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

-- | An implementation of `Show` for any `Recursive` instance.
recursiveShowsPrec :: (Recursive (->) t f, Show1 f) => Int -> t -> ShowS
recursiveShowsPrec :: forall t (f :: * -> *).
(Recursive (->) t f, Show1 f) =>
Int -> t -> ShowS
recursiveShowsPrec Int
prec =
  Algebra (->) f ShowS -> t -> ShowS
forall a. 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 (Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> Algebra (->) f ShowS -> Algebra (->) f ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int -> ShowS -> ShowS)
-> ([ShowS] -> ShowS) -> Int -> Algebra (->) f ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> 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
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) [ShowS] -> ShowS
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Int
prec)

-- | A fixed-point operator for inductive / finite data structures.
--
--  *NB*: This is only guaranteed to be finite when @f a@ is strict in @a@
--       (having strict functors won't prevent `Nu` from being lazy). Using
--       @-XStrictData@ can help with this a lot.
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 a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Algebra (->) f a -> Mu f -> a
forall a. 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 :: forall a. 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 (f :: * -> *) (g :: * -> *).
(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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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

-- | A fixed-point operator for coinductive / potentially-infinite data
--   structures.
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 :: forall a. 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 (f :: * -> *) (g :: * -> *).
(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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 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 :: forall a. 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

-- | Combines two `Algebra`s with different carriers into a single tupled
--  `Algebra`.
zipAlgebras ::
  (Functor f) =>
  Algebra (->) f a ->
  Algebra (->) f b ->
  Algebra (->) f (Pair a b)
zipAlgebras :: forall (f :: * -> *) a b.
Functor f =>
Algebra (->) f a -> Algebra (->) f b -> Algebra (->) f (Pair a b)
zipAlgebras Algebra (->) f a
f Algebra (->) f b
g = (f (Pair a b) -> a)
-> (f (Pair a b) -> b)
-> Pair (f (Pair a b)) (f (Pair a b))
-> Pair a b
forall a b c d. (a -> b) -> (c -> d) -> Pair a c -> Pair b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Algebra (->) f a
f Algebra (->) f a -> (f (Pair a b) -> f a) -> f (Pair a b) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Pair a b -> a) -> f (Pair a b) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pair a b -> a
forall a b. Pair a b -> a
fst) (Algebra (->) f b
g Algebra (->) f b -> (f (Pair a b) -> f b) -> f (Pair a b) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Pair a b -> b) -> f (Pair a b) -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pair a b -> b
forall a b. Pair a b -> b
snd) (Pair (f (Pair a b)) (f (Pair a b)) -> Pair a b)
-> (f (Pair a b) -> Pair (f (Pair a b)) (f (Pair a b)))
-> f (Pair a b)
-> Pair a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f (Pair a b) -> Pair (f (Pair a b)) (f (Pair a b))
forall a. a -> Pair a a
diagonal

-- | Combines two `AlgebraM`s with different carriers into a single tupled
--  `AlgebraM`.
zipAlgebraMs ::
  (Applicative m, Functor f) =>
  AlgebraM (->) m f a ->
  AlgebraM (->) m f b ->
  AlgebraM (->) m f (Pair a b)
zipAlgebraMs :: forall (m :: * -> *) (f :: * -> *) a b.
(Applicative m, Functor f) =>
AlgebraM (->) m f a
-> AlgebraM (->) m f b -> AlgebraM (->) m f (Pair a b)
zipAlgebraMs AlgebraM (->) m f a
f AlgebraM (->) m f b
g = Pair (m a) (m b) -> m (Pair a b)
forall (t :: * -> * -> *) (f :: * -> *) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequence (Pair (m a) (m b) -> m (Pair a b))
-> (f (Pair a b) -> Pair (m a) (m b))
-> f (Pair a b)
-> m (Pair a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (f (Pair a b) -> m a)
-> (f (Pair a b) -> m b)
-> Pair (f (Pair a b)) (f (Pair a b))
-> Pair (m a) (m b)
forall a b c d. (a -> b) -> (c -> d) -> Pair a c -> Pair b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (AlgebraM (->) m f a
f AlgebraM (->) m f a -> (f (Pair a b) -> f a) -> f (Pair a b) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Pair a b -> a) -> f (Pair a b) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pair a b -> a
forall a b. Pair a b -> a
fst) (AlgebraM (->) m f b
g AlgebraM (->) m f b -> (f (Pair a b) -> f b) -> f (Pair a b) -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Pair a b -> b) -> f (Pair a b) -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pair a b -> b
forall a b. Pair a b -> b
snd) (Pair (f (Pair a b)) (f (Pair a b)) -> Pair (m a) (m b))
-> (f (Pair a b) -> Pair (f (Pair a b)) (f (Pair a b)))
-> f (Pair a b)
-> Pair (m a) (m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f (Pair a b) -> Pair (f (Pair a b)) (f (Pair a b))
forall a. a -> Pair a a
diagonal

-- | Algebras over Day convolution are convenient for binary operations, but
--   aren’t directly handleable by `cata`.
lowerDay ::
  (Projectable (->) t g) => Algebra (->) (Day f g) a -> Algebra (->) f (t -> a)
lowerDay :: forall t (g :: * -> *) (f :: * -> *) a.
Projectable (->) t g =>
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
($))

-- | By analogy with `Control.Applicative.liftA2` (which also relies on `Day`,
--   at least conceptually).
cata2 ::
  (Recursive (->) t f, Projectable (->) u g) =>
  Algebra (->) (Day f g) a ->
  t ->
  u ->
  a
cata2 :: forall t (f :: * -> *) u (g :: * -> *) a.
(Recursive (->) t f, Projectable (->) u g) =>
Algebra (->) (Day f g) a -> t -> u -> a
cata2 = Algebra (->) f (u -> a) -> t -> u -> a
forall a. 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 (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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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

-- | Makes it possible to provide a `GAlgebra` to `cata`.
lowerAlgebra ::
  (Functor f, Comonad w) =>
  DistributiveLaw (->) f w ->
  GAlgebra (->) w f a ->
  Algebra (->) f (w a)
lowerAlgebra :: 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
φ = GAlgebra (->) w f a -> w (f (w a)) -> w a
forall a b. (a -> b) -> w a -> w b
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))) -> f (w a) -> w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (w a -> w (w a)) -> f (w a) -> f (w (w a))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap w a -> w (w a)
forall a. w a -> w (w a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate

-- | Makes it possible to provide a `GAlgebraM` to `Yaya.Zoo.cataM`.
lowerAlgebraM ::
  (Applicative m, Traversable f, Comonad w, Traversable w) =>
  DistributiveLaw (->) f w ->
  GAlgebraM (->) m w f a ->
  AlgebraM (->) m f (w a)
lowerAlgebraM :: 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
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> w a -> f (w b)
traverse GAlgebraM (->) m w f a
φ (w (f (w a)) -> m (w a))
-> (f (w a) -> w (f (w a))) -> f (w a) -> m (w a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (w a -> w (w a)) -> f (w a) -> f (w (w a))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap w a -> w (w a)
forall a. w a -> w (w a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate

-- | Makes it possible to provide a `GCoalgebra` to `ana`.
lowerCoalgebra ::
  (Functor f, Monad m) =>
  DistributiveLaw (->) m f ->
  GCoalgebra (->) m f a ->
  Coalgebra (->) f (m a)
lowerCoalgebra :: 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 (m a) -> m a) -> f (m (m a)) -> f (m a)
forall a b. (a -> b) -> f a -> f b
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))) -> m a -> f (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. GCoalgebra (->) m f a -> m a -> m (f (m a))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GCoalgebra (->) m f a
ψ

-- | Makes it possible to provide a `GCoalgebraM` to `Yaya.Unsafe.Fold.anaM`.
lowerCoalgebraM ::
  (Applicative m, Traversable f, Monad n, Traversable n) =>
  DistributiveLaw (->) n f ->
  GCoalgebraM (->) m n f a ->
  CoalgebraM (->) m f (n a)
lowerCoalgebraM :: forall (m :: * -> *) (f :: * -> *) (n :: * -> *) a.
(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
k GCoalgebraM (->) m n f a
ψ = (n (f (n a)) -> f (n a)) -> m (n (f (n a))) -> m (f (n a))
forall a b. (a -> b) -> m a -> m b
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 a b. (a -> b) -> f a -> f b
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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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)))) -> n a -> m (f (n a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> n a -> f (n 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 :: forall t (f :: * -> *) (w :: * -> *) a.
(Recursive (->) t f, Functor f, Comonad w) =>
DistributiveLaw (->) f w -> GAlgebra (->) w f a -> t -> a
gcata DistributiveLaw (->) f w
k GAlgebra (->) w f a
φ = w a -> a
forall 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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Algebra (->) f (w a) -> t -> w a
forall a. 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 (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 f (w a) -> w (f a)
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 :: forall t (f :: * -> *) (w :: * -> *) a.
(Recursive (->) t f, Functor f, Comonad w) =>
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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Algebra (->) f (w (f a)) -> t -> w (f a)
forall a. 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 (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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (w (f a) -> w a) -> f (w (f a)) -> f (w a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ElgotAlgebra (->) w f a -> w (f a) -> w a
forall a b. (w a -> b) -> w a -> w b
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 :: forall (m :: * -> *) t (f :: * -> *) (w :: * -> *) a.
(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
w GAlgebraM (->) m w f a
φ = (w a -> a) -> m (w a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap w a -> a
forall a. 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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Algebra (->) f (m (w a)) -> t -> m (w a)
forall a. 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 (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 f (w a) -> w (f a)
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)
forall (f :: * -> *) a. Applicative f => f (f a) -> f (f 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 :: forall (m :: * -> *) t (f :: * -> *) (w :: * -> *) a.
(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
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 a. 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 ((f (w a) -> w (f a)) -> m (f (w a)) -> m (w (f a))
forall a b. (a -> b) -> m a -> m b
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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse (w (m a) -> m (w a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => w (f a) -> f (w a)
sequenceA (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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ElgotAlgebraM (->) m w f a -> w (f a) -> w (m a)
forall a b. (w a -> b) -> w a -> w b
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)
forall (f :: * -> *) a. Applicative f => f (f a) -> f (f a)
sequenceA)

ezygoM ::
  (Monad m, Recursive (->) t f, Traversable f) =>
  AlgebraM (->) m f b ->
  ElgotAlgebraM (->) m (Pair b) f a ->
  t ->
  m a
ezygoM :: forall (m :: * -> *) t (f :: * -> *) b a.
(Monad m, Recursive (->) t f, Traversable f) =>
AlgebraM (->) m f b
-> ElgotAlgebraM (->) m (Pair b) f a -> t -> m a
ezygoM AlgebraM (->) m f b
φ' ElgotAlgebraM (->) m (Pair b) f a
φ =
  (Pair b a -> a) -> m (Pair b a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pair b a -> a
forall a b. Pair a b -> b
snd
    (m (Pair b a) -> m a) -> (t -> m (Pair b a)) -> t -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Algebra (->) f (m (Pair b a)) -> t -> m (Pair b a)
forall a. 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
      ( (\x :: Pair b (f a)
x@(b
b :!: f a
_) -> (b
b :!:) (a -> Pair b a) -> m a -> m (Pair b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElgotAlgebraM (->) m (Pair b) f a
φ Pair b (f a)
x)
          (Pair b (f a) -> m (Pair b a))
-> (f (m (Pair b a)) -> m (Pair b (f a)))
-> Algebra (->) f (m (Pair b a))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Pair (m b) (m (f a)) -> m (Pair b (f a))
forall (t :: * -> * -> *) (f :: * -> *) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequence (Pair (m b) (m (f a)) -> m (Pair b (f a)))
-> (f (Pair b a) -> Pair (m b) (m (f a)))
-> f (Pair b a)
-> m (Pair b (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (f (Pair b a) -> m b)
-> (f (Pair b a) -> m (f a))
-> Pair (f (Pair b a)) (f (Pair b a))
-> Pair (m b) (m (f a))
forall a b c d. (a -> b) -> (c -> d) -> Pair a c -> Pair b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (AlgebraM (->) m f b
φ' AlgebraM (->) m f b -> (f (Pair b a) -> f b) -> f (Pair b a) -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Pair b a -> b) -> f (Pair b a) -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pair b a -> b
forall a b. Pair a b -> a
fst) (f a -> m (f a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a -> m (f a))
-> (f (Pair b a) -> f a) -> f (Pair b a) -> m (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Pair b a -> a) -> f (Pair b a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pair b a -> a
forall a b. Pair a b -> b
snd) (Pair (f (Pair b a)) (f (Pair b a)) -> Pair (m b) (m (f a)))
-> (f (Pair b a) -> Pair (f (Pair b a)) (f (Pair b a)))
-> f (Pair b a)
-> Pair (m b) (m (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f (Pair b a) -> Pair (f (Pair b a)) (f (Pair b a))
forall a. a -> Pair a a
diagonal
          (f (Pair b a) -> m (Pair b (f a)))
-> (f (m (Pair b a)) -> m (f (Pair b a)))
-> f (m (Pair b a))
-> m (Pair b (f a))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< f (m (Pair b a)) -> m (f (Pair b a))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => f (f a) -> f (f a)
sequenceA
      )

gana ::
  (Corecursive (->) t f, Functor f, Monad m) =>
  DistributiveLaw (->) m f ->
  GCoalgebra (->) m f a ->
  a ->
  t
gana :: forall t (f :: * -> *) (m :: * -> *) a.
(Corecursive (->) t f, Functor f, Monad m) =>
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 a. 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 (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 m (f a) -> f (m a)
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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> m a
forall a. 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 :: forall t (f :: * -> *) (m :: * -> *) a.
(Corecursive (->) t f, Functor f, Monad m) =>
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 a. 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 ((m a -> m (f a)) -> f (m a) -> f (m (f a))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ElgotCoalgebra (->) m f a
ψ

lambek ::
  (Steppable (->) t f, Recursive (->) t f, Functor f) => Coalgebra (->) f t
lambek :: forall t (f :: * -> *).
(Steppable (->) t f, Recursive (->) t f, Functor f) =>
Coalgebra (->) f t
lambek = Algebra (->) f (f t) -> t -> f t
forall a. 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 ((f t -> t) -> Algebra (->) f (f t)
forall a b. (a -> b) -> f a -> f b
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 :: forall t (f :: * -> *).
(Projectable (->) t f, Corecursive (->) t f, Functor f) =>
Algebra (->) f t
colambek = Coalgebra (->) f (f t) -> f t -> t
forall a. 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 ((t -> f t) -> Coalgebra (->) f (f t)
forall a b. (a -> b) -> f a -> f b
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)

-- | There are a number of distributive laws, including
--  `sequenceA`, `Data.Distributive.distribute`, and `Data.Align.sequenceL`.
--   Yaya also provides others for specific recursion schemes.
type DistributiveLaw c f g = forall a. f (g a) `c` g (f a)

-- | A less-constrained `Data.Distributive.distribute` for `Identity`.
distIdentity :: (Functor f) => DistributiveLaw (->) f Identity
distIdentity :: forall (f :: * -> *). Functor f => 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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Identity a -> a) -> f (Identity a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity a -> a
forall a. Identity a -> a
runIdentity

-- | A less-constrained `sequenceA` for `Identity`.
seqIdentity :: (Functor f) => DistributiveLaw (->) Identity f
seqIdentity :: forall (f :: * -> *). Functor f => DistributiveLaw (->) Identity f
seqIdentity = (a -> Identity a) -> f a -> f (Identity a)
forall a b. (a -> b) -> f a -> f b
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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Identity (f a) -> f a
forall a. Identity a -> a
runIdentity

distTuple :: (Functor f) => Algebra (->) f a -> DistributiveLaw (->) f (Pair a)
distTuple :: forall (f :: * -> *) a.
Functor f =>
Algebra (->) f a -> DistributiveLaw (->) f (Pair a)
distTuple Algebra (->) f a
φ = (f (Pair a a) -> a)
-> (f (Pair a a) -> f a)
-> Pair (f (Pair a a)) (f (Pair a a))
-> Pair a (f a)
forall a b c d. (a -> b) -> (c -> d) -> Pair a c -> Pair b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Algebra (->) f a
φ Algebra (->) f a -> (f (Pair a a) -> f a) -> f (Pair a a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Pair a a -> a) -> f (Pair a a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pair a a -> a
forall a b. Pair a b -> a
fst) ((Pair a a -> a) -> f (Pair a a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pair a a -> a
forall a b. Pair a b -> b
snd) (Pair (f (Pair a a)) (f (Pair a a)) -> Pair a (f a))
-> (f (Pair a a) -> Pair (f (Pair a a)) (f (Pair a a)))
-> f (Pair a a)
-> Pair a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f (Pair a a) -> Pair (f (Pair a a)) (f (Pair a a))
forall a. a -> Pair a a
diagonal

distEnvT ::
  (Functor f) =>
  Algebra (->) f a ->
  DistributiveLaw (->) f w ->
  DistributiveLaw (->) f (EnvT a w)
distEnvT :: forall (f :: * -> *) a (w :: * -> *).
Functor f =>
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))
-> Pair a (w (f a)) -> EnvT a w (f a)
forall a b c. (a -> b -> c) -> Pair 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 (Pair a (w (f a)) -> EnvT a w (f a))
-> (f (EnvT a w a) -> Pair a (w (f a)))
-> f (EnvT a w a)
-> EnvT a w (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (f (EnvT a w a) -> a)
-> (f (EnvT a w a) -> w (f a))
-> Pair (f (EnvT a w a)) (f (EnvT a w a))
-> Pair a (w (f a))
forall a b c d. (a -> b) -> (c -> d) -> Pair a c -> Pair b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (EnvT a w a -> a) -> f (EnvT a w a) -> f a
forall a b. (a -> b) -> f a -> f b
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 (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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (EnvT a w a -> w a) -> f (EnvT a w a) -> f (w a)
forall a b. (a -> b) -> f a -> f b
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) (Pair (f (EnvT a w a)) (f (EnvT a w a)) -> Pair a (w (f a)))
-> (f (EnvT a w a) -> Pair (f (EnvT a w a)) (f (EnvT a w a)))
-> f (EnvT a w a)
-> Pair a (w (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f (EnvT a w a) -> Pair (f (EnvT a w a)) (f (EnvT a w a))
forall a. a -> Pair a a
diagonal

seqEither ::
  (Functor f) => Coalgebra (->) f a -> DistributiveLaw (->) (Either a) f
seqEither :: forall (f :: * -> *) a.
Functor f =>
Coalgebra (->) f a -> DistributiveLaw (->) (Either a) f
seqEither Coalgebra (->) f a
ψ = Either (f (Either a a)) (f (Either a a)) -> f (Either a a)
forall a. Either a a -> a
fromEither (Either (f (Either a a)) (f (Either a a)) -> f (Either a a))
-> (Either a (f a) -> Either (f (Either a a)) (f (Either a a)))
-> Either a (f a)
-> f (Either a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> f (Either a a))
-> (f a -> f (Either a a))
-> Either a (f a)
-> Either (f (Either a a)) (f (Either a a))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((a -> Either a a) -> f a -> f (Either a a)
forall a b. (a -> b) -> f a -> f b
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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coalgebra (->) f a
ψ) ((a -> Either a a) -> f a -> f (Either a a)
forall a b. (a -> b) -> f a -> f b
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)

-- | Converts an `Algebra` to one that annotates the tree with the result for
--   each node.
attributeAlgebra ::
  (Steppable (->) t (EnvT a f), Functor f) =>
  Algebra (->) f a ->
  Algebra (->) f t
attributeAlgebra :: forall t a (f :: * -> *).
(Steppable (->) t (EnvT a f), Functor f) =>
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 a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pair a (f t) -> a
forall a b. Pair a b -> a
fst (Pair a (f t) -> a) -> (t -> Pair a (f t)) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a, f t) -> Pair a (f t)
forall lazy strict. Strict lazy strict => lazy -> strict
toStrict ((a, f t) -> Pair a (f t)) -> (t -> (a, f t)) -> t -> Pair a (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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

-- | Converts a `Coalgebra` to one that annotates the tree with the seed that
--   generated each node.
attributeCoalgebra :: Coalgebra (->) f a -> Coalgebra (->) (EnvT a f) a
attributeCoalgebra :: forall (f :: * -> *) a.
Coalgebra (->) f a -> Coalgebra (->) (EnvT a f) a
attributeCoalgebra Coalgebra (->) f a
ψ = (a -> f a -> EnvT a f a) -> Pair a (f a) -> EnvT a f a
forall a b c. (a -> b -> c) -> Pair a b -> c
uncurry a -> f a -> EnvT a f a
forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT (Pair a (f a) -> EnvT a f a)
-> (a -> Pair a (f a)) -> a -> EnvT a f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coalgebra (->) f a -> Pair a a -> Pair a (f a)
forall b c a. (b -> c) -> Pair a b -> Pair a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Coalgebra (->) f a
ψ (Pair a a -> Pair a (f a)) -> (a -> Pair a a) -> a -> Pair a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Pair a a
forall a. a -> Pair a a
diagonal

-- | This is just a more obvious name for composing `lowerEnvT` with your
--   algebra directly.
ignoringAttribute :: Algebra (->) f a -> Algebra (->) (EnvT b f) a
ignoringAttribute :: forall (f :: * -> *) a b.
Algebra (->) f a -> Algebra (->) (EnvT b f) a
ignoringAttribute Algebra (->) f a
φ = Algebra (->) f a
φ Algebra (->) f a -> (EnvT b f a -> f a) -> EnvT b f a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EnvT b f a -> f a
forall e (w :: * -> *) a. EnvT e w a -> w a
lowerEnvT

-- | It is somewhat common to have a natural transformation that looks like
--  @η :: forall a. f a -> Free g a@. This maps naturally to a `GCoalgebra` (to
--   pass to `Yaya.Zoo.apo`) with @η . project@, but the desired `Algebra` is
--   more likely to be @cata unFree . η@ than @embed . η@. See yaya-streams for
--   some examples of this.
unFree :: (Steppable (->) t f) => Algebra (->) (FreeF f t) t
unFree :: forall t (f :: * -> *).
Steppable (->) t f =>
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

-- preservingAttribute :: (forall a. f a -> g a) -> EnvT a f b -> EnvT a g b
-- preservingAttribute = cohoist

-- * instances for non-recursive types

constEmbed :: Algebra (->) (Const a) a
constEmbed :: forall a. Algebra (->) (Const a) a
constEmbed = Const a a -> a
forall {k} a (b :: k). Const a b -> a
getConst

constProject :: Coalgebra (->) (Const a) a
constProject :: forall a. Coalgebra (->) (Const a) a
constProject = a -> Const a a
forall {k} a (b :: k). a -> Const a b
Const

constCata :: Algebra (->) (Const b) a -> b -> a
constCata :: forall b a. 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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> Const b a
forall {k} a (b :: k). a -> Const a b
Const

constAna :: Coalgebra (->) (Const b) a -> a -> b
constAna :: forall b a. Coalgebra (->) (Const b) a -> a -> b
constAna Coalgebra (->) (Const b) a
ψ = Const b a -> b
forall {k} a (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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. 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

-- * Optics

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 :: forall t (f :: * -> *). Steppable (->) t f => BialgebraIso f t
steppableIso = (f t -> t) -> (t -> f t) -> Iso (f t) (f t) t 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 :: forall t (f :: * -> *) a.
(Recursive (->) t f, Corecursive (->) t f) =>
BialgebraIso f a -> Iso' t a
birecursiveIso BialgebraIso f a
alg = (t -> a) -> (a -> t) -> Iso t t a a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (Algebra (->) f a -> t -> a
forall a. 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 a. 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 :: forall t (f :: * -> *) a.
(Recursive (->) t f, Corecursive (->) t f, Traversable f) =>
AlgebraPrism f a -> Prism' t a
recursivePrism AlgebraPrism f a
alg =
  (a -> t) -> (t -> Either t a) -> Prism t t a a
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    (Coalgebra (->) f a -> a -> t
forall a. 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 b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (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 a. 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 (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)
forall (f :: * -> *) a. Applicative f => f (f a) -> f (f a)
sequenceA) t
t)