generic-data-functions 0.1.1 → 0.2.0

raw patch · 15 files changed

+264/−116 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• README.md +20/−0
• generic-data-functions.cabal +4/−2
• src/Generic/Data/Function/Common.hs +5/−0
• src/Generic/Data/Function/Error.hs +0/−25
• src/Generic/Data/Function/Example.hs +31/−9
• src/Generic/Data/Function/FoldMap.hs +13/−8
• src/Generic/Data/Function/FoldMap/NonSum.hs +6/−10
• src/Generic/Data/Function/FoldMap/Sum.hs +13/−12
• src/Generic/Data/Function/FoldMap/SumConsByte.hs +2/−3
• src/Generic/Data/Function/Traverse.hs +15/−10
• src/Generic/Data/Function/Traverse/NonSum.hs +7/−14
• src/Generic/Data/Function/Traverse/Sum.hs +25/−23
• src/Generic/Data/Rep/Assert.hs +68/−0
• src/Generic/Data/Rep/Error.hs +48/−0

@@ -1,3 +1,10 @@+## 0.2.0 (2023-08-04)+* Redesign interface, pushing certain checks out of type classes into top-level+  generic function type signature. It means busier top-level types and more code+  for wrapping them, but it allows for more flexibility and cleans up+  implementation. (And the busyness simply makes explicit the implicit checks+  that were being done before.)+ ## 0.1.1 (2023-07-20)   * add work-in-progress store-style generic `foldMap`, encoding constructors by     their index, at `Generic.Data.Function.FoldMap.SumConsByte`

@@ -73,5 +73,25 @@ classes. Thus, you will likely be dealing in orphans. Instances, that is. That's life, Jim. +### Funky generics+I have made some weird design choices in this library. Here are some rationales.++#### Handling badness on type & term levels+I don't like silently erroring on badly-configured generics usage, e.g. asking+for a function via generics for an empty data type. Originally, I made those+type error, and that was that. But it meant I would write the same instance over+and over again. And that requirement was hidden in a type class implementation.+Really, it'd be nice if I could put such requirements directly in the types of+the functions that have them.++I've done that. Now, on certain *representation errors*, e.g. you tried to use+non-sum generics on a sum type, we runtime error instead. However, there's a+separate layer for making *assertions about generic representation on the type+level*, the use of which is highly suggested.++Note that if you like to write wrappers over generic functions to fill in+certain bits of info, your job just got a lot uglier. Soz. Anything for type+safety my sweet.+ ## License Provided under the MIT license. See `LICENSE` for license text.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           generic-data-functions-version:        0.1.1+version:        0.2.0 synopsis:       Familiar functions lifted to generic data types description:    Please see README.md. category:       Data, Serialization@@ -27,7 +27,7 @@ library   exposed-modules:       Generic.Data.Function-      Generic.Data.Function.Error+      Generic.Data.Function.Common       Generic.Data.Function.Example       Generic.Data.Function.FoldMap       Generic.Data.Function.FoldMap.Constructor@@ -41,6 +41,8 @@       Generic.Data.Function.Util.Generic       Generic.Data.Function.Util.TypeNats       Generic.Data.Function.Via+      Generic.Data.Rep.Assert+      Generic.Data.Rep.Error   other-modules:       Paths_generic_data_functions   hs-source-dirs:

@@ -0,0 +1,5 @@+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.

@@ -1,25 +0,0 @@--- | Common descriptions for generic data type errors.--module Generic.Data.Function.Error where--import GHC.TypeLits ( ErrorMessage(Text) )---- | 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"---- | 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"---- | 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"

@@ -1,14 +1,36 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+ module Generic.Data.Function.Example where -import GHC.Generics ( Generic )-import Generic.Data.Function.FoldMap.Constructor ( GenericFoldMap(..) )+import GHC.Generics+import Generic.Data.Function.FoldMap+import Generic.Data.Rep.Assert -data D a = D1 a | D2 a a deriving stock (Generic, Show)+import Data.List qualified as List -newtype Showly a = Showly { unShowly :: a }-    deriving Show via a-    deriving (Semigroup, Monoid) via a+--data D a = D1 a | D2 a a deriving stock (Generic, Show)+data X = X1 | X2 deriving stock (Generic)+data Y = Y deriving stock (Generic) -instance GenericFoldMap (Showly String) where-    type GenericFoldMapC (Showly String) a = Show a-    genericFoldMapF = Showly . show+newtype Showly = Showly { unShowly :: [String] }+    --deriving Show via String+    deriving (Semigroup, Monoid) via [String]++instance GenericFoldMap Showly where+    type GenericFoldMapC Showly a = Show a+    genericFoldMapF = Showly . (\a -> [a]) . show++showGeneric+    :: forall {cd} {f} opts asserts a+    .  (Generic a, Rep a ~ D1 cd f, GFoldMapSum opts Showly f, ApplyGCAsserts asserts f)+    => a -> String+showGeneric =+      mconcat . List.intersperse " " . unShowly+    . genericFoldMapSum @opts @asserts (\cstr -> Showly [cstr])++showGeneric'+    :: forall {cd} {f} asserts a+    .  (Generic a, Rep a ~ D1 cd f, GFoldMapNonSum Showly f, ApplyGCAsserts asserts f)+    => a -> String+showGeneric' =+    mconcat . List.intersperse " " . unShowly . genericFoldMapNonSum @asserts

