-- | 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 where

import Control.Arrow hiding (first)
import Control.Comonad.Cofree
import Control.Comonad.Env
import Control.Monad
import Data.Bifunctor
import Data.Bitraversable
import Data.Either.Combinators
import Data.Profunctor
import Data.Tuple
import Yaya.Fold
import Yaya.Fold.Native (distCofreeT)
import Yaya.Pattern

-- | 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 :: 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 k (c :: k -> k -> *) (t :: k) (f :: k -> k).
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 :: AlgebraM (->) m f a -> t -> m a
cataM AlgebraM (->) m f a
φ = Algebra (->) f (m a) -> t -> m 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 (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)
sequenceA)

-- | A recursion scheme that allows to 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 (->) ((,) a) f b ->
  GAlgebra (->) ((,) b) f a ->
  t ->
  a
mutu :: GAlgebra (->) ((,) a) f b -> GAlgebra (->) ((,) b) f a -> t -> a
mutu GAlgebra (->) ((,) a) f b
φ' GAlgebra (->) ((,) b) f a
φ = (b, a) -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract ((b, a) -> a) -> (t -> (b, a)) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Algebra (->) f (b, a) -> t -> (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 (GAlgebra (->) ((,) a) f b
φ' GAlgebra (->) ((,) a) f b
-> (f (b, a) -> f (a, b)) -> f (b, a) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a) -> (a, b)) -> f (b, a) -> f (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, a) -> (a, b)
forall a b. (a, b) -> (b, a)
swap (f (b, a) -> b)
-> GAlgebra (->) ((,) b) f a -> Algebra (->) f (b, a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& GAlgebra (->) ((,) b) f a
φ)

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 :: 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 (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
. GAlgebra (->) ((,) (v a)) f (w b)
-> GAlgebra (->) ((,) (w b)) f (v a) -> t -> v a
forall t (f :: * -> *) a b.
(Recursive (->) t f, Functor f) =>
GAlgebra (->) ((,) a) f b -> GAlgebra (->) ((,) 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 (->) ((,) (v a)) f (w b)
forall (w :: * -> *) (f :: * -> *) (f :: * -> *) (f :: * -> *) e a
       a b.
(Comonad w, Comonad f, Functor f, Functor f) =>
(f (f (EnvT e f a)) -> f a) -> (a -> b) -> f (w e, 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 (->) ((,) (w b)) f (v a)
forall (w :: * -> *) (f :: * -> *) (f :: * -> *) (f :: * -> *) e a
       a b.
(Comonad w, Comonad f, Functor f, Functor f) =>
(f (f (EnvT e f a)) -> f a) -> (a -> b) -> f (w e, 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 e f a)) -> f a) -> (a -> b) -> f (w e, f a) -> f b
lowerEnv f (f (EnvT e f a)) -> f a
x 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 (w e, f a) -> f a) -> f (w e, f a) -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (f (EnvT e f a)) -> f a
x
        (f (f (EnvT e f a)) -> f a)
-> (f (w e, f a) -> f (f (EnvT e f a))) -> f (w e, f a) -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((w e, f a) -> f (EnvT e f a))
-> f (w e, f a) -> f (f (EnvT e f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((e, f a) -> EnvT e f a) -> f (e, f a) -> f (EnvT e f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> f a -> EnvT e f a) -> (e, f a) -> EnvT e f a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry e -> f a -> EnvT e f a
forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT) (f (e, f a) -> f (EnvT e f a))
-> ((w e, f a) -> f (e, f a)) -> (w e, f a) -> f (EnvT e f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e, f (f a)) -> f (e, f a)
forall (f :: * -> *) t t. Functor f => (t, f t) -> f (t, t)
distProd ((e, f (f a)) -> f (e, f a))
-> ((w e, f a) -> (e, f (f a))) -> (w e, f a) -> f (e, f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w e -> e
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w e -> e) -> (f a -> f (f a)) -> (w e, f a) -> (e, f (f a))
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** f a -> f (f a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate))
    distProd :: (t, f t) -> f (t, t)
distProd (t, f t)
p =
      let a :: t
