{-# LANGUAGE CPP #-}
{-# 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,
    recursiveCompare,
    recursiveCompare',
    recursiveEq,
    recursiveEq',
    recursivePrism,
    recursiveShowsPrec,
    recursiveShowsPrec',
    seqEither,
    seqIdentity,
    steppableIso,
    steppableReadPrec,
    steppableReadPrec',
    unFree,
    zipAlgebraMs,
    zipAlgebras,
  )
where

import "base" Control.Applicative (Applicative (pure), (*>))
import "base" Control.Category (Category ((.)))
import "base" Control.Monad (Monad, join, (<=<), (=<<))
import "base" Data.Bifunctor (Bifunctor (bimap, first, second))
import "base" Data.Bitraversable (bisequence)
import "base" Data.Bool (Bool)
import "base" Data.Eq (Eq ((==)))
import "base" Data.Foldable (Foldable (toList))
import "base" Data.Function (const, flip, ($))
import "base" Data.Functor (Functor (fmap), (<$>))
import "base" Data.Functor.Classes
  ( Eq1 (liftEq),
    Ord1 (liftCompare),
    Read1 (liftReadPrec),
    Show1,
  )
import "base" Data.Int (Int)
import "base" Data.List.NonEmpty (NonEmpty ((:|)))
import "base" Data.Ord (Ord (compare, (<=)), Ordering)
import "base" Data.String (String)
import "base" Data.Traversable (sequenceA)
import "base" Data.Void (Void, absurd)
import "base" GHC.Read (expectP, list)
import "base" GHC.Show (appPrec1)
import "base" Numeric.Natural (Natural)
import "base" Text.Read
  ( Read (readListPrec, readPrec),
    ReadPrec,
    parens,
    prec,
    readListPrecDefault,
    step,
  )
import qualified "base" Text.Read.Lex as Lex
import "base" Text.Show (Show (showsPrec), ShowS, showParen, showString)
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
  ( compareDay,
    diagonal,
    equalDay,
    fromEither,
    showsPrecF,
  )
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))

-- $setup
-- >>> :seti -XTypeApplications

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

-- | Like `recursiveEq`, but allows you to provide a custom comparator for @f@.
--
--   @since 0.6.1.0
recursiveEq' ::
  (Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f) =>
  (f () -> f () -> Bool) ->
  t ->
  u ->
  Bool
recursiveEq' :: forall t (f :: * -> *) u.
(Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f) =>
(f () -> f () -> Bool) -> 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 -> t -> u -> Bool)
-> ((f () -> f () -> Bool) -> Algebra (->) (Day f f) Bool)
-> (f () -> f () -> Bool)
-> t
-> u
-> Bool
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 () -> Bool) -> Algebra (->) (Day f f) Bool
forall (f :: * -> *).
(Functor f, Foldable f) =>
(f () -> f () -> Bool) -> Day f f Bool -> Bool
equalDay

-- | An implementation of `==` for any `Recursive` instance. Note that this is
--   actually more general than `Eq`’s `==`, as it can compare between different
--   fixed-point representations of the same functor.
--
--  __NB__: Use `recursiveEq'` if you need to use a custom comparator for @f@.
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 = (f () -> f () -> Bool) -> t -> u -> Bool
forall t (f :: * -> *) u.
(Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f) =>
(f () -> f () -> Bool) -> t -> u -> Bool
recursiveEq' ((f () -> f () -> Bool) -> t -> u -> Bool)
-> (f () -> f () -> Bool) -> t -> u -> Bool
forall a b. (a -> b) -> a -> b
$ (() -> () -> Bool) -> f () -> f () -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq () -> () -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Like `recursiveCompare`, but allows you to provide a custom comparator for
--   @f@.
--
--   @since 0.6.1.0
recursiveCompare' ::
  (Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f) =>
  (f () -> f () -> Ordering) ->
  t ->
  u ->
  Ordering
recursiveCompare' :: forall t (f :: * -> *) u.
(Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f) =>
(f () -> f () -> Ordering) -> t -> u -> Ordering
recursiveCompare' = Algebra (->) (Day f f) Ordering -> t -> u -> Ordering
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) Ordering -> t -> u -> Ordering)
-> ((f () -> f () -> Ordering) -> Algebra (->) (Day f f) Ordering)
-> (f () -> f () -> Ordering)
-> t
-> u
-> Ordering
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 () -> Ordering) -> Algebra (->) (Day f f) Ordering
forall (f :: * -> *).
(Functor f, Foldable f) =>
(f () -> f () -> Ordering) -> Day f f Ordering -> Ordering
compareDay

