binrep 0.5.0 → 0.6.0

raw patch · 50 files changed

+927/−2511 lines, 50 filesdep +bytezapdep +generic-data-assertsdep −aesondep −masondep −megaparsecdep ~flatparsedep ~generic-data-functionsPVP ok

version bump matches the API change (PVP)

Dependencies added: bytezap, generic-data-asserts

Dependencies removed: aeson, mason, megaparsec, vector, vector-sized

Dependency ranges changed: flatparse, generic-data-functions

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• bench/Main.hs +2/−2
• binrep.cabal +28/−46
• src/Binrep.hs +9/−7
• src/Binrep/BLen.hs +115/−0
• src/Binrep/BLen/Simple.hs +0/−120
• src/Binrep/CBLen.hs +21/−2
• src/Binrep/CBLen/Generic.hs +4/−2
• src/Binrep/Common/Class/TypeErrors.hs +19/−0
• src/Binrep/Common/Via/Prim.hs +4/−0
• src/Binrep/Extra/HexByteString.hs +0/−109
• src/Binrep/Generic.hs +2/−3
• src/Binrep/Get.hs +298/−0
• src/Binrep/Get/Flatparse.hs +0/−268
• src/Binrep/Put.hs +117/−0
• src/Binrep/Put/Bytezap.hs +0/−99
• src/Binrep/Put/Mason.hs +0/−102
• src/Binrep/Put/Struct.hs +87/−0
• src/Binrep/Test.hs +15/−0
• src/Binrep/Type/Byte.hs +0/−809
• src/Binrep/Type/Common.hs +0/−10
• src/Binrep/Type/Int.hs +0/−142
• src/Binrep/Type/Magic.hs +24/−21
• src/Binrep/Type/NullPadded.hs +24/−8
• src/Binrep/Type/NullTerminated.hs +3/−4
• src/Binrep/Type/Prefix.hs +0/−56
• src/Binrep/Type/Prefix/Count.hs +10/−2
• src/Binrep/Type/Prefix/Size.hs +1/−1
• src/Binrep/Type/Sized.hs +7/−3
• src/Binrep/Type/Text/Encoding/Utf16.hs +6/−6
• src/Binrep/Type/Text/Encoding/Utf32.hs +6/−6
• src/Binrep/Type/Thin.hs +0/−4
• src/Binrep/Util/ByteOrder.hs +19/−0
• src/Binrep/Util/Class.hs +0/−19
• src/Binrep/Util/Prefix.hs +62/−0
• src/Binrep/Via.hs +0/−12
• src/Bytezap.hs +0/−97
• src/Bytezap/Bytes.hs +0/−41
• src/Bytezap/Class.hs +0/−51
• src/Bytezap/Int.hs +0/−158
• src/Bytezap/Poke/Bytes.hs +0/−33
• src/Bytezap/Poke/Int.hs +0/−141
• src/Bytezap/Text.hs +0/−58
• src/Data/Aeson/Extra/SizedVector.hs +0/−19
• src/Raehik/Compat/FlatParse/Basic/Prim.hs +11/−0
• src/Raehik/Compat/FlatParse/Basic/WithLength.hs +15/−0
• src/Util/TypeNats.hs +8/−2
• test/ArbitraryOrphans.hs +3/−3
• test/Binrep/Extra/HexByteStringSpec.hs +0/−39
• test/Binrep/LawsSpec.hs +3/−6

@@ -1,3 +1,7 @@+## 0.6.0 (2024-04-05)+* many updates to parsing/serializing internals, including generics+* provide "C struct" serializer+ ## 0.5.0 (2023-08-17)   * support GHC 9.2 - 9.6   * extract generic serializing & parsing into separate library. yes, I wrote

@@ -29,8 +29,8 @@     | X33 Word8 (NullTerminated B.ByteString) X3     deriving stock (Generic) -instance BLen X3 where blen = blenGenericSum cDef-instance Put  X3 where put  = putGenericSum  cDef+instance BLen X3 where blen = blenGenericSum $ blen . nullTermCstrPfxTag+instance Put  X3 where put  =  putGenericSum $  put . nullTermCstrPfxTag  x33 :: X3 x33 =

@@ -5,10 +5,10 @@ -- see: https://github.com/sol/hpack  name:           binrep-version:        0.5.0+version:        0.6.0 synopsis:       Encode precise binary representations directly in types description:    Please see README.md.-category:       Data, Serialization+category:       Data, Serialization, Generics homepage:       https://github.com/raehik/binrep#readme bug-reports:    https://github.com/raehik/binrep/issues author:         Ben Orchard@@ -34,21 +34,19 @@ library   exposed-modules:       Binrep-      Binrep.BLen.Simple+      Binrep.BLen       Binrep.CBLen       Binrep.CBLen.Generic-      Binrep.Extra.HexByteString+      Binrep.Common.Class.TypeErrors+      Binrep.Common.Via.Prim       Binrep.Generic-      Binrep.Get.Flatparse-      Binrep.Put.Bytezap-      Binrep.Put.Mason-      Binrep.Type.Byte-      Binrep.Type.Common-      Binrep.Type.Int+      Binrep.Get+      Binrep.Put+      Binrep.Put.Struct+      Binrep.Test       Binrep.Type.Magic       Binrep.Type.NullPadded       Binrep.Type.NullTerminated-      Binrep.Type.Prefix       Binrep.Type.Prefix.Count       Binrep.Type.Prefix.Size       Binrep.Type.Sized@@ -61,17 +59,11 @@       Binrep.Type.Text.Internal       Binrep.Type.Thin       Binrep.Util-      Binrep.Util.Class+      Binrep.Util.ByteOrder       Binrep.Util.Generic-      Binrep.Via-      Bytezap-      Bytezap.Bytes-      Bytezap.Class-      Bytezap.Int-      Bytezap.Poke.Bytes-      Bytezap.Poke.Int-      Bytezap.Text-      Data.Aeson.Extra.SizedVector+      Binrep.Util.Prefix+      Raehik.Compat.FlatParse.Basic.Prim+      Raehik.Compat.FlatParse.Basic.WithLength       Util.TypeNats   other-modules:       Paths_binrep@@ -90,20 +82,17 @@       MagicHash   ghc-options: -Wall   build-depends:-      aeson >=2.0 && <2.2-    , base >=4.14 && <5+      base >=4.14 && <5     , bytestring >=0.11 && <0.13+    , bytezap >=1.1.0 && <1.2     , deepseq >=1.4.6.1 && <1.6-    , flatparse >=0.4.0.1 && <0.6-    , generic-data-functions >=0.2.0 && <0.3-    , mason >=0.2.5 && <0.3-    , megaparsec >=9.2.0 && <9.5.0+    , flatparse >=0.5.0.2 && <0.6+    , generic-data-asserts >=0.1.0 && <0.2+    , generic-data-functions >=0.4.1 && <0.5     , parser-combinators >=1.3.0 && <1.4     , refined1 ==0.9.*     , strongweak >=0.6.0 && <0.7     , text >=1.2.5.0 && <2.1-    , vector >=0.12.3.1 && <0.14-    , vector-sized >=1.5.0 && <1.6   default-language: GHC2021   if flag(icu)     cpp-options: -DHAVE_ICU@@ -115,7 +104,6 @@   main-is: Spec.hs   other-modules:       ArbitraryOrphans-      Binrep.Extra.HexByteStringSpec       Binrep.LawsSpec       Paths_binrep   hs-source-dirs:@@ -136,24 +124,21 @@       hspec-discover:hspec-discover >=2.7 && <2.12   build-depends:       QuickCheck >=2.14.2 && <2.15-    , aeson >=2.0 && <2.2     , base >=4.14 && <5     , binrep     , bytestring >=0.11 && <0.13+    , bytezap >=1.1.0 && <1.2     , deepseq >=1.4.6.1 && <1.6-    , flatparse >=0.4.0.1 && <0.6-    , generic-data-functions >=0.2.0 && <0.3+    , flatparse >=0.5.0.2 && <0.6+    , generic-data-asserts >=0.1.0 && <0.2+    , generic-data-functions >=0.4.1 && <0.5     , generic-random >=1.5.0.1 && <1.6     , hspec >=2.7 && <2.12-    , mason >=0.2.5 && <0.3-    , megaparsec >=9.2.0 && <9.5.0     , parser-combinators >=1.3.0 && <1.4     , quickcheck-instances >=0.3.26 && <0.4     , refined1 ==0.9.*     , strongweak >=0.6.0 && <0.7     , text >=1.2.5.0 && <2.1-    , vector >=0.12.3.1 && <0.14-    , vector-sized >=1.5.0 && <1.6   default-language: GHC2021   if flag(icu)     cpp-options: -DHAVE_ICU@@ -178,24 +163,21 @@       TypeFamilies       DataKinds       MagicHash-  ghc-options: -Wall -O2+  ghc-options: -Wall   build-depends:-      aeson >=2.0 && <2.2-    , base >=4.14 && <5+      base >=4.14 && <5     , binrep     , bytestring >=0.11 && <0.13+    , bytezap >=1.1.0 && <1.2     , deepseq >=1.4.6.1 && <1.6-    , flatparse >=0.4.0.1 && <0.6+    , flatparse >=0.5.0.2 && <0.6     , gauge-    , generic-data-functions >=0.2.0 && <0.3-    , mason >=0.2.5 && <0.3-    , megaparsec >=9.2.0 && <9.5.0+    , generic-data-asserts >=0.1.0 && <0.2+    , generic-data-functions >=0.4.1 && <0.5     , parser-combinators >=1.3.0 && <1.4     , refined1 ==0.9.*     , strongweak >=0.6.0 && <0.7     , text >=1.2.5.0 && <2.1-    , vector >=0.12.3.1 && <0.14-    , vector-sized >=1.5.0 && <1.6   default-language: GHC2021   if flag(icu)     cpp-options: -DHAVE_ICU

