generic-data-functions 0.3.1 → 0.4.1

raw patch · 16 files changed

+169/−195 lines, 16 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• generic-data-functions.cabal +1/−2
• src/Generic/Data/Function/Contra.hs +12/−16
• src/Generic/Data/Function/Contra/Constructor.hs +6/−0
• src/Generic/Data/Function/Contra/NonSum.hs +11/−5
• src/Generic/Data/Function/Contra/Sum.hs +18/−10
• src/Generic/Data/Function/Example.hs +6/−7
• src/Generic/Data/Function/FoldMap.hs +8/−13
• src/Generic/Data/Function/FoldMap/Constructor.hs +2/−2
• src/Generic/Data/Function/FoldMap/NonSum.hs +5/−2
• src/Generic/Data/Function/FoldMap/Sum.hs +16/−11
• src/Generic/Data/Function/Traverse.hs +17/−18
• src/Generic/Data/Function/Traverse/Constructor.hs +10/−10
• src/Generic/Data/Function/Traverse/NonSum.hs +15/−6
• src/Generic/Data/Function/Traverse/Sum.hs +34/−25
• src/Generic/Data/Rep/Assert.hs +0/−68

@@ -1,3 +1,11 @@+## 0.4.1 (2024-04-04)+* Remove generic representation asserts. We can handle them elsewhere without+  cluttering type signatures here. (I strongly recommend them, but that's not a+  reason to keep them here.)+* Unwrap `D1` in generic type classes rather than handing off to user. This was+  never really clever or useful, as it turns out. Saved a an extra type class+  per function, but requires the user to write more weird stuff.+ ## 0.3.1 (2024-04-03) * fix error in traverse types 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           generic-data-functions-version:        0.3.1+version:        0.4.1 synopsis:       Familiar functions lifted to generic data types description:    Please see README.md. category:       Data, Serialization@@ -44,7 +44,6 @@       Generic.Data.Function.Traverse.Sum       Generic.Data.Function.Util.Generic       Generic.Data.Function.Util.TypeNats-      Generic.Data.Rep.Assert       Generic.Data.Rep.Error       Generic.Data.Wrappers   other-modules:

@@ -8,7 +8,6 @@  import GHC.Generics -import Generic.Data.Rep.Assert import Generic.Data.Function.Contra.NonSum import Generic.Data.Function.Contra.Sum import Generic.Data.Function.Contra.Constructor@@ -18,13 +17,12 @@ -- -- @a@ must have exactly one constructor. genericContraNonSum-    :: forall {cd} {gf} asserts tag a-    .  ( Generic a, Rep a ~ D1 cd gf-       , GContraNonSum tag gf-       , ApplyGCAsserts asserts gf-       , Contravariant (GenericContraF tag))-    => GenericContraF tag a-genericContraNonSum = contramap (unM1 . from) (gContraNonSum @tag)+    :: forall {k} (tag :: k) a+    .  ( Generic a+       , Contravariant (GenericContraF tag)+       , GContraNonSum tag (Rep a)+    ) => GenericContraF tag a+genericContraNonSum = contramap from (gContraNonSum @tag)  -- | Generic contra over a term of sum data type @a@. --@@ -33,11 +31,9 @@ -- This is the most generic option, but depending on your string manipulation -- may be slower. genericContraSum-    :: forall {cd} {gf} opts asserts tag a-    .  ( Generic a, Rep a ~ D1 cd gf-       , GContraSum opts tag gf-       , ApplyGCAsserts asserts gf-       , Contravariant (GenericContraF tag))-    => GenericContraF tag String-    -> GenericContraF tag a-genericContraSum f = contramap (unM1 . from) (gContraSum @opts @tag f)+    :: forall {k} (tag :: k) opts a+    .  ( Generic a+       , Contravariant (GenericContraF tag)+       , GContraSum tag opts (Rep a)+    ) => GenericContraF tag String -> GenericContraF tag a+genericContraSum f = contramap from (gContraSum @tag @opts f)

