{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
module Generic.Data.Function.FoldMap.Sum where
import GHC.Generics
import Generic.Data.Function.Util.Generic ( conName' )
import Generic.Data.Function.FoldMap.Constructor
( GFoldMapC(gFoldMapC)
, GenericFoldMap(type GenericFoldMapM) )
import Generic.Data.Rep.Error
import Generic.Data.Function.Common
class GFoldMapSum (opts :: SumOpts) tag f where
gFoldMapSum :: (String -> GenericFoldMapM tag) -> f p -> GenericFoldMapM tag
instance GFoldMapCSum tag (l :+: r) => GFoldMapSum opts tag (l :+: r) where
gFoldMapSum :: forall (p :: k).
(String -> GenericFoldMapM tag)
-> (:+:) l r p -> GenericFoldMapM tag
gFoldMapSum = forall (tag :: k) (f :: k -> Type) (p :: k).
GFoldMapCSum tag f =>
(String -> GenericFoldMapM tag) -> f p -> GenericFoldMapM tag
forall {k} {k} (tag :: k) (f :: k -> Type) (p :: k).
GFoldMapCSum tag f =>
(String -> GenericFoldMapM tag) -> f p -> GenericFoldMapM tag
gFoldMapCSum @tag
instance GFoldMapSum 'SumOnly tag (C1 c f) where
gFoldMapSum :: forall (p :: k).
(String -> GenericFoldMapM tag) -> C1 c f p -> GenericFoldMapM tag
gFoldMapSum = String
-> (String -> GenericFoldMapM tag)
-> C1 c f p
-> GenericFoldMapM tag
forall a. HasCallStack => String -> a
error String
eNeedSum
instance GFoldMapCSum tag (C1 c f)
=> GFoldMapSum 'AllowSingletonSum tag (C1 c f) where
gFoldMapSum :: forall (p :: k).
(String -> GenericFoldMapM tag) -> C1 c f p -> GenericFoldMapM tag
gFoldMapSum = forall (tag :: k) (f :: k -> Type) (p :: k).
GFoldMapCSum tag f =>
(String -> GenericFoldMapM tag) -> f p -> GenericFoldMapM tag
forall {k} {k} (tag :: k) (f :: k -> Type) (p :: k).
GFoldMapCSum tag f =>
(String -> GenericFoldMapM tag) -> f p -> GenericFoldMapM tag
gFoldMapCSum @tag
instance GFoldMapSum opts tag V1 where
gFoldMapSum :: forall (p :: k).
(String -> GenericFoldMapM tag) -> V1 p -> GenericFoldMapM tag
gFoldMapSum = String
-> (String -> GenericFoldMapM tag) -> V1 p -> GenericFoldMapM tag
forall a. HasCallStack => String -> a
error String
eNoEmpty
class GFoldMapCSum tag f where
gFoldMapCSum :: (String -> GenericFoldMapM tag) -> f 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) (f :: k -> Type) (p :: k).
GFoldMapCSum tag f =>
(String -> GenericFoldMapM tag) -> f p -> GenericFoldMapM tag
forall {k} {k} (tag :: k) (f :: k -> Type) (p :: k).
GFoldMapCSum tag f =>
(String -> GenericFoldMapM tag) -> f p -> GenericFoldMapM tag
gFoldMapCSum @tag String -> GenericFoldMapM tag
f l p
l
R1 r p
r -> forall (tag :: k) (f :: k -> Type) (p :: k).
GFoldMapCSum tag f =>
(String -> GenericFoldMapM tag) -> f p -> GenericFoldMapM tag
forall {k} {k} (tag :: k) (f :: k -> Type) (p :: k).
GFoldMapCSum tag f =>
(String -> GenericFoldMapM tag) -> f p -> GenericFoldMapM tag
gFoldMapCSum @tag String -> GenericFoldMapM tag
f r p
r
instance (Semigroup (GenericFoldMapM tag), Constructor c, GFoldMapC tag f)
=> GFoldMapCSum tag (C1 c f) where
gFoldMapCSum :: forall (p :: k).
(String -> GenericFoldMapM tag) -> C1 c f p -> GenericFoldMapM tag
gFoldMapCSum String -> GenericFoldMapM tag
mapCstr (M1 f 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 f p
a