@@ -1,14 +1,16 @@ module Binrep-  ( module Binrep.CBLen-  , module Binrep.BLen.Simple-  , module Binrep.Put.Bytezap-  , module Binrep.Get.Flatparse+  ( module Binrep.BLen+  , module Binrep.CBLen+  , module Binrep.Put+  , module Binrep.Put.Struct+  , module Binrep.Get   ) where +import Binrep.BLen import Binrep.CBLen-import Binrep.BLen.Simple-import Binrep.Put.Bytezap-import Binrep.Get.Flatparse+import Binrep.Put+import Binrep.Put.Struct+import Binrep.Get  {- TODO   * binrep is its own ecosystem where explicitness and correctness wins over

@@ -0,0 +1,115 @@+{-# LANGUAGE UndecidableInstances #-} -- for 'ViaCBLen', 'TypeError'++{- | Byte length as a simple pure function, no bells or whistles.++Non-reallocating serializers like store, bytezap or ptr-poker request the+expected total byte length when serializing. Thus, they need some way to measure+byte length *before* serializing. This is that.++It should be very efficient to calculate serialized byte length for most+binrep-compatible Haskell types. If it isn't, consider whether the+representation is appropriate for binrep.++Note that you _may_ encode this inside the serializer type (whatever the @Put@+class stores). I went back and forth on this a couple times. But some binrep+code seems to make more sense when byte length is standalone. And I don't mind+the extra explicitness. So it's here to stay :)+-}++module Binrep.BLen+  ( BLen(blen)+  , blenGenericNonSum, blenGenericSum+  , ViaCBLen(..), cblen+  ) where++import Binrep.CBLen+import GHC.TypeNats++import Binrep.Common.Class.TypeErrors ( ENoSum, ENoEmpty )+import GHC.TypeLits ( TypeError )++import Data.Void+import Data.ByteString qualified as B+import Data.Word+import Data.Int+import Binrep.Util.ByteOrder++import Data.Monoid qualified as Monoid+import GHC.Generics+import Generic.Data.Function.FoldMap+import Generic.Data.Rep.Assert+import Generic.Data.Function.Common++-- | Class for types with easily-calculated length in bytes.+--+-- If it appears hard to calculate byte length for a given type (e.g. without+-- first serializing it, then measuring serialized byte length), consider+-- whether this type is a good fit for binrep.+class BLen a where+    -- | Calculate the serialized byte length of the given value.+    blen :: a -> Int++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 a+    .  ( Generic a, GFoldMapNonSum BLen (Rep a)+       , GAssertNotVoid a, GAssertNotSum a+    ) => a -> Int+blenGenericNonSum = Monoid.getSum . genericFoldMapNonSum @BLen++-- | Measure the byte length of a term of the sum type @a@ via its 'Generic'+--   instance.+--+-- You must provide a function to obtain the byte length for the prefix tag, via+-- inspecting the reified constructor names. This is regrettably inefficient.+-- Alas. Do write your own instance if you want better performance!+blenGenericSum+    :: forall a+    .  ( Generic a, GFoldMapSum BLen 'SumOnly (Rep a)+       , GAssertNotVoid a, GAssertSum a+    ) => (String -> Int) -> a -> Int+blenGenericSum f =+    Monoid.getSum . genericFoldMapSum @BLen @'SumOnly (Monoid.Sum <$> f)++instance TypeError ENoEmpty => BLen Void where blen = undefined+instance TypeError ENoSum => BLen (Either a b) where blen = undefined++-- | _O(1)_ Unit type has length 0.+instance BLen () where blen () = 0++-- | _O(1)_ Sum tuples.+instance (BLen l, BLen r) => BLen (l, r) where blen (l, r) = blen l + blen r++-- | _O(n)_ Sum the length of each element of a list.+instance BLen a => BLen [a] where blen = sum . map blen++-- | _O(1)_ 'B.ByteString's store their own length.+instance BLen B.ByteString where blen = B.length++-- All words have a constant byte length-- including host-size words, mind you!+deriving via ViaCBLen Word8  instance BLen Word8+deriving via ViaCBLen  Int8  instance BLen  Int8+deriving via ViaCBLen Word16 instance BLen Word16+deriving via ViaCBLen  Int16 instance BLen  Int16+deriving via ViaCBLen Word32 instance BLen Word32+deriving via ViaCBLen  Int32 instance BLen  Int32+deriving via ViaCBLen Word64 instance BLen Word64+deriving via ViaCBLen  Int64 instance BLen  Int64+deriving via ViaCBLen (ByteOrdered end a)+    instance KnownNat (CBLen a) => BLen (ByteOrdered end a)++--------------------------------------------------------------------------------++-- | DerivingVia wrapper for types which may derive a 'BLen' instance through+--   an existing 'IsCBLen' instance (i.e. it is known at compile time)+--+-- Examples of such types include machine integers, and explicitly-sized types+-- (e.g. "Binrep.Type.Sized").+newtype ViaCBLen a = ViaCBLen { unViaCBLen :: a }+instance KnownNat (CBLen a) => BLen (ViaCBLen a) where blen _ = cblen @a

@@ -1,120 +0,0 @@-{-# LANGUAGE UndecidableInstances #-} -- for 'CBLenly', 'TypeError'-{-# LANGUAGE AllowAmbiguousTypes #-} -- for 'cblen', 'natValInt'--{- | Byte length as a simple pure function, no bells or whistles.--Non-reallocating serializers like store, bytezap or ptr-poker request the-expected total byte length when serializing. Thus, they need some way to measure-byte length *before* serializing. This is that.--It should be very efficient to calculate serialized byte length for most-binrep-compatible Haskell types. If it isn't, consider whether the-representation is appropriate for binrep.--}--module Binrep.BLen.Simple where--import Binrep.CBLen-import GHC.TypeNats-import Util.TypeNats ( natValInt )--import Binrep.Util.Class-import GHC.TypeLits ( TypeError )--import Data.Void-import Data.ByteString qualified as B-import Data.Word-import Data.Int-import Bytezap ( Write(..) )--import Data.Monoid ( Sum(..) )-import GHC.Generics-import Generic.Data.Function.FoldMap-import Generic.Data.Rep.Assert-import Generic.Data.Function.Common--class BLen a where 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---- | 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)-    => a -> Int-blenGenericNonSum = getBLen' . genericFoldMapNonSum @asserts---- | Measure the byte length of a term of the sum type @a@ via its 'Generic'---   instance.------ You must provide a function to obtain the byte length for the prefix tag, via--- 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)-    => (String -> Int) -> a -> Int-blenGenericSum f = getBLen' . genericFoldMapSum @'SumOnly @asserts (BLen' <$> f)--instance TypeError ENoEmpty => BLen Void where blen = undefined-instance TypeError ENoSum => BLen (Either a b) where blen = undefined--instance BLen Write where-    {-# INLINE blen #-}-    blen = writeSize---- | Unit type has length 0.-instance BLen () where-    {-# INLINE blen #-}-    blen () = 0---- | Sum tuples.-instance (BLen l, BLen r) => BLen (l, r) where-    {-# INLINE blen #-}-    blen (l, r) = blen l + blen r---- | _O(n)_ Sum the length of each element of a list.-instance BLen a => BLen [a] where-    {-# INLINE blen #-}-    blen = sum . map blen---- | Length of a bytestring is fairly obvious.-instance BLen B.ByteString where-    {-# INLINE blen #-}-    blen = B.length---- Machine integers have a constant byte length.-deriving via CBLenly Word8  instance BLen Word8-deriving via CBLenly  Int8  instance BLen  Int8-deriving via CBLenly Word16 instance BLen Word16-deriving via CBLenly  Int16 instance BLen  Int16-deriving via CBLenly Word32 instance BLen Word32-deriving via CBLenly  Int32 instance BLen  Int32-deriving via CBLenly Word64 instance BLen Word64-deriving via CBLenly  Int64 instance BLen  Int64-------------------------------------------------------------------------------------- | Deriving via wrapper for types which may derive a 'BLen' instance through---   an existing 'IsCBLen' instance.------ Examples of such types include machine integers, and explicitly-sized types--- (e.g. "Binrep.Type.Sized").-newtype CBLenly a = CBLenly { unCBLenly :: a }-instance KnownNat (CBLen a) => BLen (CBLenly a) where-    {-# INLINE blen #-}-    blen _ = cblen @a---- | Reify a type's constant byte length to the term level.-cblen :: forall a n. (n ~ CBLen a, KnownNat n) => Int-cblen = natValInt @n-{-# INLINE cblen #-}

@@ -1,12 +1,16 @@-{-# LANGUAGE UndecidableInstances #-} -- for 'WithCBLen'-{-# LANGUAGE AllowAmbiguousTypes #-} -- for 'cblen'+{-# LANGUAGE UndecidableInstances #-} -- for nested type families+{-# LANGUAGE AllowAmbiguousTypes  #-} -- for reification util  module Binrep.CBLen where  import GHC.TypeNats import Data.Word import Data.Int+import Binrep.Util.ByteOrder +import GHC.Exts ( Int#, Int(I#), Proxy# )+import Util.TypeNats ( natValInt )+ class IsCBLen a where type CBLen a :: Natural  instance IsCBLen () where type CBLen () = 0@@ -21,3 +25,18 @@ instance IsCBLen  Int32 where type CBLen  Int32 = 2^2 instance IsCBLen Word64 where type CBLen Word64 = 2^3 instance IsCBLen  Int64 where type CBLen  Int64 = 2^3++instance IsCBLen a => IsCBLen (ByteOrdered end a) where+    type CBLen (ByteOrdered end a) = CBLen a++-- | Reify a type's constant byte length to the term level.+cblen :: forall a. KnownNat (CBLen a) => Int+cblen = natValInt @(CBLen a)++cblen# :: forall a. KnownNat (CBLen a) => Int#+cblen# = i#+  where !(I# i#) = natValInt @(CBLen a)++cblenProxy# :: forall a. KnownNat (CBLen a) => Proxy# a -> Int#+cblenProxy# _ = i#+  where !(I# i#) = natValInt @(CBLen a)

@@ -14,7 +14,7 @@ You can (attempt to) derive a 'CBLen' type family instance generically for a type via -    instance BLen a where type CBLen a = CBLenGeneric w a+    instance IsCBLen a where type CBLen a = CBLenGeneric w a  As with deriving @BLen@ generically, you must provide the type used to store the sum tag for sum types.@@ -26,7 +26,7 @@ module Binrep.CBLen.Generic where  import Binrep.CBLen-import Binrep.Util.Class+import Binrep.Common.Class.TypeErrors ( ENoEmpty )  import GHC.Generics import GHC.TypeLits@@ -34,6 +34,8 @@  import Data.Type.Equality import Data.Type.Bool++-- TODO provide non-sum version  type CBLenGeneric w a = GCBLen w (Rep a) 

@@ -0,0 +1,19 @@+module Binrep.Common.Class.TypeErrors where++import GHC.TypeLits++-- | Common type error string for when you attempt to use a binrep instance at+--   an empty data type (e.g. 'Data.Void.Void', 'GHC.Generics.V1').+type ENoEmpty = 'Text "No binary representation for empty data type"++-- | Common type error string for when you attempt to use a binrep instance+--   at a sum data type+--   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 ENoSum =+         'Text "No binary representation for unannotated sum data type"+    :$$: 'Text "Consider defining a custom data type"+    :<>: 'Text " and deriving a generic instance with explicit sum handling"

@@ -0,0 +1,4 @@+module Binrep.Common.Via.Prim where++-- | DerivingVia newtype for types which can borrow from 'Prim''.+newtype ViaPrim a = ViaPrim { unViaPrim :: a }

@@ -1,109 +0,0 @@--- | Pretty bytestrings via printing each byte as two hex digits.------ This is primarily for aeson and when we want better 'show'ing of non-textual--- bytestrings. It's not really binrep-related, but it needs _somewhere_ to go--- and my projects that need it usually also touch binrep, so here it is.------ Sadly, we can't use it to make aeson print integers as hex literals. It only--- deals in Scientifics, and if we tried printing them as strings, it would--- quote them. I need a YAML-like with better literals...--module Binrep.Extra.HexByteString where--import GHC.Generics ( Generic )-import Data.Data ( Data )--import Data.ByteString qualified as B-import Data.ByteString.Short qualified as B.Short-import Data.Char qualified as Char-import Data.Word-import Data.Text qualified as Text-import Data.Text ( Text )-import Data.List as List--import Text.Megaparsec hiding ( parse )-import Text.Megaparsec.Char qualified as MC-import Data.Void--import Data.Aeson---- TODO could add some integer instances to print them as hex too---- No harm in being polymorphic over the byte representation.-newtype Hex a = Hex { unHex :: a }-    deriving stock (Generic, Data)-    deriving Eq via a---- But most users will probably just want this.-type HexByteString = Hex B.ByteString--instance Show (Hex B.ByteString) where-    show = Text.unpack . prettyHexByteString B.unpack . unHex--instance FromJSON (Hex B.ByteString) where-    parseJSON = withText "hex bytestring" $ \t ->-        case parseMaybe @Void (parseHexByteString B.pack) t of-          Nothing -> fail "failed to parse hex bytestring (TODO)"-          Just t' -> pure (Hex t')--instance ToJSON   (Hex B.ByteString) where-    toJSON = String . prettyHexByteString B.unpack . unHex--instance Show (Hex B.Short.ShortByteString) where-    show = Text.unpack . prettyHexByteString B.Short.unpack . unHex--instance FromJSON (Hex B.Short.ShortByteString) where-    parseJSON = withText "hex bytestring" $ \t ->-        case parseMaybe @Void (parseHexByteString B.Short.pack) t of-          Nothing -> fail "failed to parse hex bytestring (TODO)"-          Just t' -> pure (Hex t')--instance ToJSON   (Hex B.Short.ShortByteString) where-    toJSON = String . prettyHexByteString B.Short.unpack . unHex---- | A hex bytestring looks like this: @00 01 89 8a   FEff@. You can mix and--- match capitalization and spacing, but I prefer to space each byte, full caps.-parseHexByteString-    :: (MonadParsec e s m, Token s ~ Char)-    => ([Word8] -> a) -> m a-parseHexByteString pack = pack <$> parseHexByte `sepBy` MC.hspace---- | Parse a byte formatted as two hex digits e.g. EF. You _must_ provide both--- nibbles e.g. @0F@, not @F@. They cannot be spaced e.g. @E F@ is invalid.------ Returns a value 0-255, so can fit in any Num type that can store that.-parseHexByte :: (MonadParsec e s m, Token s ~ Char, Num a) => m a-parseHexByte = do-    c1 <- MC.hexDigitChar-    c2 <- MC.hexDigitChar-    pure $ 0x10 * fromIntegral (Char.digitToInt c1) + fromIntegral (Char.digitToInt c2)---- | Pretty print to default format @00 12 AB FF@: space between each byte, all---   caps.------ This format I consider most human readable. I prefer caps to draw attention--- to this being data instead of text (you don't see that many capital letters--- packed together in prose).-prettyHexByteString :: (a -> [Word8]) -> a -> Text-prettyHexByteString unpack =-      Text.concat-    . List.intersperse (Text.singleton ' ')-    . fmap (f . prettyHexByte Char.toUpper)-    . unpack-  where-    f :: (Char, Char) -> Text-    f (c1, c2) = Text.cons c1 $ Text.singleton c2--prettyHexByte :: (Char -> Char) -> Word8 -> (Char, Char)-prettyHexByte f w = (prettyNibble h, prettyNibble l)-  where-    (h,l) = fromIntegral w `divMod` 0x10-    prettyNibble = f . Char.intToDigit -- Char.intToDigit returns lower case---- | Pretty print to "compact" format @0012abff@ (often output by hashers).-prettyHexByteStringCompact :: (a -> [Word8]) -> a -> Text-prettyHexByteStringCompact unpack =-    Text.concat . fmap (f . prettyHexByte id) . unpack-  where-    f :: (Char, Char) -> Text-    f (c1, c2) = Text.cons c1 $ Text.singleton c2

@@ -9,8 +9,7 @@ -- | Turn a constructor name into a prefix tag by adding a null terminator. -- -- Not common in binary data representations, but safe and useful for debugging.------ The refine force is safe under the assumption that Haskell constructor names--- are UTF-8 with no null bytes allowed. Fairly certain that's true. nullTermCstrPfxTag :: String -> NullTerminated B.ByteString nullTermCstrPfxTag = reallyUnsafeRefine . Text.encodeUtf8 . Text.pack+-- ^ reallyUnsafeRefine : safe assuming Haskell constructor names are UTF-8 with+-- no null bytes allowed

@@ -0,0 +1,298 @@+{-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6+{-# LANGUAGE BlockArguments #-}++module Binrep.Get+  ( Getter, Get(..), runGet, runGetter+  , E(..), EBase(..), EGeneric(..), EGenericSum(..)+  , eBase+  , getEBase+  -- , GetWith(..), runGetWith+  , getPrim+  , getGenericNonSum, getGenericSum+  ) where++import Data.Functor.Identity+import Binrep.Util.ByteOrder+import Binrep.Common.Via.Prim ( ViaPrim(..) )+import Raehik.Compat.Data.Primitive.Types ( Prim', sizeOf )+import Raehik.Compat.Data.Primitive.Types.Endian ( ByteSwap )++import FlatParse.Basic qualified as FP+import Raehik.Compat.FlatParse.Basic.Prim qualified as FP++import Data.ByteString qualified as B++import Binrep.Common.Class.TypeErrors ( ENoSum, ENoEmpty )+import GHC.TypeLits ( TypeError )++import Data.Void+import Data.Word+import Data.Int++import Data.Text ( Text )++import Numeric.Natural++import GHC.Generics+import Generic.Data.Function.Traverse+import Generic.Data.Function.Common+import Generic.Data.Rep.Assert++import GHC.Exts ( minusAddr#, Int(I#) )++type Getter a = FP.Parser E a++-- | Structured parse error.+data E+  = E Int EMiddle++  -- | Unhandled parse error.+  --+  -- You get this if you don't change a flatparse fail to an error.+  --+  -- Should not be set except by library code.+  | EFail++    deriving stock (Eq, Show, Generic)++data EMiddle++  -- | Parse error with no further context.+  = EBase EBase++  -- | Somehow, we got two parse errors.+  --+  -- I have a feeling that seeing this indicates a problem in your code.+  | EAnd E EBase++  -- | Parse error decorated with generic info.+  --+  -- Should not be set except by library code.+  | EGeneric String {- ^ data type name -} (EGeneric E)++    deriving stock (Eq, Show, Generic)++data EBase+  = EExpectedByte Word8 Word8+  -- ^ expected first, got second++  | EOverlong Int Int+  -- ^ expected first, got second++  | EExpected B.ByteString B.ByteString+  -- ^ expected first, got second++  | EFailNamed String+  -- ^ known fail++  | EFailParse String B.ByteString Word8+  -- ^ parse fail (where you parse a larger object, then a smaller one in it)++  | ERanOut Int+  -- ^ ran out of input, needed precisely @n@ bytes for this part (n > 0)+  --+  -- Actually a 'Natural', but we use 'Int' because that's what flatparse uses+  -- internally.++    deriving stock (Eq, Show, Generic)++-- | A generic context layer for a parse error of type @e@.+--+-- Recursive: parse errors occurring in fields are wrapped up here. (Those+-- errors may also have a generic context layer.)+--+-- Making this explicitly recursive may seem strange, but it clarifies that this+-- data type is to be seen as a layer over a top-level type.+data EGeneric e+  -- | Parse error relating to sum types (constructors).+  = EGenericSum (EGenericSum e)++  -- | Parse error in a constructor field.+  | EGenericField+        String          -- ^ constructor name+        (Maybe String)  -- ^ field record name (if present)+        Natural         -- ^ field index in constructor+        e               -- ^ field parse error+    deriving stock (Eq, Show, Generic)++data EGenericSum e+  -- | Parse error parsing prefix tag.+  = EGenericSumTag e++  -- | Unable to match a constructor to the parsed prefix tag.+  | EGenericSumTagNoMatch+        [String] -- ^ constructors tested+        Text     -- ^ prettified prefix tag+    deriving stock (Eq, Show, Generic)++eBase :: EBase -> Getter a+eBase eb = FP.ParserT \_fp eob s st ->+    let os = I# (minusAddr# eob s)+     in FP.Err# st (E os $ EBase eb)++getEBase :: Getter a -> EBase -> Getter a+getEBase (FP.ParserT f) eb =+    FP.ParserT \fp eob s st ->+        let os = I# (minusAddr# eob s)+         in case f fp eob s st of+              FP.Fail# st'   -> FP.Err# st' (E os $ EBase eb)+              FP.Err#  st' e -> FP.Err# st' (E os $ EAnd e eb)+              x -> x++-- | Parse. On parse error, coat it in a generic context layer.+getWrapGeneric :: Get a => String -> (E -> EGeneric E) -> Getter a+getWrapGeneric = getWrapGeneric' get++getWrapGeneric' :: Getter a -> String -> (E -> EGeneric E) -> Getter a+getWrapGeneric' (FP.ParserT f) cd fe =+    FP.ParserT \fp eob s st ->+        let os = I# (minusAddr# eob s)+         in case f fp eob s st of+              FP.Fail# st'   -> FP.Err# st' (E os $ EGeneric cd $ fe EFail)+              FP.Err#  st' e -> FP.Err# st' (E os $ EGeneric cd $ fe e)+              x -> x++class Get a where+    -- | Parse from binary.+    get :: Getter a++runGet :: Get a => B.ByteString -> Either E (a, B.ByteString)+runGet = runGetter get++runGetter :: Getter a -> B.ByteString -> Either E (a, B.ByteString)+runGetter g bs = case FP.runParser g bs of+                   FP.OK a bs' -> Right (a, bs')+                   FP.Fail     -> Left EFail+                   FP.Err e    -> Left e++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 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 a+    .  (Generic a, GTraverseNonSum Get (Rep a)+       , GAssertNotVoid a, GAssertNotSum a+    ) => Getter a+getGenericNonSum = genericTraverseNonSum @Get++getGenericSum+    :: forall pt a+    .  ( Generic a, GTraverseSum Get 'SumOnly (Rep a)+       , Get pt+       , GAssertNotVoid a, GAssertSum a+    ) => PfxTagCfg pt -> Getter a+getGenericSum = genericTraverseSum @Get @'SumOnly++instance TypeError ENoEmpty => Get Void where get = undefined+instance TypeError ENoSum => Get (Either a b) where get = undefined++{-++-- | Parse a bytestring and... immediate reserialize it.+--+-- Note that this _does_ perform work: we make a new bytestring so we don't rely+-- on the input bytestring. To use the input bytestring directly, see+-- "Binrep.Type.Thin".+instance Get Write where+    {-# INLINE get #-}+    get = fmap BZ.byteString $ fmap B.copy $ FP.takeRest++-}++instance Get a => Get (Identity a) where get = Identity <$> get++-- | Unit type parses nothing.+instance Get () where+    {-# INLINE get #-}+    get = pure ()++-- | Parse tuples left-to-right.+instance (Get l, Get r) => Get (l, r) where+    {-# INLINE get #-}+    get = do+        l <- get+        r <- get+        pure (l, r)++-- | Parse elements until EOF. Sometimes used at the "top" of binary formats.+instance Get a => Get [a] where+    get = go+      where+        go = do+            FP.withOption FP.eof (\() -> pure []) $ do+                a <- get+                as <- go+                pure $ a : as++-- | Return the rest of the input.+--+-- A plain unannotated bytestring isn't very useful -- you'll usually want to+-- null-terminate or length-prefix it.+--+-- Note that this _does_ perform work: we make a new bytestring so we don't rely+-- on the input bytestring. To use the input bytestring directly, see+-- "Binrep.Type.Thin".+instance Get B.ByteString where+    {-# INLINE get #-}+    get = B.copy <$> FP.takeRest++-- | 8-bit (1-byte) words do not require byte order in order to precisely+--   define their representation.+deriving via ViaPrim Word8 instance Get Word8++-- | 8-bit (1-byte) words do not require byte order in order to precisely+--   define their representation.+deriving via ViaPrim  Int8 instance Get  Int8++-- | Byte order is irrelevant for 8-bit (1-byte) words.+deriving via Identity Word8 instance Get (ByteOrdered end Word8)++-- | Byte order is irrelevant for 8-bit (1-byte) words.+deriving via Identity  Int8 instance Get (ByteOrdered end  Int8)++-- | Parse any 'Prim''.+getPrim :: forall a. Prim' a => Getter a+getPrim = getEBase FP.anyPrim (ERanOut (sizeOf (undefined :: a)))++instance Prim' a => Get (ViaPrim a) where get = ViaPrim <$> getPrim++-- ByteSwap is required on opposite endian platforms, but we're not checking+-- here, so make sure to keep it on both.+deriving via ViaPrim (ByteOrdered 'LittleEndian a)+    instance (Prim' a, ByteSwap a) => Get (ByteOrdered 'LittleEndian a)+deriving via ViaPrim (ByteOrdered    'BigEndian a)+    instance (Prim' a, ByteSwap a) => Get (ByteOrdered    'BigEndian a)++{-++-- | A type that can be parsed from binary given some environment.+--+-- Making this levity polymorphic makes things pretty strange, but is useful.+-- See @Binrep.Example.FileTable@.+class GetWith (r :: TYPE rep) a | a -> r where+    -- | Parse from binary with the given environment.+    getWith :: r -> Getter a+    -- can no longer provide default implementation due to levity polymorphism+    --default getWith :: Get a => r -> Getter a+    --getWith _ = get++--deriving anyclass instance Get a => GetWith r [a]++-- Note that @r@ is not levity polymorphic, GHC forces it to be lifted. You+-- can't bind (LHS) a levity polymorphic value.+runGetWith+    :: GetWith (r :: TYPE LiftedRep) a+    => r -> B.ByteString -> Either E (a, B.ByteString)+runGetWith r bs = runGetter (getWith r) bs++-}

@@ -1,268 +0,0 @@-{-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6-{-# LANGUAGE BlockArguments #-}--module Binrep.Get.Flatparse-  ( Getter, Get(..), runGet, runGetter-  , E(..), EBase(..), EGeneric(..), EGenericSum(..)-  , eBase-  , getEBase-  -- , GetWith(..), runGetWith-  , getGenericNonSum, getGenericSum-  ) where--import FlatParse.Basic qualified as FP-import Data.ByteString qualified as B--import Binrep.Util.Class-import GHC.TypeLits ( TypeError )--import Data.Void-import Data.Word-import Data.Int-import Bytezap-import Bytezap.Bytes qualified as BZ--import Data.Text ( Text )--import Numeric.Natural--import GHC.Generics-import Generic.Data.Function.Traverse-import Generic.Data.Function.Common-import Generic.Data.Rep.Assert--import GHC.Exts ( minusAddr#, Int(I#) )--type Getter a = FP.Parser E a---- | Structured parse error.-data E-  = E Int EMiddle--  -- | Unhandled parse error.-  ---  -- You get this if you don't change a flatparse fail to an error.-  ---  -- Should not be set except by library code.-  | EFail--    deriving stock (Eq, Show, Generic)--data EMiddle--  -- | Parse error with no further context.-  = EBase EBase--  -- | Somehow, we got two parse errors.-  ---  -- I have a feeling that seeing this indicates a problem in your code.-  | EAnd E EBase--  -- | Parse error decorated with generic info.-  ---  -- Should not be set except by library code.-  | EGeneric String {- ^ data type name -} (EGeneric E)--    deriving stock (Eq, Show, Generic)--data EBase-  = EExpectedByte Word8 Word8-  -- ^ expected first, got second--  | EOverlong Int Int-  -- ^ expected first, got second--  | EExpected B.ByteString B.ByteString-  -- ^ expected first, got second--  | EFailNamed String-  -- ^ known fail--  | EFailParse String B.ByteString Word8-  -- ^ parse fail (where you parse a larger object, then a smaller one in it)--  | ERanOut Int-  -- ^ ran out of input, needed precisely @n@ bytes for this part (n > 0)-  ---  -- Actually a 'Natural', but we use 'Int' because that's what flatparse uses-  -- internally.--    deriving stock (Eq, Show, Generic)---- | A generic context layer for a parse error of type @e@.------ Recursive: parse errors occurring in fields are wrapped up here. (Those--- errors may also have a generic context layer.)------ Making this explicitly recursive may seem strange, but it clarifies that this--- data type is to be seen as a layer over a top-level type.-data EGeneric e-  -- | Parse error relating to sum types (constructors).-  = EGenericSum (EGenericSum e)--  -- | Parse error in a constructor field.-  | EGenericField-        String          -- ^ constructor name-        (Maybe String)  -- ^ field record name (if present)-        Natural         -- ^ field index in constructor-        e               -- ^ field parse error-    deriving stock (Eq, Show, Generic)--data EGenericSum e-  -- | Parse error parsing prefix tag.-  = EGenericSumTag e--  -- | Unable to match a constructor to the parsed prefix tag.-  | EGenericSumTagNoMatch-        [String] -- ^ constructors tested-        Text     -- ^ prettified prefix tag-    deriving stock (Eq, Show, Generic)--eBase :: EBase -> Getter a-eBase eb = FP.ParserT \_fp eob s st ->-    let os = I# (minusAddr# eob s)-     in FP.Err# st (E os $ EBase eb)--getEBase :: Getter a -> EBase -> Getter a-getEBase (FP.ParserT f) eb =-    FP.ParserT \fp eob s st ->-        let os = I# (minusAddr# eob s)-         in case f fp eob s st of-              FP.Fail# st'   -> FP.Err# st' (E os $ EBase eb)-              FP.Err#  st' e -> FP.Err# st' (E os $ EAnd e eb)-              x -> x---- | Parse. On parse error, coat it in a generic context layer.-getWrapGeneric :: Get a => String -> (E -> EGeneric E) -> Getter a-getWrapGeneric = getWrapGeneric' get--getWrapGeneric' :: Getter a -> String -> (E -> EGeneric E) -> Getter a-getWrapGeneric' (FP.ParserT f) cd fe =-    FP.ParserT \fp eob s st ->-        let os = I# (minusAddr# eob s)-         in case f fp eob s st of-              FP.Fail# st'   -> FP.Err# st' (E os $ EGeneric cd $ fe EFail)-              FP.Err#  st' e -> FP.Err# st' (E os $ EGeneric cd $ fe e)-              x -> x--class Get a where-    -- | Parse from binary.-    get :: Getter a--runGet :: Get a => B.ByteString -> Either E (a, B.ByteString)-runGet = runGetter get--runGetter :: Getter a -> B.ByteString -> Either E (a, B.ByteString)-runGetter g bs = case FP.runParser g bs of-                   FP.OK a bs' -> Right (a, bs')-                   FP.Fail     -> Left EFail-                   FP.Err e    -> Left e--instance GenericTraverse (FP.Parser E) where-    type GenericTraverseC (FP.Parser E) a = Get a-    genericTraverseAction cd cc mcs si =-        getWrapGeneric cd $ EGenericField cc mcs si--instance GenericTraverseSum (FP.Parser E) 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)-    => Getter a-getGenericNonSum = genericTraverseNonSum @asserts--getGenericSum-    :: forall {cd} {f} {asserts} pt a-    .  ( Generic a, Rep a ~ D1 cd f, GTraverseSum 'SumOnly cd (FP.Parser E) f-       , Get pt-       , asserts ~ '[ 'NoEmpty, 'NeedSum], ApplyGCAsserts asserts f)-    => PfxTagCfg pt -> Getter a-getGenericSum = genericTraverseSum @'SumOnly @asserts--instance TypeError ENoEmpty => Get Void where get = undefined-instance TypeError ENoSum => Get (Either a b) where get = undefined---- | Parse a bytestring and... immediate reserialize it.------ Note that this _does_ perform work: we make a new bytestring so we don't rely--- on the input bytestring. To use the input bytestring directly, see--- "Binrep.Type.Thin".-instance Get Write where-    {-# INLINE get #-}-    get = fmap BZ.byteString $ fmap B.copy $ FP.takeRest---- | Unit type parses nothing.-instance Get () where-    {-# INLINE get #-}-    get = pure ()---- | Parse tuples left-to-right.-instance (Get l, Get r) => Get (l, r) where-    {-# INLINE get #-}-    get = do-        l <- get-        r <- get-        pure (l, r)---- | Parse elements until EOF. Sometimes used at the "top" of binary formats.-instance Get a => Get [a] where-    get = go-      where-        go = do-            FP.withOption FP.eof (\() -> pure []) $ do-                a <- get-                as <- go-                pure $ a : as---- | Return the rest of the input.------ A plain unannotated bytestring isn't very useful -- you'll usually want to--- null-terminate or length-prefix it.------ Note that this _does_ perform work: we make a new bytestring so we don't rely--- on the input bytestring. To use the input bytestring directly, see--- "Binrep.Type.Thin".-instance Get B.ByteString where-    {-# INLINE get #-}-    get = B.copy <$> FP.takeRest---- | Unsigned byte.-instance Get Word8 where get = getEBase FP.anyWord8 (ERanOut 1)---- | Signed byte.-instance Get  Int8 where get = getEBase FP.anyInt8  (ERanOut 1)--{--Multi-byte machine integers require an endianness to use. A common wrapper is-defined in "Binrep.Type.Int".--}--{----- | A type that can be parsed from binary given some environment.------ Making this levity polymorphic makes things pretty strange, but is useful.--- See @Binrep.Example.FileTable@.-class GetWith (r :: TYPE rep) a | a -> r where-    -- | Parse from binary with the given environment.-    getWith :: r -> Getter a-    -- can no longer provide default implementation due to levity polymorphism-    --default getWith :: Get a => r -> Getter a-    --getWith _ = get----deriving anyclass instance Get a => GetWith r [a]---- Note that @r@ is not levity polymorphic, GHC forces it to be lifted. You--- can't bind (LHS) a levity polymorphic value.-runGetWith-    :: GetWith (r :: TYPE LiftedRep) a-    => r -> B.ByteString -> Either E (a, B.ByteString)-runGetWith r bs = runGetter (getWith r) bs---}

@@ -0,0 +1,117 @@+{-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6++module Binrep.Put where++import Binrep.BLen ( BLen(blen) )+import Binrep.CBLen ( IsCBLen(CBLen), cblen )+import Data.Functor.Identity+import Bytezap.Poke+import Raehik.Compat.Data.Primitive.Types ( Prim', sizeOf )+import Binrep.Util.ByteOrder+import Raehik.Compat.Data.Primitive.Types.Endian ( ByteSwap )+import Binrep.Common.Via.Prim ( ViaPrim(..) )++import Data.ByteString qualified as B++import Binrep.Common.Class.TypeErrors ( ENoSum, ENoEmpty )+import GHC.TypeLits ( TypeError, KnownNat )++import Data.Void+import Data.Word+import Data.Int++import GHC.Generics+import Generic.Data.Function.FoldMap+import Generic.Data.Function.Common+import Generic.Data.Rep.Assert++import Control.Monad.ST ( RealWorld )++import Binrep.Put.Struct ( PutC(putC) )++type Putter = Poke RealWorld+class Put a where put :: a -> Putter++runPut :: (BLen a, Put a) => a -> B.ByteString+runPut a = unsafeRunPokeBS (blen 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 a+    .  ( Generic a, GFoldMapNonSum Put (Rep a)+       , GAssertNotVoid a, GAssertNotSum a+    ) => a -> Putter+putGenericNonSum = genericFoldMapNonSum @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 a+    .  ( Generic a, GFoldMapSum Put 'SumOnly (Rep a)+       , GAssertNotVoid a, GAssertSum a+    ) => (String -> Putter) -> a -> Putter+putGenericSum = genericFoldMapSum @Put @'SumOnly++newtype ViaPutC a = ViaPutC { unViaPutC :: a }+instance (PutC a, KnownNat (CBLen a)) => Put (ViaPutC a) where+    {-# INLINE put #-}+    put = fromStructPoke (cblen @a) . putC . unViaPutC++-- use ViaPutC over this, but should be semantically identical+instance Prim' a => Put (ViaPrim a) where+    put = fromStructPoke (sizeOf (undefined :: a)) . putC+    {-# INLINE put #-}++instance TypeError ENoEmpty => Put Void where put = undefined+instance TypeError ENoSum => Put (Either a b) where put = undefined++instance Put a => Put (Identity a) where put = put . runIdentity++instance Put Putter where put = id++-- | Unit type serializes to nothing. How zen.+instance Put () where+    {-# INLINE put #-}+    put = mempty++instance (Put l, Put r) => Put (l, r) where+    {-# INLINE put #-}+    put (l, r) = put l <> put r++instance Put a => Put [a] where+    {-# INLINE put #-}+    put = mconcat . map put++instance Put B.ByteString where+    {-# INLINE put #-}+    put = byteString++-- | 8-bit (1-byte) words do not require byte order in order to precisely+--   define their representation.+deriving via ViaPutC Word8 instance Put Word8++-- | 8-bit (1-byte) words do not require byte order in order to precisely+--   define their representation.+deriving via ViaPutC  Int8 instance Put  Int8++-- | Byte order is irrelevant for 8-bit (1-byte) words.+deriving via Word8 instance Put (ByteOrdered end Word8)++-- | Byte order is irrelevant for 8-bit (1-byte) words.+deriving via  Int8 instance Put (ByteOrdered end  Int8)++-- ByteSwap is required on opposite endian platforms, but we're not checking+-- here, so make sure to keep it on both.+-- Stick with ViaPrim here because ByteOrdered is connected to it.+deriving via ViaPrim (ByteOrdered 'LittleEndian a)+    instance (Prim' a, ByteSwap a) => Put (ByteOrdered 'LittleEndian a)+deriving via ViaPrim (ByteOrdered    'BigEndian a)+    instance (Prim' a, ByteSwap a) => Put (ByteOrdered    'BigEndian a)

@@ -1,99 +0,0 @@-{-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6-{-# OPTIONS_GHC -fno-warn-orphans #-} -- for generic data op instance--{- | Serialization using the bytezap library.--bytezap serializers ("pokes") work by writing bytes into a pointer, which is-assumed to have _precisely_ the space required. The user must determine the-post-serialize length before the fact. For that reason, this module requires-that types to be serialized have a 'BLen' instance. In general, we are happy-about this, because a binrep type should always have an efficient and preferably-simple 'BLen' instance (and if not, it shouldn't be a binrep type).--}--module Binrep.Put.Bytezap where--import Bytezap-import Bytezap.Poke.Bytes-import Bytezap.Poke.Int-import Data.ByteString qualified as B-import Binrep.BLen.Simple--import Binrep.Util.Class-import GHC.TypeLits ( TypeError )--import Data.Void-import Data.Word-import Data.Int--import GHC.Generics-import Generic.Data.Function.FoldMap-import Generic.Data.Function.Common-import Generic.Data.Rep.Assert--class Put a where put :: a -> Poke--runPut :: (BLen a, Put a) => a -> B.ByteString-runPut a = runPoke (blen a) (put a)-{-# INLINE runPut #-}--instance GenericFoldMap Poke where-    type GenericFoldMapC Poke 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 Poke f-       , asserts ~ '[ 'NoEmpty, 'NoSum], ApplyGCAsserts asserts f)-    => a -> Poke-putGenericNonSum = genericFoldMapNonSum @asserts---- | 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 Poke f-       , asserts ~ '[ 'NoEmpty, 'NeedSum], ApplyGCAsserts asserts f)-    => (String -> Poke) -> a -> Poke-putGenericSum = genericFoldMapSum @'SumOnly @asserts--instance TypeError ENoEmpty => Put Void where put = undefined-instance TypeError ENoSum => Put (Either a b) where put = undefined--instance Put Write where-    {-# INLINE put #-}-    put = writePoke---- | Fairly useless because 'Poke' doesn't have a 'BLen' instance.-instance Put Poke where-    {-# INLINE put #-}-    put = id---- | Unit type serializes to nothing. How zen.-instance Put () where-    {-# INLINE put #-}-    put = mempty--instance (Put l, Put r) => Put (l, r) where-    {-# INLINE put #-}-    put (l, r) = put l <> put r--instance Put a => Put [a] where-    {-# INLINE put #-}-    put = mconcat . map put--instance Put B.ByteString where-    {-# INLINE put #-}-    put = byteString--instance Put Word8 where-    {-# INLINE put #-}-    put = w8--instance Put Int8  where-    {-# INLINE put #-}-    put = i8

@@ -1,102 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-} -- for generic data op instance---- TODO some instances are wrong, Void should be typeerror--module Binrep.Put.Mason where--import Mason.Builder qualified as Mason--import Data.ByteString qualified as B--import Data.Word-import Data.Int-import Data.Void ( Void, absurd )--import GHC.Generics-import Generic.Data.Function.FoldMap-import Generic.Data.Function.Common-import Generic.Data.Rep.Assert--type Builder = Mason.BuilderFor Mason.StrictByteStringBackend--class Put a where-    -- | Serialize to binary.-    put :: a -> Builder---- | Run the serializer.-runPut :: Put a => a -> B.ByteString-runPut = runBuilder . put--runBuilder :: Builder -> B.ByteString-runBuilder = Mason.toStrictByteString--instance GenericFoldMap Builder where-    type GenericFoldMapC Builder 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 Builder f-       , asserts ~ '[ 'NoEmpty, 'NoSum], ApplyGCAsserts asserts f)-    => a -> Builder-putGenericNonSum = genericFoldMapNonSum @asserts---- | 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 Builder f-       , asserts ~ '[ 'NoEmpty, 'NeedSum], ApplyGCAsserts asserts f)-    => (String -> Builder) -> a -> Builder-putGenericSum = genericFoldMapSum @'SumOnly @asserts---- | Impossible to serialize 'Void'.-instance Put Void where-    put = absurd---- | Serialize each element in order. No length indicator, so parse until either---   error or EOF. Usually not what you want, but sometimes used at the "top" of---   binary formats.-instance Put a => Put [a] where-    put = mconcat . map put--instance (Put a, Put b) => Put (a, b) where-    put (a, b) = put a <> put b---- | Serialize the bytestring as-is.------ Careful -- the only way you're going to be able to parse this is to read--- until EOF.-instance Put B.ByteString where-    put = Mason.byteString-    {-# INLINE put #-}---- need to give args for RankNTypes reasons I don't understand-instance Put Word8 where-    put w = Mason.word8 w-    {-# INLINE put #-}-instance Put  Int8 where-    put w = Mason.int8 w-    {-# INLINE put #-}---- | Put with inlined checks via an environment.-class PutWith r a where-    -- | Attempt to serialize to binary with the given environment.-    putWith :: r -> a -> Either String Builder-    default putWith :: Put a => r -> a -> Either String Builder-    putWith _ = putWithout---- | Helper for wrapping a 'BinRep' into a 'BinRepWith' (for encoding).-putWithout :: Put a => a -> Either String Builder-putWithout = Right . put--instance Put a => PutWith r [a]---- | Run the serializer with the given environment.-runPutWith :: PutWith r a => r -> a -> Either String B.ByteString-runPutWith r a = case putWith r a of Left  e -> Left e-                                     Right x -> Right $ runBuilder x

@@ -0,0 +1,87 @@+{-# LANGUAGE UndecidableInstances #-} -- for @KnownNat (CBLen a)@ in head++module Binrep.Put.Struct where++import Bytezap.Struct qualified as Struct+import Bytezap.Struct.Generic qualified as Struct+import Control.Monad.ST ( RealWorld )+import Binrep.CBLen+import GHC.TypeLits ( KnownNat )+import GHC.Generics+import Data.ByteString qualified as B++import Binrep.Common.Via.Prim ( ViaPrim(..) )+import Raehik.Compat.Data.Primitive.Types ( Prim' )+import Data.Word+import Data.Int+import Binrep.Util.ByteOrder+import Data.Functor.Identity+import Raehik.Compat.Data.Primitive.Types.Endian ( ByteSwap )++import Binrep.Common.Class.TypeErrors ( ENoSum, ENoEmpty )+import GHC.TypeLits ( TypeError )+import Data.Void++type PutterC = Struct.Poke RealWorld++-- | constant size putter+class PutC a where putC :: a -> PutterC++runPutC :: forall a. (PutC a, KnownNat (CBLen a)) => a -> B.ByteString+runPutC = Struct.unsafeRunPokeBS (cblen @a) . putC++instance Struct.GPokeBase PutC where+    type GPokeBaseSt PutC   = RealWorld+    type GPokeBaseC  PutC a = PutC a+    gPokeBase = Struct.unPoke . putC+    type KnownSizeOf' PutC a = KnownNat (CBLen a)+    sizeOf' = cblenProxy#++-- | Serialize a term of the struct-like type @a@ via its 'Generic' instance.+putGenericStruct+    :: forall a+    .  ( Generic a, Struct.GPoke PutC (Rep a) )+    => a -> PutterC+putGenericStruct = Struct.Poke . Struct.gPoke @PutC . from++instance Prim' a => PutC (ViaPrim a) where+    putC = Struct.prim . unViaPrim+    {-# INLINE putC #-}++instance TypeError ENoEmpty => PutC Void where putC = undefined+instance TypeError ENoSum => PutC (Either a b) where putC = undefined++instance PutC a => PutC (Identity a) where putC = putC . runIdentity++instance PutC PutterC where putC = id++-- | Unit type serializes to nothing. How zen.+instance PutC () where+    {-# INLINE putC #-}+    putC () = Struct.emptyPoke++-- | Look weird? Yeah. But it's correct :)+instance (PutC l, KnownNat (CBLen l), PutC r) => PutC (l, r) where+    {-# INLINE putC #-}+    putC (l, r) = Struct.sequencePokes (putC l) (cblen @l) (putC r)++-- | 8-bit (1-byte) words do not require byte order in order to precisely+--   define their representation.+deriving via ViaPrim Word8 instance PutC Word8++-- | 8-bit (1-byte) words do not require byte order in order to precisely+--   define their representation.+deriving via ViaPrim  Int8 instance PutC  Int8++-- | Byte order is irrelevant for 8-bit (1-byte) words.+deriving via Word8 instance PutC (ByteOrdered end Word8)++-- | Byte order is irrelevant for 8-bit (1-byte) words.+deriving via  Int8 instance PutC (ByteOrdered end  Int8)++-- ByteSwap is required on opposite endian platforms, but we're not checking+-- here, so make sure to keep it on both.+deriving via ViaPrim (ByteOrdered 'LittleEndian a)+    instance (Prim' a, ByteSwap a) => PutC (ByteOrdered 'LittleEndian a)+deriving via ViaPrim (ByteOrdered    'BigEndian a)+    instance (Prim' a, ByteSwap a) => PutC (ByteOrdered    'BigEndian a)

@@ -0,0 +1,15 @@+{-# LANGUAGE UndecidableInstances #-}++module Binrep.Test where++import Binrep+import Binrep.Type.Magic+import Binrep.CBLen.Generic+import GHC.Generics ( Generic )++data DMagic = DMagic+  { dMagic1_8b :: Magic '[0xFF, 0, 1, 0, 1, 0, 1, 0xFF]+  } deriving stock Generic++instance IsCBLen DMagic where type CBLen DMagic = CBLenGeneric () DMagic+instance PutC DMagic where putC = putGenericStruct

@@ -1,809 +0,0 @@-{- | Safe, if silly, byte representation for use at the type level.--'Word8' is a special type that GHC doesn't (and I think can't) promote to the-type level. We only have 'Natural's, which are unbounded. So we define a safe,-promotable representation, to allow us to prove well-sizedness at compile time.-Then we provide a bunch of type families and reifying typeclasses to enable-going between "similar" kinds ('Natural') and types ('Word8', 'B.ByteString')-respectively.--Type-level functionality is stored in 'Binrep.Type.Byte.TypeLevel' because the-definitions are even sillier than the ones here.--Do not use this on the term level. That would be _extremely_ silly.--}--{-# LANGUAGE AllowAmbiguousTypes, UndecidableInstances #-}--module Binrep.Type.Byte where--import Bytezap qualified as BZ-import Bytezap.Poke.Int qualified as BZ-import GHC.TypeNats-import GHC.Word---- | Efficiently reify a list of type-level 'Natural' bytes to to a bytestring---   builder.------ Attempting to reify a 'Natural' larger than 255 results in a type error.------ This is about as far as one should go for pointless performance here, I--- should think.-class ReifyBytes (ns :: [Natural]) where reifyBytes :: BZ.Poke-instance ReifyBytes '[] where-    {-# INLINE reifyBytes #-}-    reifyBytes = mempty-instance (ByteVal n, ReifyBytes ns) => ReifyBytes (n ': ns) where-    {-# INLINE reifyBytes #-}-    reifyBytes = BZ.w8 (byteVal @n) <> reifyBytes @ns--class ByteVal (n :: Natural) where byteVal :: Word8--instance ByteVal 0x00 where-    {-# INLINE byteVal #-}-    byteVal = 0x00-instance ByteVal 0x01 where-    {-# INLINE byteVal #-}-    byteVal = 0x01-instance ByteVal 0x02 where-    {-# INLINE byteVal #-}-    byteVal = 0x02-instance ByteVal 0x03 where-    {-# INLINE byteVal #-}-    byteVal = 0x03-instance ByteVal 0x04 where-    {-# INLINE byteVal #-}-    byteVal = 0x04-instance ByteVal 0x05 where-    {-# INLINE byteVal #-}-    byteVal = 0x05-instance ByteVal 0x06 where-    {-# INLINE byteVal #-}-    byteVal = 0x06-instance ByteVal 0x07 where-    {-# INLINE byteVal #-}-    byteVal = 0x07-instance ByteVal 0x08 where-    {-# INLINE byteVal #-}-    byteVal = 0x08-instance ByteVal 0x09 where-    {-# INLINE byteVal #-}-    byteVal = 0x09-instance ByteVal 0x0a where-    {-# INLINE byteVal #-}-    byteVal = 0x0a-instance ByteVal 0x0b where-    {-# INLINE byteVal #-}-    byteVal = 0x0b-instance ByteVal 0x0c where-    {-# INLINE byteVal #-}-    byteVal = 0x0c-instance ByteVal 0x0d where-    {-# INLINE byteVal #-}-    byteVal = 0x0d-instance ByteVal 0x0e where-    {-# INLINE byteVal #-}-    byteVal = 0x0e-instance ByteVal 0x0f where-    {-# INLINE byteVal #-}-    byteVal = 0x0f-instance ByteVal 0x10 where-    {-# INLINE byteVal #-}-    byteVal = 0x10-instance ByteVal 0x11 where-    {-# INLINE byteVal #-}-    byteVal = 0x11-instance ByteVal 0x12 where-    {-# INLINE byteVal #-}-    byteVal = 0x12-instance ByteVal 0x13 where-    {-# INLINE byteVal #-}-    byteVal = 0x13-instance ByteVal 0x14 where-    {-# INLINE byteVal #-}-    byteVal = 0x14-instance ByteVal 0x15 where-    {-# INLINE byteVal #-}-    byteVal = 0x15-instance ByteVal 0x16 where-    {-# INLINE byteVal #-}-    byteVal = 0x16-instance ByteVal 0x17 where-    {-# INLINE byteVal #-}-    byteVal = 0x17-instance ByteVal 0x18 where-    {-# INLINE byteVal #-}-    byteVal = 0x18-instance ByteVal 0x19 where-    {-# INLINE byteVal #-}-    byteVal = 0x19-instance ByteVal 0x1a where-    {-# INLINE byteVal #-}-    byteVal = 0x1a-instance ByteVal 0x1b where-    {-# INLINE byteVal #-}-    byteVal = 0x1b-instance ByteVal 0x1c where-    {-# INLINE byteVal #-}-    byteVal = 0x1c-instance ByteVal 0x1d where-    {-# INLINE byteVal #-}-    byteVal = 0x1d-instance ByteVal 0x1e where-    {-# INLINE byteVal #-}-    byteVal = 0x1e-instance ByteVal 0x1f where-    {-# INLINE byteVal #-}-    byteVal = 0x1f-instance ByteVal 0x20 where-    {-# INLINE byteVal #-}-    byteVal = 0x20-instance ByteVal 0x21 where-    {-# INLINE byteVal #-}-    byteVal = 0x21-instance ByteVal 0x22 where-    {-# INLINE byteVal #-}-    byteVal = 0x22-instance ByteVal 0x23 where-    {-# INLINE byteVal #-}-    byteVal = 0x23-instance ByteVal 0x24 where-    {-# INLINE byteVal #-}-    byteVal = 0x24-instance ByteVal 0x25 where-    {-# INLINE byteVal #-}-    byteVal = 0x25-instance ByteVal 0x26 where-    {-# INLINE byteVal #-}-    byteVal = 0x26-instance ByteVal 0x27 where-    {-# INLINE byteVal #-}-    byteVal = 0x27-instance ByteVal 0x28 where-    {-# INLINE byteVal #-}-    byteVal = 0x28-instance ByteVal 0x29 where-    {-# INLINE byteVal #-}-    byteVal = 0x29-instance ByteVal 0x2a where-    {-# INLINE byteVal #-}-    byteVal = 0x2a-instance ByteVal 0x2b where-    {-# INLINE byteVal #-}-    byteVal = 0x2b-instance ByteVal 0x2c where-    {-# INLINE byteVal #-}-    byteVal = 0x2c-instance ByteVal 0x2d where-    {-# INLINE byteVal #-}-    byteVal = 0x2d-instance ByteVal 0x2e where-    {-# INLINE byteVal #-}-    byteVal = 0x2e-instance ByteVal 0x2f where-    {-# INLINE byteVal #-}-    byteVal = 0x2f-instance ByteVal 0x30 where-    {-# INLINE byteVal #-}-    byteVal = 0x30-instance ByteVal 0x31 where-    {-# INLINE byteVal #-}-    byteVal = 0x31-instance ByteVal 0x32 where-    {-# INLINE byteVal #-}-    byteVal = 0x32-instance ByteVal 0x33 where-    {-# INLINE byteVal #-}-    byteVal = 0x33-instance ByteVal 0x34 where-    {-# INLINE byteVal #-}-    byteVal = 0x34-instance ByteVal 0x35 where-    {-# INLINE byteVal #-}-    byteVal = 0x35-instance ByteVal 0x36 where-    {-# INLINE byteVal #-}-    byteVal = 0x36-instance ByteVal 0x37 where-    {-# INLINE byteVal #-}-    byteVal = 0x37-instance ByteVal 0x38 where-    {-# INLINE byteVal #-}-    byteVal = 0x38-instance ByteVal 0x39 where-    {-# INLINE byteVal #-}-    byteVal = 0x39-instance ByteVal 0x3a where-    {-# INLINE byteVal #-}-    byteVal = 0x3a-instance ByteVal 0x3b where-    {-# INLINE byteVal #-}-    byteVal = 0x3b-instance ByteVal 0x3c where-    {-# INLINE byteVal #-}-    byteVal = 0x3c-instance ByteVal 0x3d where-    {-# INLINE byteVal #-}-    byteVal = 0x3d-instance ByteVal 0x3e where-    {-# INLINE byteVal #-}-    byteVal = 0x3e-instance ByteVal 0x3f where-    {-# INLINE byteVal #-}-    byteVal = 0x3f-instance ByteVal 0x40 where-    {-# INLINE byteVal #-}-    byteVal = 0x40-instance ByteVal 0x41 where-    {-# INLINE byteVal #-}-    byteVal = 0x41-instance ByteVal 0x42 where-    {-# INLINE byteVal #-}-    byteVal = 0x42-instance ByteVal 0x43 where-    {-# INLINE byteVal #-}-    byteVal = 0x43-instance ByteVal 0x44 where-    {-# INLINE byteVal #-}-    byteVal = 0x44-instance ByteVal 0x45 where-    {-# INLINE byteVal #-}-    byteVal = 0x45-instance ByteVal 0x46 where-    {-# INLINE byteVal #-}-    byteVal = 0x46-instance ByteVal 0x47 where-    {-# INLINE byteVal #-}-    byteVal = 0x47-instance ByteVal 0x48 where-    {-# INLINE byteVal #-}-    byteVal = 0x48-instance ByteVal 0x49 where-    {-# INLINE byteVal #-}-    byteVal = 0x49-instance ByteVal 0x4a where-    {-# INLINE byteVal #-}-    byteVal = 0x4a-instance ByteVal 0x4b where-    {-# INLINE byteVal #-}-    byteVal = 0x4b-instance ByteVal 0x4c where-    {-# INLINE byteVal #-}-    byteVal = 0x4c-instance ByteVal 0x4d where-    {-# INLINE byteVal #-}-    byteVal = 0x4d-instance ByteVal 0x4e where-    {-# INLINE byteVal #-}-    byteVal = 0x4e-instance ByteVal 0x4f where-    {-# INLINE byteVal #-}-    byteVal = 0x4f-instance ByteVal 0x50 where-    {-# INLINE byteVal #-}-    byteVal = 0x50-instance ByteVal 0x51 where-    {-# INLINE byteVal #-}-    byteVal = 0x51-instance ByteVal 0x52 where-    {-# INLINE byteVal #-}-    byteVal = 0x52-instance ByteVal 0x53 where-    {-# INLINE byteVal #-}-    byteVal = 0x53-instance ByteVal 0x54 where-    {-# INLINE byteVal #-}-    byteVal = 0x54-instance ByteVal 0x55 where-    {-# INLINE byteVal #-}-    byteVal = 0x55-instance ByteVal 0x56 where-    {-# INLINE byteVal #-}-    byteVal = 0x56-instance ByteVal 0x57 where-    {-# INLINE byteVal #-}-    byteVal = 0x57-instance ByteVal 0x58 where-    {-# INLINE byteVal #-}-    byteVal = 0x58-instance ByteVal 0x59 where-    {-# INLINE byteVal #-}-    byteVal = 0x59-instance ByteVal 0x5a where-    {-# INLINE byteVal #-}-    byteVal = 0x5a-instance ByteVal 0x5b where-    {-# INLINE byteVal #-}-    byteVal = 0x5b-instance ByteVal 0x5c where-    {-# INLINE byteVal #-}-    byteVal = 0x5c-instance ByteVal 0x5d where-    {-# INLINE byteVal #-}-    byteVal = 0x5d-instance ByteVal 0x5e where-    {-# INLINE byteVal #-}-    byteVal = 0x5e-instance ByteVal 0x5f where-    {-# INLINE byteVal #-}-    byteVal = 0x5f-instance ByteVal 0x60 where-    {-# INLINE byteVal #-}-    byteVal = 0x60-instance ByteVal 0x61 where-    {-# INLINE byteVal #-}-    byteVal = 0x61-instance ByteVal 0x62 where-    {-# INLINE byteVal #-}-    byteVal = 0x62-instance ByteVal 0x63 where-    {-# INLINE byteVal #-}-    byteVal = 0x63-instance ByteVal 0x64 where-    {-# INLINE byteVal #-}-    byteVal = 0x64-instance ByteVal 0x65 where-    {-# INLINE byteVal #-}-    byteVal = 0x65-instance ByteVal 0x66 where-    {-# INLINE byteVal #-}-    byteVal = 0x66-instance ByteVal 0x67 where-    {-# INLINE byteVal #-}-    byteVal = 0x67-instance ByteVal 0x68 where-    {-# INLINE byteVal #-}-    byteVal = 0x68-instance ByteVal 0x69 where-    {-# INLINE byteVal #-}-    byteVal = 0x69-instance ByteVal 0x6a where-    {-# INLINE byteVal #-}-    byteVal = 0x6a-instance ByteVal 0x6b where-    {-# INLINE byteVal #-}-    byteVal = 0x6b-instance ByteVal 0x6c where-    {-# INLINE byteVal #-}-    byteVal = 0x6c-instance ByteVal 0x6d where-    {-# INLINE byteVal #-}-    byteVal = 0x6d-instance ByteVal 0x6e where-    {-# INLINE byteVal #-}-    byteVal = 0x6e-instance ByteVal 0x6f where-    {-# INLINE byteVal #-}-    byteVal = 0x6f-instance ByteVal 0x70 where-    {-# INLINE byteVal #-}-    byteVal = 0x70-instance ByteVal 0x71 where-    {-# INLINE byteVal #-}-    byteVal = 0x71-instance ByteVal 0x72 where-    {-# INLINE byteVal #-}-    byteVal = 0x72-instance ByteVal 0x73 where-    {-# INLINE byteVal #-}-    byteVal = 0x73-instance ByteVal 0x74 where-    {-# INLINE byteVal #-}-    byteVal = 0x74-instance ByteVal 0x75 where-    {-# INLINE byteVal #-}-    byteVal = 0x75-instance ByteVal 0x76 where-    {-# INLINE byteVal #-}-    byteVal = 0x76-instance ByteVal 0x77 where-    {-# INLINE byteVal #-}-    byteVal = 0x77-instance ByteVal 0x78 where-    {-# INLINE byteVal #-}-    byteVal = 0x78-instance ByteVal 0x79 where-    {-# INLINE byteVal #-}-    byteVal = 0x79-instance ByteVal 0x7a where-    {-# INLINE byteVal #-}-    byteVal = 0x7a-instance ByteVal 0x7b where-    {-# INLINE byteVal #-}-    byteVal = 0x7b-instance ByteVal 0x7c where-    {-# INLINE byteVal #-}-    byteVal = 0x7c-instance ByteVal 0x7d where-    {-# INLINE byteVal #-}-    byteVal = 0x7d-instance ByteVal 0x7e where-    {-# INLINE byteVal #-}-    byteVal = 0x7e-instance ByteVal 0x7f where-    {-# INLINE byteVal #-}-    byteVal = 0x7f-instance ByteVal 0x80 where-    {-# INLINE byteVal #-}-    byteVal = 0x80-instance ByteVal 0x81 where-    {-# INLINE byteVal #-}-    byteVal = 0x81-instance ByteVal 0x82 where-    {-# INLINE byteVal #-}-    byteVal = 0x82-instance ByteVal 0x83 where-    {-# INLINE byteVal #-}-    byteVal = 0x83-instance ByteVal 0x84 where-    {-# INLINE byteVal #-}-    byteVal = 0x84-instance ByteVal 0x85 where-    {-# INLINE byteVal #-}-    byteVal = 0x85-instance ByteVal 0x86 where-    {-# INLINE byteVal #-}-    byteVal = 0x86-instance ByteVal 0x87 where-    {-# INLINE byteVal #-}-    byteVal = 0x87-instance ByteVal 0x88 where-    {-# INLINE byteVal #-}-    byteVal = 0x88-instance ByteVal 0x89 where-    {-# INLINE byteVal #-}-    byteVal = 0x89-instance ByteVal 0x8a where-    {-# INLINE byteVal #-}-    byteVal = 0x8a-instance ByteVal 0x8b where-    {-# INLINE byteVal #-}-    byteVal = 0x8b-instance ByteVal 0x8c where-    {-# INLINE byteVal #-}-    byteVal = 0x8c-instance ByteVal 0x8d where-    {-# INLINE byteVal #-}-    byteVal = 0x8d-instance ByteVal 0x8e where-    {-# INLINE byteVal #-}-    byteVal = 0x8e-instance ByteVal 0x8f where-    {-# INLINE byteVal #-}-    byteVal = 0x8f-instance ByteVal 0x90 where-    {-# INLINE byteVal #-}-    byteVal = 0x90-instance ByteVal 0x91 where-    {-# INLINE byteVal #-}-    byteVal = 0x91-instance ByteVal 0x92 where-    {-# INLINE byteVal #-}-    byteVal = 0x92-instance ByteVal 0x93 where-    {-# INLINE byteVal #-}-    byteVal = 0x93-instance ByteVal 0x94 where-    {-# INLINE byteVal #-}-    byteVal = 0x94-instance ByteVal 0x95 where-    {-# INLINE byteVal #-}-    byteVal = 0x95-instance ByteVal 0x96 where-    {-# INLINE byteVal #-}-    byteVal = 0x96-instance ByteVal 0x97 where-    {-# INLINE byteVal #-}-    byteVal = 0x97-instance ByteVal 0x98 where-    {-# INLINE byteVal #-}-    byteVal = 0x98-instance ByteVal 0x99 where-    {-# INLINE byteVal #-}-    byteVal = 0x99-instance ByteVal 0x9a where-    {-# INLINE byteVal #-}-    byteVal = 0x9a-instance ByteVal 0x9b where-    {-# INLINE byteVal #-}-    byteVal = 0x9b-instance ByteVal 0x9c where-    {-# INLINE byteVal #-}-    byteVal = 0x9c-instance ByteVal 0x9d where-    {-# INLINE byteVal #-}-    byteVal = 0x9d-instance ByteVal 0x9e where-    {-# INLINE byteVal #-}-    byteVal = 0x9e-instance ByteVal 0x9f where-    {-# INLINE byteVal #-}-    byteVal = 0x9f-instance ByteVal 0xa0 where-    {-# INLINE byteVal #-}-    byteVal = 0xa0-instance ByteVal 0xa1 where-    {-# INLINE byteVal #-}-    byteVal = 0xa1-instance ByteVal 0xa2 where-    {-# INLINE byteVal #-}-    byteVal = 0xa2-instance ByteVal 0xa3 where-    {-# INLINE byteVal #-}-    byteVal = 0xa3-instance ByteVal 0xa4 where-    {-# INLINE byteVal #-}-    byteVal = 0xa4-instance ByteVal 0xa5 where-    {-# INLINE byteVal #-}-    byteVal = 0xa5-instance ByteVal 0xa6 where-    {-# INLINE byteVal #-}-    byteVal = 0xa6-instance ByteVal 0xa7 where-    {-# INLINE byteVal #-}-    byteVal = 0xa7-instance ByteVal 0xa8 where-    {-# INLINE byteVal #-}-    byteVal = 0xa8-instance ByteVal 0xa9 where-    {-# INLINE byteVal #-}-    byteVal = 0xa9-instance ByteVal 0xaa where-    {-# INLINE byteVal #-}-    byteVal = 0xaa-instance ByteVal 0xab where-    {-# INLINE byteVal #-}-    byteVal = 0xab-instance ByteVal 0xac where-    {-# INLINE byteVal #-}-    byteVal = 0xac-instance ByteVal 0xad where-    {-# INLINE byteVal #-}-    byteVal = 0xad-instance ByteVal 0xae where-    {-# INLINE byteVal #-}-    byteVal = 0xae-instance ByteVal 0xaf where-    {-# INLINE byteVal #-}-    byteVal = 0xaf-instance ByteVal 0xb0 where-    {-# INLINE byteVal #-}-    byteVal = 0xb0-instance ByteVal 0xb1 where-    {-# INLINE byteVal #-}-    byteVal = 0xb1-instance ByteVal 0xb2 where-    {-# INLINE byteVal #-}-    byteVal = 0xb2-instance ByteVal 0xb3 where-    {-# INLINE byteVal #-}-    byteVal = 0xb3-instance ByteVal 0xb4 where-    {-# INLINE byteVal #-}-    byteVal = 0xb4-instance ByteVal 0xb5 where-    {-# INLINE byteVal #-}-    byteVal = 0xb5-instance ByteVal 0xb6 where-    {-# INLINE byteVal #-}-    byteVal = 0xb6-instance ByteVal 0xb7 where-    {-# INLINE byteVal #-}-    byteVal = 0xb7-instance ByteVal 0xb8 where-    {-# INLINE byteVal #-}-    byteVal = 0xb8-instance ByteVal 0xb9 where-    {-# INLINE byteVal #-}-    byteVal = 0xb9-instance ByteVal 0xba where-    {-# INLINE byteVal #-}-    byteVal = 0xba-instance ByteVal 0xbb where-    {-# INLINE byteVal #-}-    byteVal = 0xbb-instance ByteVal 0xbc where-    {-# INLINE byteVal #-}-    byteVal = 0xbc-instance ByteVal 0xbd where-    {-# INLINE byteVal #-}-    byteVal = 0xbd-instance ByteVal 0xbe where-    {-# INLINE byteVal #-}-    byteVal = 0xbe-instance ByteVal 0xbf where-    {-# INLINE byteVal #-}-    byteVal = 0xbf-instance ByteVal 0xc0 where-    {-# INLINE byteVal #-}-    byteVal = 0xc0-instance ByteVal 0xc1 where-    {-# INLINE byteVal #-}-    byteVal = 0xc1-instance ByteVal 0xc2 where-    {-# INLINE byteVal #-}-    byteVal = 0xc2-instance ByteVal 0xc3 where-    {-# INLINE byteVal #-}-    byteVal = 0xc3-instance ByteVal 0xc4 where-    {-# INLINE byteVal #-}-    byteVal = 0xc4-instance ByteVal 0xc5 where-    {-# INLINE byteVal #-}-    byteVal = 0xc5-instance ByteVal 0xc6 where-    {-# INLINE byteVal #-}-    byteVal = 0xc6-instance ByteVal 0xc7 where-    {-# INLINE byteVal #-}-    byteVal = 0xc7-instance ByteVal 0xc8 where-    {-# INLINE byteVal #-}-    byteVal = 0xc8-instance ByteVal 0xc9 where-    {-# INLINE byteVal #-}-    byteVal = 0xc9-instance ByteVal 0xca where-    {-# INLINE byteVal #-}-    byteVal = 0xca-instance ByteVal 0xcb where-    {-# INLINE byteVal #-}-    byteVal = 0xcb-instance ByteVal 0xcc where-    {-# INLINE byteVal #-}-    byteVal = 0xcc-instance ByteVal 0xcd where-    {-# INLINE byteVal #-}-    byteVal = 0xcd-instance ByteVal 0xce where-    {-# INLINE byteVal #-}-    byteVal = 0xce-instance ByteVal 0xcf where-    {-# INLINE byteVal #-}-    byteVal = 0xcf-instance ByteVal 0xd0 where-    {-# INLINE byteVal #-}-    byteVal = 0xd0-instance ByteVal 0xd1 where-    {-# INLINE byteVal #-}-    byteVal = 0xd1-instance ByteVal 0xd2 where-    {-# INLINE byteVal #-}-    byteVal = 0xd2-instance ByteVal 0xd3 where-    {-# INLINE byteVal #-}-    byteVal = 0xd3-instance ByteVal 0xd4 where-    {-# INLINE byteVal #-}-    byteVal = 0xd4-instance ByteVal 0xd5 where-    {-# INLINE byteVal #-}-    byteVal = 0xd5-instance ByteVal 0xd6 where-    {-# INLINE byteVal #-}-    byteVal = 0xd6-instance ByteVal 0xd7 where-    {-# INLINE byteVal #-}-    byteVal = 0xd7-instance ByteVal 0xd8 where-    {-# INLINE byteVal #-}-    byteVal = 0xd8-instance ByteVal 0xd9 where-    {-# INLINE byteVal #-}-    byteVal = 0xd9-instance ByteVal 0xda where-    {-# INLINE byteVal #-}-    byteVal = 0xda-instance ByteVal 0xdb where-    {-# INLINE byteVal #-}-    byteVal = 0xdb-instance ByteVal 0xdc where-    {-# INLINE byteVal #-}-    byteVal = 0xdc-instance ByteVal 0xdd where-    {-# INLINE byteVal #-}-    byteVal = 0xdd-instance ByteVal 0xde where-    {-# INLINE byteVal #-}-    byteVal = 0xde-instance ByteVal 0xdf where-    {-# INLINE byteVal #-}-    byteVal = 0xdf-instance ByteVal 0xe0 where-    {-# INLINE byteVal #-}-    byteVal = 0xe0-instance ByteVal 0xe1 where-    {-# INLINE byteVal #-}-    byteVal = 0xe1-instance ByteVal 0xe2 where-    {-# INLINE byteVal #-}-    byteVal = 0xe2-instance ByteVal 0xe3 where-    {-# INLINE byteVal #-}-    byteVal = 0xe3-instance ByteVal 0xe4 where-    {-# INLINE byteVal #-}-    byteVal = 0xe4-instance ByteVal 0xe5 where-    {-# INLINE byteVal #-}-    byteVal = 0xe5-instance ByteVal 0xe6 where-    {-# INLINE byteVal #-}-    byteVal = 0xe6-instance ByteVal 0xe7 where-    {-# INLINE byteVal #-}-    byteVal = 0xe7-instance ByteVal 0xe8 where-    {-# INLINE byteVal #-}-    byteVal = 0xe8-instance ByteVal 0xe9 where-    {-# INLINE byteVal #-}-    byteVal = 0xe9-instance ByteVal 0xea where-    {-# INLINE byteVal #-}-    byteVal = 0xea-instance ByteVal 0xeb where-    {-# INLINE byteVal #-}-    byteVal = 0xeb-instance ByteVal 0xec where-    {-# INLINE byteVal #-}-    byteVal = 0xec-instance ByteVal 0xed where-    {-# INLINE byteVal #-}-    byteVal = 0xed-instance ByteVal 0xee where-    {-# INLINE byteVal #-}-    byteVal = 0xee-instance ByteVal 0xef where-    {-# INLINE byteVal #-}-    byteVal = 0xef-instance ByteVal 0xf0 where-    {-# INLINE byteVal #-}-    byteVal = 0xf0-instance ByteVal 0xf1 where-    {-# INLINE byteVal #-}-    byteVal = 0xf1-instance ByteVal 0xf2 where-    {-# INLINE byteVal #-}-    byteVal = 0xf2-instance ByteVal 0xf3 where-    {-# INLINE byteVal #-}-    byteVal = 0xf3-instance ByteVal 0xf4 where-    {-# INLINE byteVal #-}-    byteVal = 0xf4-instance ByteVal 0xf5 where-    {-# INLINE byteVal #-}-    byteVal = 0xf5-instance ByteVal 0xf6 where-    {-# INLINE byteVal #-}-    byteVal = 0xf6-instance ByteVal 0xf7 where-    {-# INLINE byteVal #-}-    byteVal = 0xf7-instance ByteVal 0xf8 where-    {-# INLINE byteVal #-}-    byteVal = 0xf8-instance ByteVal 0xf9 where-    {-# INLINE byteVal #-}-    byteVal = 0xf9-instance ByteVal 0xfa where-    {-# INLINE byteVal #-}-    byteVal = 0xfa-instance ByteVal 0xfb where-    {-# INLINE byteVal #-}-    byteVal = 0xfb-instance ByteVal 0xfc where-    {-# INLINE byteVal #-}-    byteVal = 0xfc-instance ByteVal 0xfd where-    {-# INLINE byteVal #-}-    byteVal = 0xfd-instance ByteVal 0xfe where-    {-# INLINE byteVal #-}-    byteVal = 0xfe-instance ByteVal 0xff where-    {-# INLINE byteVal #-}-    byteVal = 0xff

@@ -1,10 +0,0 @@-module Binrep.Type.Common where--import GHC.Generics ( Generic )-import Data.Data ( Data )---- | Byte order.-data Endianness-  = LE -- ^ little endian, MSB last.  e.g. most processor architectures-  | BE -- ^    big endian, MSB first. e.g. most network protocols-    deriving stock (Generic, Data, Show, Eq)

@@ -1,142 +0,0 @@--- | "Machine" integers: sized integers & naturals with explicit endianness type---   tags for serialization.--{-# LANGUAGE CPP #-} -- for host endianness checking-{-# LANGUAGE UndecidableInstances #-} -- for convenient type level arithmetic--module Binrep.Type.Int where--import Binrep.Put.Mason qualified as Mason-import Binrep.Put.Bytezap qualified as Bytezap-import Binrep.Get.Flatparse qualified as Flatparse-import Binrep.BLen.Simple qualified as Simple-import Binrep.CBLen--import Bytezap.Poke.Int qualified as BZ-import FlatParse.Basic qualified as FP--import Binrep.Type.Common ( Endianness(..) )-import Strongweak--import Data.Word-import Data.Int-import Data.Aeson--import GHC.Generics ( Generic )-import Data.Data ( Data )-import GHC.TypeNats--import Binrep.Via ( Binreply(..) )---- | Machine integer sign.------ Signed integers use two's complement for representation.-data ISign-  = U -- ^ unsigned-  | I -- ^   signed (two's complement)-    deriving stock (Generic, Data, Show, Eq)---- | A type tagged with the endianness (byte order) to use when serializing.------ Intended to be used to wrap existing types which do not otherwise expose--- endianness, namely the machine integers 'Int32', 'Word64' etc. As such, it--- derives various relevant type classes using the wrapped type.------ May be considered a restricted 'Data.Tagged.Tagged' (from the @tagged@--- package).-newtype Endian (end :: Endianness) a = Endian-    { -- | Discard endianness information.-      unEndian :: a }-    deriving stock (Generic, Data, Show)-    deriving (Eq, Ord, Bounded, Num, Enum, Real, Integral) via a-    deriving (IsCBLen, Simple.BLen) via a-    deriving (Weaken, Strengthen) via a-    deriving (ToJSON, FromJSON) via a---- | Endianness doesn't matter for single bytes.-deriving via Binreply Word8 instance Mason.Put (Endian end Word8)---- | Endianness doesn't matter for single bytes.-deriving via Binreply Word8 instance Flatparse.Get (Endian end Word8)---- | Endianness doesn't matter for single bytes.-deriving via Binreply  Int8 instance Mason.Put (Endian end  Int8)---- | Endianness doesn't matter for single bytes.-deriving via Binreply  Int8 instance Flatparse.Get (Endian end  Int8)--{- 2023-02-01 raehik:-byteswapping should be faster than poking "backwards" byte by byte. confirmed-with nikita-volkov's ptr-poker package via benchmarks (single operation ~2%-faster) and inspecting disassembly (byteswapX is inlined at the assembly level-as BSWAP, byte by byte takes lots of MOVs and SHRs)--2023-02-18 raehik: this change is applied to nikita-volkov's ptr-poker pkg :)--}---- | Ask for a minimum length before running the given parser and wrapping the---   result in 'Endian'.-flatparseParseEndianMin-    :: Flatparse.Getter a -> Int -> Flatparse.Getter (Endian end a)-flatparseParseEndianMin f n =-    Endian <$> Flatparse.getEBase f (Flatparse.ERanOut n)--instance Bytezap.Put (Endian 'LE Word16) where put = BZ.w16le . unEndian-instance Flatparse.Get (Endian 'LE Word16) where-    get = flatparseParseEndianMin FP.anyWord16le 2-instance Bytezap.Put (Endian 'BE Word16) where put = BZ.w16be . unEndian-instance Flatparse.Get (Endian 'BE Word16) where-    get = flatparseParseEndianMin FP.anyWord16be 2--instance Bytezap.Put (Endian 'LE Word32) where put = BZ.w32le . unEndian-instance Flatparse.Get (Endian 'LE Word32) where-    get = flatparseParseEndianMin FP.anyWord32le 4-instance Bytezap.Put (Endian 'BE Word32) where put = BZ.w32be . unEndian-instance Flatparse.Get (Endian 'BE Word32) where-    get = flatparseParseEndianMin FP.anyWord32be 4--instance Bytezap.Put (Endian 'LE Word64) where put = BZ.w64le . unEndian-instance Flatparse.Get (Endian 'LE Word64) where-    get = flatparseParseEndianMin FP.anyWord64le 8-instance Bytezap.Put (Endian 'BE Word64) where put = BZ.w64be . unEndian-instance Flatparse.Get (Endian 'BE Word64) where-    get = flatparseParseEndianMin FP.anyWord64be 8--instance Bytezap.Put (Endian 'LE Int16) where put = BZ.i16le . unEndian-instance Flatparse.Get (Endian 'LE Int16) where-    get = flatparseParseEndianMin FP.anyInt16le 2-instance Bytezap.Put (Endian 'BE Int16) where put = BZ.i16be . unEndian-instance Flatparse.Get (Endian 'BE Int16) where-    get = flatparseParseEndianMin FP.anyInt16be 2--instance Bytezap.Put (Endian 'LE Int32) where put = BZ.i32le . unEndian-instance Flatparse.Get (Endian 'LE Int32) where-    get = flatparseParseEndianMin FP.anyInt32le 4-instance Bytezap.Put (Endian 'BE Int32) where put = BZ.i32be . unEndian-instance Flatparse.Get (Endian 'BE Int32) where-    get = flatparseParseEndianMin FP.anyInt32be 4--instance Bytezap.Put (Endian 'LE Int64) where put = BZ.i64le . unEndian-instance Flatparse.Get (Endian 'LE Int64) where-    get = flatparseParseEndianMin FP.anyInt64le 8-instance Bytezap.Put (Endian 'BE Int64) where put = BZ.i64be . unEndian-instance Flatparse.Get (Endian 'BE Int64) where-    get = flatparseParseEndianMin FP.anyInt64be 8---- | Grouping for matching a signedness and size to a Haskell integer data type.-type family IRep (isign :: ISign) (isize :: Natural) where-    IRep 'U 8 = Word8-    IRep 'I 8 =  Int8-    IRep 'U 16 = Word16-    IRep 'I 16 =  Int16-    IRep 'U 32 = Word32-    IRep 'I 32 =  Int32-    IRep 'U 64 = Word64-    IRep 'I 64 =  Int64---- | Largest representable value for a machine integer made of @n@ bits.------ If signed ''I', twos complement is used, so negative range has 1 extra value.-type family IMax (isign :: ISign) (n :: Natural) :: Natural where-    IMax 'U n = 2^n-1-    IMax 'I n = 2^(n-1)

@@ -23,9 +23,10 @@ module Binrep.Type.Magic where  import Binrep-import Binrep.Type.Byte+import Bytezap.Struct.TypeLits ( ReifyBytesW64(reifyBytesW64) ) import FlatParse.Basic qualified as FP import Data.ByteString qualified as B+import Util.TypeNats ( natValInt )  import GHC.TypeLits @@ -34,49 +35,52 @@  import Strongweak --- | A singleton data type representing a "magic number" (a constant bytestring)---   via a phantom type.+-- | A singleton data type representing a "magic number" via a phantom type. -- -- The phantom type variable unambiguously defines a constant bytestring. -- A handful of types are supported for using magics conveniently, e.g. for pure -- ASCII magics, you may use a 'Symbol' type-level string.-data Magic (a :: k) = Magic-    deriving stock (Generic, Data, Show, Eq)+data Magic (a :: k) = Magic deriving stock (Generic, Data, Show, Eq) --- | Weaken a 'Magic a' to the unit. Perhaps you prefer pattern matching on @()@---   over @Magic@, or wish a weak type to be fully divorced from its binrep---   origins.+-- | Weaken a @'Magic' a@ to the unit. instance Weaken (Magic a) where     type Weak (Magic a) = ()     weaken Magic = () --- | Strengthen the unit to some 'Magic a'.-instance Strengthen (Magic a) where-    strengthen () = pure Magic+-- | Strengthen the unit to some @'Magic' a@.+instance Strengthen (Magic a) where strengthen () = pure Magic +-- | The byte length of a magic is known at compile time. instance IsCBLen (Magic a) where type CBLen (Magic a) = Length (MagicBytes a)-deriving via CBLenly (Magic a) instance++-- | The byte length of a magic is obtained via reifying.+deriving via ViaCBLen (Magic a) instance     KnownNat (Length (MagicBytes a)) => BLen (Magic a) -instance (bs ~ MagicBytes a, ReifyBytes bs) => Put (Magic a) where-    put Magic = reifyBytes @bs+instance (bs ~ MagicBytes a, ReifyBytesW64 bs) => PutC (Magic a) where+    putC Magic = reifyBytesW64 @bs -instance (bs ~ MagicBytes a, ReifyBytes bs, KnownNat (Length bs))+deriving via (ViaPutC (Magic a)) instance+  (bs ~ MagicBytes a, ReifyBytesW64 bs, KnownNat (Length bs)) => Put (Magic a)++instance (bs ~ MagicBytes a, ReifyBytesW64 bs, KnownNat (Length bs))   => Get (Magic a) where-    -- TODO silly optimization: we _could_ skip comparing BS lengths because we-    -- know they have to be the same. lmao     get = do         -- Nice case where we _want_ flatparse's no-copy behaviour, because         -- 'actual' is only in scope for this parser. Except, of course, if we         -- error, in which case _now_ we copy. Efficient!-        actual <- FP.take (blen magic)+        actual <- FP.take (natValInt @(Length bs))+        -- silly optimization: we could skip comparing lengths because we know+        -- they must be the same. very silly though         if   actual == expected-        then pure Magic+        then pure magic         else eBase $ EExpected expected (B.copy actual)       where         expected = runPut magic         magic = Magic :: Magic a +-- TODO might wanna move this+-- | The length of a type-level list. type family Length (a :: [k]) :: Natural where     Length '[]       = 0     Length (a ': as) = 1 + Length as@@ -116,8 +120,7 @@     type MagicBytes a :: [Natural]  -- | Type-level naturals go as-is. (Make sure you don't go over 255, though!)-instance Magical (ns :: [Natural]) where-    type MagicBytes ns = ns+instance Magical (ns :: [Natural]) where type MagicBytes ns = ns  -- | Type-level symbols are turned into their Unicode codepoints - but --   multibyte characters aren't handled, so they'll simply be overlarge bytes,

@@ -1,11 +1,15 @@+-- | Data null-padded to a given length.+ {-# LANGUAGE OverloadedStrings #-}  module Binrep.Type.NullPadded where  import Binrep-import Bytezap.Bytes qualified as BZ+import Bytezap.Poke qualified as BZ+import Bytezap.Struct qualified as BZ.Struct import FlatParse.Basic qualified as FP-import Control.Monad.Combinators qualified as Monad+import Raehik.Compat.FlatParse.Basic.WithLength qualified as FP+import Control.Monad.Combinators ( skipCount )  import Binrep.Util ( tshow ) @@ -48,19 +52,31 @@         n = natValInt @n         len = blen a -instance (BLen a, Put a, KnownNat n) => Put (NullPadded n a) where-    put ra = put a <> BZ.pokeByteReplicate paddingLen 0x00+instance IsCBLen (NullPadded n a) where type CBLen (NullPadded n a) = n+deriving via ViaCBLen (NullPadded n a) instance KnownNat n => BLen (NullPadded n a)++instance (BLen a, KnownNat n, PutC a) => PutC (NullPadded n a) where+    putC ra = BZ.Struct.sequencePokes (putC a) len+        (BZ.Struct.replicateByte paddingLen 0x00)       where+        len = blen a         a = unrefine ra+        paddingLen = natValInt @n - len+        -- ^ refinement guarantees >=0++instance (BLen a, KnownNat n, Put a) => Put (NullPadded n a) where+    put ra = put a <> BZ.replicateByte paddingLen 0x00+      where+        a = unrefine ra         paddingLen = natValInt @n - blen a         -- ^ refinement guarantees >=0 -instance (BLen a, Get a, KnownNat n) => Get (NullPadded n a) where+instance (Get a, KnownNat n) => Get (NullPadded n a) where     get = do-        a <- get-        let paddingLen = natValInt @n - blen a+        (a, len) <- FP.parseWithLength get+        let paddingLen = natValInt @n - len         if   paddingLen < 0         then eBase $ EFailNamed "TODO used to be EOverlong, cba"         else do-            Monad.skipCount paddingLen (FP.word8 0x00)+            skipCount paddingLen (FP.word8 0x00)             pure $ reallyUnsafeRefine a

@@ -11,7 +11,6 @@  import Binrep -import Binrep.Get.Flatparse qualified as Flatparse import FlatParse.Basic qualified as FP  import Refined@@ -48,10 +47,10 @@     {-# INLINE put #-}     put a = put (unrefine a) <> put @Word8 0x00 --- | Parse a null-terminated bytestring.-instance Flatparse.Get (NullTerminated B.ByteString) where+-- | We may parse any null-terminated data using a special flatparse combinator.+instance Get a => Get (NullTerminated a) where     {-# INLINE get #-}-    get = reallyUnsafeRefine <$> Flatparse.getEBase FP.anyCString (EFailNamed "cstring")+    get = reallyUnsafeRefine <$> getEBase (FP.isolateToNextNull get) (EFailNamed "cstring")  {- I don't know how to do @[a]@. Either I nullterm each element, which is weird

@@ -1,56 +0,0 @@-{-# LANGUAGE UndecidableInstances #-} -- for convenient type level arithmetic--module Binrep.Type.Prefix where--import Binrep.Type.Int-import GHC.TypeNats-import Data.Word--import Data.Kind---- | Types which may be used as prefixes.------ Generally, these will be integer types.------ Note that this is separate to binary representation, so endianness is--- irrelevant.------ TODO oops can't use 'Int's everywhere because of overflow :'( that's OK-class Prefix a where-    type Max a :: Natural--    -- | used by put. guaranteed that it fits from refined. that is, lenToPfx <=-    --   Max.-    lenToPfx :: Int -> a--    -- | used by get. better not lie.-    pfxToLen :: a -> Int---- | Length prefixing with the unit means a length of 0.------ This is the only sensible case. 1 doesn't work because refining checks @<=@.------ I think there are laws here, where using this is the same as doing nothing at--- all.-instance Prefix () where-    type Max () = 0-    lenToPfx 0 = ()-    lenToPfx _ = error "you lied to refine and broke everything :("-    pfxToLen () = 0--deriving via (a :: Type) instance Prefix a => Prefix (Endian end a)--instance Prefix Word8  where-    type Max Word8  = 2^8  - 1-    lenToPfx = fromIntegral-    pfxToLen = fromIntegral-instance Prefix Word16 where-    type Max Word16 = 2^16 - 1-    lenToPfx = fromIntegral-    pfxToLen = fromIntegral-instance Prefix Word32 where-    type Max Word32 = 2^32 - 1-    lenToPfx = fromIntegral-    pfxToLen = fromIntegral---- TODO no instances > Int, since they would break when too large

@@ -3,7 +3,7 @@  module Binrep.Type.Prefix.Count where -import Binrep.Type.Prefix+import Binrep.Util.Prefix import Binrep import Control.Monad.Combinators qualified as Monad @@ -30,10 +30,18 @@   => Predicate (CountPrefix pfx) (f a) where     validate = validate1 --- TODO no idea if this is sensible+-- | We can know byte length at compile time _if_ we know it for the prefix and+--   the list-like.+--+-- This is extremely unlikely, because then what counting are we even+-- performing for the list-like? But it's a valid instance. instance IsCBLen (CountPrefixed pfx f a) where     type CBLen (CountPrefixed pfx f a) = CBLen pfx + CBLen (f a) +-- | The byte length of a count-prefixed type is the length of the prefix type+--   (holding the length of the type) plus the length of the type.+--+-- Bit confusing. How to explain this? TODO instance (Prefix pfx, Foldable f, BLen pfx, BLen (f a))   => BLen (CountPrefixed pfx f a) where     blen rfa = blen (lenToPfx @pfx (Foldable.length fa)) + blen fa

@@ -3,7 +3,7 @@  module Binrep.Type.Prefix.Size where -import Binrep.Type.Prefix+import Binrep.Util.Prefix import Binrep.Type.Thin import Binrep import FlatParse.Basic qualified as FP

@@ -16,7 +16,7 @@ import GHC.TypeNats import Util.TypeNats ( natValInt ) --- | Essentially reflects a 'BLen' type to 'CBLen'.+-- | Essentially runtime reflection of a 'BLen' type to 'CBLen'. data Size (n :: Natural) type Sized n = Refined (Size n) @@ -31,13 +31,17 @@         len = blen a  instance IsCBLen (Sized n a) where type CBLen (Sized n a) = n-deriving via CBLenly (Sized n a) instance KnownNat n => BLen (Sized n a)+deriving via ViaCBLen (Sized n a) instance KnownNat n => BLen (Sized n a) +instance PutC a => PutC (Sized n a) where+    putC = putC . unrefine+ instance Put a => Put (Sized n a) where     put = put . unrefine --- TODO safety: isolate consumes all bytes if succeeds instance (Get a, KnownNat n) => Get (Sized n a) where     get = do         a <- FP.isolate (natValInt @n) get         pure $ reallyUnsafeRefine a+        -- ^ REFINE SAFETY: 'FP.isolate' consumes precisely the number of bytes+        -- requested when it succeeds

@@ -1,7 +1,7 @@ module Binrep.Type.Text.Encoding.Utf16 where  import Binrep.Type.Text.Internal-import Binrep.Type.Common ( Endianness(..) )+import Binrep.Util.ByteOrder  import Refined import Data.Typeable ( Typeable )@@ -9,13 +9,13 @@ import Data.Text.Encoding qualified as Text import Data.Text ( Text ) -data Utf16 (end :: Endianness)+data Utf16 (end :: ByteOrder) -instance Encode (Utf16 'BE) where encode' = Text.encodeUtf16BE-instance Encode (Utf16 'LE) where encode' = Text.encodeUtf16LE+instance Encode (Utf16 BE) where encode' = Text.encodeUtf16BE+instance Encode (Utf16 LE) where encode' = Text.encodeUtf16LE -instance Decode (Utf16 'BE) where decode = decodeText show $ wrapUnsafeDecoder Text.decodeUtf16BE-instance Decode (Utf16 'LE) where decode = decodeText show $ wrapUnsafeDecoder Text.decodeUtf16LE+instance Decode (Utf16 BE) where decode = decodeText show $ wrapUnsafeDecoder Text.decodeUtf16BE+instance Decode (Utf16 LE) where decode = decodeText show $ wrapUnsafeDecoder Text.decodeUtf16LE  -- | Any 'Text' value is always valid UTF-16. instance Typeable end => Predicate (Utf16 end) Text where validate _ _ = success

@@ -1,7 +1,7 @@ module Binrep.Type.Text.Encoding.Utf32 where  import Binrep.Type.Text.Internal-import Binrep.Type.Common ( Endianness(..) )+import Binrep.Util.ByteOrder  import Refined import Data.Typeable ( Typeable )@@ -9,13 +9,13 @@ import Data.Text.Encoding qualified as Text import Data.Text ( Text ) -data Utf32 (end :: Endianness)+data Utf32 (end :: ByteOrder) -instance Encode (Utf32 'BE) where encode' = Text.encodeUtf32BE-instance Encode (Utf32 'LE) where encode' = Text.encodeUtf32LE+instance Encode (Utf32 BE) where encode' = Text.encodeUtf32BE+instance Encode (Utf32 LE) where encode' = Text.encodeUtf32LE -instance Decode (Utf32 'BE) where decode = decodeText show $ wrapUnsafeDecoder Text.decodeUtf32BE-instance Decode (Utf32 'LE) where decode = decodeText show $ wrapUnsafeDecoder Text.decodeUtf32LE+instance Decode (Utf32 BE) where decode = decodeText show $ wrapUnsafeDecoder Text.decodeUtf32BE+instance Decode (Utf32 LE) where decode = decodeText show $ wrapUnsafeDecoder Text.decodeUtf32LE  -- | Any 'Text' value is always valid UTF-32. instance Typeable end => Predicate (Utf32 end) Text where validate _ _ = success

@@ -25,8 +25,6 @@ import Binrep  import FlatParse.Basic qualified as FP-import Bytezap qualified as BZ-import Bytezap.Bytes qualified as BZ  import GHC.Generics ( Generic ) import Data.Data ( Data )@@ -51,5 +49,3 @@     deriving (Weaken, Strengthen) via Identity a  instance Get (Thin B.ByteString) where get = Thin <$> FP.takeRest-instance Get (Thin BZ.Write) where-    get = fmap Thin $ fmap BZ.byteString $ FP.takeRest

@@ -0,0 +1,19 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Binrep.Util.ByteOrder+  ( ByteOrder(..), ByteOrdered(..)+  , type LE, type BE, type Endian+  ) where++import Raehik.Compat.Data.Primitive.Types.Endian ( ByteOrdered(..) )+import GHC.ByteOrder ( ByteOrder(..) )+import Strongweak+import Data.Kind ( Type )++deriving via (a :: Type) instance     Weaken a =>     Weaken (ByteOrdered end a)+deriving via (a :: Type) instance Strengthen a => Strengthen (ByteOrdered end a)++-- shorter names I originally used+type LE = 'LittleEndian+type BE =    'BigEndian+type Endian = ByteOrdered

@@ -1,19 +0,0 @@-module Binrep.Util.Class where--import GHC.TypeLits---- | Common type error string for when you attempt to use a binrep instance at---   an empty data type (e.g. 'Data.Void.Void', 'GHC.Generics.V1').-type ENoEmpty = 'Text "No binary representation for empty data type"---- | Common type error string for when you attempt to use a binrep instance---   at a sum data type---   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 ENoSum =-         'Text "No binary representation for unannotated sum data type"-    :$$: 'Text "Consider defining a custom data type"-    :<>: 'Text " and deriving a generic instance with explicit sum handling"

@@ -0,0 +1,62 @@+{-# LANGUAGE UndecidableInstances #-} -- for convenient type level arithmetic++module Binrep.Util.Prefix where++import Binrep.Util.ByteOrder ( ByteOrdered(ByteOrdered) )+import GHC.TypeNats+import Data.Word++import Data.Kind++-- | Types which may be used as prefixes.+--+-- Generally, these will be integer types.+--+-- Note that this is separate to binary representation, so endianness is+-- irrelevant.+--+-- Note that we are also limited by the host architecture's 'Int' type.+-- We don't try to work around this, because most types are indexed with 'Int's,+-- so I think other things will break before we do.+class Prefix a where+    type Max a :: Natural++    -- | used by put. guaranteed that it fits from refined. that is, lenToPfx <=+    --   Max.+    lenToPfx :: Int -> a++    -- | used by get. better not lie.+    pfxToLen :: a -> Int++-- | Length prefixing with the unit means a length of 0.+--+-- This is the only sensible case. 1 doesn't work because refining checks @<=@.+--+-- I think there are laws here, where using this is the same as doing nothing at+-- all.+instance Prefix () where+    type Max () = 0+    lenToPfx = \case+      0 -> ()+      _ -> error "you lied to refine and broke everything :("+    pfxToLen () = 0++-- | Byte ordering doesn't change how prefixes work.+deriving via (a :: Type) instance Prefix a => Prefix (ByteOrdered end a)++instance Prefix Word8  where+    type Max Word8  = 2^8  - 1+    lenToPfx = fromIntegral+    pfxToLen = fromIntegral+instance Prefix Word16 where+    type Max Word16 = 2^16 - 1+    lenToPfx = fromIntegral+    pfxToLen = fromIntegral+instance Prefix Word32 where+    type Max Word32 = 2^32 - 1+    lenToPfx = fromIntegral+    pfxToLen = fromIntegral+instance Prefix Word64 where+    type Max Word64 = 2^64 - 1+    lenToPfx = fromIntegral+    pfxToLen = fromIntegral

@@ -1,12 +0,0 @@-module Binrep.Via where--import Binrep.CBLen qualified as BR-import Binrep.BLen.Simple qualified as BR.Simple-import Binrep.Put.Mason qualified as BR.Mason-import Binrep.Put.Bytezap qualified as BR.Bytezap-import Binrep.Get.Flatparse qualified as BR.Flatparse---- | Identity newtype for using with @DerivingVia@.-newtype Binreply a = Binreply { unBinreply :: a }-    deriving stock Show-    deriving (BR.IsCBLen, BR.Simple.BLen, BR.Mason.Put, BR.Bytezap.Put, BR.Flatparse.Get) via a

@@ -1,97 +0,0 @@-{-# LANGUAGE UnboxedTuples #-}--module Bytezap where--import GHC.Exts-import Data.ByteString qualified as B-import Data.ByteString.Internal qualified as B-import GHC.IO-import Data.Word---- | TODO inner poke type------ TODO can I change this to------ @--- Ptr Word8 -> IO (Ptr Word8)--- @------ without any performance loss? it's the same underneath newtypes and datas.--- 'Ptr' is a data rather than a newtype, but IO is just a newtype.------ I originally did this to beat ptr-poker, but idk. Now doubtful.-type Poke# = Addr# -> State# RealWorld -> (# State# RealWorld, Addr# #)---- | Unboxed poke operation.------ A newtype allows us a monoidal interface.-newtype Poke = Poke-  { -- | Write at an offset from an address and return the next offset.-    ---    -- The returned offset must be after the argument offset.-    ---    -- TODO I use that output order because it matches IO. Probs doesn't matter.-    unPoke :: Poke#-  }---- | Construct a 'Poke'.-poke :: Poke# -> Poke-poke = Poke-{-# INLINE poke #-}---- | Sequence two 'Poke's left-to-right.-instance Semigroup Poke where-    {-# INLINE (<>) #-}-    Poke l <> Poke r = Poke $ \addr# st# ->-        case l addr# st# of (# st'#, addr'# #) -> r addr'# st'#---- | The empty 'Poke' simply returns its arguments.-instance Monoid Poke where-    {-# INLINE mempty #-}-    mempty = Poke $ \addr# st# -> (# st#, addr# #)---- | Allocate a buffer of the given size and run a 'Poke' over it.------ The 'Poke' must fill the buffer exactly. If it goes under, you should get--- some random garbage at the end. If it goes over, your computer will probably--- explode.-runPoke :: Int -> Poke -> B.ByteString-runPoke len = B.unsafeCreate len . wrapPoke-{-# INLINE runPoke #-}--wrapPoke :: Poke -> Ptr Word8 -> IO ()-wrapPoke (Poke p) (Ptr addr#) =-    IO (\st# -> case p addr# st# of (# l, _r #) -> (# l, () #))-{-# INLINE wrapPoke #-}---- | Instructions on how to perform a sized write.------ The 'Poke' in 'writePoke' must write the _exact_ number of bytes specified in--- 'writeSize'. Otherwise, your computer explodes.-data Write = Write-  { writeSize :: {-# UNPACK #-} !Int-  , writePoke :: !Poke -- unpack unusable TODO is strict good or not here-  }---- | Construct a 'Write'.-write :: Int -> Poke# -> Write-write len p = Write len (Poke p)-{-# INLINE write #-}---- | Sequence the 'Poke's, sum the sizes.-instance Semigroup Write where-    -- TODO feels like this might be INLINE[1] or even INLINE[0]?-    {-# INLINE (<>) #-}-    Write ll lp <> Write rl rp = Write (ll + rl) (lp <> rp)---- | The empty 'Write' is the empty 'Poke', which writes zero bytes.-instance Monoid Write where-    {-# INLINE mempty #-}-    mempty = Write 0 mempty---- | Serialize and show the resulting ByteString.-instance Show Write where showsPrec p = showsPrec p . runWrite--runWrite :: Write -> B.ByteString-runWrite (Write len p) = runPoke len p-{-# INLINE runWrite #-}

@@ -1,41 +0,0 @@--- | 'ByteString's and primitive byte arrays.--{-# LANGUAGE UnboxedTuples #-}--module Bytezap.Bytes where--import Bytezap--import GHC.Exts-import Data.ByteString qualified as B-import Data.ByteString.Internal qualified as B-import GHC.IO-import Data.Word-import Foreign.ForeignPtr--byteString :: B.ByteString -> Write-byteString (B.BS fptr len) = Write len (pokeForeignPtr fptr len)-{-# INLINE byteString #-}--pokeForeignPtr :: ForeignPtr Word8 -> Int -> Poke-pokeForeignPtr fptr len@(I# len#) = poke $ \addr# st# ->-    case unIO (memcpyForeignPtr (Ptr addr#) fptr len) st# of-      (# st'#, () #) -> (# st'#, addr# `plusAddr#` len# #)-{-# INLINE pokeForeignPtr #-}--memcpyForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()-memcpyForeignPtr ptrTo fptrFrom len =-    B.unsafeWithForeignPtr fptrFrom $ \ptrFrom -> B.memcpy ptrTo ptrFrom len-{-# INLINE memcpyForeignPtr #-}--pokeByteArray# :: ByteArray# -> Int# -> Int# -> Poke-pokeByteArray# arr# off# len# = poke $ \addr# st# ->-    case copyByteArrayToAddr# arr# off# addr# len# st# of-      st'# -> (# st'#, addr# `plusAddr#` len# #)-{-# INLINE pokeByteArray# #-}---- TODO this seems to work but like, really? wow lol-pokeByteReplicate :: Int -> Word8 -> Poke-pokeByteReplicate n@(I# n#) w8 = poke $ \addr# st# ->-    case unIO (B.memset (Ptr addr#) w8 (fromIntegral n)) st# of-      (# st'#, _ #) -> (# st'#, addr# `plusAddr#` n# #)

@@ -1,51 +0,0 @@-module Bytezap.Class where--import Bytezap-import Bytezap.Bytes qualified as W-import Bytezap.Int qualified as W--import Data.ByteString ( ByteString )-import Data.Word-import Data.Int--class Put a where put :: a -> Write--instance Put Write where-    {-# INLINE put #-}-    put = id--instance Put ByteString where-    {-# INLINE put #-}-    put = W.byteString--instance Put Word8 where-    {-# INLINE put #-}-    put = W.w8--instance Put Word16 where-    {-# INLINE put #-}-    put = W.w16--instance Put Word32 where-    {-# INLINE put #-}-    put = W.w32--instance Put Word64 where-    {-# INLINE put #-}-    put = W.w64--instance Put Int8 where-    {-# INLINE put #-}-    put = W.i8--instance Put Int16 where-    {-# INLINE put #-}-    put = W.i16--instance Put Int32 where-    {-# INLINE put #-}-    put = W.i32--instance Put Int64 where-    {-# INLINE put #-}-    put = W.i64

@@ -1,158 +0,0 @@--- | Sized machine integers.--{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE CPP #-}--module Bytezap.Int where--import Bytezap---import Bytezap.Prim.Integer qualified as Prim-import GHC.Exts-import Data.Word-import GHC.Word-import Data.Int-import GHC.Int--w8 :: Word8 -> Write-w8 (W8# a#) = write 1 $ \addr# st# ->-    case writeWord8OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 1# #)-{-# INLINE w8 #-}--w16 :: Word16 -> Write-w16 (W16# a#) = write 2 $ \addr# st# ->-    case writeWord16OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 2# #)-{-# INLINE w16 #-}--w32 :: Word32 -> Write-w32 (W32# a#) = write 4 $ \addr# st# ->-    case writeWord32OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 4# #)-{-# INLINE w32 #-}--w64 :: Word64 -> Write-w64 (W64# a#) = write 8 $ \addr# st# ->-    case writeWord64OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 8# #)-{-# INLINE w64 #-}--{-# INLINE w16le #-}-{-# INLINE w16be #-}-w16le, w16be :: Word16 -> Write-#ifdef WORDS_BIGENDIAN-w16le = w16 . byteSwap16-w16be = w16-#else-w16le = w16-w16be = w16 . byteSwap16-#endif--{-# INLINE w32le #-}-{-# INLINE w32be #-}-w32le, w32be :: Word32 -> Write-#ifdef WORDS_BIGENDIAN-w32le = w32 . byteSwap32-w32be = w32-#else-w32le = w32-w32be = w32 . byteSwap32-#endif--{-# INLINE w64le #-}-{-# INLINE w64be #-}-w64le, w64be :: Word64 -> Write-#ifdef WORDS_BIGENDIAN-w64le = w64 . byteSwap64-w64be = w64-#else-w64le = w64-w64be = w64 . byteSwap64-#endif--i8 :: Int8 -> Write-i8 (I8# a#) = write 1 $ \addr# st# ->-    case writeInt8OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 1# #)-{-# INLINE i8 #-}--i16 :: Int16 -> Write-i16 (I16# a#) = write 2 $ \addr# st# ->-    case writeInt16OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 2# #)-{-# INLINE i16 #-}--i32 :: Int32 -> Write-i32 (I32# a#) = write 4 $ \addr# st# ->-    case writeInt32OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 4# #)-{-# INLINE i32 #-}--i64 :: Int64 -> Write-i64 (I64# a#) = write 8 $ \addr# st# ->-    case writeInt64OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 8# #)-{-# INLINE i64 #-}--byteSwapI16 :: Int16 -> Int16-byteSwapI16 = undefined--byteSwapI32 :: Int32 -> Int32-byteSwapI32 = undefined--byteSwapI64 :: Int64 -> Int64-byteSwapI64 = undefined--{-# INLINE i16le #-}-{-# INLINE i16be #-}-i16le, i16be :: Int16 -> Write-#ifdef WORDS_BIGENDIAN-i16le = i16 . byteSwapI16-i16be = i16-#else-i16le = i16-i16be = i16 . byteSwapI16-#endif--{-# INLINE i32le #-}-{-# INLINE i32be #-}-i32le, i32be :: Int32 -> Write-#ifdef WORDS_BIGENDIAN-i32le = i32 . byteSwapI32-i32be = i32-#else-i32le = i32-i32be = i32 . byteSwapI32-#endif--{-# INLINE i64le #-}-{-# INLINE i64be #-}-i64le, i64be :: Int64 -> Write-#ifdef WORDS_BIGENDIAN-i64le = i64 . byteSwapI64-i64be = i64-#else-i64le = i64-i64be = i64 . byteSwapI64-#endif---- TODO assumes 64-bit-int# :: Int# -> Write-int# a# = write 8 $ \addr# st# ->-    case writeIntOffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 8# #)-{-# INLINE int# #-}--{----- | Construct a 'Write' of the following length using the given primitive poke.-writeViaPrim-    :: Int#-    -> (forall s. Addr# -> Int# -> a -> State# s -> State# s)-    -> a -> Write-writeViaPrim len# writeOffPrim a = write (I# len#) $ \addr# os# st# ->-    case writeOffPrim addr# os# a st# of-      st'# -> (# st'#, os# +# len# #)-{-# INLINE writeViaPrim #-}---}

@@ -1,33 +0,0 @@-{-# LANGUAGE UnboxedTuples #-}--module Bytezap.Poke.Bytes where--import Bytezap--import GHC.Exts-import Data.ByteString qualified as B-import Data.ByteString.Internal qualified as B-import GHC.IO-import Data.Word-import Foreign.ForeignPtr--byteString :: B.ByteString -> Poke-byteString (B.BS fptr len) = pokeForeignPtr fptr len-{-# INLINE byteString #-}--pokeForeignPtr :: ForeignPtr Word8 -> Int -> Poke-pokeForeignPtr fptr len@(I# len#) = poke $ \addr# st# ->-    case unIO (memcpyForeignPtr (Ptr addr#) fptr len) st# of-      (# st'#, () #) -> (# st'#, addr# `plusAddr#` len# #)-{-# INLINE pokeForeignPtr #-}--memcpyForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()-memcpyForeignPtr ptrTo fptrFrom len =-    B.unsafeWithForeignPtr fptrFrom $ \ptrFrom -> B.memcpy ptrTo ptrFrom len-{-# INLINE memcpyForeignPtr #-}--pokeByteArray# :: ByteArray# -> Int# -> Int# -> Poke-pokeByteArray# arr# off# len# = poke $ \addr# st# ->-    case copyByteArrayToAddr# arr# off# addr# len# st# of-      st'# -> (# st'#, addr# `plusAddr#` len# #)-{-# INLINE pokeByteArray# #-}

@@ -1,141 +0,0 @@-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE CPP #-}--module Bytezap.Poke.Int where--import Bytezap-import GHC.Exts-import Data.Word-import GHC.Word-import Data.Int-import GHC.Int--w8 :: Word8 -> Poke-w8 (W8# a#) = Poke $ \addr# st# ->-    case writeWord8OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 1# #)-{-# INLINE w8 #-}--w16 :: Word16 -> Poke-w16 (W16# a#) = Poke $ \addr# st# ->-    case writeWord16OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 2# #)-{-# INLINE w16 #-}--w32 :: Word32 -> Poke-w32 (W32# a#) = Poke $ \addr# st# ->-    case writeWord32OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 4# #)-{-# INLINE w32 #-}--w64 :: Word64 -> Poke-w64 (W64# a#) = Poke $ \addr# st# ->-    case writeWord64OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 8# #)-{-# INLINE w64 #-}--{-# INLINE w16le #-}-{-# INLINE w16be #-}-w16le, w16be :: Word16 -> Poke-#ifdef WORDS_BIGENDIAN-w16le = w16 . byteSwap16-w16be = w16-#else-w16le = w16-w16be = w16 . byteSwap16-#endif--{-# INLINE w32le #-}-{-# INLINE w32be #-}-w32le, w32be :: Word32 -> Poke-#ifdef WORDS_BIGENDIAN-w32le = w32 . byteSwap32-w32be = w32-#else-w32le = w32-w32be = w32 . byteSwap32-#endif--{-# INLINE w64le #-}-{-# INLINE w64be #-}-w64le, w64be :: Word64 -> Poke-#ifdef WORDS_BIGENDIAN-w64le = w64 . byteSwap64-w64be = w64-#else-w64le = w64-w64be = w64 . byteSwap64-#endif--i8 :: Int8 -> Poke-i8 (I8# a#) = Poke $ \addr# st# ->-    case writeInt8OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 1# #)-{-# INLINE i8 #-}--i16 :: Int16 -> Poke-i16 (I16# a#) = Poke $ \addr# st# ->-    case writeInt16OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 2# #)-{-# INLINE i16 #-}--i32 :: Int32 -> Poke-i32 (I32# a#) = Poke $ \addr# st# ->-    case writeInt32OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 4# #)-{-# INLINE i32 #-}--i64 :: Int64 -> Poke-i64 (I64# a#) = Poke $ \addr# st# ->-    case writeInt64OffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 8# #)-{-# INLINE i64 #-}--byteSwapI16 :: Int16 -> Int16-byteSwapI16 = undefined--byteSwapI32 :: Int32 -> Int32-byteSwapI32 = undefined--byteSwapI64 :: Int64 -> Int64-byteSwapI64 = undefined--{-# INLINE i16le #-}-{-# INLINE i16be #-}-i16le, i16be :: Int16 -> Poke-#ifdef WORDS_BIGENDIAN-i16le = i16 . byteSwapI16-i16be = i16-#else-i16le = i16-i16be = i16 . byteSwapI16-#endif--{-# INLINE i32le #-}-{-# INLINE i32be #-}-i32le, i32be :: Int32 -> Poke-#ifdef WORDS_BIGENDIAN-i32le = i32 . byteSwapI32-i32be = i32-#else-i32le = i32-i32be = i32 . byteSwapI32-#endif--{-# INLINE i64le #-}-{-# INLINE i64be #-}-i64le, i64be :: Int64 -> Poke-#ifdef WORDS_BIGENDIAN-i64le = i64 . byteSwapI64-i64be = i64-#else-i64le = i64-i64be = i64 . byteSwapI64-#endif---- TODO assumes 64-bit-int# :: Int# -> Poke-int# a# = Poke $ \addr# st# ->-    case writeIntOffAddr# addr# 0# a# st# of-      st'# -> (# st'#, addr# `plusAddr#` 8# #)-{-# INLINE int# #-}

@@ -1,58 +0,0 @@-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE CPP #-}--module Bytezap.Text where--import Bytezap-import Bytezap.Int--import Data.Text.Internal---- unused import warnings due to messy CPP-import Bytezap.Bytes-import Data.Text.Array qualified as A-import GHC.Exts--import Data.Char ( ord )-import Data.Foldable ( foldl' )-import Data.Bits ( shiftR, (.&.) )--textUtf8 :: Text -> Write-{-# INLINE textUtf8 #-}-#if MIN_VERSION_text(2,0,0)-textUtf8 (Text (A.ByteArray arr#) (I# off#) len@(I# len#)) =-    Write len $ pokeByteArray# arr# off# len#-#else-textUtf8 = error "Bytezap.Text.textUtf8: cba for text-1"-#endif---- TODO adapted from utf8-string-charUtf8 :: Char -> Write-charUtf8 = go . ord- where-  go oc-   | oc <= 0x7f       = w8 $ fromIntegral oc--   | oc <= 0x7ff      =    w8 (fromIntegral (0xc0 + (oc `shiftR` 6)))-                        <> w8 (fromIntegral (0x80 + oc .&. 0x3f))--   | oc <= 0xffff     =    w8 (fromIntegral (0xe0 + (oc `shiftR` 12)))-                        <> w8 (fromIntegral (0x80 + ((oc `shiftR` 6) .&. 0x3f)))-                        <> w8 (fromIntegral (0x80 + oc .&. 0x3f))-   | otherwise        =    w8 (fromIntegral (0xf0 + (oc `shiftR` 18)))-                        <> w8 (fromIntegral (0x80 + ((oc `shiftR` 12) .&. 0x3f)))-                        <> w8 (fromIntegral (0x80 + ((oc `shiftR` 6) .&. 0x3f)))-                        <> w8 (fromIntegral (0x80 + oc .&. 0x3f))-{-# INLINE charUtf8 #-}---- | TODO------ In a perfect world, functions like this would not exist. But this is not a--- perfect world. 'String's suck for a number of reasons. One big one is that--- they are horrendous to serialize. Worse, as of GHC 9.6, type-level strings--- only reflect to 'String'. This function does the best it can to efficiently--- serialize 'String's. It would be much easier and probably similarly fast to--- go through 'Text' instead, but who doesn't like a little challenge?-stringUtf8 :: String -> Write-stringUtf8 = foldl' (\w c -> w <> charUtf8 c) mempty-{-# INLINE stringUtf8 #-}

@@ -1,19 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Data.Aeson.Extra.SizedVector() where--import Data.Aeson-import Data.Vector.Generic.Sized.Internal qualified as VSI-import Data.Vector.Generic.Sized qualified as VS-import Data.Vector.Generic qualified as V-import GHC.TypeNats ( KnownNat )--instance ToJSON   (v a) => ToJSON   (VSI.Vector v n a) where-    toJSON     (VSI.Vector v) = toJSON     v-    toEncoding (VSI.Vector v) = toEncoding v-instance (FromJSON (v a), KnownNat n, V.Vector v a) => FromJSON (VSI.Vector v n a) where-    parseJSON j = do-        v <- parseJSON j-        case VS.toSized v of-          Nothing -> fail "TODO bad size"-          Just v' -> pure v'

@@ -0,0 +1,11 @@+module Raehik.Compat.FlatParse.Basic.Prim where++import Raehik.Compat.Data.Primitive.Types+import FlatParse.Basic+import GHC.Exts ( plusAddr# )++anyPrim :: forall a e st. Prim' a => ParserT st e a+anyPrim = withEnsure# size# $ ParserT $ \_fp _eob buf st ->+    OK# st (indexWord8OffAddrAs# buf 0#) (buf `plusAddr#` size#)+  where+    size# = sizeOf# (undefined :: a)

@@ -0,0 +1,15 @@+-- | https://github.com/AndrasKovacs/flatparse/pull/56+module Raehik.Compat.FlatParse.Basic.WithLength where++import FlatParse.Basic.Parser+import GHC.Exts++-- | Run a parser, and return the result as well as the number of bytes it+--   consumed.+parseWithLength :: ParserT st e a -> ParserT st e (a, Int)+parseWithLength (ParserT f) = ParserT $ \fp eob s st -> do+    case f fp eob s st of+      Fail# st'      -> Fail# st'+      Err#  st' e    -> Err#  st' e+      OK#   st' a s' -> OK#   st' (a, I# (s' `minusAddr#` s)) s'+{-# inline parseWithLength #-}

@@ -1,11 +1,12 @@-{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE AllowAmbiguousTypes #-} -- for my TypeApplications-based natVals+{-# LANGUAGE UndecidableInstances #-} -- for Length type family  -- | Handy typenat utils.  module Util.TypeNats where  -- natVal''-import GHC.TypeNats ( Natural, KnownNat, natVal' )+import GHC.TypeNats ( Natural, KnownNat, natVal', type (+) ) import GHC.Exts ( proxy#, Proxy# )  natVal'' :: forall n. KnownNat n => Natural@@ -16,3 +17,8 @@ natValInt = fromIntegral $ natVal'' @n {-# INLINE natValInt #-} +-- TODO might wanna move this+-- | The length of a type-level list.+type family Length (a :: [k]) :: Natural where+    Length '[]       = 0+    Length (a ': as) = 1 + Length as

@@ -3,9 +3,9 @@ module ArbitraryOrphans() where  import Test.QuickCheck ( Arbitrary )-import Binrep.Type.Int-import Data.Kind+import Binrep.Util.ByteOrder ( ByteOrdered(..) )+import Data.Kind ( Type )  -- TODO 2023-01-26 raehik: why does the following crash GHC-deriving via (a :: Type) instance Arbitrary a => Arbitrary (Endian end a)+deriving via (a :: Type) instance Arbitrary a => Arbitrary (ByteOrdered end a) --deriving newtype instance Arbitrary a => Arbitrary (Endian end a)

@@ -1,39 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Binrep.Extra.HexByteStringSpec ( spec ) where--import Binrep.Extra.HexByteString-import Test.Hspec--import Data.ByteString qualified as B-import Text.Megaparsec-import Data.Void ( Void )--megaparsecParseFromCharStream :: forall s a. (Stream s, Token s ~ Char) => Parsec Void s a -> s -> Maybe a-megaparsecParseFromCharStream parser text = parseMaybe parser text--spec :: Spec-spec = do-    let bs = B.pack-    describe "parse" $ do-      let p = megaparsecParseFromCharStream @String (parseHexByteString B.pack)-      it "parses valid hex bytestrings" $ do-        p "00" `shouldBe` Just (bs [0x00])-        p "FF" `shouldBe` Just (bs [0xFF])-        p "1234" `shouldBe` Just (bs [0x12, 0x34])-        p "01 9A FE" `shouldBe` Just (bs [0x01, 0x9A, 0xFE])-        p "FFFFFFFF" `shouldBe` Just (B.replicate 4 0xFF)-        p "12 34    AB CD" `shouldBe` Just (bs [0x12, 0x34, 0xAB, 0xCD])-      it "fails to parse invalid hex bytestrings" $ do-        p "-00" `shouldBe` Nothing-        p "FG" `shouldBe` Nothing-      it "fails to parse 0x prefix" $ do-        p   "1234" `shouldBe` Just (bs [0x12, 0x34])-        p "0x1234" `shouldBe` Nothing-    describe "print" $ do-      it "prints pretty hex bytestrings" $ do-        let p = prettyHexByteString B.unpack-        p (bs [0x5a, 0x7d]) `shouldBe` "5A 7D"-      it "prints compact hex bytestrings" $ do-        let pc = prettyHexByteStringCompact B.unpack-        pc (bs [0xab, 0x25]) `shouldBe` "ab25"

@@ -11,10 +11,7 @@  import Binrep import Binrep.Generic ( nullTermCstrPfxTag )-import Binrep.BLen.Simple ( blenGenericNonSum, blenGenericSum )-import Binrep.Type.Int-import Binrep.Type.Common ( Endianness(..) )-import Binrep.Type.NullTerminated+import Binrep.Util.ByteOrder import Data.Word import Data.ByteString qualified as B import GHC.Generics ( Generic )@@ -33,8 +30,8 @@ --------------------------------------------------------------------------------  type W1   = Word8-type W2LE = Endian 'LE Word16-type W8BE = Endian 'BE Word64+type W2LE = ByteOrdered LE Word16+type W8BE = ByteOrdered BE Word64  data D   = D01Bla     Word8 W1 W8BE