update generic-data-functions :)

binrep.cabal

@@ -90,7 +90,7 @@ library
     , bytezap
     , deepseq >=1.4.6.1 && <1.6
     , flatparse >=0.5.0.2 && <0.6
-    , generic-data-functions >=0.2.0 && <0.3
+    , generic-data-functions >=0.3.0 && <0.4
     , megaparsec >=9.2.0 && <9.7
     , parser-combinators >=1.3.0 && <1.4
     , primitive >=0.8.0.0 && <0.10.0.0
@@ -138,7 +138,7 @@ test-suite spec
     , bytezap
     , deepseq >=1.4.6.1 && <1.6
     , flatparse >=0.5.0.2 && <0.6
-    , generic-data-functions >=0.2.0 && <0.3
+    , generic-data-functions >=0.3.0 && <0.4
     , generic-random >=1.5.0.1 && <1.6
     , hspec >=2.7 && <2.12
     , megaparsec >=9.2.0 && <9.7
@@ -184,7 +184,7 @@ benchmark bench
     , deepseq >=1.4.6.1 && <1.6
     , flatparse >=0.5.0.2 && <0.6
     , gauge
-    , generic-data-functions >=0.2.0 && <0.3
+    , generic-data-functions >=0.3.0 && <0.4
     , megaparsec >=9.2.0 && <9.7
     , parser-combinators >=1.3.0 && <1.4
     , primitive >=0.8.0.0 && <0.10.0.0

flake.nix

@@ -3,12 +3,14 @@
     nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable";
     flake-parts.url = "github:hercules-ci/flake-parts";
     haskell-flake.url = "github:srid/haskell-flake";
-    bytezap.url  = "github:raehik/bytezap";
+    bytezap.url   = "github:raehik/bytezap";
     bytezap.flake = false;
-    flatparse.url  = "github:AndrasKovacs/flatparse";
+    flatparse.url   = "github:AndrasKovacs/flatparse";
     flatparse.flake = false;
-    strongweak.url  = "github:raehik/strongweak";
+    strongweak.url   = "github:raehik/strongweak";
     strongweak.flake = false;
+    generic-data-functions.url   = "github:raehik/generic-data-functions";
+    generic-data-functions.flake = false;
   };
   outputs = inputs:
   let
@@ -34,13 +36,15 @@
           packages.bytezap.source = inputs.bytezap;
           packages.flatparse.source = inputs.flatparse;
           packages.strongweak.source = inputs.strongweak;
+          packages.generic-data-functions.source = inputs.generic-data-functions;
           devShell = nondevDevShell "ghc98";
         };
         haskellProjects.ghc96 = {
           basePackages = pkgs.haskell.packages.ghc96;
           packages.bytezap.source = inputs.bytezap;
           packages.flatparse.source = inputs.flatparse;
           packages.strongweak.source = inputs.strongweak;
+          packages.generic-data-functions.source = inputs.generic-data-functions;
           devShell.mkShellArgs.name = "ghc96-binrep";
           devShell.tools = _: {
             haskell-language-server = null; # 2024-03-06: broken
@@ -51,13 +55,15 @@
           packages.bytezap.source = inputs.bytezap;
           packages.flatparse.source = inputs.flatparse;
           packages.strongweak.source = inputs.strongweak;
+          packages.generic-data-functions.source = inputs.generic-data-functions;
           devShell = nondevDevShell "ghc94";
         };
         haskellProjects.ghc92 = {
           basePackages = pkgs.haskell.packages.ghc92;
           packages.bytezap.source = inputs.bytezap;
           packages.flatparse.source = inputs.flatparse;
           packages.strongweak.source = inputs.strongweak;
+          packages.generic-data-functions.source = inputs.generic-data-functions;
           devShell = nondevDevShell "ghc92";
         };
       };

package.yaml

@@ -56,7 +56,7 @@ dependencies:
 - bytezap
 - primitive >= 0.8.0.0 && < 0.10.0.0
 - flatparse >= 0.5.0.2 && < 0.6
-- generic-data-functions ^>= 0.2.0
+- generic-data-functions ^>= 0.3.0
 - parser-combinators ^>= 1.3.0
 - bytestring >= 0.11 && < 0.13
 - strongweak ^>= 0.6.0

src/Binrep/BLen.hs

@@ -36,7 +36,7 @@ import Data.Word
 import Data.Int
 import Binrep.Util.ByteOrder
 
