{-# LANGUAGE FlexibleContexts #-}
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
data HRecWitness h n where
HRecSelf :: HRecWitness h h
HRecSub :: HWitness h c -> HRecWitness c n -> HRecWitness h n
{-# 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 :: forall (m :: * -> *) (h :: HyperType) (w :: HyperType).
(Monad m, RTraversable h) =>
(forall (n :: HyperType). HRecWitness h n -> (n # w) -> m (w # n))
-> (Pure # h) -> m (w # h)
wrapM forall (n :: HyperType). HRecWitness h n -> (n # w) -> m (w # n)
f Pure # h
x =
Pure # h
x forall s a. s -> Getting a s a -> a
^. forall (h :: HyperType) (j :: HyperType).
Iso (Pure # h) (Pure # j) (h # Pure) (j # Pure)
_Pure
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) (h :: HyperType) (p :: HyperType)
(q :: HyperType).
(Applicative f, HTraversable h) =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> f (q # n))
-> (h # p) -> f (h # q)
htraverse (forall {k} (t :: k). Proxy t
Proxy @RTraversable forall (h :: HyperType) (c :: HyperType -> Constraint)
(n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => HWitness h n -> r) -> HWitness h n -> r
#*# \HWitness h n
w -> forall (m :: * -> *) (h :: HyperType) (w :: HyperType).
(Monad m, RTraversable h) =>
(forall (n :: HyperType). HRecWitness h n -> (n # w) -> m (w # n))
-> (Pure # h) -> m (w # h)
wrapM (forall (n :: HyperType). HRecWitness h n -> (n # w) -> m (w # n)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (c :: HyperType) (n :: HyperType).
HWitness h c -> HRecWitness c n -> HRecWitness h n
HRecSub HWitness h n
w))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (n :: HyperType). HRecWitness h n -> (n # w) -> m (w # n)
f forall (h :: HyperType). HRecWitness h h
HRecSelf
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (c :: HyperType -> Constraint) (h :: HyperType)
(proxy :: Constraint -> *).
(Recursive c, HNodes h, c h) =>
proxy (c h) -> Dict (HNodesConstraint h c)
recurse (forall {k} (t :: k). Proxy t
Proxy @(RTraversable h))
{-# 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 :: forall (m :: * -> *) (h :: HyperType) (w :: HyperType).
(Monad m, RTraversable h) =>
(forall (n :: HyperType). HRecWitness h n -> (w # n) -> m (n # w))
-> (w # h) -> m (Pure # h)
unwrapM forall (n :: HyperType). HRecWitness h n -> (w # n) -> m (n # w)
f w # h
x =
forall (n :: HyperType). HRecWitness h n -> (w # n) -> m (n # w)
f forall (h :: HyperType). HRecWitness h h
HRecSelf w # h
x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) (h :: HyperType) (p :: HyperType)
(q :: HyperType).
(Applicative f, HTraversable h) =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> f (q # n))
-> (h # p) -> f (h # q)
htraverse (forall {k} (t :: k). Proxy t
Proxy @RTraversable forall (h :: HyperType) (c :: HyperType -> Constraint)
(n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => HWitness h n -> r) -> HWitness h n -> r
#*# \HWitness h n
w -> forall (m :: * -> *) (h :: HyperType) (w :: HyperType).
(Monad m, RTraversable h) =>
(forall (n :: HyperType). HRecWitness h n -> (w # n) -> m (n # w))
-> (w # h) -> m (Pure # h)
unwrapM (forall (n :: HyperType). HRecWitness h n -> (w # n) -> m (n # w)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (c :: HyperType) (n :: HyperType).
HWitness h c -> HRecWitness c n -> HRecWitness h n
HRecSub HWitness h n
w))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall (h :: HyperType) (j :: HyperType).
Iso (Pure # h) (Pure # j) (h # Pure) (j # Pure)
_Pure forall t b. AReview t b -> b -> t
#)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (c :: HyperType -> Constraint) (h :: HyperType)
(proxy :: Constraint -> *).
(Recursive c, HNodes h, c h) =>
proxy (c h) -> Dict (HNodesConstraint h c)
recurse (forall {k} (t :: k). Proxy t
Proxy @(RTraversable h))
{-# INLINE wrap #-}
wrap ::
forall h w.
Recursively HFunctor h =>
(forall n. HRecWitness h n -> n # w -> w # n) ->
Pure # h ->
w # h
wrap :: forall (h :: HyperType) (w :: HyperType).
Recursively HFunctor h =>
(forall (n :: HyperType). HRecWitness h n -> (n # w) -> w # n)
-> (Pure # h) -> w # h
wrap forall (n :: HyperType). HRecWitness h n -> (n # w) -> w # n
f Pure # h
x =
Pure # h
x forall s a. s -> Getting a s a -> a
^. forall (h :: HyperType) (j :: HyperType).
Iso (Pure # h) (Pure # j) (h # Pure) (j # Pure)
_Pure
forall a b. a -> (a -> b) -> b
& forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap (forall {k} (t :: k). Proxy t
Proxy @(Recursively HFunctor) forall (h :: HyperType) (c :: HyperType -> Constraint)
(n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => HWitness h n -> r) -> HWitness h n -> r
#*# \HWitness h n
w -> forall (h :: HyperType) (w :: HyperType).
Recursively HFunctor h =>
(forall (n :: HyperType). HRecWitness h n -> (n # w) -> w # n)
-> (Pure # h) -> w # h
wrap (forall (n :: HyperType). HRecWitness h n -> (n # w) -> w # n
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (c :: HyperType) (n :: HyperType).
HWitness h c -> HRecWitness c n -> HRecWitness h n
HRecSub HWitness h n
w))
forall a b. a -> (a -> b) -> b
& forall (n :: HyperType). HRecWitness h n -> (n # w) -> w # n
f forall (h :: HyperType). HRecWitness h h
HRecSelf
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (c :: HyperType -> Constraint) (h :: HyperType)
(proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (forall {k} (t :: k). Proxy t
Proxy @(HFunctor h))
{-# INLINE unwrap #-}
unwrap ::
forall h w.
Recursively HFunctor h =>
(forall n. HRecWitness h n -> w # n -> n # w) ->
w # h ->
Pure # h
unwrap :: forall (h :: HyperType) (w :: HyperType).
Recursively HFunctor h =>
(forall (n :: HyperType). HRecWitness h n -> (w # n) -> n # w)
-> (w # h) -> Pure # h
unwrap forall (n :: HyperType). HRecWitness h n -> (w # n) -> n # w
f w # h
x =
forall (h :: HyperType) (j :: HyperType).
Iso (Pure # h) (Pure # j) (h # Pure) (j # Pure)
_Pure
# hmap
(Proxy @(Recursively HFunctor) #*# \w -> unwrap (f . HRecSub w))
(f HRecSelf x)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (c :: HyperType -> Constraint) (h :: HyperType)
(proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (forall {k} (t :: k). Proxy t
Proxy @(HFunctor h))
{-# INLINE fold #-}
fold ::
Recursively HFunctor h =>
(forall n. HRecWitness h n -> n # Const a -> a) ->
Pure # h ->
a
fold :: forall (h :: HyperType) a.
Recursively HFunctor h =>
(forall (n :: HyperType). HRecWitness h n -> (n # Const a) -> a)
-> (Pure # h) -> a
fold forall (n :: HyperType). HRecWitness h n -> (n # Const a) -> a
f = forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (w :: HyperType).
Recursively HFunctor h =>
(forall (n :: HyperType). HRecWitness h n -> (n # w) -> w # n)
-> (Pure # h) -> w # h
wrap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: HyperType). HRecWitness h n -> (n # Const a) -> a
f)
{-# INLINE unfold #-}
unfold ::
Recursively HFunctor h =>
(forall n. HRecWitness h n -> a -> n # Const a) ->
a ->
Pure # h
unfold :: forall (h :: HyperType) a.
Recursively HFunctor h =>
(forall (n :: HyperType). HRecWitness h n -> a -> n # Const a)
-> a -> Pure # h
unfold forall (n :: HyperType). HRecWitness h n -> a -> n # Const a
f = forall (h :: HyperType) (w :: HyperType).
Recursively HFunctor h =>
(forall (n :: HyperType). HRecWitness h n -> (w # n) -> n # w)
-> (w # h) -> Pure # h
unwrap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst) forall (n :: HyperType). HRecWitness h n -> a -> n # Const a
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). a -> Const a b
Const
{-# 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 :: forall (h :: HyperType) (p :: HyperType) a.
(Recursively HFoldable h, Recursively HFoldable p, Monoid a) =>
(forall (n :: HyperType) (q :: HyperType).
HRecWitness h n -> (n # q) -> a)
-> (h # p) -> a
foldMapRecursive forall (n :: HyperType) (q :: HyperType).
HRecWitness h n -> (n # q) -> a
f h # p
x =
forall (n :: HyperType) (q :: HyperType).
HRecWitness h n -> (n # q) -> a
f forall (h :: HyperType). HRecWitness h h
HRecSelf h # p
x
forall a. Semigroup a => a -> a -> a
<> forall (h :: HyperType) a (p :: HyperType).
(HFoldable h, Monoid a) =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> a)
-> (h # p) -> a
hfoldMap
( forall {k} (t :: k). Proxy t
Proxy @(Recursively HFoldable) forall (h :: HyperType) (c :: HyperType -> Constraint)
(n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => HWitness h n -> r) -> HWitness h n -> r
#*#
\HWitness h n
w ->
forall (h :: HyperType) a (p :: HyperType).
(HFoldable h, Monoid a) =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> a)
-> (h # p) -> a
hfoldMap (forall {k} (t :: k). Proxy t
Proxy @(Recursively HFoldable) forall (h :: HyperType) (c :: HyperType -> Constraint)
(n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => r) -> HWitness h n -> r
#> forall (h :: HyperType) (p :: HyperType) a.
(Recursively HFoldable h, Recursively HFoldable p, Monoid a) =>
(forall (n :: HyperType) (q :: HyperType).
HRecWitness h n -> (n # q) -> a)
-> (h # p) -> a
foldMapRecursive (forall (n :: HyperType) (q :: HyperType).
HRecWitness h n -> (n # q) -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (c :: HyperType) (n :: HyperType).
HWitness h c -> HRecWitness c n -> HRecWitness h n
HRecSub HWitness h n
w))
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (c :: HyperType -> Constraint) (h :: HyperType)
(proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (forall {k} (t :: k). Proxy t
Proxy @(HFoldable p))
)
h # p
x
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (c :: HyperType -> Constraint) (h :: HyperType)
(proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (forall {k} (t :: k). Proxy t
Proxy @(HFoldable h))
infixr 0 #>>
infixr 0 ##>>
infixr 0 #**#
{-# INLINE (#>>) #-}
(#>>) ::
forall c h n r.
(Recursive c, c h, RNodes h) =>
Proxy c ->
(c n => r) ->
HRecWitness h n ->
r
#>> :: forall (c :: HyperType -> Constraint) (h :: HyperType)
(n :: HyperType) r.
(Recursive c, c h, RNodes h) =>
Proxy c -> (c n => r) -> HRecWitness h n -> r
(#>>) Proxy c
_ c n => r
r HRecWitness h n
HRecSelf = c n => r
r
(#>>) Proxy c
p c n => r
r (HRecSub HWitness h c
w0 HRecWitness c n
w1) =
(forall {k} (t :: k). Proxy t
Proxy @RNodes forall (h :: HyperType) (c :: HyperType -> Constraint)
(n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => HWitness h n -> r) -> HWitness h n -> r
#*# Proxy c
p forall (h :: HyperType) (c :: HyperType -> Constraint)
(n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => r) -> HWitness h n -> r
#> (Proxy c
p forall (c :: HyperType -> Constraint) (h :: HyperType)
(n :: HyperType) r.
(Recursive c, c h, RNodes h) =>
Proxy c -> (c n => r) -> HRecWitness h n -> r
#>> c n => r
r) HRecWitness c n
w1) HWitness h c
w0
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (c :: HyperType -> Constraint) (h :: HyperType)
(proxy :: Constraint -> *).
(Recursive c, HNodes h, c h) =>
proxy (c h) -> Dict (HNodesConstraint h c)
recurse (forall {k} (t :: k). Proxy t
Proxy @(RNodes h))
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (c :: HyperType -> Constraint) (h :: HyperType)
(proxy :: Constraint -> *).
(Recursive c, HNodes h, c h) =>
proxy (c h) -> Dict (HNodesConstraint h c)
recurse (forall {k} (t :: k). Proxy t
Proxy @(c h))
{-# INLINE (##>>) #-}
(##>>) ::
forall c h n r.
Recursively c h =>
Proxy c ->
(c n => r) ->
HRecWitness h n ->
r
##>> :: forall (c :: HyperType -> Constraint) (h :: HyperType)
(n :: HyperType) r.
Recursively c h =>
Proxy c -> (c n => r) -> HRecWitness h n -> r
(##>>) Proxy c
p c n => r
r =
\case
HRecWitness h n
HRecSelf -> c n => r
r
HRecSub HWitness h c
w0 HRecWitness c n
w1 -> (forall {k} (t :: k). Proxy t
Proxy @(Recursively c) forall (h :: HyperType) (c :: HyperType -> Constraint)
(n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => r) -> HWitness h n -> r
#> (Proxy c
p forall (c :: HyperType -> Constraint) (h :: HyperType)
(n :: HyperType) r.
Recursively c h =>
Proxy c -> (c n => r) -> HRecWitness h n -> r
##>> c n => r
r) HRecWitness c n
w1) HWitness h c
w0
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (c :: HyperType -> Constraint) (h :: HyperType)
(proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (forall {k} (t :: k). Proxy t
Proxy @(c h))
{-# INLINE (#**#) #-}
(#**#) ::
(Recursive c, c h, RNodes h) =>
Proxy c ->
(c n => HRecWitness h n -> r) ->
HRecWitness h n ->
r
#**# :: forall (c :: HyperType -> Constraint) (h :: HyperType)
(n :: HyperType) r.
(Recursive c, c h, RNodes h) =>
Proxy c -> (c n => HRecWitness h n -> r) -> HRecWitness h n -> r
(#**#) Proxy c
p c n => HRecWitness h n -> r
r HRecWitness h n
w = (Proxy c
p forall (c :: HyperType -> Constraint) (h :: HyperType)
(n :: HyperType) r.
(Recursive c, c h, RNodes h) =>
Proxy c -> (c n => r) -> HRecWitness h n -> r
#>> c n => HRecWitness h n -> r
r) HRecWitness h n
w HRecWitness h n
w