{-# 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) )
import Generic.Data.Rep.Error
import Generic.Data.Function.Common
class GFoldMapSum (opts :: SumOpts) m f where gFoldMapSum :: (String -> m) -> f p -> m
instance GFoldMapCSum m (l :+: r) => GFoldMapSum opts m (l :+: r) where
gFoldMapSum :: forall (p :: k). (String -> m) -> (:+:) l r p -> m
gFoldMapSum = forall {k} m (f :: k -> Type) (p :: k).
GFoldMapCSum m f =>
(String -> m) -> f p -> m
gFoldMapCSum
instance GFoldMapSum 'SumOnly m (C1 c f) where
gFoldMapSum :: forall (p :: k). (String -> m) -> C1 c f p -> m
gFoldMapSum = forall a. HasCallStack => String -> a
error String
eNeedSum
instance GFoldMapCSum m (C1 c f)
=> GFoldMapSum 'AllowSingletonSum m (C1 c f) where
gFoldMapSum :: forall (p :: k). (String -> m) -> C1 c f p -> m
gFoldMapSum = forall {k} m (f :: k -> Type) (p :: k).
GFoldMapCSum m f =>
(String -> m) -> f p -> m
gFoldMapCSum
instance GFoldMapSum opts m V1 where
gFoldMapSum :: forall (p :: k). (String -> m) -> V1 p -> m
gFoldMapSum = forall a. HasCallStack => String -> a
error String
eNoEmpty
class GFoldMapCSum m f where gFoldMapCSum :: (String -> m) -> f p -> m
instance (GFoldMapCSum m l, GFoldMapCSum m r) => GFoldMapCSum m (l :+: r) where
gFoldMapCSum :: forall (p :: k). (String -> m) -> (:+:) l r p -> m
gFoldMapCSum String -> m
f = \case L1 l p
l -> forall {k} m (f :: k -> Type) (p :: k).
GFoldMapCSum m f =>
(String -> m) -> f p -> m
gFoldMapCSum String -> m
f l p
l
R1 r p
r -> forall {k} m (f :: k -> Type) (p :: k).
GFoldMapCSum m f =>
(String -> m) -> f p -> m
gFoldMapCSum String -> m
f r p
r
instance (Semigroup m, Constructor c, GFoldMapC m f)
=> GFoldMapCSum m (C1 c f) where
gFoldMapCSum :: forall (p :: k). (String -> m) -> C1 c f p -> m
gFoldMapCSum String -> m
mapCstr (M1 f p
a) = String -> m
mapCstr (forall {k} (c :: k). Constructor c => String
conName' @c) forall a. Semigroup a => a -> a -> a
<> forall {k} m (f :: k -> Type) (p :: k). GFoldMapC m f => f p -> m
gFoldMapC f p
a