@@ -1,3 +1,5 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+ {- | 'foldMap' for generic data types.  'foldMap' can be considered a two-step process:@@ -34,6 +36,7 @@  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@@ -44,25 +47,27 @@ -- -- @a@ must have exactly one constructor. genericFoldMapNonSum-    :: forall m a-    .  (Generic a, GFoldMapNonSum m (Rep a))+    :: forall {cd} {f} asserts m a+    .  ( Generic a, Rep a ~ D1 cd f+       , GFoldMapNonSum m f+       , ApplyGCAsserts asserts f)     => a -> m-genericFoldMapNonSum = gFoldMapNonSum . from+genericFoldMapNonSum = gFoldMapNonSum . unM1 . from  -- | Generic 'foldMap' over a term of sum data type @a@. ----- @a@ must have at least two constructors.--- -- You must provide a function for mapping constructor names to monoidal values. -- -- This is the most generic option, but depending on your string manipulation -- may be slower. genericFoldMapSum-    :: forall m a-    .  (Generic a, GFoldMapSum m (Rep a))+    :: forall {cd} {f} opts asserts m a+    .  ( Generic a, Rep a ~ D1 cd f+       , GFoldMapSum opts m f+       , ApplyGCAsserts asserts f)     => (String -> m)     -> a -> m-genericFoldMapSum f = gFoldMapSum f . from+genericFoldMapSum f = gFoldMapSum @opts f . unM1 . from  -- | Generic 'foldMap' over a term of sum data type @a@ where constructors are -- mapped to their index (distance from first/leftmost constructor)

@@ -3,9 +3,8 @@ module Generic.Data.Function.FoldMap.NonSum where  import GHC.Generics-import GHC.TypeLits ( TypeError )-import Generic.Data.Function.Error ( type ENoEmpty, type EUnexpectedSum ) import Generic.Data.Function.FoldMap.Constructor ( GFoldMapC(gFoldMapC) )+import Generic.Data.Rep.Error  {- | 'foldMap' over generic product data types. @@ -14,14 +13,11 @@ -} class GFoldMapNonSum m f where gFoldMapNonSum :: f p -> m -instance GFoldMapNonSum m f => GFoldMapNonSum m (D1 c f) where-    gFoldMapNonSum (M1 a) = gFoldMapNonSum a--instance TypeError EUnexpectedSum => GFoldMapNonSum m (l :+: r) where-    gFoldMapNonSum = undefined- instance GFoldMapC m f => GFoldMapNonSum m (C1 c f) where     gFoldMapNonSum (M1 a) = gFoldMapC a -instance TypeError ENoEmpty => GFoldMapNonSum m V1 where-    gFoldMapNonSum = undefined+instance GFoldMapNonSum m (l :+: r) where+    gFoldMapNonSum = error eNoSum++instance GFoldMapNonSum m V1 where+    gFoldMapNonSum = error eNoEmpty

@@ -1,3 +1,4 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6  {- | 'foldMap' for sum types where constructors are encoded by mapping the@@ -11,25 +12,25 @@ module Generic.Data.Function.FoldMap.Sum where  import GHC.Generics-import GHC.TypeLits ( TypeError ) import Generic.Data.Function.Util.Generic ( conName' )-import Generic.Data.Function.Error ( type ENoEmpty, type EUnexpectedNonSum ) import Generic.Data.Function.FoldMap.Constructor ( GFoldMapC(gFoldMapC) )--class GFoldMapSum m f where-    gFoldMapSum :: (String -> m) -> f p -> m+import Generic.Data.Rep.Error+import Generic.Data.Function.Common -instance GFoldMapSum m f => GFoldMapSum m (D1 c f) where-    gFoldMapSum f (M1 a) = gFoldMapSum f a+class GFoldMapSum (opts :: SumOpts) m f where gFoldMapSum :: (String -> m) -> f p -> m -instance GFoldMapCSum m (l :+: r) => GFoldMapSum m (l :+: r) where+instance GFoldMapCSum m (l :+: r) => GFoldMapSum opts m (l :+: r) where     gFoldMapSum = gFoldMapCSum -instance TypeError EUnexpectedNonSum => GFoldMapSum m (C1 c f) where-    gFoldMapSum = undefined+instance GFoldMapSum 'SumOnly m (C1 c f) where+    gFoldMapSum = error eNeedSum -instance TypeError ENoEmpty => GFoldMapSum m V1 where-    gFoldMapSum = undefined+instance GFoldMapCSum m (C1 c f)+  => GFoldMapSum 'AllowSingletonSum m (C1 c f) where+    gFoldMapSum = gFoldMapCSum++instance GFoldMapSum opts m V1 where+    gFoldMapSum = error eNoEmpty  -- | Sum type handler prefixing constructor contents with their mapped --   constructor name via a provided @String -> m@.

@@ -15,7 +15,6 @@ import GHC.TypeLits import Data.Kind ( Type, Constraint ) import Generic.Data.Function.Util.TypeNats ( natVal'' )-import Generic.Data.Function.Error ( type ENoEmpty, type EUnexpectedNonSum ) import Generic.Data.Function.FoldMap.Constructor ( GFoldMapC(gFoldMapC) )  import Data.Word ( Word8 )@@ -35,10 +34,10 @@     gFoldMapSumConsByte f lr =         gFoldMapCSumCtrArityByte @m @0 f lr <> gFoldMapCSumCtr lr -instance TypeError EUnexpectedNonSum => GFoldMapSumConsByte m (C1 c f) where+instance GFoldMapSumConsByte m (C1 c f) where     gFoldMapSumConsByte _ = undefined -instance TypeError ENoEmpty => GFoldMapSumConsByte m V1 where+instance GFoldMapSumConsByte m V1 where     gFoldMapSumConsByte _ = undefined  ---

@@ -1,3 +1,5 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+ {- | 'traverse' for generic data types.  TODO This is harder to conceptualize than generic 'foldMap'. No nice clean@@ -16,6 +18,7 @@  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@@ -23,25 +26,27 @@ import Data.Text qualified as Text  -- | Generic 'traverse' over a term of non-sum data type @f a@.------ @f a@ must have exactly one constructor. genericTraverseNonSum-    :: forall f a-    .  (Generic a, GTraverseNonSum f (Rep a), Functor f)+    :: forall {cd} {gf} asserts f a+    .  ( Generic a, Rep a ~ D1 cd gf+       , GTraverseNonSum cd f gf+       , ApplyGCAsserts asserts f+       , Functor f)     => f a-genericTraverseNonSum = to <$> gTraverseNonSum+genericTraverseNonSum = (to . M1) <$> gTraverseNonSum @cd  -- | Generic 'traverse' over a term of sum data type @f a@. ----- @f a@ must have at least two constructors.--- -- You must provide a configuration for how to handle constructors. genericTraverseSum-    :: forall f a pt-    .  (Generic a, GTraverseSum f (Rep a), GenericTraverseC f pt, Functor f)+    :: forall {cd} {gf} opts asserts f a pt+    .  ( Generic a, Rep a ~ D1 cd gf+       , GTraverseSum opts cd f gf+       , ApplyGCAsserts asserts f+       , GenericTraverseC f pt, Functor f)     => PfxTagCfg pt     -> f a-genericTraverseSum ptc = to <$> gTraverseSum ptc+genericTraverseSum ptc = (to . M1) <$> gTraverseSum @opts @cd ptc  -- | Construct a prefix tag config using existing 'Eq' and 'Show' instances. --

@@ -4,23 +4,16 @@ module Generic.Data.Function.Traverse.NonSum where  import GHC.Generics-import GHC.TypeLits ( TypeError )-import Generic.Data.Function.Error ( type ENoEmpty, type EUnexpectedSum ) import Generic.Data.Function.Traverse.Constructor ( GTraverseC(gTraverseC) ) -class GTraverseNonSum f f' where gTraverseNonSum :: f (f' p)--instance (Functor f, GTraverseNonSum' cd f f') => GTraverseNonSum f (D1 cd f') where-    gTraverseNonSum = M1 <$> gTraverseNonSum' @cd--class GTraverseNonSum' cd f f' where gTraverseNonSum' :: f (f' p)+class GTraverseNonSum (cd :: Meta) f f' where gTraverseNonSum :: f (f' p) -instance TypeError EUnexpectedSum => GTraverseNonSum' cd f (l :+: r) where-    gTraverseNonSum' = undefined+instance GTraverseNonSum cd f (l :+: r) where+    gTraverseNonSum = undefined  instance (Functor f, GTraverseC cd cc 0 f f')-  => GTraverseNonSum' cd f (C1 cc f') where-    gTraverseNonSum' = M1 <$> gTraverseC @cd @cc @0+  => GTraverseNonSum cd f (C1 cc f') where+    gTraverseNonSum = M1 <$> gTraverseC @cd @cc @0 -instance TypeError ENoEmpty => GTraverseNonSum' cd f V1 where-    gTraverseNonSum' = undefined+instance GTraverseNonSum cd f V1 where+    gTraverseNonSum = undefined

@@ -4,10 +4,10 @@ module Generic.Data.Function.Traverse.Sum where  import GHC.Generics-import GHC.TypeLits ( TypeError ) import Generic.Data.Function.Util.Generic ( datatypeName', conName' )-import Generic.Data.Function.Error ( type ENoEmpty, type EUnexpectedNonSum ) import Generic.Data.Function.Traverse.Constructor ( GTraverseC(gTraverseC), GenericTraverse(..) )+import Generic.Data.Rep.Error+import Generic.Data.Function.Common  import Data.Text ( Text ) import Control.Applicative qualified as Applicative@@ -50,33 +50,35 @@   -- ^ Make a prefix tag human-readable. 'show' is often appropriate.   } -class GTraverseSum f f' where+class GTraverseSum (opts :: SumOpts) cd f f' where     gTraverseSum :: GenericTraverseC f pt => PfxTagCfg pt -> f (f' p) -instance (Functor f, GTraverseSum' cd f f') => GTraverseSum f (D1 cd f') where-    gTraverseSum pt = M1 <$> gTraverseSum' @cd pt+instance (GenericTraverseSum f, GTraverseCSum cd f (l :+: r), Datatype cd)+  => GTraverseSum opts cd f (l :+: r) where+    gTraverseSum = gTraverseSum' @cd -class GTraverseSum' cd f f' where-    gTraverseSum' :: GenericTraverseC f pt => PfxTagCfg pt -> f (f' p)+gTraverseSum'+    :: forall {p} cd f f' pt+    .  (GenericTraverseC f pt, GenericTraverseSum f, GTraverseCSum cd f f', Datatype cd)+    => PfxTagCfg pt -> f (f' p)+gTraverseSum' ptc = do+    pt <- genericTraverseSumPfxTagAction cd+    gTraverseCSum @cd ptc pt <|> parseErrorNoMatch pt+  where+    cd = datatypeName' @cd+    parseErrorNoMatch pt =+        genericTraverseSumNoMatchingCstrAction cd testedCstrs ((pfxTagCfgShow ptc) pt)+    testedCstrs = [] -- TODO -instance (GenericTraverseSum f, GTraverseCSum cd f (l :+: r), Datatype cd)-  => GTraverseSum' cd f (l :+: r) where-    gTraverseSum' ptc = do-        pt <- genericTraverseSumPfxTagAction cd-        gTraverseCSum @cd ptc pt <|> parseErrorNoMatch pt-      where-        cd = datatypeName' @cd-        parseErrorNoMatch pt =-            genericTraverseSumNoMatchingCstrAction cd testedCstrs ((pfxTagCfgShow ptc) pt)-        testedCstrs = [] -- TODO+instance GTraverseSum 'SumOnly cd f (C1 cc f') where+    gTraverseSum = error eNeedSum --- | Refuse to derive a non-sum instance if we expected a sum data type.-instance TypeError EUnexpectedNonSum => GTraverseSum' cd f (C1 cc f') where-    gTraverseSum' = undefined+instance (GenericTraverseSum f, GTraverseCSum cd f (C1 cc f'), Datatype cd)+  => GTraverseSum 'AllowSingletonSum cd f (C1 cc f') where+    gTraverseSum = gTraverseSum' @cd --- | Refuse to derive an instance for an empty data type.-instance TypeError ENoEmpty => GTraverseSum' cd f V1 where-    gTraverseSum' = undefined+instance GTraverseSum opts cd f V1 where+    gTraverseSum = error eNoEmpty  -- | Generic getter (constructor sum level). class GTraverseCSum cd f f' where

@@ -0,0 +1,68 @@+{-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6 TODO maybe untrue for this++{- | 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 = ()

@@ -0,0 +1,48 @@+{- | 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"