generic-data-functions 0.4.1 → 0.5.0

raw patch · 23 files changed

+193/−230 lines, 23 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• generic-data-functions.cabal +6/−6
• src/Generic/Data/Function/Common.hs +0/−5
• src/Generic/Data/Function/Common/Error.hs +18/−0
• src/Generic/Data/Function/Common/Generic.hs +35/−0
• src/Generic/Data/Function/Common/Generic/Meta.hs +24/−0
• src/Generic/Data/Function/Common/TypeNats.hs +17/−0
• src/Generic/Data/Function/Contra.hs +3/−3
• src/Generic/Data/Function/Contra/Constructor.hs +3/−7
• src/Generic/Data/Function/Contra/NonSum.hs +6/−5
• src/Generic/Data/Function/Contra/Sum.hs +10/−19
• src/Generic/Data/Function/Example.hs +3/−3
• src/Generic/Data/Function/FoldMap.hs +3/−3
• src/Generic/Data/Function/FoldMap/NonSum.hs +3/−2
• src/Generic/Data/Function/FoldMap/Sum.hs +8/−14
• src/Generic/Data/Function/FoldMap/SumConsByte.hs +1/−1
• src/Generic/Data/Function/Traverse.hs +3/−3
• src/Generic/Data/Function/Traverse/Constructor.hs +9/−2
• src/Generic/Data/Function/Traverse/NonSum.hs +4/−8
• src/Generic/Data/Function/Traverse/Sum.hs +23/−53
• src/Generic/Data/Function/Util/Generic.hs +0/−31
• src/Generic/Data/Function/Util/TypeNats.hs +0/−17
• src/Generic/Data/Rep/Error.hs +0/−48

@@ -1,3 +1,17 @@+## 0.5.0 (2024-04-05)+* Remove `SumOpts` type used for switching whether or not to permit "singleton+  sum types" for sum handlers. This was a type-level switch which changed+  runtime behaviour. generic-data-asserts provides type-level asserts which fail+  at compile time. Now you can't fail at runtime on a singleton sum -- you must+  either allow it, or fail at compile time -- but I don't see this as a problem.+* Add "checked constructor names" to generic traverse fail.+* Clean up some errors, `error` usage:+  * `V1` errors are handled using `absurdV1 :: V1 p -> a` (like `absurd :: Void+    -> a`) instead of error messages -- since I suppose that's what you want if+    you're thrusting void data types at us+  * except for generic traverse, where the user can choose to wrap it into their+    functor (e.g. as a parse error)+ ## 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

@@ -5,10 +5,10 @@ -- see: https://github.com/sol/hpack  name:           generic-data-functions-version:        0.4.1+version:        0.5.0 synopsis:       Familiar functions lifted to generic data types description:    Please see README.md.-category:       Data, Serialization+category:       Data, Generics homepage:       https://github.com/raehik/generic-data-functions#readme bug-reports:    https://github.com/raehik/generic-data-functions/issues author:         Ben Orchard@@ -27,7 +27,10 @@ library   exposed-modules:       Generic.Data.Function-      Generic.Data.Function.Common+      Generic.Data.Function.Common.Error+      Generic.Data.Function.Common.Generic+      Generic.Data.Function.Common.Generic.Meta+      Generic.Data.Function.Common.TypeNats       Generic.Data.Function.Contra       Generic.Data.Function.Contra.Constructor       Generic.Data.Function.Contra.NonSum@@ -42,9 +45,6 @@       Generic.Data.Function.Traverse.Constructor       Generic.Data.Function.Traverse.NonSum       Generic.Data.Function.Traverse.Sum-      Generic.Data.Function.Util.Generic-      Generic.Data.Function.Util.TypeNats-      Generic.Data.Rep.Error       Generic.Data.Wrappers   other-modules:       Paths_generic_data_functions

@@ -1,5 +0,0 @@-module Generic.Data.Function.Common where--data SumOpts-  = SumOnly           -- ^ Only "proper" sum types are permitted, no singletons.-  | AllowSingletonSum -- ^ Treat a single constructor as a sum type still.

