packages feed

generic-data-functions (empty) → 0.1.0

raw patch · 17 files changed

+721/−0 lines, 17 filesdep +basedep +text

Dependencies added: base, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,4 @@+## 0.1.0 (2023-06-23)+Initial release.++  * extracted from binrep
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2023 Ben Orchard (@raehik) <thefirstmuffinman@gmail.com>++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,91 @@+[hackage-flatparse]: https://hackage.haskell.org/package/flatparse+[hackage-megaparsec]: https://hackage.haskell.org/package/megaparsec++# generic-data-functions+A small Haskell library providing some funky generics that work over arbitrary+Haskell data types. We handle the sums of products representation; you only need+to pass a handful of definitions. Obtain simple, type-safe generic+serializers/reducers and parsers for almost zero effort.++## Functions+### `foldMap` (L->R)+```haskell+foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m+```++The user provides the `a -> m` dictionary via a special type class instance.+Constructor fields are mapped and combined left-to-right. Sum representations+are handled by mappending the constructor via a user-supplied `String -> m`+first.++Useful for:++  * simple binary serializers which just concatenate fields together+  * reducing to a numeric value++### `traverse` (L->R)+```haskell+traverse :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b)+```++The user provides the `f a` dictionary via a special type class instance.+Constructor field actions are run left-to-right.+Sum representations are handled by running a constructor action first (thus+requiring `Monad f`).++Useful for:++  * simple binary parsers which can parse generic `foldMap` output++## Notes+### Orphan instances+This library is designed to work with and around existing libraries and type+classes. Thus, you will likely be dealing in orphans. Instances, that is. That's+life, Jim.++## License+Provided under the MIT license. See `LICENSE` for license text.++---++senserial is a small library providing reusable generics for (binary) parsers+and serializers. No need to muddle through boilerplate generics that look the+same as everyone else's; just provide a few definitions and senserial can give+you powerful generic instances.++Currently an unofficial library, distributed as part of binrep. Reader, please+let the author know if you'd like it released separately.++## Why?+It is 2023. There are a number of competing parsing and serialization Haskell+libraries, and some notable high-performance binary serialization libraries.+These are often fairly experimental. Maybe you want some generics to benchmark+some real-world use case against popular libraries like binary and cereal. But+maybe generics aren't provided. Shucks.++That's a shame, because a pure generic binary parser or serializer doesn't have+much work to do:++  * traverse the generic sum-of-products tree of the given type left to right+  * defer to the appropriate type class for base cases++Sum types necessitate a little more work. Otherwise, most generic binary parsers+and serializers look fairly comparable to each other. Why are we rewriting this+stuff over and over again?++senserial provides *reusable generics* which have holes in for your favourite+parsers and serializers. Fill out a few definitions to receive a fresh new+generic instance for your own library, without all the boilerplate.++## Really?+Kind of. In reality, this library can only handle cases where no configuration+is needed other than what is provided in the data type itself. senserial+provides the generic traversal, and you can't alter that. Plus, the only+often rewritten and straightforward traversal I can think of is sequential field+concatenation. So though the code isn't limited to bytestrings and binary+serialization formats, you will have trouble using it for anything else, because+anything else will probably require a very different traversal (e.g. JSON+serialization).++In short, the primary use of this library is to pull out the common generics+patterns from binary serialization libraries for easy reuse.
+ generic-data-functions.cabal view
@@ -0,0 +1,61 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack++name:           generic-data-functions+version:        0.1.0+synopsis:       Familiar functions lifted to generic data types+description:    Please see README.md.+category:       Data, Serialization+homepage:       https://github.com/raehik/generic-data-functions#readme+bug-reports:    https://github.com/raehik/generic-data-functions/issues+author:         Ben Orchard+maintainer:     Ben Orchard <thefirstmuffinman@gmail.com>+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/raehik/generic-data-functions++library+  exposed-modules:+      Generic.Data.Function+      Generic.Data.Function.Error+      Generic.Data.Function.FoldMap+      Generic.Data.Function.FoldMap.Constructor+      Generic.Data.Function.FoldMap.NonSum+      Generic.Data.Function.FoldMap.Sum+      Generic.Data.Function.Traverse+      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.Function.Via+  other-modules:+      Paths_generic_data_functions+  hs-source-dirs:+      src+  default-extensions:+      LambdaCase+      NoStarIsType+      DerivingVia+      DeriveAnyClass+      GADTs+      RoleAnnotations+      DefaultSignatures+      TypeFamilies+      DataKinds+      MagicHash+  ghc-options: -Wall+  build-depends:+      base >=4.14 && <5+    , text >=1.2.5.0 && <2.1+  default-language: GHC2021
+ src/Generic/Data/Function.hs view
@@ -0,0 +1,22 @@+{- | Functions "lifted" (roughly) to generic Haskell data types.++Haskell data types have a fair amount of structure to them:++  * Multiple constructors (sums)+  * Multiple fields (products)+  * Constructor names must be unique+  * Fields are ordered left-to-right (or top-to-bottom)++We leverage this structure to provide parameterized generic functions, where the+user only handles the base case (individual fields). Such generics are very+relevant for simplistic usages like boring type folds and serializing tasks. No+need to bash out 50 lines of arcane type algebra -- just write a single instance+and you're golden.++Sum types introduce choice, which brings an extra layer of complexity. For this+reason, most functions provide a sum type version and a non-sum type version.+Sum type generic functions will require a bit more information, like some extra+definitions or instances. Using the wrong one will result in a clear type error.+-}++module Generic.Data.Function where
+ src/Generic/Data/Function/Error.hs view
@@ -0,0 +1,25 @@+-- | 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"
+ src/Generic/Data/Function/FoldMap.hs view
@@ -0,0 +1,59 @@+{- | 'foldMap' for generic data types.++'foldMap' can be considered a two-step process:++  * map every element @a@ of a @t a@ (where @'Foldable' t@) to some @'Monoid' m@+  * combine elements using '(<>)'++Applying this to generic data types:++  * map every field of a constructor to some @'Monoid' m@+  * combine elements using '(<>)'++Field mappings are handled using a per-monoid type class. You need a monoid @m@+with an associated type class which has a function @a -> m@. Write a+'GenericFoldMap' instance for your monoid which points to your type class. If a+field type doesn't have a matching instance, the generic instance emits a type+error.++Sum types (with multiple constructors) are handled by '(<>)'-ing the constructor+with its contents (in that order). You must provide a @String -> m@ function for+mapping constructor names. If you need custom sum type handling, you may write+your own and still leverage the individual constructor generics.++This function can provide generic support for simple fold-y operations like+serialization.+-}++module Generic.Data.Function.FoldMap+  ( GenericFoldMap(..)+  , genericFoldMapNonSum, GFoldMapNonSum+  , genericFoldMapSum,    GFoldMapSum+  ) where++import GHC.Generics++import Generic.Data.Function.FoldMap.NonSum+import Generic.Data.Function.FoldMap.Sum+import Generic.Data.Function.FoldMap.Constructor++-- | Generic 'foldMap' over a term of non-sum data type @a@.+--+-- @a@ must have exactly one constructor.+genericFoldMapNonSum+    :: forall m a+    .  (Generic a, GFoldMapNonSum m (Rep a))+    => a -> m+genericFoldMapNonSum = gFoldMapNonSum . 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.+genericFoldMapSum+    :: forall m a+    .  (Generic a, GFoldMapSum m (Rep a))+    => (String -> m)+    -> a -> m+genericFoldMapSum f = gFoldMapSum f . from
+ src/Generic/Data/Function/FoldMap/Constructor.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE UndecidableInstances #-} -- due to type class design++module Generic.Data.Function.FoldMap.Constructor where++import GHC.Generics+import Data.Kind ( type Constraint )++import Generic.Data.Function.Via+import GHC.TypeLits ( TypeError )++-- | 'Monoid's that can be generically 'foldMap'ped to.+class GenericFoldMap m where+    -- | The type class that enables mapping permitted types to the monoid.+    --+    -- The type class should provide a function that looks like+    -- 'genericFoldMapF'.+    type GenericFoldMapC m a :: Constraint++    -- | The "map" function in 'foldMap' (first argument).+    genericFoldMapF :: GenericFoldMapC m a => a -> m++-- | 'foldMap' over types with no fields in any constructor.+instance GenericFoldMap (NoRec0 m) where+    type GenericFoldMapC (NoRec0 m) _ = TypeError ENoRec0+    genericFoldMapF = undefined++-- | 'foldMap' over types where all fields map to 'mempty'.+instance Monoid m => GenericFoldMap (EmptyRec0 m) where+    type GenericFoldMapC (EmptyRec0 m) _ = ()+    genericFoldMapF _ = EmptyRec0 mempty++-- | 'foldMap' on individual constructors (products).+class GFoldMapC m f where gFoldMapC :: f p -> m++-- | 'foldMap' on individual constructors (products).+instance (Semigroup m, GFoldMapC m l, GFoldMapC m r)+  => GFoldMapC m (l :*: r) where+    gFoldMapC (l :*: r) = gFoldMapC l <> gFoldMapC r++instance (GenericFoldMap m, GenericFoldMapC m a)+  => GFoldMapC m (S1 c (Rec0 a)) where+    gFoldMapC (M1 (K1 a)) = genericFoldMapF a++-- | Wow, look! Nothing!+instance Monoid m => GFoldMapC m U1 where gFoldMapC U1 = mempty
+ src/Generic/Data/Function/FoldMap/NonSum.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6++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) )++{- | '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 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
+ src/Generic/Data/Function/FoldMap/Sum.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6++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++instance GFoldMapSum m f => GFoldMapSum m (D1 c f) where+    gFoldMapSum f (M1 a) = gFoldMapSum f a++instance GFoldMapCSum m (l :+: r) => GFoldMapSum m (l :+: r) where+    gFoldMapSum = gFoldMapCSum++instance TypeError EUnexpectedNonSum => GFoldMapSum m (C1 c f) where+    gFoldMapSum = undefined++instance TypeError ENoEmpty => GFoldMapSum m V1 where+    gFoldMapSum = undefined++class GFoldMapCSum m f where gFoldMapCSum :: (String -> m) -> f p -> m++instance (GFoldMapCSum m l, GFoldMapCSum m r) => GFoldMapCSum m (l :+: r) where+    gFoldMapCSum f = \case L1 l -> gFoldMapCSum f l+                           R1 r -> gFoldMapCSum f r++instance (Semigroup m, Constructor c, GFoldMapC m f)+  => GFoldMapCSum m (C1 c f) where+    gFoldMapCSum mapCstr (M1 a) = mapCstr (conName' @c) <> gFoldMapC a
+ src/Generic/Data/Function/Traverse.hs view
@@ -0,0 +1,54 @@+{- | 'traverse' for generic data types.++TODO This is harder to conceptualize than generic 'foldMap'. No nice clean+explanation yet.++This function can provide generic support for simple parser-esque types.+-}++module Generic.Data.Function.Traverse+  ( GenericTraverse(..)+  , genericTraverseNonSum , GTraverseNonSum+  , GenericTraverseSum(..), PfxTagCfg(..)+  , genericTraverseSum,     GTraverseSum+  , eqShowPfxTagCfg+  ) where++import GHC.Generics++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@.+--+-- @f a@ must have exactly one constructor.+genericTraverseNonSum+    :: forall f a+    .  (Generic a, GTraverseNonSum f (Rep a), Functor f)+    => f a+genericTraverseNonSum = to <$> gTraverseNonSum++-- | 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)+    => PfxTagCfg pt+    -> f a+genericTraverseSum ptc = to <$> gTraverseSum ptc++-- | Construct a prefix tag config using existing 'Eq' and 'Show' instances.+--+-- The user only needs to provide the constructor name parser.+eqShowPfxTagCfg :: (Eq a, Show a) => (String -> a) -> PfxTagCfg a+eqShowPfxTagCfg f = PfxTagCfg+    { pfxTagCfgFromCstr = f+    , pfxTagCfgEq = (==)+    , pfxTagCfgShow = Text.pack . show+    }
+ src/Generic/Data/Function/Traverse/Constructor.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE UndecidableInstances #-} -- due to type class design+{-# LANGUAGE AllowAmbiguousTypes #-}  -- due to type class design+{-# LANGUAGE ApplicativeDo #-} -- TODO because I'm lazy++module Generic.Data.Function.Traverse.Constructor where++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 Control.Applicative ( liftA2 )++import Data.Kind ( type Type, type Constraint )++import Generic.Data.Function.Via+import GHC.TypeLits ( TypeError )++import Data.Monoid+data A a = A a (Sum Int) ()+    deriving stock (Generic, Show)++-- | 'Applicative' functors that can be generically 'traverse'd.+class GenericTraverse f where+    -- | The type class providing (applicative) actions for permitted types.+    type GenericTraverseC f a :: Constraint++    -- | The action in 'traverse' (first argument).+    --+    -- We include data type metadata because this function is useful for monadic+    -- parsers, which can record it in error messages. (We don't do it for+    -- foldMap because it's pure.)+    genericTraverseAction+        :: GenericTraverseC f a+        => String       {- ^ data type name -}+        -> String       {- ^ constructor name -}+        -> Maybe String {- ^ record name (if present) -}+        -> Natural      {- ^ field index -}+        -> f a++-- | 'traverse' over types with no fields in any constructor.+instance GenericTraverse NoRec0 where+    type GenericTraverseC NoRec0 a = TypeError ENoRec0+    genericTraverseAction = undefined++-- | 'traverse' over types where all fields map to their respective 'mempty'.+--+-- Can result in type errors lacking context: a field missing a 'Monoid'+-- instance will type error with a regular "no instance for" message, without+-- telling you the surrounding type.+--+-- Maybe silly.+instance GenericTraverse EmptyRec0 where+    type GenericTraverseC EmptyRec0 a = Monoid a+    genericTraverseAction _ _ _ _ = EmptyRec0 mempty++class GTraverseC cd cc (si :: Natural) f f' where gTraverseC :: f (f' p)++instance (Applicative f, GTraverseC cd cc si f l, GTraverseC cd cc (si + ProdArity r) f r)+  => GTraverseC cd cc si f (l :*: r) where+    gTraverseC = liftA2 (:*:)+                   (gTraverseC @cd @cc @si)+                   (gTraverseC @cd @cc @(si + ProdArity r))++instance (GenericTraverse f, GenericTraverseC f a, Functor f, KnownNat si, Selector cs, Constructor cc, Datatype cd)+  => GTraverseC cd cc si f (S1 cs (Rec0 a)) where+    gTraverseC = (M1 . K1) <$> genericTraverseAction cd cc cs si+      where+        cs = selName'' @cs+        cd = datatypeName' @cd+        cc = conName' @cc+        si = natVal'' @si++instance Applicative f => GTraverseC cd cc 0 f U1 where gTraverseC = pure U1++type family ProdArity (f :: Type -> Type) :: Natural where+    ProdArity (S1 c f)  = 1+    ProdArity (l :*: r) = ProdArity l + ProdArity r
+ src/Generic/Data/Function/Traverse/NonSum.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6+{-# LANGUAGE AllowAmbiguousTypes #-} -- due to type class design++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)++instance TypeError EUnexpectedSum => 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++instance TypeError ENoEmpty => GTraverseNonSum' cd f V1 where+    gTraverseNonSum' = undefined
+ src/Generic/Data/Function/Traverse/Sum.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6+{-# LANGUAGE AllowAmbiguousTypes #-} -- required due to generic typeclass design++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 Data.Text ( Text )+import Control.Applicative qualified as Applicative+import Control.Applicative ( Alternative((<|>)) )++{- | Sum-type monads that can be generically 'traverse'd.++For sum types, we require a monad with choice to differentiate constructors.+-}+class (GenericTraverse f, Alternative f, Monad f) => GenericTraverseSum f where+    -- | Try to parse a prefix tag of type 'pt'.+    --+    -- Relevant metadata is provided as arguments.+    genericTraverseSumPfxTagAction+        :: GenericTraverseC f pt+        => String   -- ^ data type name+        -> f pt++    -- | Parse error due to no constructor matching the parsed prefix tag.+    --+    -- Relevant metadata is provided as arguments.+    genericTraverseSumNoMatchingCstrAction+        :: String   -- ^ data type name+        -> [String] -- ^ non-matching constructor names+        -> Text     -- ^ prefix tag, prettified+        -> f a++-- | How to use a type as a prefix tag in a generic sum type parser.+data PfxTagCfg a = PfxTagCfg+  { pfxTagCfgFromCstr :: String -> a+  -- ^ How to turn a constructor name into a prefix tag.++  , pfxTagCfgEq :: a -> a -> Bool+  -- ^ How to compare prefix tags for equality.+  --+  -- By shoving this into our generic derivation config, we can avoid adding an+  -- insidious 'Eq' constraint. In general, you will want to set this to '(==)'.++  , pfxTagCfgShow :: a -> Text+  -- ^ Make a prefix tag human-readable. 'show' is often appropriate.+  }++class GTraverseSum 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++class GTraverseSum' cd f f' where+    gTraverseSum' :: GenericTraverseC f pt => PfxTagCfg pt -> f (f' p)++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++-- | 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++-- | Refuse to derive an instance for an empty data type.+instance TypeError ENoEmpty => GTraverseSum' cd f V1 where+    gTraverseSum' = undefined++-- | Generic getter (constructor sum level).+class GTraverseCSum cd f f' where+    gTraverseCSum :: PfxTagCfg pt -> pt -> f (f' p)++instance (Functor f, Alternative f, GTraverseCSum cd f l, GTraverseCSum cd f r)+  => GTraverseCSum cd f (l :+: r) where+    gTraverseCSum ptc pt = l <|> r+      where+        l = L1 <$> gTraverseCSum @cd ptc pt+        r = R1 <$> gTraverseCSum @cd ptc pt++instance (Alternative f, GTraverseC cd cc 0 f f', Constructor cc)+  => GTraverseCSum cd f (C1 cc f') where+    gTraverseCSum ptc pt = do+        if   (pfxTagCfgEq ptc) pt ptCstr+        then M1 <$> gTraverseC @cd @cc @0+        else Applicative.empty+      where+        ptCstr = (pfxTagCfgFromCstr ptc) (conName' @cc)
+ src/Generic/Data/Function/Util/Generic.hs view
@@ -0,0 +1,31 @@+{-# 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
+ src/Generic/Data/Function/Util/TypeNats.hs view
@@ -0,0 +1,17 @@+{-# 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 #-}
+ src/Generic/Data/Function/Via.hs view
@@ -0,0 +1,28 @@+-- | Wrapper types for using with @DerivingVia@.++module Generic.Data.Function.Via where++import GHC.Generics ( Generic )+import GHC.TypeLits ( ErrorMessage(Text) )+import Data.Functor.Identity ( Identity(..) )++-- | Wrapper for using to derive instances via generics. Emit type error on+--   'Rec0' base case i.e. any non-empty constructor.+newtype NoRec0 a = NoRec0 { unNoRec0 :: a }+    deriving stock (Generic, Show)+    deriving (Functor, Applicative, Monad) via Identity++type ENoRec0 =+    'Text "Cannot use generic function on NoRec0-wrapped type containing fields"++-- | Wrapper for using to derive instances via generics. Do nothing for 'Rec0'+--   base case i.e. every constructor field.+--+-- "nothing" probably means 'mempty', but *may* be another unit-like.+--+-- TODO This might not be useful. It's not "special" like 'NoRec0', it's+-- basically tied to 'Monoid'. So it's useful for 'foldMap', but kind of+-- arbitrary when applied to 'traverse'.+newtype EmptyRec0 a = EmptyRec0 { unEmptyRec0 :: a }+    deriving stock (Generic, Show)+    deriving (Functor, Applicative, Monad) via Identity