-- | An implementation of `==` for any `Recursive` instance. Note that this is
--   actually more general than `Ord`’s `compare`, as it can compare between
--   different fixed-point representations of the same functor.
--
--  __NB__: Use `recursiveCompare'` if you need to use a custom comparator for
--          @f@.
--
--   @since 0.6.1.0
recursiveCompare ::
  (Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f, Ord1 f) =>
  t ->
  u ->
  Ordering
recursiveCompare :: forall t (f :: * -> *) u.
(Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f,
 Ord1 f) =>
t -> u -> Ordering
recursiveCompare = (f () -> f () -> Ordering) -> t -> u -> Ordering
forall t (f :: * -> *) u.
(Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f) =>
(f () -> f () -> Ordering) -> t -> u -> Ordering
recursiveCompare' ((f () -> f () -> Ordering) -> t -> u -> Ordering)
-> (f () -> f () -> Ordering) -> t -> u -> Ordering
forall a b. (a -> b) -> a -> b
$ (() -> () -> Ordering) -> f () -> f () -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare () -> () -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

embedOperation :: String
embedOperation :: String
embedOperation = String
"embed"

-- | Like `recursiveShowsPrec`, but allows you to provide a custom display
--   function for @f@.
--
--   @since 0.6.1.0
recursiveShowsPrec' ::
  (Recursive (->) t f) => Algebra (->) f (Int -> ShowS) -> Int -> t -> ShowS
recursiveShowsPrec' :: forall t (f :: * -> *).
Recursive (->) t f =>
Algebra (->) f (Int -> ShowS) -> Int -> t -> ShowS
recursiveShowsPrec' Algebra (->) f (Int -> ShowS)
showsFPrec = (t -> Int -> ShowS) -> Int -> t -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((t -> Int -> ShowS) -> Int -> t -> ShowS)
-> (Algebra (->) f (Int -> ShowS) -> t -> Int -> ShowS)
-> Algebra (->) f (Int -> ShowS)
-> Int
-> t
-> 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
. Algebra (->) f (Int -> ShowS) -> t -> Int -> 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 (Algebra (->) f (Int -> ShowS) -> Int -> t -> ShowS)
-> Algebra (->) f (Int -> ShowS) -> Int -> t -> ShowS
forall a b. (a -> b) -> a -> b
$
  \f (Int -> ShowS)
f Int
p ->
    Bool -> ShowS -> ShowS
showParen (Int
appPrec1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
p) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
embedOperation ShowS -> ShowS -> 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
. String -> ShowS
showString String
" " ShowS -> ShowS -> 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
. Algebra (->) f (Int -> ShowS)
showsFPrec f (Int -> ShowS)
f Int
appPrec1

-- | An implementation of `showsPrec` for any `Recursive` instance.
#if MIN_VERSION_GLASGOW_HASKELL(8, 8, 0, 0) \
    && !MIN_VERSION_GLASGOW_HASKELL(8, 10, 0, 0)
--
--  __FIXME__: There should be doctests here, but `doctest` crashes with these
--             tests in the very specific case of GHC 8.8.4 from Nixpkgs 23.11.
--             So, either figure out how to get them working there, or wait
--             until we no longer support that combination.
#else
--
-- >>> :{
--   recursiveShowsPrec
--     @(Mu (XNor String))
--     10
--     (embed (Both "a" (embed (Both "b" (embed Neither)))))
--     ""
-- :}
-- "embed (Both \"a\" (embed (Both \"b\" (embed Neither))))"
--
-- >>> :{
--   recursiveShowsPrec
--     @(Mu (XNor String))
--     11
--     (embed (Both "a" (embed (Both "b" (embed Neither)))))
--     ""
-- :}
-- "(embed (Both \"a\" (embed (Both \"b\" (embed Neither)))))"
#endif
--
--  __NB__: Use `recursiveShowsPrec'` if you need to use a custom serialization
--          function for @f@.
--
--  __NB__: This only requires `Recursive`, but the inverse operation is
--         `steppableReadPrec`, which requires `Steppable` instead.
recursiveShowsPrec :: (Recursive (->) t f, Show1 f) => Int -> t -> ShowS
recursiveShowsPrec :: forall t (f :: * -> *).
(Recursive (->) t f, Show1 f) =>
Int -> t -> ShowS
recursiveShowsPrec = Algebra (->) f (Int -> ShowS) -> Int -> t -> ShowS
forall t (f :: * -> *).
Recursive (->) t f =>
Algebra (->) f (Int -> ShowS) -> Int -> t -> ShowS
recursiveShowsPrec' (Algebra (->) f (Int -> ShowS) -> Int -> t -> ShowS)
-> Algebra (->) f (Int -> ShowS) -> Int -> t -> ShowS
forall a b. (a -> b) -> a -> b
$ (Int -> f (Int -> ShowS) -> ShowS) -> Algebra (->) f (Int -> ShowS)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> f (Int -> ShowS) -> ShowS
forall (f :: * -> *). Show1 f => Int -> f (Int -> ShowS) -> ShowS
showsPrecF

