{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
module Generic.Data.Function.FoldMap.Constructor where
import GHC.Generics
import Data.Kind ( type Constraint, type Type )
import Generic.Data.Wrappers ( NoRec0, type ENoRec0, EmptyRec0 )
import GHC.TypeLits ( TypeError )
class GenericFoldMap tag where
type GenericFoldMapM tag :: Type
type GenericFoldMapC tag a :: Constraint
genericFoldMapF :: GenericFoldMapC tag a => a -> GenericFoldMapM tag
instance GenericFoldMap (NoRec0 (m :: Type)) where
type GenericFoldMapM (NoRec0 m) = m
type GenericFoldMapC (NoRec0 m) _ = TypeError ENoRec0
genericFoldMapF :: forall a.
GenericFoldMapC (NoRec0 m) a =>
a -> GenericFoldMapM (NoRec0 m)
genericFoldMapF = a -> m
a -> GenericFoldMapM (NoRec0 m)
forall a. HasCallStack => a
undefined
instance Monoid m => GenericFoldMap (EmptyRec0 m) where
type GenericFoldMapM (EmptyRec0 m) = m
type GenericFoldMapC (EmptyRec0 m) _ = ()
genericFoldMapF :: forall a.
GenericFoldMapC (EmptyRec0 m) a =>
a -> GenericFoldMapM (EmptyRec0 m)
genericFoldMapF a
_ = m
GenericFoldMapM (EmptyRec0 m)
forall a. Monoid a => a
mempty
class GFoldMapC tag f where gFoldMapC :: f p -> GenericFoldMapM tag
instance (Semigroup (GenericFoldMapM tag), GFoldMapC tag l, GFoldMapC tag r)
=> GFoldMapC tag (l :*: r) where
gFoldMapC :: forall (p :: k). (:*:) l r p -> GenericFoldMapM tag
gFoldMapC (l p
l :*: r p
r) = forall (tag :: k) (f :: k -> Type) (p :: k).
GFoldMapC tag f =>
f p -> GenericFoldMapM tag
forall {k} {k} (tag :: k) (f :: k -> Type) (p :: k).
GFoldMapC tag f =>
f p -> GenericFoldMapM tag
gFoldMapC @tag l p
l 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} {k} (tag :: k) (f :: k -> Type) (p :: k).
GFoldMapC tag f =>
f p -> GenericFoldMapM tag
gFoldMapC @tag r p
r
instance (GenericFoldMap tag, GenericFoldMapC tag a)
=> GFoldMapC tag (S1 c (Rec0 a)) where
gFoldMapC :: forall (p :: k). S1 c (Rec0 a) p -> GenericFoldMapM tag
gFoldMapC (M1 (K1 a
a)) = forall (tag :: k) a.
(GenericFoldMap tag, GenericFoldMapC tag a) =>
a -> GenericFoldMapM tag
forall {k} (tag :: k) a.
(GenericFoldMap tag, GenericFoldMapC tag a) =>
a -> GenericFoldMapM tag
genericFoldMapF @tag a
a
instance Monoid (GenericFoldMapM tag) => GFoldMapC tag U1 where
gFoldMapC :: forall (p :: k). U1 p -> GenericFoldMapM tag
gFoldMapC U1 p
U1 = GenericFoldMapM tag
forall a. Monoid a => a
mempty