{-# LANGUAGE Safe #-}

-- | Contains all the commonly-named folds that aren’t core to the library. In
--   general, this can be seen as a mapping from names you may have heard or
--   read in a paper to how Yaya expects you to achieve the same end. Of course,
--   you can always import this module and use the “common” name as well.
module Yaya.Zoo
  ( Colist,
    List,
    Nat,
    NonEmptyList,
    Partial (Partial, fromPartial),
    Stream,
    apo,
    cataM,
    cocontramap,
    comap,
    comutu,
    contramap,
    gmutu,
    histo,
    insidePartial,
    map,
    mutu,
    mutuM,
    para,
    traverse,
    zygo,
    zygoM,
  )
where

import "base" Control.Applicative (Applicative (pure, (<*>)))
import "base" Control.Category (Category (id, (.)))
import "base" Control.Monad (Monad ((>>=)), (<=<))
import "base" Data.Bifunctor (Bifunctor (bimap, first))
import "base" Data.Bitraversable (Bitraversable (bitraverse), bisequence)
import "base" Data.Function (flip, ($))
import "base" Data.Functor (Functor (fmap))
import "base" Data.Traversable (Traversable (sequenceA))
import "comonad" Control.Comonad (Comonad (duplicate, extract))
import "comonad" Control.Comonad.Env (EnvT (EnvT))
import "free" Control.Comonad.Cofree (Cofree)
import "profunctors" Data.Profunctor (Profunctor (lmap))
import "this" Yaya.Fold
  ( Algebra,
    AlgebraM,
    Corecursive (ana),
    DistributiveLaw,
    GAlgebra,
    GAlgebraM,
    GCoalgebra,
    Mu,
    Nu,
    Projectable (project),
    Recursive (cata),
    Steppable (embed),
    distTuple,
    elgotAna,
    gana,
    gcata,
    seqEither,
  )
import "this" Yaya.Fold.Common (diagonal, fromEither)
import "this" Yaya.Fold.Native (distCofreeT)
import "this" Yaya.Pattern
  ( AndMaybe,
    Either (Left, Right),
    Maybe,
    Pair ((:!:)),
    XNor,
    fst,
    snd,
    swap,
    uncurry,
  )

-- | A recursion scheme that allows you to return a complete branch when
--   unfolding.
apo ::
  (Projectable (->) t f, Corecursive (->) t f, Functor f) =>
  GCoalgebra (->) (Either t) f a ->
  a ->
  t
apo :: forall t (f :: * -> *) a.
(Projectable (->) t f, Corecursive (->) t f, Functor f) =>
GCoalgebra (->) (Either t) f a -> a -> t
apo = DistributiveLaw (->) (Either t) f
-> GCoalgebra (->) (Either t) f a -> a -> t
forall t (f :: * -> *) (m :: * -> *) a.
(Corecursive (->) t f, Functor f, Monad m) =>
DistributiveLaw (->) m f -> GCoalgebra (->) m f a -> a -> t
gana (Coalgebra (->) f t -> DistributiveLaw (->) (Either t) f
forall (f :: * -> *) a.
Functor f =>
Coalgebra (->) f a -> DistributiveLaw (->) (Either a) f
seqEither Coalgebra (->) f t
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k -> k1).
Projectable c t f =>
Coalgebra c f t
project)

-- | If you have a monadic algebra, you can fold it by distributing the monad
--   over the algebra.
cataM ::
  (Monad m, Recursive (->) t f, Traversable f) =>
  AlgebraM (->) m f a ->
  t ->
  m a
cataM :: forall (m :: * -> *) t (f :: * -> *) a.
(Monad m, Recursive (->) t f, Traversable f) =>
AlgebraM (->) m f a -> t -> m a
cataM AlgebraM (->) m f a
φ = Algebra (->) f (m a) -> t -> m a
forall a. Algebra (->) f a -> t -> a
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k1 -> k)
       (a :: k1).
