{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
module Generic.Data.Function.FoldMap.Sum where
import GHC.Generics
import Generic.Data.Function.Common.Generic ( conName', absurdV1 )
import Generic.Data.Function.FoldMap.Constructor
( GFoldMapC(gFoldMapC)
, GenericFoldMap(type GenericFoldMapM) )
class GFoldMapSum tag gf where
gFoldMapSum
:: (String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag
instance GFoldMapSum tag gf => GFoldMapSum tag (D1 c gf) where
gFoldMapSum :: forall (p :: k).
(String -> GenericFoldMapM tag) -> D1 c gf p -> GenericFoldMapM tag
gFoldMapSum String -> GenericFoldMapM tag
f = forall (tag :: k) (gf :: k -> Type) (p :: k).
GFoldMapSum tag gf =>
(String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GFoldMapSum tag gf =>
(String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag
gFoldMapSum @tag String -> GenericFoldMapM tag
f (gf p -> GenericFoldMapM tag)
-> (D1 c gf p -> gf p) -> D1 c gf p -> GenericFoldMapM tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D1 c gf p -> gf p
forall k i (c :: Meta) (f :: k -> Type) (p :: k). M1 i c f p -> f p
unM1
instance GFoldMapCSum tag (l :+: r) => GFoldMapSum tag (l :+: r) where
gFoldMapSum :: forall (p :: k).
(String -> GenericFoldMapM tag)
-> (:+:) l r p -> GenericFoldMapM tag
gFoldMapSum = forall (tag :: k) (gf :: k -> Type) (p :: k).
GFoldMapCSum tag gf =>
(String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GFoldMapCSum tag gf =>
(String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag
gFoldMapCSum @tag
instance GFoldMapCSum tag (C1 c gf) => GFoldMapSum tag (C1 c gf) where
gFoldMapSum :: forall (p :: k).
(String -> GenericFoldMapM tag) -> C1 c gf p -> GenericFoldMapM tag
gFoldMapSum = forall (tag :: k) (gf :: k -> Type) (p :: k).
GFoldMapCSum tag gf =>
(String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GFoldMapCSum tag gf =>
(String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag
gFoldMapCSum @tag
instance GFoldMapSum tag V1 where
gFoldMapSum :: forall (p :: k).
(String -> GenericFoldMapM tag) -> V1 p -> GenericFoldMapM tag
gFoldMapSum String -> GenericFoldMapM tag
_ = V1 p -> GenericFoldMapM tag
forall {k} (x :: k) a. V1 x -> a
absurdV1
class GFoldMapCSum tag gf where
gFoldMapCSum
:: (String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag
instance (GFoldMapCSum tag l, GFoldMapCSum tag r)
=> GFoldMapCSum tag (l :+: r) where
gFoldMapCSum :: forall (p :: k).
(String -> GenericFoldMapM tag)
-> (:+:) l r p -> GenericFoldMapM tag
gFoldMapCSum String -> GenericFoldMapM tag
f = \case L1 l p
l -> forall (tag :: k) (gf :: k -> Type) (p :: k).
GFoldMapCSum tag gf =>
(String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GFoldMapCSum tag gf =>
(String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag
gFoldMapCSum @tag String -> GenericFoldMapM tag
f l p
l
R1 r p
r -> forall (tag :: k) (gf :: k -> Type) (p :: k).
GFoldMapCSum tag gf =>
(String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GFoldMapCSum tag gf =>
(String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag
gFoldMapCSum @tag String -> GenericFoldMapM tag
f r p
r
instance (Semigroup (GenericFoldMapM tag), Constructor c, GFoldMapC tag gf)
=> GFoldMapCSum tag (C1 c gf) where
gFoldMapCSum :: forall (p :: k).
(String -> GenericFoldMapM tag) -> C1 c gf p -> GenericFoldMapM tag
gFoldMapCSum String -> GenericFoldMapM tag
mapCstr (M1 gf p
a) = String -> GenericFoldMapM tag
mapCstr (forall {k} (c :: k). Constructor c => String
forall (c :: Meta). Constructor c => String
conName' @c) GenericFoldMapM tag -> GenericFoldMapM tag -> GenericFoldMapM tag
forall a. Semigroup a => a -> a -> a
<> forall (tag :: k) (f :: k -> Type) (p :: k).
GFoldMapC tag f =>
f p -> GenericFoldMapM tag
forall {k} {k1} (tag :: k) (f :: k1 -> Type) (p :: k1).
GFoldMapC tag f =>
f p -> GenericFoldMapM tag
gFoldMapC @tag gf p
a