content: {-# LANGUAGE FlexibleContexts #-}
  
  -- | Combinators for processing/constructing trees recursively
  module Hyper.Recurse
      ( module Hyper.Class.Recursive
      , fold
      , unfold
      , wrap
      , wrapM
      , unwrap
      , unwrapM
      , foldMapRecursive
      , HRecWitness (..)
      , (#>>)
      , (#**#)
      , (##>>)
      ) where
  
  import Hyper.Class.Foldable
  import Hyper.Class.Functor (HFunctor (..))
  import Hyper.Class.Nodes (HWitness, (#*#), (#>))
  import Hyper.Class.Recursive
  import Hyper.Class.Traversable
  import Hyper.Type
  import Hyper.Type.Pure (Pure (..), _Pure)
  
  import Hyper.Internal.Prelude
  
  -- | @HRecWitness h n@ is a witness that @n@ is a recursive node of @h@
  data HRecWitness h n where
      HRecSelf :: HRecWitness h h
      HRecSub :: HWitness h c -> HRecWitness c n -> HRecWitness h n
  
  -- | Monadically convert a 'Pure' to a different 'HyperType' from the bottom up
  {-# INLINE wrapM #-}
  wrapM ::
      forall m h w.
      (Monad m, RTraversable h) =>
      (forall n. HRecWitness h n -> n # w -> m (w # n)) ->
      Pure # h ->
      m (w # h)
  wrapM f x =
      x ^. _Pure
          & htraverse (Proxy @RTraversable #*# \w -> wrapM (f . HRecSub w))
          >>= f HRecSelf
          \\ recurse (Proxy @(RTraversable h))
  
  -- | Monadically unwrap a tree from the top down, replacing its 'HyperType' with 'Pure'
  {-# INLINE unwrapM #-}
  unwrapM ::
      forall m h w.
      (Monad m, RTraversable h) =>
      (forall n. HRecWitness h n -> w # n -> m (n # w)) ->
      w # h ->
      m (Pure # h)
  unwrapM f x =
      f HRecSelf x
          >>= htraverse (Proxy @RTraversable #*# \w -> unwrapM (f . HRecSub w))
          <&> (_Pure #)
          \\ recurse (Proxy @(RTraversable h))
  
  -- | Wrap a 'Pure' to a different 'HyperType' from the bottom up
  {-# INLINE wrap #-}
  wrap ::
      forall h w.
      Recursively HFunctor h =>
      (forall n. HRecWitness h n -> n # w -> w # n) ->
      Pure # h ->
      w # h
  wrap f x =
      x ^. _Pure
          & hmap (Proxy @(Recursively HFunctor) #*# \w -> wrap (f . HRecSub w))
          & f HRecSelf
          \\ recursively (Proxy @(HFunctor h))
  
  -- | Unwrap a tree from the top down, replacing its 'HyperType' with 'Pure'
  {-# INLINE unwrap #-}
  unwrap ::
      forall h w.
      Recursively HFunctor h =>
      (forall n. HRecWitness h n -> w # n -> n # w) ->
      w # h ->
      Pure # h
  unwrap f x =
      _Pure
          # hmap
              (Proxy @(Recursively HFunctor) #*# \w -> unwrap (f . HRecSub w))
              (f HRecSelf x)
          \\ recursively (Proxy @(HFunctor h))
  
  -- | Recursively fold up a tree to produce a result (aka catamorphism)
  {-# INLINE fold #-}
  fold ::
      Recursively HFunctor h =>
      (forall n. HRecWitness h n -> n # Const a -> a) ->
      Pure # h ->
      a
  fold f = getConst . wrap (fmap Const . f)
  
  -- | Build/load a tree from a seed value (aka anamorphism)
  {-# INLINE unfold #-}
  unfold ::
      Recursively HFunctor h =>
      (forall n. HRecWitness h n -> a -> n # Const a) ->
      a ->
      Pure # h
  unfold f = unwrap (fmap (. getConst) f) . Const
  
  -- | Fold over all of the recursive child nodes of a tree in pre-order
  {-# INLINE foldMapRecursive #-}
  foldMapRecursive ::
      forall h p a.
      (Recursively HFoldable h, Recursively HFoldable p, Monoid a) =>
      (forall n q. HRecWitness h n -> n # q -> a) ->
      h # p ->
      a
  foldMapRecursive f x =
      f HRecSelf x
          <> hfoldMap
              ( Proxy @(Recursively HFoldable) #*#
                  \w ->
                      hfoldMap (Proxy @(Recursively HFoldable) #> foldMapRecursive (f . HRecSub w))
                          \\ recursively (Proxy @(HFoldable p))
              )
              x
          \\ recursively (Proxy @(HFoldable h))
  
  infixr 0 #>>
  infixr 0 ##>>
  infixr 0 #**#
  
  -- | @Proxy @c #> r@ replaces a recursive witness parameter of @r@ with a constraint on the witnessed node
  {-# INLINE (#>>) #-}
  (#>>) ::
      forall c h n r.
      (Recursive c, c h, RNodes h) =>
      Proxy c ->
      (c n => r) ->
      HRecWitness h n ->
      r
  (#>>) _ r HRecSelf = r
  (#>>) p r (HRecSub w0 w1) =
      (Proxy @RNodes #*# p #> (p #>> r) w1) w0
          \\ recurse (Proxy @(RNodes h))
          \\ recurse (Proxy @(c h))
  
  -- | @Proxy @c #> r@ replaces a recursive witness parameter of @r@ with a @Recursively c@ constraint on the witnessed node
  {-# INLINE (##>>) #-}
  (##>>) ::
      forall c h n r.
      Recursively c h =>
      Proxy c ->
      (c n => r) ->
      HRecWitness h n ->
      r
  (##>>) p r =
      \case
          HRecSelf -> r
          HRecSub w0 w1 -> (Proxy @(Recursively c) #> (p ##>> r) w1) w0
          \\ recursively (Proxy @(c h))
  
  -- | A variant of '#>>' which does not consume the witness parameter.
  --
  -- @Proxy @c0 #**# Proxy @c1 #>> r@ brings into context both the @c0 n@ and @c1 n@ constraints.
  {-# INLINE (#**#) #-}
  (#**#) ::
      (Recursive c, c h, RNodes h) =>
      Proxy c ->
      (c n => HRecWitness h n -> r) ->
      HRecWitness h n ->
      r
  (#**#) p r w = (p #>> r) w w
  