@@ -0,0 +1,18 @@+-- | Runtime error messages for common generic data representation errors.++module Generic.Data.Function.Common.Error where++wrapE :: String -> String -> String+wrapE msgGot msgWhyBad =+       "Generic.Data.Function.Common.Error:\n"+    <> "Attempted to use an invalid generic instance: \n"+    <> "  got: "<>msgGot<>"\n"+    <> "  but: "<>msgWhyBad<>"\n"+    <> "If you like, you can catch such errors during compilation.\n"+    <> "See the generic-data-asserts package on Hackage."++eNoEmpty :: String+eNoEmpty = wrapE "empty data type" "disallowed"++eNoSum :: String+eNoSum = wrapE "sum data type" "cannot use non-sum generics"

@@ -0,0 +1,35 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Handy generics utils.++module Generic.Data.Function.Common.Generic where++import GHC.Generics++-- | 'datatypeName' without the value (only used as a proxy). Lets us push our+--   'undefined's into one place.+datatypeName' :: forall d. Datatype d => String+datatypeName' = datatypeName @d undefined++-- | 'conName' without the value (only used as a proxy). Lets us push our+--   'undefined's into one place.+conName' :: forall c. Constructor c => String+conName' = conName @c undefined++-- | 'selName' without the value (only used as a proxy). Lets us push our+--   'undefined's into one place.+selName' :: forall s. Selector s => String+selName' = selName @s undefined++-- | Get the record name for a selector if present.+--+-- On the type level, a 'Maybe Symbol' is stored for record names. But the+-- reification is done using @fromMaybe ""@. So we have to inspect the resulting+-- string to determine whether the field uses record syntax or not. (Silly.)+selName'' :: forall s. Selector s => Maybe String+selName'' = case selName' @s of "" -> Nothing+                                s  -> Just s++-- | 'Data.Void.absurd' for the generic representation of the void type.+absurdV1 :: forall {k} x a. V1 (x :: k) -> a+absurdV1 a = case a of {}

@@ -0,0 +1,24 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE AllowAmbiguousTypes #-} -- for my testing++module Generic.Data.Function.Common.Generic.Meta where++import GHC.Generics+import GHC.TypeLits+import GHC.Exts ( proxy# )++-- | List every constructor name in a generic type rep.+type family CstrNames gf :: [Symbol] where+    CstrNames (l :+: r) = CstrNames l ++ CstrNames r+    CstrNames (C1 ('MetaCons n _ _) _) = '[n]++-- | Append for type-level lists.+type family (as :: [k]) ++ (bs :: [k]) :: [k] where+    '[] ++ bs = bs+    (a ': as) ++ bs = a ': (as ++ bs)++-- | Reify a list of type-level strings. Order is maintained.+class KnownSymbols as where symbolVals :: [String]+instance (KnownSymbol a, KnownSymbols as) => KnownSymbols (a ': as) where+    symbolVals = symbolVal' (proxy# @a) : symbolVals @as+instance KnownSymbols '[] where symbolVals = []

