content: {-# 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' = cata2 . 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 = recursiveEq' $ liftEq (==)
  
  -- | 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' = cata2 . 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 = recursiveCompare' $ liftCompare compare
  
  embedOperation :: String
  embedOperation = "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' showsFPrec = flip . cata $
    \f p ->
      showParen (appPrec1 <= p) $
        showString embedOperation . showString " " . showsFPrec f 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 = recursiveShowsPrec' $ flip 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' readFPrec =
    let appPrec = 10
     in parens . prec appPrec . fmap embed $
          expectP (Lex.Ident embedOperation)
            *> step
              ( readFPrec (steppableReadPrec' readFPrec) . list $
                  steppableReadPrec' 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 = steppableReadPrec' 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 = lambek
  
  instance (Functor f) => Steppable (->) (Mu f) f where
    embed m = Mu (\f -> f (fmap (cata f) m))
  
  instance Recursive (->) (Mu f) f where
    cata φ (Mu f) = f φ
  
  instance DFunctor Mu where
    dmap f (Mu run) = Mu (\φ -> run (φ . f))
  
  instance (Functor f, Foldable f, Eq1 f) => Eq (Mu f) where
    (==) = recursiveEq
  
  -- | @since 0.6.1.0
  instance (Functor f, Foldable f, Ord1 f) => Ord (Mu f) where
    compare = recursiveCompare
  
  -- | @since 0.6.1.0
  instance (Functor f, Read1 f) => Read (Mu f) where
    readPrec = steppableReadPrec
    readListPrec = readListPrecDefault
  
  instance (Show1 f) => Show (Mu f) where
    showsPrec = 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 (Nu f a) = Nu f <$> f a
  
  instance (Functor f) => Steppable (->) (Nu f) f where
    embed = colambek
  
  instance Corecursive (->) (Nu f) f where
    ana = Nu
  
  instance DFunctor Nu where
    dmap f (Nu φ a) = Nu (f . φ) a
  
  -- | @since 0.6.1.0
  instance (Functor f, Read1 f) => Read (Nu f) where
    readPrec = steppableReadPrec
    readListPrec = readListPrecDefault
  
  instance Projectable (->) [a] (XNor a) where
    project [] = Neither
    project (h : t) = Both h t
  
  instance Steppable (->) [a] (XNor a) where
    embed Neither = []
    embed (Both h t) = h : t
  
  instance Projectable (->) (NonEmpty a) (AndMaybe a) where
    project (a :| []) = Only a
    project (a :| b : bs) = Indeed a (b :| bs)
  
  instance Steppable (->) (NonEmpty a) (AndMaybe a) where
    embed (Only a) = a :| []
    embed (Indeed a b) = a :| toList b
  
  instance Projectable (->) Natural Maybe where
    project 0 = Nothing
    project n = Just (pred n)
  
  instance Steppable (->) Natural Maybe where
    embed = maybe 0 succ
  
  instance Projectable (->) Void Identity where
    project = Identity
  
  instance Steppable (->) Void Identity where
    embed = runIdentity
  
  instance Recursive (->) Void Identity where
    cata _ = absurd
  
  instance Projectable (->) (Cofree f a) (EnvT a f) where
    project (a :< ft) = EnvT a ft
  
  instance Steppable (->) (Cofree f a) (EnvT a f) where
    embed (EnvT a ft) = a :< ft
  
  instance Projectable (->) (Free f a) (FreeF f a) where
    project = runFree
  
  instance Steppable (->) (Free f a) (FreeF f a) where
    embed = 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 f g = bimap (f . fmap fst) (g . fmap snd) . 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 f g = bisequence . bimap (f . fmap fst) (g . fmap snd) . 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 φ fta t = φ (Day fta (project t) ($))
  
  -- | 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 = cata . 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 k φ = fmap φ . k . fmap 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 k φ = traverse φ . k . fmap 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 k ψ = fmap join . k . fmap ψ
  
  -- | 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 k ψ = fmap (fmap join . k) . traverse ψ
  
  gcata ::
    (Recursive (->) t f, Functor f, Comonad w) =>
    DistributiveLaw (->) f w ->
    GAlgebra (->) w f a ->
    t ->
    a
  gcata k φ = extract . cata (lowerAlgebra k φ)
  
  elgotCata ::
    (Recursive (->) t f, Functor f, Comonad w) =>
    DistributiveLaw (->) f w ->
    ElgotAlgebra (->) w f a ->
    t ->
    a
  elgotCata k φ = φ . cata (k . fmap (extend φ))
  
  gcataM ::
    (Monad m, Recursive (->) t f, Traversable f, Comonad w, Traversable w) =>
    DistributiveLaw (->) f w ->
    GAlgebraM (->) m w f a ->
    t ->
    m a
  gcataM w φ = fmap extract . cata (lowerAlgebraM w φ <=< 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 w φ =
    φ <=< cata (fmap w . traverse (sequenceA . extend φ) <=< sequenceA)
  
  ezygoM ::
    (Monad m, Recursive (->) t f, Traversable f) =>
    AlgebraM (->) m f b ->
    ElgotAlgebraM (->) m (Pair b) f a ->
    t ->
    m a
  ezygoM φ' φ =
    fmap snd
      . cata
        ( (\x@(b :!: _) -> (b :!:) <$> φ x)
            <=< bisequence . bimap (φ' . fmap fst) (pure . fmap snd) . diagonal
            <=< sequenceA
        )
  
  gana ::
    (Corecursive (->) t f, Functor f, Monad m) =>
    DistributiveLaw (->) m f ->
    GCoalgebra (->) m f a ->
    a ->
    t
  gana k ψ = ana (lowerCoalgebra k ψ) . pure
  
  elgotAna ::
    (Corecursive (->) t f, Functor f, Monad m) =>
    DistributiveLaw (->) m f ->
    ElgotCoalgebra (->) m f a ->
    a ->
    t
  elgotAna k ψ = ana (fmap (ψ =<<) . k) . ψ
  
  lambek ::
    (Steppable (->) t f, Recursive (->) t f, Functor f) => Coalgebra (->) f t
  lambek = cata (fmap embed)
  
  colambek ::
    (Projectable (->) t f, Corecursive (->) t f, Functor f) => Algebra (->) f t
  colambek = ana (fmap 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 = Identity . fmap runIdentity
  
  -- | A less-constrained `sequenceA` for `Identity`.
  seqIdentity :: (Functor f) => DistributiveLaw (->) Identity f
  seqIdentity = fmap Identity . runIdentity
  
  distTuple :: (Functor f) => Algebra (->) f a -> DistributiveLaw (->) f (Pair a)
  distTuple φ = bimap (φ . fmap fst) (fmap snd) . diagonal
  
  distEnvT ::
    (Functor f) =>
    Algebra (->) f a ->
    DistributiveLaw (->) f w ->
    DistributiveLaw (->) f (EnvT a w)
  distEnvT φ k =
    uncurry EnvT . bimap (φ . fmap ask) (k . fmap lowerEnvT) . diagonal
  
  seqEither ::
    (Functor f) => Coalgebra (->) f a -> DistributiveLaw (->) (Either a) f
  seqEither ψ = fromEither . bimap (fmap Left . ψ) (fmap 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 φ ft =
    embed $ EnvT (φ (fmap (fst . toStrict . runEnvT . project) ft)) 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 ψ = uncurry EnvT . second ψ . 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 φ = φ . 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 = \case
    Pure t -> t
    Free ft -> embed 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 = getConst
  
  constProject :: Coalgebra (->) (Const a) a
  constProject = Const
  
  constCata :: Algebra (->) (Const b) a -> b -> a
  constCata φ = φ . Const
  
  constAna :: Coalgebra (->) (Const b) a -> a -> b
  constAna ψ = getConst . ψ
  
  instance Projectable (->) (Either a b) (Const (Either a b)) where
    project = constProject
  
  instance Steppable (->) (Either a b) (Const (Either a b)) where
    embed = constEmbed
  
  instance Recursive (->) (Either a b) (Const (Either a b)) where
    cata = constCata
  
  instance Corecursive (->) (Either a b) (Const (Either a b)) where
    ana = constAna
  
  instance Projectable (->) (Maybe a) (Const (Maybe a)) where
    project = constProject
  
  instance Steppable (->) (Maybe a) (Const (Maybe a)) where
    embed = constEmbed
  
  instance Recursive (->) (Maybe a) (Const (Maybe a)) where
    cata = constCata
  
  instance Corecursive (->) (Maybe a) (Const (Maybe a)) where
    ana = 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 = iso embed project
  
  birecursiveIso ::
    (Recursive (->) t f, Corecursive (->) t f) =>
    BialgebraIso f a ->
    Iso' t a
  birecursiveIso alg = iso (cata (view alg)) (ana (review alg))
  
  recursivePrism ::
    (Recursive (->) t f, Corecursive (->) t f, Traversable f) =>
    AlgebraPrism f a ->
    Prism' t a
  recursivePrism alg =
    prism
      (ana (review alg))
      (\t -> first (const t) $ cata (matching alg <=< sequenceA) t)
  