Recursive c t f =>
Algebra c f a -> c t a
cata (AlgebraM (->) m f a
φ AlgebraM (->) m f a -> (f (m a) -> m (f a)) -> Algebra (->) f (m a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< f (m a) -> m (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)

-- | A recursion scheme that allows two algebras to see each others’ results. (A
--   generalization of `zygo`.) This is an example that falls outside the scope
--   of “comonadic folds”, but _would_ be covered by “adjoint folds”.
mutu ::
  (Recursive (->) t f, Functor f) =>
  GAlgebra (->) (Pair a) f b ->
  GAlgebra (->) (Pair b) f a ->
  t ->
  a
mutu :: forall t (f :: * -> *) a b.
(Recursive (->) t f, Functor f) =>
GAlgebra (->) (Pair a) f b -> GAlgebra (->) (Pair b) f a -> t -> a
mutu GAlgebra (->) (Pair a) f b
φ' GAlgebra (->) (Pair b) f a
φ = Pair b a -> a
forall a. Pair b a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Pair b a -> a) -> (t -> Pair b 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 (Pair b a) -> t -> Pair b a
forall a. Algebra (->) f a -> t -> a
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k1 -> k)
       (a :: k1).
Recursive c t f =>
Algebra c f a -> c t a
cata ((f (Pair b a) -> b)
-> GAlgebra (->) (Pair b) f a
-> Pair (f (Pair b a)) (f (Pair b a))
-> Pair b 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 (GAlgebra (->) (Pair a) f b
φ' GAlgebra (->) (Pair a) f b
-> (f (Pair b a) -> f (Pair a b)) -> f (Pair b 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
. (Pair b a -> Pair a b) -> f (Pair b a) -> f (Pair a 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 -> Pair a b
forall a b. Pair a b -> Pair b a
swap) GAlgebra (->) (Pair b) f a
φ (Pair (f (Pair b a)) (f (Pair b a)) -> Pair b a)
-> (f (Pair b a) -> Pair (f (Pair b a)) (f (Pair b a)))
-> Algebra (->) f (Pair 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
. f (Pair b a) -> Pair (f (Pair b a)) (f (Pair b a))
forall a. a -> Pair a a
diagonal)

gmutu ::
  (Comonad w, Comonad v, Recursive (->) t f, Functor f) =>
  DistributiveLaw (->) f w ->
  DistributiveLaw (->) f v ->
  GAlgebra (->) (EnvT a w) f b ->
  GAlgebra (->) (EnvT b v) f a ->
  t ->
  a
gmutu :: forall (w :: * -> *) (v :: * -> *) t (f :: * -> *) a b.
(Comonad w, Comonad v, Recursive (->) t f, Functor f) =>
DistributiveLaw (->) f w
-> DistributiveLaw (->) f v
-> GAlgebra (->) (EnvT a w) f b
-> GAlgebra (->) (EnvT b v) f a
-> t
-> a
gmutu DistributiveLaw (->) f w
w DistributiveLaw (->) f v
v GAlgebra (->) (EnvT a w) f b
φ' GAlgebra (->) (EnvT b v) f a
φ = v a -> a
forall a. v a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (v a -> a) -> (t -> v 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
. GAlgebra (->) (Pair (v a)) f (w b)
-> GAlgebra (->) (Pair (w b)) f (v a) -> t -> v a
forall t (f :: * -> *) a b.
(Recursive (->) t f, Functor f) =>
GAlgebra (->) (Pair a) f b -> GAlgebra (->) (Pair b) f a -> t -> a
mutu ((f (w (EnvT a w b)) -> w (f (EnvT a w b)))
-> GAlgebra (->) (EnvT a w) f b
-> GAlgebra (->) (Pair (v a)) f (w b)
forall {w :: * -> *} {f :: * -> *} {f :: * -> *} {f :: * -> *} {a}
       {a} {a} {b}.
(Comonad w, Comonad f, Functor f, Functor f) =>
(f (f (EnvT a f a)) -> f a)
-> (a -> b) -> f (Pair (w a) (f a)) -> f b
lowerEnv f (w (EnvT a w b)) -> w (f (EnvT a w b))
DistributiveLaw (->) f w
w GAlgebra (->) (EnvT a w) f b
φ') ((f (v (EnvT b v a)) -> v (f (EnvT b v a)))
-> GAlgebra (->) (EnvT b v) f a
-> GAlgebra (->) (Pair (w b)) f (v a)
forall {w :: * -> *} {f :: * -> *} {f :: * -> *} {f :: * -> *} {a}
       {a} {a} {b}.
(Comonad w, Comonad f, Functor f, Functor f) =>
(f (f (EnvT a f a)) -> f a)
-> (a -> b) -> f (Pair (w a) (f a)) -> f b
lowerEnv f (v (EnvT b v a)) -> v (f (EnvT b v a))
DistributiveLaw (->) f v
v GAlgebra (->) (EnvT b v) f a
φ)
  where
    lowerEnv :: (f (f (EnvT a f a)) -> f a)
-> (a -> b) -> f (Pair (w a) (f a)) -> f b
lowerEnv f (f (EnvT a f a)) -> f a
x a -> b
φ'' =
      (a -> b) -> f 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 a -> b
φ''
        (f a -> f b)
-> (f (Pair (w a) (f a)) -> f a) -> f (Pair (w a) (f a)) -> f 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 (f (EnvT a f a)) -> f a
x
        (f (f (EnvT a f a)) -> f a)
-> (f (Pair (w a) (f a)) -> f (f (EnvT a f a)))
-> f (Pair (w a) (f 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
. (Pair (w a) (f a) -> f (EnvT a f a))
-> f (Pair (w a) (f a)) -> f (f (EnvT 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 (f a) -> EnvT a f a) -> f (Pair a (f a)) -> f (EnvT 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 ((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) (f (Pair a (f a)) -> f (EnvT a f a))
-> (Pair (w a) (f a) -> f (Pair a (f a)))
-> Pair (w a) (f a)
-> f (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
. Pair a (f (f a)) -> f (Pair a (f a))
forall {f :: * -> *} {a} {a}.
Functor f =>
Pair a (f a) -> f (Pair a a)
distProd (Pair a (f (f a)) -> f (Pair a (f a)))
-> (Pair (w a) (f a) -> Pair a (f (f a)))
-> Pair (w a) (f a)
-> f (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
. (w a -> a)
-> (f a -> f (f a)) -> Pair (w a) (f a) -> Pair a (f (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 w a -> a
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract f a -> f (f a)
forall a. f a -> f (f a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate)
    distProd :: Pair a (f a) -> f (Pair a a)
distProd Pair a (f a)
p =
      let a :: a
a = Pair a (f a) -> a
forall a b. Pair a b -> a
fst Pair a (f a)
p
       in (a -> Pair a a) -> f a -> f (Pair 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
a :!:) (Pair a (f a) -> f a
forall a b. Pair a b -> b
snd Pair a (f a)
p)

-- | This could use a better name.
comutu ::
  (Corecursive (->) t f, Functor f) =>
  GCoalgebra (->) (Either a) f b ->
  GCoalgebra (->) (Either b) f a ->
  a ->
  t
comutu :: forall t (f :: * -> *) a b.
(Corecursive (->) t f, Functor f) =>
GCoalgebra (->) (Either a) f b
-> GCoalgebra (->) (Either b) f a -> a -> t
comutu GCoalgebra (->) (Either a) f b
ψ' GCoalgebra (->) (Either b) f a
ψ = Coalgebra (->) f (Either b a) -> Either b a -> t
forall a. Coalgebra (->) f a -> a -> t
forall {k} {k1} (c :: k -> k1 -> *) (t :: k1) (f :: k -> k1)
       (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
ana (Either (f (Either b a)) (f (Either b a)) -> f (Either b a)
forall a. Either a a -> a
fromEither (Either (f (Either b a)) (f (Either b a)) -> f (Either b a))
-> (Either b a -> Either (f (Either b a)) (f (Either b a)))
-> Coalgebra (->) f (Either 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 -> f (Either b a))
-> GCoalgebra (->) (Either b) f a
-> Either b a
-> Either (f (Either b a)) (f (Either b 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 ((Either a b -> Either b a) -> f (Either a b) -> f (Either b a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either a b -> Either b a
forall {b} {a}. Either b a -> Either a b
swapEither (f (Either a b) -> f (Either b a))
-> GCoalgebra (->) (Either a) f b -> b -> f (Either 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
. GCoalgebra (->) (Either a) f b
ψ') GCoalgebra (->) (Either b) f a
ψ) (Either b a -> t) -> (a -> Either b 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 -> Either b a
forall a. a -> Either b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    swapEither :: Either b a -> Either a b
swapEither = \case
      Left b
x -> b -> Either a b
forall a b. b -> Either a b
Right b
x
      Right a
y -> a -> Either a b
forall a b. a -> Either a b
Left a
y

-- gcomutu
--   :: (Monad m, Monad n, Corecursive (->) t f, Functor f)
--   => DistributiveLaw (->) m f
--   -> DistributiveLaw (->) n f
--   -> GCoalgebra (->) (FreeF m a) f b
--   -> GCoalgebra (->) (FreeF n b) f a
--   -> a
--   -> t
-- gcomutu m n ψ' ψ = comutu (lowerFree m ψ') (lowerFree n ψ) . pure
--   where
--     lowerFree x ψ'' =
--       fmap ((pure +++ join) . distProd . fmap (uncurry EnvT))
--       . x
--       . fmap ψ''
--     distProd :: DistributiveLaw (->) f (Either a)
--     distProd p =
--       let a = fst p
--       in fmap (\b -> (a , b)) (snd p)

mutuM ::
  (Monad m, Recursive (->) t f, Traversable f) =>
  GAlgebraM (->) m (Pair a) f b ->
  GAlgebraM (->) m (Pair b) f a ->
  t ->
  m a
mutuM :: forall (m :: * -> *) t (f :: * -> *) a b.
(Monad m, Recursive (->) t f, Traversable f) =>
GAlgebraM (->) m (Pair a) f b
-> GAlgebraM (->) m (Pair b) f a -> t -> m a
mutuM GAlgebraM (->) m (Pair a) f b
φ' GAlgebraM (->) 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
. AlgebraM (->) m f (Pair b a) -> t -> m (Pair b a)
forall (m :: * -> *) t (f :: * -> *) a.
(Monad m, Recursive (->) t f, Traversable f) =>
AlgebraM (->) m f a -> t -> m a
cataM (Pair (m b) (m a) -> m (Pair b a)
forall (t :: * -> * -> *) (f :: * -> *) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequence (Pair (m b) (m a) -> m (Pair b a))
-> (f (Pair b a) -> Pair (m b) (m a))
-> AlgebraM (->) m f (Pair 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
. (f (Pair b a) -> m b)
-> GAlgebraM (->) m (Pair b) f a
-> Pair (f (Pair b a)) (f (Pair b a))
-> Pair (m b) (m 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 (GAlgebraM (->) m (Pair a) f b
φ' GAlgebraM (->) m (Pair a) f b
-> (f (Pair b a) -> f (Pair a 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 -> Pair a b) -> f (Pair b a) -> f (Pair a 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 -> Pair a b
forall a b. Pair a b -> Pair b a
swap) GAlgebraM (->) m (Pair b) f a
φ (Pair (f (Pair b a)) (f (Pair b a)) -> Pair (m b) (m a))
-> (f (Pair b a) -> Pair (f (Pair b a)) (f (Pair b a)))
-> f (Pair b a)
-> Pair (m 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
. f (Pair b a) -> Pair (f (Pair b a)) (f (Pair b a))
forall a. a -> Pair a a
diagonal)

histo :: (Recursive (->) t f, Functor f) => GAlgebra (->) (Cofree f) f a -> t -> a
histo :: forall t (f :: * -> *) a.
(Recursive (->) t f, Functor f) =>
GAlgebra (->) (Cofree f) f a -> t -> a
histo = DistributiveLaw (->) f (Cofree f)
-> GAlgebra (->) (Cofree f) f a -> t -> a
forall t (f :: * -> *) (w :: * -> *) a.
(Recursive (->) t f, Functor f, Comonad w) =>
DistributiveLaw (->) f w -> GAlgebra (->) w f a -> t -> a
gcata (DistributiveLaw (->) f f -> DistributiveLaw (->) f (Cofree f)
forall (f :: * -> *) (h :: * -> *).
(Functor f, Functor h) =>
DistributiveLaw (->) f h -> DistributiveLaw (->) f (Cofree h)
distCofreeT f (f a) -> f (f a)
forall a. a -> a
DistributiveLaw (->) f f
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)

-- | A recursion scheme that gives you access to the original structure as you
--   fold. (A specialization of `zygo`.)
para ::
  (Steppable (->) t f, Recursive (->) t f, Functor f) =>
  GAlgebra (->) (Pair t) f a ->
  t ->
  a
para :: forall t (f :: * -> *) a.
(Steppable (->) t f, Recursive (->) t f, Functor f) =>
GAlgebra (->) (Pair t) f a -> t -> a
para = DistributiveLaw (->) f (Pair t)
-> GAlgebra (->) (Pair t) f a -> t -> a
forall t (f :: * -> *) (w :: * -> *) a.
(Recursive (->) t f, Functor f, Comonad w) =>
DistributiveLaw (->) f w -> GAlgebra (->) w f a -> t -> a
gcata (Algebra (->) f t -> DistributiveLaw (->) f (Pair t)
forall (f :: * -> *) a.
Functor f =>
Algebra (->) f a -> DistributiveLaw (->) f (Pair a)
distTuple Algebra (->) f t
forall {k} (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed)

-- | A recursion scheme that uses a “helper algebra” to provide additional
--   information when folding. (A generalization of `para`, and specialization
--   of `mutu`.)
zygo ::
  (Recursive (->) t f, Functor f) =>
  Algebra (->) f b ->
  GAlgebra (->) (Pair b) f a ->
  t ->
  a
zygo :: forall t (f :: * -> *) b a.
(Recursive (->) t f, Functor f) =>
Algebra (->) f b -> GAlgebra (->) (Pair b) f a -> t -> a
zygo Algebra (->) f b
φ = DistributiveLaw (->) f (Pair b)
-> GAlgebra (->) (Pair b) f a -> t -> a
forall t (f :: * -> *) (w :: * -> *) a.
(Recursive (->) t f, Functor f, Comonad w) =>
DistributiveLaw (->) f w -> GAlgebra (->) w f a -> t -> a
gcata (Algebra (->) f b -> DistributiveLaw (->) f (Pair b)
forall (f :: * -> *) a.
Functor f =>
Algebra (->) f a -> DistributiveLaw (->) f (Pair a)
distTuple Algebra (->) f b
φ)

-- | This definition is different from the one given by `gcataM (distTuple φ')`
--   because it has a monadic “helper” algebra. But at least it gives us the
--   opportunity to show how `zygo` is a specialization of `mutu`.
zygoM ::
  (Monad m, Recursive (->) t f, Traversable f) =>
  AlgebraM (->) m f b ->
  GAlgebraM (->) m (Pair b) f a ->
  t ->
  m a
zygoM :: forall (m :: * -> *) t (f :: * -> *) b a.
(Monad m, Recursive (->) t f, Traversable f) =>
AlgebraM (->) m f b -> GAlgebraM (->) m (Pair b) f a -> t -> m a
zygoM AlgebraM (->) m f b
φ' = GAlgebraM (->) m (Pair a) f b
-> GAlgebraM (->) m (Pair b) f a -> t -> m a
forall (m :: * -> *) t (f :: * -> *) a b.
(Monad m, Recursive (->) t f, Traversable f) =>
GAlgebraM (->) m (Pair a) f b
-> GAlgebraM (->) m (Pair b) f a -> t -> m a
mutuM (AlgebraM (->) m f b
φ' AlgebraM (->) m f b
-> (f (Pair a b) -> f b) -> GAlgebraM (->) m (Pair a) f 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)

-- | Potentially-infinite lists, like `[]`.
type Colist a = Nu (XNor a)

-- | Finite lists.
type List a = Mu (XNor a)

-- | Finite non-empty lists.
type NonEmptyList a = Mu (AndMaybe a)

-- | Finite natural numbers.
type Nat = Mu Maybe

-- | Represents partial functions that may eventually return a value (`Left`).
-- NB: This is a newtype so we can create the usual instances.
newtype Partial a = Partial {forall a. Partial a -> Nu (Either a)
fromPartial :: Nu (Either a)}

-- TODO: There may be some way to do this over an arbitrary @newtype@, or at
--       least a way to do it over an arbitrary `Iso`.
insidePartial :: (Nu (Either a) -> Nu (Either b)) -> Partial a -> Partial b
insidePartial :: forall a b.
(Nu (Either a) -> Nu (Either b)) -> Partial a -> Partial b
insidePartial Nu (Either a) -> Nu (Either b)
f = Nu (Either b) -> Partial b
forall a. Nu (Either a) -> Partial a
Partial (Nu (Either b) -> Partial b)
-> (Partial a -> Nu (Either b)) -> Partial a -> Partial 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
. Nu (Either a) -> Nu (Either b)
f (Nu (Either a) -> Nu (Either b))
-> (Partial a -> Nu (Either a)) -> Partial a -> Nu (Either 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
. Partial a -> Nu (Either a)
forall a. Partial a -> Nu (Either a)
fromPartial

instance Functor Partial where
  fmap :: forall a b. (a -> b) -> Partial a -> Partial b
fmap a -> b
f = (Nu (Either a) -> Nu (Either b)) -> Partial a -> Partial b
forall a b.
(Nu (Either a) -> Nu (Either b)) -> Partial a -> Partial b
insidePartial ((a -> b) -> Nu (Either a) -> Nu (Either b)
forall t (f :: * -> * -> *) a u b.
(Projectable (->) t (f a), Corecursive (->) u (f b),
 Bifunctor f) =>
(a -> b) -> t -> u
comap a -> b
f)

instance Applicative Partial where
  pure :: forall a. a -> Partial a
pure = Nu (Either a) -> Partial a
forall a. Nu (Either a) -> Partial a
Partial (Nu (Either a) -> Partial a)
-> (a -> Nu (Either a)) -> a -> Partial 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 (->) (Either a) (Nu (Either a))
forall {k} (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed Algebra (->) (Either a) (Nu (Either a))
-> (a -> Either a (Nu (Either a))) -> a -> Nu (Either 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 -> Either a (Nu (Either a))
forall a b. a -> Either a b
Left
  Partial (a -> b)
ff <*> :: forall a b. Partial (a -> b) -> Partial a -> Partial b
<*> Partial a
fa =
    ((Nu (Either (a -> b)) -> Nu (Either b))
 -> Partial (a -> b) -> Partial b)
-> Partial (a -> b)
-> (Nu (Either (a -> b)) -> Nu (Either b))
-> Partial b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Nu (Either (a -> b)) -> Nu (Either b))
-> Partial (a -> b) -> Partial b
forall a b.
(Nu (Either a) -> Nu (Either b)) -> Partial a -> Partial b
insidePartial Partial (a -> b)
ff ((Nu (Either (a -> b)) -> Nu (Either b)) -> Partial b)
-> (Nu (Either (a -> b)) -> Nu (Either b)) -> Partial b
forall a b. (a -> b) -> a -> b
$
      DistributiveLaw (->) (Either (Nu (Either b))) (Either b)
-> ElgotCoalgebra
     (->) (Either (Nu (Either b))) (Either b) (Nu (Either (a -> b)))
-> Nu (Either (a -> b))
-> Nu (Either b)
forall t (f :: * -> *) (m :: * -> *) a.
(Corecursive (->) t f, Functor f, Monad m) =>
DistributiveLaw (->) m f -> ElgotCoalgebra (->) m f a -> a -> t
elgotAna
        (Coalgebra (->) (Either b) (Nu (Either b))
-> DistributiveLaw (->) (Either (Nu (Either b))) (Either b)
forall (f :: * -> *) a.
Functor f =>
Coalgebra (->) f a -> DistributiveLaw (->) (Either a) f
seqEither Coalgebra (->) (Either b) (Nu (Either b))
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k -> k1).
Projectable c t f =>
Coalgebra c f t
project)
        (((a -> b) -> Nu (Either b))
-> (Nu (Either (a -> b)) -> Either b (Nu (Either (a -> b))))
-> Either (a -> b) (Nu (Either (a -> b)))
-> Either (Nu (Either b)) (Either b (Nu (Either (a -> b))))
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 (Partial b -> Nu (Either b)
forall a. Partial a -> Nu (Either a)
fromPartial (Partial b -> Nu (Either b))
-> ((a -> b) -> Partial b) -> (a -> b) -> Nu (Either 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
. ((a -> b) -> Partial a -> Partial b)
-> Partial a -> (a -> b) -> Partial b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> Partial a -> Partial b
forall a b. (a -> b) -> Partial a -> Partial b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Partial a
fa) Nu (Either (a -> b)) -> Either b (Nu (Either (a -> b)))
forall a b. b -> Either a b
Right (Either (a -> b) (Nu (Either (a -> b)))
 -> Either (Nu (Either b)) (Either b (Nu (Either (a -> b)))))
-> (Nu (Either (a -> b)) -> Either (a -> b) (Nu (Either (a -> b))))
-> ElgotCoalgebra
     (->) (Either (Nu (Either b))) (Either b) (Nu (Either (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
. Nu (Either (a -> b)) -> Either (a -> b) (Nu (Either (a -> b)))
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k -> k1).
Projectable c t f =>
Coalgebra c f t
project)

instance Monad Partial where
  Partial a
pa >>= :: forall a b. Partial a -> (a -> Partial b) -> Partial b
>>= a -> Partial b
f = Partial (Partial b) -> Partial b
forall {a}. Partial (Partial a) -> Partial a
join' ((a -> Partial b) -> Partial a -> Partial (Partial b)
forall a b. (a -> b) -> Partial a -> Partial b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Partial b
f Partial a
pa)
    where
      join' :: Partial (Partial a) -> Partial a
join' =
        (Nu (Either (Partial a)) -> Nu (Either a))
-> Partial (Partial a) -> Partial a
forall a b.
(Nu (Either a) -> Nu (Either b)) -> Partial a -> Partial b
insidePartial ((Nu (Either (Partial a)) -> Nu (Either a))
 -> Partial (Partial a) -> Partial a)
-> (Nu (Either (Partial a)) -> Nu (Either a))
-> Partial (Partial a)
-> Partial a
forall a b. (a -> b) -> a -> b
$
          DistributiveLaw (->) (Either (Nu (Either a))) (Either a)
-> ElgotCoalgebra
     (->) (Either (Nu (Either a))) (Either a) (Nu (Either (Partial a)))
-> Nu (Either (Partial a))
-> Nu (Either a)
forall t (f :: * -> *) (m :: * -> *) a.
(Corecursive (->) t f, Functor f, Monad m) =>
DistributiveLaw (->) m f -> ElgotCoalgebra (->) m f a -> a -> t
elgotAna (Coalgebra (->) (Either a) (Nu (Either a))
-> DistributiveLaw (->) (Either (Nu (Either a))) (Either a)
forall (f :: * -> *) a.
Functor f =>
Coalgebra (->) f a -> DistributiveLaw (->) (Either a) f
seqEither Coalgebra (->) (Either a) (Nu (Either a))
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k -> k1).
Projectable c t f =>
Coalgebra c f t
project) ((Partial a -> Nu (Either a))
-> (Nu (Either (Partial a)) -> Either a (Nu (Either (Partial a))))
-> Either (Partial a) (Nu (Either (Partial a)))
-> Either (Nu (Either a)) (Either a (Nu (Either (Partial 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 Partial a -> Nu (Either a)
forall a. Partial a -> Nu (Either a)
fromPartial Nu (Either (Partial a)) -> Either a (Nu (Either (Partial a)))
forall a b. b -> Either a b
Right (Either (Partial a) (Nu (Either (Partial a)))
 -> Either (Nu (Either a)) (Either a (Nu (Either (Partial a)))))
-> (Nu (Either (Partial a))
    -> Either (Partial a) (Nu (Either (Partial a))))
-> ElgotCoalgebra
     (->) (Either (Nu (Either a))) (Either a) (Nu (Either (Partial 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
. Nu (Either (Partial a))
-> Either (Partial a) (Nu (Either (Partial a)))
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k -> k1).
Projectable c t f =>
Coalgebra c f t
project)

-- | Always-infinite streams (as opposed to `Colist`, which _may_ terminate).
type Stream a = Nu (Pair a)

-- | A more general implementation of `fmap`, because it can also work to, from,
--   or within monomorphic structures, obviating the need for classes like
--  `Data.MonoTraversable.MonoFunctor`.
map :: (Recursive (->) t (f a), Steppable (->) u (f b), Bifunctor f) => (a -> b) -> t -> u
map :: forall t (f :: * -> * -> *) a u b.
(Recursive (->) t (f a), Steppable (->) u (f b), Bifunctor f) =>
(a -> b) -> t -> u
map a -> b
f = Algebra (->) (f a) u -> t -> u
forall a. Algebra (->) (f a) a -> t -> a
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k1 -> k)
       (a :: k1).
Recursive c t f =>
Algebra c f a -> c t a
cata (Algebra (->) (f b) u
forall {k} (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed Algebra (->) (f b) u -> (f a u -> f b u) -> Algebra (->) (f a) u
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 -> b) -> f a u -> f b u
forall a b c. (a -> b) -> f a c -> f b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f)

-- | A version of `Yaya.Zoo.map` that applies to Corecursive structures.
comap ::
  (Projectable (->) t (f a), Corecursive (->) u (f b), Bifunctor f) =>
  (a -> b) ->
  t ->
  u
comap :: forall t (f :: * -> * -> *) a u b.
(Projectable (->) t (f a), Corecursive (->) u (f b),
 Bifunctor f) =>
(a -> b) -> t -> u
comap a -> b
f = Coalgebra (->) (f b) t -> t -> u
forall a. Coalgebra (->) (f b) a -> a -> u
forall {k} {k1} (c :: k -> k1 -> *) (t :: k1) (f :: k -> k1)
       (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
ana ((a -> b) -> f a t -> f b t
forall a b c. (a -> b) -> f a c -> f b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f (f a t -> f b t) -> (t -> f a t) -> Coalgebra (->) (f b) 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 -> f a t
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k -> k1).
Projectable c t f =>
Coalgebra c f t
project)

-- TODO: Weaken the `Monad` constraint to `Applicative`.

-- | A more general implementation of `Data.Traversable.traverse`, because it
--   can also work to, from, or within monomorphic structures, obviating the
--   need for classes like `Data.MonoTraversable.MonoTraversable`.
traverse ::
  ( Recursive (->) t (f a),
    Steppable (->) u (f b),
    Bitraversable f,
    Traversable (f a),
    Monad m
  ) =>
  (a -> m b) ->
  t ->
  m u
traverse :: forall t (f :: * -> * -> *) a u b (m :: * -> *).
(Recursive (->) t (f a), Steppable (->) u (f b), Bitraversable f,
 Traversable (f a), Monad m) =>
(a -> m b) -> t -> m u
traverse a -> m b
f = Algebra (->) (f a) (m u) -> t -> m u
forall a. Algebra (->) (f a) a -> t -> a
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k1 -> k)
       (a :: k1).
Recursive c t f =>
Algebra c f a -> c t a
cata ((f b u -> u) -> m (f b u) -> m u
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f b u -> u
forall {k} (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed (m (f b u) -> m u) -> (f a u -> m (f b u)) -> f a u -> m u
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 b) -> (u -> m u) -> f a u -> m (f b u)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> f a b -> f (f c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> m b
f u -> m u
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a u -> m u)
-> (f a (m u) -> m (f a u)) -> Algebra (->) (f a) (m u)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< f a (m u) -> m (f a u)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => f a (f a) -> f (f a a)
sequenceA)

-- | A more general implementation of `Data.Functor.contramap`, because it can
--   also work to, from, or within monomorphic structures.
contramap ::
  (Recursive (->) t (f b), Steppable (->) u (f a), Profunctor f) =>
  (a -> b) ->
  t ->
  u
contramap :: forall t (f :: * -> * -> *) b u a.
(Recursive (->) t (f b), Steppable (->) u (f a), Profunctor f) =>
(a -> b) -> t -> u
contramap a -> b
f = Algebra (->) (f b) u -> t -> u
forall a. Algebra (->) (f b) a -> t -> a
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k1 -> k)
       (a :: k1).
Recursive c t f =>
Algebra c f a -> c t a
cata (Algebra (->) (f a) u
forall {k} (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed Algebra (->) (f a) u -> (f b u -> f a u) -> Algebra (->) (f b) u
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 -> b) -> f b u -> f a u
forall a b c. (a -> b) -> f b c -> f a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f)

cocontramap ::
  (Projectable (->) t (f b), Corecursive (->) u (f a), Profunctor f) =>
  (a -> b) ->
  t ->
  u
cocontramap :: forall t (f :: * -> * -> *) b u a.
(Projectable (->) t (f b), Corecursive (->) u (f a),
 Profunctor f) =>
(a -> b) -> t -> u
cocontramap a -> b
f = Coalgebra (->) (f a) t -> t -> u
forall a. Coalgebra (->) (f a) a -> a -> u
forall {k} {k1} (c :: k -> k1 -> *) (t :: k1) (f :: k -> k1)
       (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
ana ((a -> b) -> f b t -> f a t
forall a b c. (a -> b) -> f b c -> f a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f (f b t -> f a t) -> (t -> f b t) -> Coalgebra (->) (f 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
. t -> f b t
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k -> k1).
Projectable c t f =>
Coalgebra c f t
project)