@@ -12,6 +12,12 @@ import Generic.Data.Wrappers ( NoRec0, type ENoRec0, EmptyRec0 ) import GHC.TypeLits ( TypeError ) +-- | TODO+--+-- The type variable is uninstantiated, used purely as a tag.+-- Good types include the type class used inside (providing you define the+-- type class/it's not an orphan instance), or a custom void data type.+-- See the binrep library on Hackage for an example. class GenericContra tag where     type GenericContraF tag :: Type -> Type     type GenericContraC tag a :: Constraint

@@ -14,9 +14,15 @@  class GContraNonSum tag gf where gContraNonSum :: GenericContraF tag (gf p) -instance (Contravariant (GenericContraF tag), GContraC tag g)-  => GContraNonSum tag (C1 c g) where-    gContraNonSum = contramap unM1 (gContraC @tag)+instance (Contravariant (GenericContraF tag), GContraNonSumD tag gf)+  => GContraNonSum tag (C1 c gf) where+    gContraNonSum = contramap unM1 (gContraNonSumD @tag) -instance GContraNonSum tag (l :+: r) where gContraNonSum = error eNoSum-instance GContraNonSum tag V1        where gContraNonSum = error eNoEmpty+class GContraNonSumD tag gf where gContraNonSumD :: GenericContraF tag (gf p)++instance (Contravariant (GenericContraF tag), GContraC tag gf)+  => GContraNonSumD tag (C1 c gf) where+    gContraNonSumD = contramap unM1 (gContraC @tag)++instance GContraNonSumD tag (l :+: r) where gContraNonSumD = error eNoSum+instance GContraNonSumD tag V1        where gContraNonSumD = error eNoEmpty

@@ -13,22 +13,30 @@ import Generic.Data.Function.Common  import Data.Functor.Contravariant.Divisible+import Data.Functor.Contravariant -class GContraSum (opts :: SumOpts) tag gf where+class GContraSum tag (opts :: SumOpts) gf where     gContraSum :: GenericContraF tag String -> GenericContraF tag (gf p) -instance GContraCSum tag (l :+: r) => GContraSum opts tag (l :+: r) where-    gContraSum = gContraCSum @tag+instance (GContraSumD tag opts gf, Contravariant (GenericContraF tag))+  => GContraSum tag opts (D1 cd gf) where+    gContraSum f = contramap unM1 (gContraSumD @tag @opts f) -instance GContraSum 'SumOnly tag (C1 c g) where-    gContraSum = error eNeedSum+class GContraSumD tag (opts :: SumOpts) gf where+    gContraSumD :: GenericContraF tag String -> GenericContraF tag (gf p) -instance GContraCSum tag (C1 c g)-  => GContraSum 'AllowSingletonSum tag (C1 c g) where-    gContraSum = gContraCSum @tag+instance GContraCSum tag (l :+: r) => GContraSumD tag opts (l :+: r) where+    gContraSumD = gContraCSum @tag -instance GContraSum opts tag V1 where-    gContraSum = error eNoEmpty+instance GContraSumD tag 'SumOnly (C1 cc gf) where+    gContraSumD = error eNeedSum++instance GContraCSum tag (C1 cc gf)+  => GContraSumD tag 'AllowSingletonSum (C1 cc gf) where+    gContraSumD = gContraCSum @tag++instance GContraSumD tag opts V1 where+    gContraSumD = error eNoEmpty  -- TODO rename (? had this on foldmap sum) class GContraCSum tag gf where

@@ -4,7 +4,6 @@  import GHC.Generics import Generic.Data.Function.FoldMap-import Generic.Data.Rep.Assert  import Data.List qualified as List @@ -22,16 +21,16 @@     genericFoldMapF = (\a -> [a]) . show  showGeneric-    :: forall {cd} {f} opts asserts a-    .  (Generic a, Rep a ~ D1 cd f, GFoldMapSum opts Showly f, ApplyGCAsserts asserts f)+    :: forall opts a+    .  (Generic a, GFoldMapSum Showly opts (Rep a))     => a -> String showGeneric =       mconcat . List.intersperse " "-    . genericFoldMapSum @opts @asserts @Showly (\cstr -> [cstr])+    . genericFoldMapSum @Showly @opts (\cstr -> [cstr])  showGeneric'-    :: forall {cd} {f} asserts a-    .  (Generic a, Rep a ~ D1 cd f, GFoldMapNonSum Showly f, ApplyGCAsserts asserts f)+    :: forall a+    .  (Generic a, GFoldMapNonSum Showly (Rep a))     => a -> String showGeneric' =-    mconcat . List.intersperse " " . genericFoldMapNonSum @asserts @Showly+    mconcat . List.intersperse " " . genericFoldMapNonSum @Showly

@@ -36,7 +36,6 @@  import GHC.Generics -import Generic.Data.Rep.Assert import Generic.Data.Function.FoldMap.NonSum import Generic.Data.Function.FoldMap.Sum import Generic.Data.Function.FoldMap.Constructor@@ -47,12 +46,10 @@ -- -- @a@ must have exactly one constructor. genericFoldMapNonSum-    :: forall {cd} {gf} asserts tag a-    .  ( Generic a, Rep a ~ D1 cd gf-       , GFoldMapNonSum tag gf-       , ApplyGCAsserts asserts gf)-    => a -> GenericFoldMapM tag-genericFoldMapNonSum = gFoldMapNonSum @tag . unM1 . from+    :: forall {k} (tag :: k) a+    .  ( Generic a, GFoldMapNonSum tag (Rep a)+    ) => a -> GenericFoldMapM tag+genericFoldMapNonSum = gFoldMapNonSum @tag . from  -- | Generic 'foldMap' over a term of sum data type @a@. --@@ -61,13 +58,11 @@ -- This is the most generic option, but depending on your string manipulation -- may be slower. genericFoldMapSum-    :: forall {cd} {gf} opts asserts tag a-    .  ( Generic a, Rep a ~ D1 cd gf-       , GFoldMapSum opts tag gf-       , ApplyGCAsserts asserts gf)-    => (String -> GenericFoldMapM tag)+    :: forall {k} (tag :: k) opts a+    .  ( Generic a, GFoldMapSum tag opts (Rep a)+    ) => (String -> GenericFoldMapM tag)     -> a -> GenericFoldMapM tag-genericFoldMapSum f = gFoldMapSum @opts @tag f . unM1 . from+genericFoldMapSum f = gFoldMapSum @tag @opts f . from  -- | Generic 'foldMap' over a term of sum data type @a@ where constructors are -- mapped to their index (distance from first/leftmost constructor)

@@ -12,8 +12,8 @@ -- | Implementation enumeration type class for generic 'foldMap'. -- -- The type variable is uninstantiated, used purely as a tag.------ Avoid orphan instances by defining custom empty types to use here.+-- Good types include the type class used inside (providing you define the+-- type class/it's not an orphan instance), or a custom void data type. -- See the binrep library on Hackage for an example. class GenericFoldMap tag where     -- | The target 'Monoid' to 'foldMap' to.

@@ -14,9 +14,12 @@ Take a generic representation, map each field in the data type to a 'Monoid', and combine the results with ('<>'). -}-class GFoldMapNonSum tag f where gFoldMapNonSum :: f p -> GenericFoldMapM tag+class GFoldMapNonSum tag gf where gFoldMapNonSum :: gf p -> GenericFoldMapM tag -instance GFoldMapC tag f => GFoldMapNonSum tag (C1 c f) where+instance GFoldMapNonSum tag gf => GFoldMapNonSum tag (D1 c gf) where+    gFoldMapNonSum = gFoldMapNonSum @tag . unM1++instance GFoldMapC tag gf => GFoldMapNonSum tag (C1 c gf) where     gFoldMapNonSum (M1 a) = gFoldMapC @tag a  instance GFoldMapNonSum tag (l :+: r) where gFoldMapNonSum = error eNoSum

@@ -19,34 +19,39 @@ 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+class GFoldMapSum tag (opts :: SumOpts) gf where+    gFoldMapSum+        :: (String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag -instance GFoldMapCSum tag (l :+: r) => GFoldMapSum opts tag (l :+: r) where+instance GFoldMapSum tag opts gf => GFoldMapSum tag opts (D1 c gf) where+    gFoldMapSum f = gFoldMapSum @tag @opts f . unM1++instance GFoldMapCSum tag (l :+: r) => GFoldMapSum tag opts (l :+: r) where     gFoldMapSum = gFoldMapCSum @tag -instance GFoldMapSum 'SumOnly tag (C1 c f) where+instance GFoldMapSum tag 'SumOnly (C1 c gf) where     gFoldMapSum = error eNeedSum -instance GFoldMapCSum tag (C1 c f)-  => GFoldMapSum 'AllowSingletonSum tag (C1 c f) where+instance GFoldMapCSum tag (C1 c gf)+  => GFoldMapSum tag 'AllowSingletonSum (C1 c gf) where     gFoldMapSum = gFoldMapCSum @tag -instance GFoldMapSum opts tag V1 where+instance GFoldMapSum tag opts V1 where     gFoldMapSum = error eNoEmpty  -- | Sum type handler prefixing constructor contents with their mapped --   constructor name via a provided @String -> m@. -- -- TODO rename-class GFoldMapCSum tag f where-    gFoldMapCSum :: (String -> GenericFoldMapM tag) -> f p -> GenericFoldMapM tag+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 f = \case L1 l -> gFoldMapCSum @tag f l                            R1 r -> gFoldMapCSum @tag f r -instance (Semigroup (GenericFoldMapM tag), Constructor c, GFoldMapC tag f)-  => GFoldMapCSum tag (C1 c f) where+instance (Semigroup (GenericFoldMapM tag), Constructor c, GFoldMapC tag gf)+  => GFoldMapCSum tag (C1 c gf) where     gFoldMapCSum mapCstr (M1 a) = mapCstr (conName' @c) <> gFoldMapC @tag a

@@ -18,35 +18,34 @@  import GHC.Generics -import Generic.Data.Rep.Assert import Generic.Data.Function.Traverse.NonSum import Generic.Data.Function.Traverse.Sum import Generic.Data.Function.Traverse.Constructor  import Data.Text qualified as Text --- | Generic 'traverse' over a term of non-sum data type @f a@.+-- | Generic 'traverse' over a term of non-sum data type @f a@,+--   where @f@ is set by the @tag@ you pass. genericTraverseNonSum-    :: forall {cd} {gf} {k} asserts (tag :: k) a-    .  ( Generic a, Rep a ~ D1 cd gf-       , GTraverseNonSum cd tag gf-       , ApplyGCAsserts asserts gf-       , Functor (GenericTraverseF tag))-    => GenericTraverseF tag a-genericTraverseNonSum = (to . M1) <$> gTraverseNonSum @cd @tag+    :: forall {k} (tag :: k) a+    .  ( Generic a+       , Functor (GenericTraverseF tag)+       , GTraverseNonSum tag (Rep a)+    ) => GenericTraverseF tag a+genericTraverseNonSum = to <$> gTraverseNonSum @tag --- | Generic 'traverse' over a term of sum data type @f a@.+-- | Generic 'traverse' over a term of sum data type @f a@,+--   where @f@ is set by the @tag@ you pass. -- -- You must provide a configuration for how to handle constructors. genericTraverseSum-    :: forall {cd} {gf} opts asserts tag a pt-    .  ( Generic a, Rep a ~ D1 cd gf-       , GTraverseSum opts cd tag gf-       , ApplyGCAsserts asserts gf-       , GenericTraverseC tag pt, Functor (GenericTraverseF tag))-    => PfxTagCfg pt-    -> GenericTraverseF tag a-genericTraverseSum ptc = (to . M1) <$> gTraverseSum @opts @cd @tag ptc+    :: forall {k} (tag :: k) opts a pt+    .  ( Generic a+       , Functor (GenericTraverseF tag)+       , GTraverseSum tag opts (Rep a)+       , GenericTraverseC tag pt+    ) => PfxTagCfg pt -> GenericTraverseF tag a+genericTraverseSum ptc = to <$> gTraverseSum @tag @opts ptc  -- | Construct a prefix tag config using existing 'Eq' and 'Show' instances. --

@@ -21,8 +21,8 @@ -- | Implementation enumeration type class for generic 'traverse'. -- -- The type variable is uninstantiated, used purely as a tag.------ Avoid orphan instances by defining custom empty types to use here.+-- Good types include the type class used inside (providing you define the+-- type class/it's not an orphan instance), or a custom void data type. -- See the binrep library on Hackage for an example. class GenericTraverse tag where     -- | The target 'Applicative' to 'traverse' to.@@ -60,23 +60,23 @@     type GenericTraverseC (EmptyRec0 f) _ = Alternative f     genericTraverseAction _ _ _ _ = empty -class GTraverseC cd cc (si :: Natural) tag gf where+class GTraverseC tag cd cc (si :: Natural) gf where     gTraverseC :: GenericTraverseF tag (gf p)  instance   ( Applicative (GenericTraverseF tag)-  , GTraverseC cd cc si                 tag l-  , GTraverseC cd cc (si + ProdArity r) tag r-  ) => GTraverseC cd cc si tag (l :*: r) where+  , GTraverseC tag cd cc si                 l+  , GTraverseC tag cd cc (si + ProdArity r) r+  ) => GTraverseC tag cd cc si (l :*: r) where     gTraverseC = Applicative.liftA2 (:*:)-                   (gTraverseC @cd @cc @si                 @tag)-                   (gTraverseC @cd @cc @(si + ProdArity r) @tag)+                   (gTraverseC @tag @cd @cc @si)+                   (gTraverseC @tag @cd @cc @(si + ProdArity r))  instance   ( GenericTraverse tag, GenericTraverseC tag a   , Functor (GenericTraverseF tag)   , KnownNat si, Selector cs, Constructor cc, Datatype cd-  ) => GTraverseC cd cc si tag (S1 cs (Rec0 a)) where+  ) => GTraverseC tag cd cc si (S1 cs (Rec0 a)) where     gTraverseC = (M1 . K1) <$> genericTraverseAction @tag cd cc cs si       where         cs = selName'' @cs@@ -84,7 +84,7 @@         cc = conName' @cc         si = natVal'' @si -instance Applicative (GenericTraverseF tag) => GTraverseC cd cc 0 tag U1 where+instance Applicative (GenericTraverseF tag) => GTraverseC tag cd cc 0 U1 where     gTraverseC = pure U1  type family ProdArity (f :: Type -> Type) :: Natural where

@@ -10,12 +10,21 @@   ) import Generic.Data.Rep.Error -class GTraverseNonSum (cd :: Meta) tag gf where+class GTraverseNonSum tag gf where     gTraverseNonSum :: GenericTraverseF tag (gf p) -instance (Functor (GenericTraverseF tag), GTraverseC cd cc 0 tag gf)-  => GTraverseNonSum cd tag (C1 cc gf) where-    gTraverseNonSum = M1 <$> gTraverseC @cd @cc @0 @tag+instance (Functor (GenericTraverseF tag), GTraverseNonSumD tag cd gf)+  => GTraverseNonSum tag (D1 cd gf) where+    gTraverseNonSum = M1 <$> gTraverseNonSumD @tag @cd -instance GTraverseNonSum cd tag (l :+: r) where gTraverseNonSum = error eNoSum-instance GTraverseNonSum cd tag V1        where gTraverseNonSum = error eNoEmpty+class GTraverseNonSumD tag (cd :: Meta) gf where+    gTraverseNonSumD :: GenericTraverseF tag (gf p)++instance (Functor (GenericTraverseF tag), GTraverseC tag cd cc 0 gf)+  => GTraverseNonSumD tag cd (C1 cc gf) where+    gTraverseNonSumD = M1 <$> gTraverseC @tag @cd @cc @0++instance GTraverseNonSumD cd tag (l :+: r) where+    gTraverseNonSumD = error eNoSum+instance GTraverseNonSumD cd tag V1        where+    gTraverseNonSumD = error eNoEmpty

@@ -53,71 +53,80 @@   -- ^ Make a prefix tag human-readable. 'show' is often appropriate.   } -class GTraverseSum (opts :: SumOpts) cd tag gf where+class GTraverseSum tag (opts :: SumOpts) gf where     gTraverseSum         :: GenericTraverseC tag pt         => PfxTagCfg pt -> GenericTraverseF tag (gf p) +instance (GTraverseSumD tag cd opts gf, Functor (GenericTraverseF tag)+  ) => GTraverseSum tag opts (D1 cd gf) where+    gTraverseSum ptc = M1 <$> gTraverseSumD @tag @cd @opts ptc++class GTraverseSumD tag cd (opts :: SumOpts) gf where+    gTraverseSumD+        :: GenericTraverseC tag pt+        => PfxTagCfg pt -> GenericTraverseF tag (gf p)+ instance-  ( GenericTraverseSum tag, GTraverseCSum cd tag (l :+: r), Datatype cd+  ( GenericTraverseSum tag, GTraverseCSum tag cd (l :+: r), Datatype cd   , Alternative (GenericTraverseF tag)   , Monad (GenericTraverseF tag)-  ) => GTraverseSum opts cd tag (l :+: r) where-    gTraverseSum = gTraverseSum' @cd @tag+  ) => GTraverseSumD tag cd opts (l :+: r) where+    gTraverseSumD = gTraverseSumD' @tag @cd -gTraverseSum'-    :: forall {p} cd tag gf pt+gTraverseSumD'+    :: forall {p} tag cd gf pt     .  ( GenericTraverseC tag pt        , Alternative (GenericTraverseF tag)        , Monad (GenericTraverseF tag)-       , GenericTraverseSum tag, GTraverseCSum cd tag gf+       , GenericTraverseSum tag, GTraverseCSum tag cd gf        , Datatype cd     ) => PfxTagCfg pt -> GenericTraverseF tag (gf p)-gTraverseSum' ptc = do+gTraverseSumD' ptc = do     pt <- genericTraverseSumPfxTagAction @tag cd-    gTraverseCSum @cd @tag ptc pt <|> parseErrorNoMatch pt+    gTraverseCSum @tag @cd ptc pt <|> parseErrorNoMatch pt   where     cd = datatypeName' @cd     parseErrorNoMatch pt =         genericTraverseSumNoMatchingCstrAction @tag cd testedCstrs ((pfxTagCfgShow ptc) pt)     testedCstrs = [] -- TODO -instance GTraverseSum 'SumOnly cd tag (C1 cc gf) where-    gTraverseSum = error eNeedSum+instance GTraverseSumD tag cd 'SumOnly (C1 cc gf) where+    gTraverseSumD = error eNeedSum  instance-  ( GenericTraverseSum tag, GTraverseCSum cd tag (C1 cc gf), Datatype cd+  ( GenericTraverseSum tag, GTraverseCSum tag cd (C1 cc gf), Datatype cd   , Alternative (GenericTraverseF tag)   , Monad (GenericTraverseF tag)-  ) => GTraverseSum 'AllowSingletonSum cd tag (C1 cc gf) where-    gTraverseSum = gTraverseSum' @cd @tag+  ) => GTraverseSumD tag cd 'AllowSingletonSum (C1 cc gf) where+    gTraverseSumD = gTraverseSumD' @tag @cd -instance GTraverseSum opts cd tag V1 where-    gTraverseSum = error eNoEmpty+instance GTraverseSumD opts tag cd V1 where+    gTraverseSumD = error eNoEmpty -class GTraverseCSum cd tag gf where+class GTraverseCSum tag cd gf where     gTraverseCSum :: PfxTagCfg pt -> pt -> GenericTraverseF tag (gf p)  -- | Combine constructor options with '(<|>)' ("or"). instance   ( Alternative (GenericTraverseF tag)-  , GTraverseCSum cd tag l-  , GTraverseCSum cd tag r-  ) => GTraverseCSum cd tag (l :+: r) where+  , GTraverseCSum tag cd l+  , GTraverseCSum tag cd r+  ) => GTraverseCSum tag cd (l :+: r) where     gTraverseCSum ptc pt = l <|> r       where-        l = L1 <$> gTraverseCSum @cd @tag ptc pt-        r = R1 <$> gTraverseCSum @cd @tag ptc pt+        l = L1 <$> gTraverseCSum @tag @cd ptc pt+        r = R1 <$> gTraverseCSum @tag @cd ptc pt  -- | If the constructor matches the expected prefix tag, then return the action --   handling that constructor's contents, else return the empty action. instance   ( Alternative (GenericTraverseF tag)-  , GTraverseC cd cc 0 tag gf, Constructor cc-  ) => GTraverseCSum cd tag (C1 cc gf) where+  , GTraverseC tag cd cc 0 gf, Constructor cc+  ) => GTraverseCSum tag cd (C1 cc gf) where     gTraverseCSum ptc pt = do         if   (pfxTagCfgEq ptc) pt ptCstr-        then M1 <$> gTraverseC @cd @cc @0 @tag+        then M1 <$> gTraverseC @tag @cd @cc @0         else Applicative.empty       where         ptCstr = (pfxTagCfgFromCstr ptc) (conName' @cc)

@@ -1,68 +0,0 @@-{-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6--{- | Assertions on precise generic data representation.--I like being real picky with my generic code, disallowing misuse at the type-level. However, this makes it less flexible overall, and is a large chunk of the-code I have to write over and over again.--I mainly care about sanity checks, along the lines of "if the generic-representations looks like this, type error out". So they don't make any-term-level changes.--So, instead of hiding these in generic type class instances, I put them in type-family equations. Now we can turn these checks on and off -- and when they're-on, you have to carry around that fact in your types. Fantastic!--Checks are formed as 'Constraint's, where a failure triggers a 'TypeError' and a-success goes to the empty constraint '()' (@'()' :: 'Constraint'@ as well as-'Type').--These checks were always done on the type-level, but they were "inline" with the-rest of the type class. By pulling them out, we *should* be incurring some-compile-time performance penalty (albeit hopefully minor due to the simple-nature of the checks), but making no change to runtime.--}--module Generic.Data.Rep.Assert where--import GHC.Generics-import GHC.TypeLits ( TypeError )-import Generic.Data.Rep.Error--import Data.Kind---- | Generic representation assertions, on the constructor level (bits that come---   after 'D1').-data GCAssert-  = NoEmpty -- ^ Is not an empty type (does not have 0 constructors)-  | NoSum   -- ^ Is not a sum type (has 0 or 1 constructors)-  | NeedSum -- ^ Is     a sum type (has 0 or >2 constructors)---- | Convert a generic representation constructor-level assertion "label" to the---   assertion it represents, and make that assertion.-type family ApplyGCAssert x a where-    ApplyGCAssert 'NoEmpty a = GCNoEmpty a-    ApplyGCAssert 'NoSum   a = GCNoSum   a-    ApplyGCAssert 'NeedSum a = GCNeedSum a---- | Apply a list of generic representation constructor-level assertions.-type ApplyGCAsserts :: [GCAssert] -> (k -> Type) -> Constraint-type family ApplyGCAsserts ls a where-    ApplyGCAsserts '[]       a = ()-    ApplyGCAsserts (l ': ls) a = (ApplyGCAssert l a, ApplyGCAsserts ls a)--type GCNoEmpty :: (k -> Type) -> Constraint-type family GCNoEmpty a where-    GCNoEmpty V1 = TypeError ENoEmpty-    GCNoEmpty a = ()--type GCNoSum :: (k -> Type) -> Constraint-type family GCNoSum a where-    GCNoSum (_ :+: _) = TypeError EUnexpectedSum-    GCNoSum a = ()--type GCNeedSum :: (k -> Type) -> Constraint-type family GCNeedSum a where-    GCNeedSum (C1 _ _) = TypeError EUnexpectedNonSum-    GCNeedSum a = ()