a = (t, f t) -> t
forall a b. (a, b) -> a
fst (t, f t)
p
       in (t -> (t, t)) -> f t -> f (t, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t
a,) ((t, f t) -> f t
forall a b. (a, b) -> b
snd (t, f t)
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 :: 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 k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
ana ((Either a b -> Either b a) -> f (Either a b) -> f (Either b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either a b -> Either b a
forall e a. Either e a -> Either a e
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
. GCoalgebra (->) (Either a) f b
ψ' (b -> f (Either b a))
-> GCoalgebra (->) (Either b) f a -> Coalgebra (->) f (Either b a)
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| 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
. a -> Either b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

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

histo :: (Recursive (->) t f, Functor f) => GAlgebra (->) (Cofree f) f a -> t -> a
histo :: 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 forall a. a -> a
DistributiveLaw (->) f f
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 (->) ((,) t) f a ->
  t ->
  a
para :: GAlgebra (->) ((,) t) f a -> t -> a
para = DistributiveLaw (->) f ((,) t)
-> GAlgebra (->) ((,) 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 ((,) t)
forall (f :: * -> *) a.
Functor f =>
Algebra (->) f a -> DistributiveLaw (->) f ((,) 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 (->) ((,) b) f a ->
  t ->
  a
zygo :: Algebra (->) f b -> GAlgebra (->) ((,) b) f a -> t -> a
zygo Algebra (->) f b
φ = DistributiveLaw (->) f ((,) b)
-> GAlgebra (->) ((,) 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 ((,) b)
forall (f :: * -> *) a.
Functor f =>
Algebra (->) f a -> DistributiveLaw (->) f ((,) 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 ((,) b) f a ->
  t ->
  m a
zygoM :: AlgebraM (->) m f b -> GAlgebraM (->) m ((,) b) f a -> t -> m a
zygoM AlgebraM (->) m f b
φ' = GAlgebraM (->) m ((,) a) f b
-> GAlgebraM (->) m ((,) b) f a -> t -> m a
forall (m :: * -> *) t (f :: * -> *) a b.
(Monad m, Recursive (->) t f, Traversable f) =>
GAlgebraM (->) m ((,) a) f b
-> GAlgebraM (->) m ((,) b) f a -> t -> m a
mutuM (AlgebraM (->) m f b
φ' AlgebraM (->) m f b
-> (f (a, b) -> f b) -> GAlgebraM (->) m ((,) a) f 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)

-- | 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 {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 :: (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
. 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
. Partial a -> Nu (Either a)
forall a. Partial a -> Nu (Either a)
fromPartial

instance Functor Partial where
  fmap :: (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 :: 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
. 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
. a -> Either a (Nu (Either a))
forall a b. a -> Either a b
Left
  Partial (a -> b)
ff <*> :: 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 k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Projectable c t f =>
Coalgebra c f t
project)
        ((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
. ((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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Partial a
fa ((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 b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ 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
. Nu (Either (a -> b)) -> Either (a -> b) (Nu (Either (a -> b)))
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Projectable c t f =>
Coalgebra c f t
project)

instance Monad Partial where
  Partial a
pa >>= :: 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 (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 k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Projectable c t f =>
Coalgebra c f t
project) ((Partial a -> Nu (Either a)
forall a. Partial a -> Nu (Either a)
fromPartial (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 b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ 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
. Nu (Either (Partial a))
-> Either (Partial a) (Nu (Either (Partial a)))
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Projectable c t f =>
Coalgebra c f t
project)

-- | Always-infinite streams (as opposed to `Colist`, which _may_ terminate).
type Stream a = Nu ((,) 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 :: (a -> b) -> t -> u
map a -> b
f = Algebra (->) (f a) u -> t -> u
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 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
. (a -> b) -> f a u -> f b u
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 :: (a -> b) -> t -> u
comap a -> b
f = Coalgebra (->) (f b) t -> t -> u
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 ((a -> b) -> f a t -> f b t
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
. t -> f a t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k).
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 :: (a -> m b) -> t -> m u
traverse a -> m b
f = Algebra (->) (f a) (m u) -> t -> m u
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 b u -> u) -> m (f b u) -> m u
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
. (a -> m b) -> (u -> m u) -> f a u -> m (f b u)
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 (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)
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 :: (a -> b) -> t -> u
contramap a -> b
f = Algebra (->) (f b) u -> t -> u
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) 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
. (a -> b) -> f b u -> f a u
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 :: (a -> b) -> t -> u
cocontramap a -> b
f = Coalgebra (->) (f a) t -> t -> u
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 ((a -> b) -> f b t -> f a t
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
. t -> f b t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Projectable c t f =>
Coalgebra c f t
project)