-- | Like `steppableReadPrec`, but allows you to provide a custom display
--   function for @f@.
--
--   @since 0.6.1.0
steppableReadPrec' ::
  (Steppable (->) t f) =>
  (ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)) ->
  ReadPrec t
steppableReadPrec' :: forall t (f :: * -> *).
Steppable (->) t f =>
(ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)) -> ReadPrec t
steppableReadPrec' ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)
readFPrec =
  let appPrec :: a
appPrec = a
10
   in ReadPrec t -> ReadPrec t
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec t -> ReadPrec t)
-> (ReadPrec (f t) -> ReadPrec t) -> ReadPrec (f t) -> ReadPrec 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
. Int -> ReadPrec t -> ReadPrec t
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
forall {a}. Num a => a
appPrec (ReadPrec t -> ReadPrec t)
-> (ReadPrec (f t) -> ReadPrec t) -> ReadPrec (f t) -> ReadPrec 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
. (f t -> t) -> ReadPrec (f t) -> ReadPrec t
forall a b. (a -> b) -> ReadPrec a -> ReadPrec 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 (ReadPrec (f t) -> ReadPrec t) -> ReadPrec (f t) -> ReadPrec t
forall a b. (a -> b) -> a -> b
$
        Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Lex.Ident String
embedOperation)
          ReadPrec () -> ReadPrec (f t) -> ReadPrec (f t)
forall a b. ReadPrec a -> ReadPrec b -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadPrec (f t) -> ReadPrec (f t)
forall a. ReadPrec a -> ReadPrec a
step
            ( ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)
readFPrec ((ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)) -> ReadPrec t
forall t (f :: * -> *).
Steppable (->) t f =>
(ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)) -> ReadPrec t
steppableReadPrec' ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)
readFPrec) (ReadPrec [t] -> ReadPrec (f t))
-> (ReadPrec t -> ReadPrec [t]) -> ReadPrec t -> ReadPrec (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
. ReadPrec t -> ReadPrec [t]
forall a. ReadPrec a -> ReadPrec [a]
list (ReadPrec t -> ReadPrec (f t)) -> ReadPrec t -> ReadPrec (f t)
forall a b. (a -> b) -> a -> b
$
                (ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)) -> ReadPrec t
forall t (f :: * -> *).
Steppable (->) t f =>
(ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)) -> ReadPrec t
steppableReadPrec' ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)
readFPrec
            )

-- | An implementation of `readPrec` for any `Steppable` instance.
--
--  __NB__: Use `steppableReadPrec'` if you need to use a custom parsing
--          function  for @f@.
--
--  __NB__: This only requires `Steppable`, but the inverse operation is
--         `recursiveShowsPrec`, which requires `Recursive` instead.
--
--   @since 0.6.1.0
steppableReadPrec :: (Steppable (->) t f, Read1 f) => ReadPrec t
steppableReadPrec :: forall t (f :: * -> *). (Steppable (->) t f, Read1 f) => ReadPrec t
steppableReadPrec = (ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)) -> ReadPrec t
forall t (f :: * -> *).
Steppable (->) t f =>
(ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)) -> ReadPrec t
steppableReadPrec' ReadPrec t -> ReadPrec [t] -> ReadPrec (f t)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec

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

-- | @since 0.6.1.0
instance (Functor f, Foldable f, Ord1 f) => Ord (Mu f) where
  compare :: Mu f -> Mu f -> Ordering
compare = Mu f -> Mu f -> Ordering
forall t (f :: * -> *) u.
(Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f,
 Ord1 f) =>
t -> u -> Ordering
recursiveCompare

-- | @since 0.6.1.0
instance (Functor f, Read1 f) => Read (Mu f) where
  readPrec :: ReadPrec (Mu f)
readPrec = ReadPrec (Mu f)
forall t (f :: * -> *). (Steppable (->) t f, Read1 f) => ReadPrec t
steppableReadPrec
  readListPrec :: ReadPrec [Mu f]
readListPrec = ReadPrec [Mu f]
forall a. Read a => ReadPrec [a]
readListPrecDefault

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

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

-- | @since 0.6.1.0
instance (Functor f, Read1 f) => Read (Nu f) where
  readPrec :: ReadPrec (Nu f)
readPrec = ReadPrec (Nu f)
forall t (f :: * -> *). (Steppable (->) t f, Read1 f) => ReadPrec t
steppableReadPrec
  readListPrec :: ReadPrec [Nu f]
readListPrec = ReadPrec [Nu f]
forall a. Read a => ReadPrec [a]
readListPrecDefault

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)