-import Data.Monoid ( Sum(..) )
+import Data.Monoid qualified as Monoid
 import GHC.Generics
 import Generic.Data.Function.FoldMap
 import Generic.Data.Rep.Assert
@@ -51,22 +51,19 @@ class BLen a where
     -- | Calculate the serialized byte length of the given value.
     blen :: a -> Int
 
--- newtype sum monoid for generic foldMap
-newtype BLen' a = BLen' { getBLen' :: a }
-    deriving (Semigroup, Monoid) via Sum a
-
-instance GenericFoldMap (BLen' Int) where
-    type GenericFoldMapC (BLen' Int) a = BLen a
-    genericFoldMapF = BLen' . blen
+instance GenericFoldMap BLen where
+    type GenericFoldMapM BLen = Monoid.Sum Int
+    type GenericFoldMapC BLen a = BLen a
+    genericFoldMapF = Monoid.Sum . blen
 
 -- | Measure the byte length of a term of the non-sum type @a@ via its 'Generic'
 --   instance.
 blenGenericNonSum
-    :: forall {cd} {f} {asserts} a
-    .  ( Generic a, Rep a ~ D1 cd f, GFoldMapNonSum (BLen' Int) f
-       , asserts ~ '[ 'NoEmpty, 'NoSum], ApplyGCAsserts asserts f)
+    :: forall {cd} {gf} {asserts} a
+    .  ( Generic a, Rep a ~ D1 cd gf, GFoldMapNonSum BLen gf
+       , asserts ~ '[ 'NoEmpty, 'NoSum], ApplyGCAsserts asserts gf)
     => a -> Int
-blenGenericNonSum = getBLen' . genericFoldMapNonSum @asserts
+blenGenericNonSum = Monoid.getSum . genericFoldMapNonSum @asserts @BLen
 
 -- | Measure the byte length of a term of the sum type @a@ via its 'Generic'
 --   instance.
@@ -75,11 +72,12 @@ blenGenericNonSum = getBLen' . genericFoldMapNonSum @asserts
 -- inspecting the reified constructor names. This is regrettably inefficient.
 -- Alas. Do write your own instance if you want better performance!
 blenGenericSum
-    :: forall {cd} {f} {asserts} a
-    .  (Generic a, Rep a ~ D1 cd f, GFoldMapSum 'SumOnly (BLen' Int) f
-       , asserts ~ '[ 'NoEmpty, 'NeedSum], ApplyGCAsserts asserts f)
+    :: forall {cd} {gf} {asserts} a
+    .  (Generic a, Rep a ~ D1 cd gf, GFoldMapSum 'SumOnly BLen gf
+       , asserts ~ '[ 'NoEmpty, 'NeedSum], ApplyGCAsserts asserts gf)
     => (String -> Int) -> a -> Int
-blenGenericSum f = getBLen' . genericFoldMapSum @'SumOnly @asserts (BLen' <$> f)
+blenGenericSum f =
+    Monoid.getSum . genericFoldMapSum @'SumOnly @asserts @BLen (Monoid.Sum <$> f)
 
 instance TypeError ENoEmpty => BLen Void where blen = undefined
 instance TypeError ENoSum => BLen (Either a b) where blen = undefined

src/Binrep/Get.hs

@@ -165,32 +165,33 @@ runGetter g bs = case FP.runParser g bs of
                    FP.Fail     -> Left EFail
                    FP.Err e    -> Left e
 
-instance GenericTraverse (FP.Parser E) where
-    type GenericTraverseC (FP.Parser E) a = Get a
+instance GenericTraverse Get where
+    type GenericTraverseF Get = FP.Parser E
+    type GenericTraverseC Get a = Get a
     genericTraverseAction cd cc mcs si =
         getWrapGeneric cd $ EGenericField cc mcs si
 
-instance GenericTraverseSum (FP.Parser E) where
+instance GenericTraverseSum Get where
     genericTraverseSumPfxTagAction cd =
         getWrapGeneric cd $ EGenericSum . EGenericSumTag
     -- TODO proper offset info
     genericTraverseSumNoMatchingCstrAction cd cstrs ptText =
         FP.err $ E 0 $ EGeneric cd $ EGenericSum $ EGenericSumTagNoMatch cstrs ptText
 
 getGenericNonSum
-    :: forall {cd} {f} {asserts} a
-    .  (Generic a, Rep a ~ D1 cd f, GTraverseNonSum cd (FP.Parser E) f
-       , asserts ~ '[ 'NoEmpty, 'NoSum], ApplyGCAsserts asserts f)
+    :: forall {cd} {gf} {asserts} a
+    .  (Generic a, Rep a ~ D1 cd gf, GTraverseNonSum cd Get gf
+       , asserts ~ '[ 'NoEmpty, 'NoSum], ApplyGCAsserts asserts gf)
     => Getter a
-getGenericNonSum = genericTraverseNonSum @asserts
+getGenericNonSum = genericTraverseNonSum @asserts @Get
 
 getGenericSum
-    :: forall {cd} {f} {asserts} pt a
-    .  ( Generic a, Rep a ~ D1 cd f, GTraverseSum 'SumOnly cd (FP.Parser E) f
+    :: forall {cd} {gf} {asserts} pt a
+    .  ( Generic a, Rep a ~ D1 cd gf, GTraverseSum 'SumOnly cd Get gf
        , Get pt
-       , asserts ~ '[ 'NoEmpty, 'NeedSum], ApplyGCAsserts asserts f)
+       , asserts ~ '[ 'NoEmpty, 'NeedSum], ApplyGCAsserts asserts gf)
     => PfxTagCfg pt -> Getter a
-getGenericSum = genericTraverseSum @'SumOnly @asserts
+getGenericSum = genericTraverseSum @'SumOnly @asserts @Get
 
 instance TypeError ENoEmpty => Get Void where get = undefined
 instance TypeError ENoSum => Get (Either a b) where get = undefined

src/Binrep/Put.hs

@@ -44,32 +44,30 @@ class PutC a where putC :: a -> PutterC
 runPut :: (BLen a, Put a) => a -> B.ByteString
 runPut a = unsafeRunPokeBS (blen a) (put a)
 
--- TODO UGH I need to make my own internal idx here. Can't use 'Putter' since
--- that's just bytezap, which others may want to use differently with g-f-d.
--- Ah, but that means I need to redesign g-f-d!
-instance GenericFoldMap Putter where
-    type GenericFoldMapC Putter a = Put a
+instance GenericFoldMap Put where
+    type GenericFoldMapM Put = Putter
+    type GenericFoldMapC Put a = Put a
     genericFoldMapF = put
 
 -- | Serialize a term of the non-sum type @a@ via its 'Generic' instance.
 putGenericNonSum
-    :: forall {cd} {f} {asserts} a
-    .  ( Generic a, Rep a ~ D1 cd f, GFoldMapNonSum Putter f
-       , asserts ~ '[ 'NoEmpty, 'NoSum], ApplyGCAsserts asserts f)
+    :: forall {cd} {gf} {asserts} a
+    .  ( Generic a, Rep a ~ D1 cd gf, GFoldMapNonSum Put gf
+       , asserts ~ '[ 'NoEmpty, 'NoSum], ApplyGCAsserts asserts gf)
     => a -> Putter
-putGenericNonSum = genericFoldMapNonSum @asserts
+putGenericNonSum = genericFoldMapNonSum @asserts @Put
 
 -- | Serialize a term of the sum type @a@ via its 'Generic' instance.
 --
 -- You must provide a serializer for @a@'s constructors. This is regrettably
 -- inefficient due to having to use 'String's. Alas. Do write your own instance
 -- if you want better performance!
 putGenericSum
-    :: forall {cd} {f} {asserts} a
-    .  ( Generic a, Rep a ~ D1 cd f, GFoldMapSum 'SumOnly Putter f
-       , asserts ~ '[ 'NoEmpty, 'NeedSum], ApplyGCAsserts asserts f)
+    :: forall {cd} {gf} {asserts} a
+    .  ( Generic a, Rep a ~ D1 cd gf, GFoldMapSum 'SumOnly Put gf
+       , asserts ~ '[ 'NoEmpty, 'NeedSum], ApplyGCAsserts asserts gf)
     => (String -> Putter) -> a -> Putter
-putGenericSum = genericFoldMapSum @'SumOnly @asserts
+putGenericSum = genericFoldMapSum @'SumOnly @asserts @Put
 
 instance Struct.GPokeBase BinrepG where
     type GPokeBaseSt BinrepG = RealWorld