@@ -0,0 +1,17 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Handy typenat utils.++module Generic.Data.Function.Common.TypeNats where++-- natVal''+import GHC.TypeNats ( Natural, KnownNat, natVal' )+import GHC.Exts ( proxy#, Proxy# )++natVal'' :: forall n. KnownNat n => Natural+natVal'' = natVal' (proxy# :: Proxy# n)+{-# INLINE natVal'' #-}++natValInt :: forall n. KnownNat n => Int+natValInt = fromIntegral $ natVal'' @n+{-# INLINE natValInt #-}

@@ -31,9 +31,9 @@ -- This is the most generic option, but depending on your string manipulation -- may be slower. genericContraSum-    :: forall {k} (tag :: k) opts a+    :: forall {k} (tag :: k) a     .  ( Generic a        , Contravariant (GenericContraF tag)-       , GContraSum tag opts (Rep a)+       , GContraSum tag (Rep a)     ) => GenericContraF tag String -> GenericContraF tag a-genericContraSum f = contramap from (gContraSum @tag @opts f)+genericContraSum f = contramap from (gContraSum @tag f)

@@ -21,10 +21,7 @@ class GenericContra tag where     type GenericContraF tag :: Type -> Type     type GenericContraC tag a :: Constraint-    -- TODO added Divisible-    genericContraF-        :: (GenericContraC tag a, Divisible (GenericContraF tag))-        => GenericContraF tag a+    genericContraF :: GenericContraC tag a => GenericContraF tag a  -- | over types with no fields in any constructor instance GenericContra (NoRec0 (f :: Type -> Type)) where@@ -35,9 +32,8 @@ -- | over types where all fields map to 'mempty' instance GenericContra (EmptyRec0 (f :: Type -> Type)) where     type GenericContraF (EmptyRec0 f) = f-    type GenericContraC (EmptyRec0 f) a = ()+    type GenericContraC (EmptyRec0 f) _ = Divisible f     genericContraF = conquer-    -- TODO by adding Divisible f we don't need (Monoid a)/mempty any more  class GContraC tag gf where gContraC :: GenericContraF tag (gf p) @@ -48,7 +44,7 @@     gContraC = divide (\(l :*: r) -> (l, r)) (gContraC @tag) (gContraC @tag)  instance-  ( Divisible (GenericContraF tag)+  ( Contravariant (GenericContraF tag)   , GenericContra tag, GenericContraC tag a   ) => GContraC tag (S1 c (Rec0 a)) where     gContraC = contramap (unK1 . unM1) (genericContraF @tag)

@@ -4,13 +4,12 @@ module Generic.Data.Function.Contra.NonSum where  import Data.Functor.Contravariant+import Data.Functor.Contravariant.Divisible  import GHC.Generics import Generic.Data.Function.Contra.Constructor-  ( GContraC(gContraC)-  , GenericContra(type GenericContraF)-  )-import Generic.Data.Rep.Error+import Generic.Data.Function.Common.Error+import Generic.Data.Function.Common.Generic  class GContraNonSum tag gf where gContraNonSum :: GenericContraF tag (gf p) @@ -25,4 +24,6 @@     gContraNonSumD = contramap unM1 (gContraC @tag)  instance GContraNonSumD tag (l :+: r) where gContraNonSumD = error eNoSum-instance GContraNonSumD tag V1        where gContraNonSumD = error eNoEmpty++instance Divisible (GenericContraF tag) => GContraNonSumD tag V1 where+    gContraNonSumD = contramap absurdV1 conquer

@@ -4,39 +4,30 @@ module Generic.Data.Function.Contra.Sum where  import GHC.Generics-import Generic.Data.Function.Util.Generic ( conName' )+import Generic.Data.Function.Common.Generic import Generic.Data.Function.Contra.Constructor-  ( GContraC(gContraC)-  , GenericContra(type GenericContraF)-  )-import Generic.Data.Rep.Error-import Generic.Data.Function.Common  import Data.Functor.Contravariant.Divisible import Data.Functor.Contravariant -class GContraSum tag (opts :: SumOpts) gf where+class GContraSum tag gf where     gContraSum :: GenericContraF tag String -> GenericContraF tag (gf p) -instance (GContraSumD tag opts gf, Contravariant (GenericContraF tag))-  => GContraSum tag opts (D1 cd gf) where-    gContraSum f = contramap unM1 (gContraSumD @tag @opts f)+instance (GContraSumD tag gf, Contravariant (GenericContraF tag))+  => GContraSum tag (D1 cd gf) where+    gContraSum f = contramap unM1 (gContraSumD @tag f) -class GContraSumD tag (opts :: SumOpts) gf where+class GContraSumD tag gf where     gContraSumD :: GenericContraF tag String -> GenericContraF tag (gf p) -instance GContraCSum tag (l :+: r) => GContraSumD tag opts (l :+: r) where+instance GContraCSum tag (l :+: r) => GContraSumD tag (l :+: r) where     gContraSumD = gContraCSum @tag -instance GContraSumD tag 'SumOnly (C1 cc gf) where-    gContraSumD = error eNeedSum--instance GContraCSum tag (C1 cc gf)-  => GContraSumD tag 'AllowSingletonSum (C1 cc gf) where+instance GContraCSum tag (C1 cc gf) => GContraSumD tag (C1 cc gf) where     gContraSumD = gContraCSum @tag -instance GContraSumD tag opts V1 where-    gContraSumD = error eNoEmpty+instance Divisible (GenericContraF tag) => GContraSumD tag V1 where+    gContraSumD _ = contramap absurdV1 conquer  -- TODO rename (? had this on foldmap sum) class GContraCSum tag gf where

@@ -21,12 +21,12 @@     genericFoldMapF = (\a -> [a]) . show  showGeneric-    :: forall opts a-    .  (Generic a, GFoldMapSum Showly opts (Rep a))+    :: forall a+    .  (Generic a, GFoldMapSum Showly (Rep a))     => a -> String showGeneric =       mconcat . List.intersperse " "-    . genericFoldMapSum @Showly @opts (\cstr -> [cstr])+    . genericFoldMapSum @Showly (\cstr -> [cstr])  showGeneric'     :: forall a

@@ -58,11 +58,11 @@ -- This is the most generic option, but depending on your string manipulation -- may be slower. genericFoldMapSum-    :: forall {k} (tag :: k) opts a-    .  ( Generic a, GFoldMapSum tag opts (Rep a)+    :: forall {k} (tag :: k) a+    .  ( Generic a, GFoldMapSum tag (Rep a)     ) => (String -> GenericFoldMapM tag)     -> a -> GenericFoldMapM tag-genericFoldMapSum f = gFoldMapSum @tag @opts f . from+genericFoldMapSum f = gFoldMapSum @tag f . from  -- | Generic 'foldMap' over a term of sum data type @a@ where constructors are -- mapped to their index (distance from first/leftmost constructor)

@@ -7,7 +7,8 @@ import Generic.Data.Function.FoldMap.Constructor   ( GFoldMapC(gFoldMapC)   , GenericFoldMap(type GenericFoldMapM) )-import Generic.Data.Rep.Error+import Generic.Data.Function.Common.Error+import Generic.Data.Function.Common.Generic ( absurdV1 )  {- | 'foldMap' over generic product data types. @@ -23,4 +24,4 @@     gFoldMapNonSum (M1 a) = gFoldMapC @tag a  instance GFoldMapNonSum tag (l :+: r) where gFoldMapNonSum = error eNoSum-instance GFoldMapNonSum tag V1        where gFoldMapNonSum = error eNoEmpty+instance GFoldMapNonSum tag V1        where gFoldMapNonSum = absurdV1

@@ -12,32 +12,26 @@ module Generic.Data.Function.FoldMap.Sum where  import GHC.Generics-import Generic.Data.Function.Util.Generic ( conName' )+import Generic.Data.Function.Common.Generic ( conName', absurdV1 ) import Generic.Data.Function.FoldMap.Constructor   ( GFoldMapC(gFoldMapC)   , GenericFoldMap(type GenericFoldMapM) )-import Generic.Data.Rep.Error-import Generic.Data.Function.Common -class GFoldMapSum tag (opts :: SumOpts) gf where+class GFoldMapSum tag gf where     gFoldMapSum         :: (String -> GenericFoldMapM tag) -> gf p -> GenericFoldMapM tag -instance GFoldMapSum tag opts gf => GFoldMapSum tag opts (D1 c gf) where-    gFoldMapSum f = gFoldMapSum @tag @opts f . unM1+instance GFoldMapSum tag gf => GFoldMapSum tag (D1 c gf) where+    gFoldMapSum f = gFoldMapSum @tag f . unM1 -instance GFoldMapCSum tag (l :+: r) => GFoldMapSum tag opts (l :+: r) where+instance GFoldMapCSum tag (l :+: r) => GFoldMapSum tag (l :+: r) where     gFoldMapSum = gFoldMapCSum @tag -instance GFoldMapSum tag 'SumOnly (C1 c gf) where-    gFoldMapSum = error eNeedSum--instance GFoldMapCSum tag (C1 c gf)-  => GFoldMapSum tag 'AllowSingletonSum (C1 c gf) where+instance GFoldMapCSum tag (C1 c gf) => GFoldMapSum tag (C1 c gf) where     gFoldMapSum = gFoldMapCSum @tag -instance GFoldMapSum tag opts V1 where-    gFoldMapSum = error eNoEmpty+instance GFoldMapSum tag V1 where+    gFoldMapSum _ = absurdV1  -- | Sum type handler prefixing constructor contents with their mapped --   constructor name via a provided @String -> m@.

@@ -14,7 +14,7 @@ import GHC.Generics import GHC.TypeLits import Data.Kind ( Type, Constraint )-import Generic.Data.Function.Util.TypeNats ( natVal'' )+import Generic.Data.Function.Common.TypeNats ( natVal'' ) import Generic.Data.Function.FoldMap.Constructor   ( GFoldMapC(gFoldMapC)   , GenericFoldMap(type GenericFoldMapM) )

@@ -39,13 +39,13 @@ -- -- You must provide a configuration for how to handle constructors. genericTraverseSum-    :: forall {k} (tag :: k) opts a pt+    :: forall {k} (tag :: k) a pt     .  ( Generic a        , Functor (GenericTraverseF tag)-       , GTraverseSum tag opts (Rep a)+       , GTraverseSum tag (Rep a)        , GenericTraverseC tag pt     ) => PfxTagCfg pt -> GenericTraverseF tag a-genericTraverseSum ptc = to <$> gTraverseSum @tag @opts ptc+genericTraverseSum ptc = to <$> gTraverseSum @tag ptc  -- | Construct a prefix tag config using existing 'Eq' and 'Show' instances. --

@@ -5,8 +5,9 @@  import GHC.Generics import GHC.TypeNats ( Natural, KnownNat, type (+) )-import Generic.Data.Function.Util.Generic ( datatypeName', conName', selName'' )-import Generic.Data.Function.Util.TypeNats ( natVal'' )+import Generic.Data.Function.Common.Generic ( datatypeName', conName', selName'' )+import Generic.Data.Function.Common.TypeNats ( natVal'' )+import Generic.Data.Function.Common.Error ( eNoEmpty )  import Control.Applicative qualified as Applicative import Control.Applicative ( Alternative(empty) )@@ -43,6 +44,12 @@         -> Maybe String {- ^ record name (if present) -}         -> Natural      {- ^ field index -}         -> GenericTraverseF tag a++    -- | Action to run when trying to parse a 'V1' (void data type).+    --+    -- Defaults to 'error', but you may wrap it in your functor if it pleases.+    genericTraverseV1 :: GenericTraverseF tag (V1 p)+    genericTraverseV1 = error eNoEmpty  -- | 'traverse' over types with no fields in any constructor. instance GenericTraverse (NoRec0 (f :: Type -> Type)) where

@@ -5,10 +5,7 @@  import GHC.Generics import Generic.Data.Function.Traverse.Constructor-  ( GTraverseC(gTraverseC)-  , GenericTraverse(type GenericTraverseF)-  )-import Generic.Data.Rep.Error+import Generic.Data.Function.Common.Error  class GTraverseNonSum tag gf where     gTraverseNonSum :: GenericTraverseF tag (gf p)@@ -24,7 +21,6 @@   => 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+instance GTraverseNonSumD tag cd (l :+: r) where gTraverseNonSumD = error eNoSum+instance GenericTraverse tag => GTraverseNonSumD tag cd V1 where+    gTraverseNonSumD = genericTraverseV1 @tag

@@ -1,25 +1,18 @@-{-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6+{-# LANGUAGE UndecidableInstances #-} -- due to type hell {-# LANGUAGE AllowAmbiguousTypes  #-} -- due to generic typeclass design  module Generic.Data.Function.Traverse.Sum where  import GHC.Generics-import Generic.Data.Function.Util.Generic ( datatypeName', conName' )+import Generic.Data.Function.Common.Generic+import Generic.Data.Function.Common.Generic.Meta import Generic.Data.Function.Traverse.Constructor-  ( GTraverseC(gTraverseC)-  , GenericTraverse(type GenericTraverseF, type GenericTraverseC)-  )-import Generic.Data.Rep.Error-import Generic.Data.Function.Common  import Data.Text ( Text ) import Control.Applicative qualified as Applicative import Control.Applicative ( Alternative((<|>)) ) -{- | Sum type monads that can be generically 'traverse'd.--We use 'Alternative' to handle "which constructor" checking on the term level.--}+-- | Sum type monads that can be generically 'traverse'd. class GenericTraverse tag => GenericTraverseSum tag where     -- | Try to parse a prefix tag of type 'pt'.     --@@ -53,56 +46,33 @@   -- ^ Make a prefix tag human-readable. 'show' is often appropriate.   } -class GTraverseSum tag (opts :: SumOpts) gf where+class GTraverseSum tag 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 tag cd (l :+: r), Datatype cd-  , Alternative (GenericTraverseF tag)-  , Monad (GenericTraverseF tag)-  ) => GTraverseSumD tag cd opts (l :+: r) where-    gTraverseSumD = gTraverseSumD' @tag @cd--gTraverseSumD'-    :: forall {p} tag cd gf pt-    .  ( GenericTraverseC tag pt-       , Alternative (GenericTraverseF tag)-       , Monad (GenericTraverseF tag)-       , GenericTraverseSum tag, GTraverseCSum tag cd gf-       , Datatype cd-    ) => PfxTagCfg pt -> GenericTraverseF tag (gf p)-gTraverseSumD' ptc = do-    pt <- genericTraverseSumPfxTagAction @tag cd-    gTraverseCSum @tag @cd ptc pt <|> parseErrorNoMatch pt-  where-    cd = datatypeName' @cd-    parseErrorNoMatch pt =-        genericTraverseSumNoMatchingCstrAction @tag cd testedCstrs ((pfxTagCfgShow ptc) pt)-    testedCstrs = [] -- TODO--instance GTraverseSumD tag cd 'SumOnly (C1 cc gf) where-    gTraverseSumD = error eNeedSum+instance GenericTraverse tag => GTraverseSum tag V1 where+    gTraverseSum _ = genericTraverseV1 @tag +-- | Test all constructors of the given non-void data type; if they all fail,+--   run a failure action and pass it all the constructors names in the type. instance-  ( GenericTraverseSum tag, GTraverseCSum tag cd (C1 cc gf), Datatype cd+  ( GenericTraverseC tag pt   , Alternative (GenericTraverseF tag)   , Monad (GenericTraverseF tag)-  ) => GTraverseSumD tag cd 'AllowSingletonSum (C1 cc gf) where-    gTraverseSumD = gTraverseSumD' @tag @cd--instance GTraverseSumD opts tag cd V1 where-    gTraverseSumD = error eNoEmpty+  , GenericTraverseSum tag, GTraverseCSum tag cd gf+  , Datatype cd+  , KnownSymbols (CstrNames gf)+  ) => GTraverseSum tag (D1 cd gf) where+    gTraverseSum ptc = do+        pt <- genericTraverseSumPfxTagAction @tag cd+        M1 <$> (gTraverseCSum @tag @cd ptc pt <|> parseErrorNoMatch pt)+      where+        cd = datatypeName' @cd+        parseErrorNoMatch pt =+            genericTraverseSumNoMatchingCstrAction @tag cd testedCstrs+                ((pfxTagCfgShow ptc) pt)+        testedCstrs = symbolVals @(CstrNames gf)  class GTraverseCSum tag cd gf where     gTraverseCSum :: PfxTagCfg pt -> pt -> GenericTraverseF tag (gf p)

@@ -1,31 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}---- | Handy generics utils.--module Generic.Data.Function.Util.Generic where--import GHC.Generics---- | 'datatypeName' without the value (only used as a proxy). Lets us push our---   'undefined's into one place.-datatypeName' :: forall d. Datatype d => String-datatypeName' = datatypeName @d undefined---- | 'conName' without the value (only used as a proxy). Lets us push our---   'undefined's into one place.-conName' :: forall c. Constructor c => String-conName' = conName @c undefined---- | 'selName' without the value (only used as a proxy). Lets us push our---   'undefined's into one place.-selName' :: forall s. Selector s => String-selName' = selName @s undefined---- | Get the record name for a selector if present.------ On the type level, a 'Maybe Symbol' is stored for record names. But the--- reification is done using @fromMaybe ""@. So we have to inspect the resulting--- string to determine whether the field uses record syntax or not. (Silly.)-selName'' :: forall s. Selector s => Maybe String-selName'' = case selName' @s of "" -> Nothing-                                s  -> Just s

@@ -1,17 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}---- | Handy typenat utils.--module Generic.Data.Function.Util.TypeNats where---- natVal''-import GHC.TypeNats ( Natural, KnownNat, natVal' )-import GHC.Exts ( proxy#, Proxy# )--natVal'' :: forall n. KnownNat n => Natural-natVal'' = natVal' (proxy# :: Proxy# n)-{-# INLINE natVal'' #-}--natValInt :: forall n. KnownNat n => Int-natValInt = fromIntegral $ natVal'' @n-{-# INLINE natValInt #-}

@@ -1,48 +0,0 @@-{- | Common descriptions for common generic data representation errors. Type-    level (compile time) and term level (runtime).--TODO: if this package ever expands, these deserve plenty of attention, like-generic-optics has.--Runtime errors are a bit meatier because it's easy to do so, and I don't want-people to see them more than once (really you should use the typing support).--}--module Generic.Data.Rep.Error where--import GHC.TypeLits ( ErrorMessage(Text) )--wrapE :: String -> String -> String-wrapE msgGot msgWhyBad =-       "Generic.Data.Rep.Error:\n"-    <> "Attempted to use an invalid generic instance: \n"-    <> "got: "<>msgGot<>"\n"-    <> "but: "<>msgWhyBad<>"\n"-    <> "You can likely catch such errors during compilation.\n"-    <> "See the generic-data-functions package on Hackage."---- | Common type error string for when you attempt to use a generic instance---   at an empty data type (e.g. 'Data.Void.Void', 'GHC.Generics.V1').-type ENoEmpty = 'Text "Requested generic instance disallows empty data type"-eNoEmpty :: String-eNoEmpty = wrapE "empty data type" "disallowed"---- | Common type error string for when GHC is asked to derive a non-sum---   instance, but the data type in question turns out to be a sum data type.------ No need to add the data type name here, since GHC's context includes the--- surrounding instance declaration.-type EUnexpectedSum =-    'Text "Cannot derive non-sum generic instance for sum data type"-eNoSum :: String-eNoSum = wrapE "sum data type" "cannot use non-sum generics"---- | Common type error string for when GHC is asked to derive a sum instance,---   but the data type in question turns out to be a non-sum data type.------ No need to add the data type name here, since GHC's context includes the--- surrounding instance declaration.-type EUnexpectedNonSum =-    'Text "Refusing to derive sum generic instance for non-sum data type"-eNeedSum :: String-eNeedSum = wrapE "non-sum data type" "cannot use sum-only generics"