{-# LANGUAGE AllowAmbiguousTypes  #-} -- due to tag type class design
{-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6

module Generic.Data.Function.FoldMap.NonSum where

import GHC.Generics
import Generic.Data.Function.FoldMap.Constructor
  ( GFoldMapC(gFoldMapC)
  , GenericFoldMap(type GenericFoldMapM) )
import Generic.Data.Function.Common.Error
import Generic.Data.Function.Common.Generic ( absurdV1 )

{- | 'foldMap' over generic product data types.

Take a generic representation, map each field in the data type to a 'Monoid',
and combine the results with ('<>').
-}
class GFoldMapNonSum tag gf where gFoldMapNonSum :: gf p -> GenericFoldMapM tag

instance GFoldMapNonSum tag gf => GFoldMapNonSum tag (D1 c gf) where
    gFoldMapNonSum :: forall (p :: k). D1 c gf p -> GenericFoldMapM tag
gFoldMapNonSum = forall (tag :: k) (gf :: k -> Type) (p :: k).
GFoldMapNonSum tag gf =>
gf p -> GenericFoldMapM tag
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GFoldMapNonSum tag gf =>
gf p -> GenericFoldMapM tag
gFoldMapNonSum @tag (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 GFoldMapC tag gf => GFoldMapNonSum tag (C1 c gf) where
    gFoldMapNonSum :: forall (p :: k). C1 c gf p -> GenericFoldMapM tag
gFoldMapNonSum (M1 gf p
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

instance GFoldMapNonSum tag (l :+: r) where gFoldMapNonSum :: forall (p :: k). (:+:) l r p -> GenericFoldMapM tag
gFoldMapNonSum = [Char] -> (:+:) l r p -> GenericFoldMapM tag
forall a. HasCallStack => [Char] -> a
error [Char]
eNoSum
instance GFoldMapNonSum tag V1        where gFoldMapNonSum :: forall (p :: k). V1 p -> GenericFoldMapM tag
gFoldMapNonSum = V1 p -> GenericFoldMapM tag
forall {k} (x :: k) a. V1 x -> a
absurdV1