{-# LANGUAGE FlexibleContexts #-}

-- | A variant of 'Foldable' for 'Hyper.Type.HyperType's
module Hyper.Class.Foldable
    ( HFoldable (..)
    , hfolded1
    , htraverse_
    , htraverse1_
    ) where

import Control.Lens (Fold, folding)
import GHC.Generics
import Hyper.Class.Nodes (HNodes (..), HWitness (..), (#>), _HWitness)
import Hyper.Type (type (#))

import Hyper.Internal.Prelude

-- | A variant of 'Foldable' for 'Hyper.Type.HyperType's
class HNodes h => HFoldable h where
    -- | 'HFoldable' variant of 'foldMap'
    --
    -- Gets a function from @h@'s nodes (trees along witnesses that they are nodes of @h@)
    -- into a monoid and concats its results for all nodes.
    hfoldMap ::
        Monoid a =>
        (forall n. HWitness h n -> p # n -> a) ->
        h # p ->
        a
    {-# INLINE hfoldMap #-}
    default hfoldMap ::
        ( Generic1 h
        , HFoldable (Rep1 h)
        , HWitnessType h ~ HWitnessType (Rep1 h)
        , Monoid a
        ) =>
        (forall n. HWitness h n -> p # n -> a) ->
        h # p ->
        a
    hfoldMap forall (n :: HyperType). HWitness h n -> (p # n) -> a
f = forall (h :: HyperType) a (p :: HyperType).
(HFoldable h, Monoid a) =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> a)
-> (h # p) -> a
hfoldMap (forall (n :: HyperType). HWitness h n -> (p # n) -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (h1 :: HyperType) (n1 :: HyperType) (h2 :: HyperType)
       (n2 :: HyperType).
Iso
  (HWitness h1 n1)
  (HWitness h2 n2)
  (HWitnessType h1 n1)
  (HWitnessType h2 n2)
_HWitness forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. a -> a
id)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1

instance HFoldable (Const a) where
    {-# INLINE hfoldMap #-}
    hfoldMap :: forall a (p :: HyperType).
Monoid a =>
(forall (n :: HyperType). HWitness (Const a) n -> (p # n) -> a)
-> (Const a # p) -> a
hfoldMap forall (n :: HyperType). HWitness (Const a) n -> (p # n) -> a
_ = forall a. Monoid a => a
mempty

instance (HFoldable a, HFoldable b) => HFoldable (a :*: b) where
    {-# INLINE hfoldMap #-}
    hfoldMap :: forall a (p :: HyperType).
Monoid a =>
(forall (n :: HyperType). HWitness (a :*: b) n -> (p # n) -> a)
-> ((a :*: b) # p) -> a
hfoldMap forall (n :: HyperType). HWitness (a :*: b) n -> (p # n) -> a
f (a ('AHyperType p)
x :*: b ('AHyperType p)
y) =
        forall (h :: HyperType) a (p :: HyperType).
(HFoldable h, Monoid a) =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> a)
-> (h # p) -> a
hfoldMap (forall (n :: HyperType). HWitness (a :*: b) n -> (p # n) -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (n :: HyperType).
HWitnessType h n -> HWitness h n
HWitness forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1) a ('AHyperType 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 (n :: HyperType). HWitness (a :*: b) n -> (p # n) -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (n :: HyperType).
HWitnessType h n -> HWitness h n
HWitness forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1) b ('AHyperType p)
y

instance (HFoldable a, HFoldable b) => HFoldable (a :+: b) where
    {-# INLINE hfoldMap #-}
    hfoldMap :: forall a (p :: HyperType).
Monoid a =>
(forall (n :: HyperType). HWitness (a :+: b) n -> (p # n) -> a)
-> ((a :+: b) # p) -> a
hfoldMap forall (n :: HyperType). HWitness (a :+: b) n -> (p # n) -> a
f (L1 a ('AHyperType p)
x) = forall (h :: HyperType) a (p :: HyperType).
(HFoldable h, Monoid a) =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> a)
-> (h # p) -> a
hfoldMap (forall (n :: HyperType). HWitness (a :+: b) n -> (p # n) -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (n :: HyperType).
HWitnessType h n -> HWitness h n
HWitness forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1) a ('AHyperType p)
x
    hfoldMap forall (n :: HyperType). HWitness (a :+: b) n -> (p # n) -> a
f (R1 b ('AHyperType p)
x) = forall (h :: HyperType) a (p :: HyperType).
(HFoldable h, Monoid a) =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> a)
-> (h # p) -> a
hfoldMap (forall (n :: HyperType). HWitness (a :+: b) n -> (p # n) -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (n :: HyperType).
HWitnessType h n -> HWitness h n
HWitness forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1) b ('AHyperType p)
x

deriving newtype instance HFoldable h => HFoldable (M1 i m h)
deriving newtype instance HFoldable h => HFoldable (Rec1 h)

-- | 'HFoldable' variant for 'Control.Lens.folded' for 'Hyper.Type.HyperType's with a single node type.
--
-- Avoids using @RankNTypes@ and thus can be composed with other optics.
{-# INLINE hfolded1 #-}
hfolded1 ::
    forall h n p.
    ( HFoldable h
    , HNodesConstraint h ((~) n)
    ) =>
    Fold (h # p) (p # n)
hfolded1 :: forall (h :: HyperType) (n :: HyperType) (p :: HyperType).
(HFoldable h, HNodesConstraint h ((~) n)) =>
Fold (h # p) (p # n)
hfolded1 =
    forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding (forall (h :: HyperType) a (p :: HyperType).
(HFoldable h, Monoid a) =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> a)
-> (h # p) -> a
hfoldMap @_ @[p # n] (forall {k} (t :: k). Proxy t
Proxy @((~) n) forall (h :: HyperType) (c :: HyperType -> Constraint)
       (n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => r) -> HWitness h n -> r
#> forall (f :: * -> *) a. Applicative f => a -> f a
pure))

-- | 'HFoldable' variant of 'Data.Foldable.traverse_'
--
-- Applise a given action on all subtrees
-- (represented as trees along witnesses that they are nodes of @h@)
{-# INLINE htraverse_ #-}
htraverse_ ::
    (Applicative f, HFoldable h) =>
    (forall c. HWitness h c -> m # c -> f ()) ->
    h # m ->
    f ()
htraverse_ :: forall (f :: * -> *) (h :: HyperType) (m :: HyperType).
(Applicative f, HFoldable h) =>
(forall (c :: HyperType). HWitness h c -> (m # c) -> f ())
-> (h # m) -> f ()
htraverse_ forall (c :: HyperType). HWitness h c -> (m # c) -> f ()
f = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) a (p :: HyperType).
(HFoldable h, Monoid a) =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> a)
-> (h # p) -> a
hfoldMap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: HyperType). HWitness h c -> (m # c) -> f ()
f)

-- | 'HFoldable' variant of 'Data.Foldable.traverse_' for 'Hyper.Type.HyperType's with a single node type (avoids using @RankNTypes@)
{-# INLINE htraverse1_ #-}
htraverse1_ ::
    forall f h n p.
    ( Applicative f
    , HFoldable h
    , HNodesConstraint h ((~) n)
    ) =>
    (p # n -> f ()) ->
    h # p ->
    f ()
htraverse1_ :: forall (f :: * -> *) (h :: HyperType) (n :: HyperType)
       (p :: HyperType).
(Applicative f, HFoldable h, HNodesConstraint h ((~) n)) =>
((p # n) -> f ()) -> (h # p) -> f ()
htraverse1_ (p # n) -> f ()
f = forall (f :: * -> *) (h :: HyperType) (m :: HyperType).
(Applicative f, HFoldable h) =>
(forall (c :: HyperType). HWitness h c -> (m # c) -> f ())
-> (h # m) -> f ()
htraverse_ (forall {k} (t :: k). Proxy t
Proxy @((~) n) forall (h :: HyperType) (c :: HyperType -> Constraint)
       (n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => r) -> HWitness h n -> r
#> (p # n) -> f ()
f)