binrep 0.7.0 → 0.8.0

raw patch · 16 files changed

+289/−221 lines, 16 filesdep +generic-type-functionsdep +type-level-bytestringsdep ~bytezapPVP ok

version bump matches the API change (PVP)

Dependencies added: generic-type-functions, type-level-bytestrings

Dependency ranges changed: bytezap

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• README.md +13/−22
• binrep.cabal +12/−5
• src/Binrep.hs +62/−5
• src/Binrep/CBLen.hs +85/−5
• src/Binrep/CBLen/Generic.hs +0/−75
• src/Binrep/Common/Via/Generically/NonSum.hs +3/−0
• src/Binrep/Get.hs +12/−5
• src/Binrep/Get/Struct.hs +15/−0
• src/Binrep/Put.hs +12/−8
• src/Binrep/Put/Struct.hs +16/−0
• src/Binrep/Test.hs +5/−12
• src/Binrep/Type/Derived/NullTermPadded.hs +21/−0
• src/Binrep/Type/Magic.hs +21/−60
• src/Binrep/Type/NullPadded.hs +2/−16
• src/Util/TypeNats.hs +1/−8

@@ -1,3 +1,12 @@+## 0.8.0 (2024-04-13)+* add missing `And` predicate combinators instances (`PutC`, `GetC`)+* add `Type.Derived.NullTermPadded` (type synonym over `And`)+* add `Generically` instances for `PutC` and `GetC`, where only non-sums are+  permitted+* add `GenericallyNonSum` newtype wrapper+* `Magic (a :: Symbol)` now supports UTF-8 symbols instead of just ASCII. All+  work is still done on the type-level.+ ## 0.7.0 (2024-04-10) * provide "C struct" parser (from bytezap) * fill out some missing C struct instances

@@ -1,7 +1,9 @@-[gh-strongweak]: https://github.com/raehik/strongweak-[gh-flatparse]:  https://github.com/AndrasKovacs/flatparse-[gh-mason]:      https://github.com/fumieval/mason-[gh-refined]:    https://github.com/nikita-volkov/refined+[gh-strongweak]:   https://github.com/raehik/strongweak+[gh-flatparse]:    https://github.com/AndrasKovacs/flatparse+[gh-mason]:        https://github.com/fumieval/mason+[gh-refined]:      https://github.com/nikita-volkov/refined+[hackage-gdf]:     https://hackage.haskell.org/package/generic-data-functions+[hackage-bytezap]: https://hackage.haskell.org/package/bytezap  # binrep binrep is a Haskell library for *precisely modelling binary schemas*, especially@@ -12,16 +14,14 @@     Use highly parameterized binary representation primitives including     null-terminated data (e.g. C-style strings), Pascal-style data (length     prefixed), sized explicit-endian machine integers, null-padded data. Write-    your own as needed.-  * **Low boilerplate:** Straightforward schemas can leverage efficient generic-    parsers and serializers with just a few lines. (See [Generic binary-    representation](#generic-binary-representation) for details.)+    your own primitives if you want (if so, please consider making a PR!).+  * **Low boilerplate:** Free performant parsers and serializers via generics.+    _(See [Generic binary representation](#generic-binary-representation).)_   * **Easy validation:** Use the [strongweak][gh-strongweak] library design     pattern to define an unvalidated data type for easy internal transformation,     and get validation code for free.   * **Performant:** Parsing and serialization is *extremely fast*, using-    [flatparse][gh-flatparse] and [mason][gh-mason] respectively. An-    experimental non-allocating serializer is also provided.+    [bytezap][hackage-bytezap] and [flatparse][gh-flatparse].  ## Usage ### Dependencies@@ -66,19 +66,10 @@ supporting definitions for this pattern, and generic derivers which will work with binrep's binary representation primitives. -### Performant primitives-Parsing uses András Kovács' [flatparse][gh-flatparse] library. Serializing is-via Fumiaki Kinoshita's [mason][gh-mason] library. These are about as fast as-you can get in 2022.--We only define serializers for validated types, meaning we can potentially skip-safety checks, that other serializers would do. Except we still do them, but-validation is an explicitly required step before serialization.--*This might change if we start to support weirder binary representations,-specifically offset-based data.*- ## Generic binary representation+_(Generics are now handled by [generic-data-functions][hackage-gdf]. This info+is largely the same, but the code is elsewhere.)_+ binrep's generic deriving makes very few decisions:    * Constructors are encoded by sequentially encoding every enclosed field.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           binrep-version:        0.7.0+version:        0.8.0 synopsis:       Encode precise binary representations directly in types description:    Please see README.md. category:       Data, Serialization, Generics@@ -36,8 +36,8 @@       Binrep       Binrep.BLen       Binrep.CBLen-      Binrep.CBLen.Generic       Binrep.Common.Class.TypeErrors+      Binrep.Common.Via.Generically.NonSum       Binrep.Common.Via.Prim       Binrep.Generic       Binrep.Get@@ -46,6 +46,7 @@       Binrep.Put       Binrep.Put.Struct       Binrep.Test+      Binrep.Type.Derived.NullTermPadded       Binrep.Type.Magic       Binrep.Type.NullPadded       Binrep.Type.NullTerminated@@ -86,16 +87,18 @@   build-depends:       base >=4.14 && <5     , bytestring >=0.11 && <0.13-    , bytezap >=1.1.0 && <1.2+    , bytezap >=1.2.0 && <1.3     , deepseq >=1.4.6.1 && <1.6     , defun-core ==0.1.*     , flatparse >=0.5.0.2 && <0.6     , generic-data-functions >=0.5.0 && <0.6     , generic-type-asserts >=0.3.0 && <0.4+    , generic-type-functions >=0.1.0 && <0.2     , parser-combinators >=1.3.0 && <1.4     , refined1 ==0.9.*     , strongweak >=0.6.0 && <0.7     , text >=1.2.5.0 && <2.1+    , type-level-bytestrings >=0.1.0 && <0.2   default-language: GHC2021   if flag(icu)     cpp-options: -DHAVE_ICU@@ -130,19 +133,21 @@     , base >=4.14 && <5     , binrep     , bytestring >=0.11 && <0.13-    , bytezap >=1.1.0 && <1.2+    , bytezap >=1.2.0 && <1.3     , deepseq >=1.4.6.1 && <1.6     , defun-core ==0.1.*     , flatparse >=0.5.0.2 && <0.6     , generic-data-functions >=0.5.0 && <0.6     , generic-random >=1.5.0.1 && <1.6     , generic-type-asserts >=0.3.0 && <0.4+    , generic-type-functions >=0.1.0 && <0.2     , hspec >=2.7 && <2.12     , 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+    , type-level-bytestrings >=0.1.0 && <0.2   default-language: GHC2021   if flag(icu)     cpp-options: -DHAVE_ICU@@ -172,17 +177,19 @@       base >=4.14 && <5     , binrep     , bytestring >=0.11 && <0.13-    , bytezap >=1.1.0 && <1.2+    , bytezap >=1.2.0 && <1.3     , deepseq >=1.4.6.1 && <1.6     , defun-core ==0.1.*     , flatparse >=0.5.0.2 && <0.6     , gauge     , generic-data-functions >=0.5.0 && <0.6     , generic-type-asserts >=0.3.0 && <0.4+    , generic-type-functions >=0.1.0 && <0.2     , parser-combinators >=1.3.0 && <1.4     , refined1 ==0.9.*     , strongweak >=0.6.0 && <0.7     , text >=1.2.5.0 && <2.1+    , type-level-bytestrings >=0.1.0 && <0.2   default-language: GHC2021   if flag(icu)     cpp-options: -DHAVE_ICU

@@ -1,5 +1,25 @@+{- | Top-level binrep module, exporting all classes, generics & runners.++binrep helps you precisely model binary schemas by combining simple "building+blocks" (e.g. @'Binrep.Type.NullTerminated.NullTerminated' a@) in regular+Haskell types. You can then receive high-performance serializers and parsers for+free via generics.++binrep is /not/ a general-purpose parsing/serializing library. For that, see++  * mason, for fast and flexible serializing+  * flatparse, for extremely performant parsing+  * bytezap, for overly-fast serializing and parsing (but very limited)+-}+ module Binrep-  ( module Binrep.BLen+  (+  -- * Class and instance design+  -- $class-and-instance-design++  -- * Struct parsing & serializing+  -- $struct-handlers+    module Binrep.BLen   , module Binrep.CBLen   , module Binrep.Put   , module Binrep.Put.Struct@@ -14,9 +34,46 @@ import Binrep.Get import Binrep.Get.Struct -{- TODO-  * binrep is its own ecosystem where explicitness and correctness wins over-    all. There are no binrep instances for 'Data.Void.Void' or 'GHC.Generics.V1'-    because these can't be binrepped; rather than providing an absurd, possibly+{- $class-and-instance-design+At the core of binrep are a set of classes defining parsers, serializers, and+serialized length checkers on supported types. binrep is its own ecosystem where+explicitness and correctness win over all:++  * there are no binrep instances for 'Data.Void.Void' or 'GHC.Generics.V1'+    because we can't use them; rather than providing an absurd, possibly     convenient instance, we emit a type error for their attempted use.+  * you can't put/get 'Data.Word.Word32's etc by themselves; you must provide+    endianness information via the 'Binrep.Util.ByteOrder.ByteOrdered' newtype+  * @'Get' 'Data.ByteString.ByteString'@ just consumes the whole input. seem+    weird? it works with the combinators (it's actually rather important)++Here are some important design decisions:++  * Fields in product types are concatenated left-to-right. e.g. @'Put' (l, r)@+    first puts @l@, then @r@. Nothing is placed between them.+  * Sum types must define how to handle the constructor sum.+    Generics are split into sum handlers and non-sum handlers.+    binrep instances are not provided for types such as @'Either' a b@, where we+    can't state how to choose between the 'Left' and 'Right' constructors.+  * @'Refined.Refined' (pl `Refined.And` pr) a@ is re-associated to+    @'Refined.Refined' pr ('Refined.Refined' pl a)@. The single layer of+    refinements is ergonomic, but the way binrep instances work means we need+    the latter. So 'Refined.And' instances essentially rewrite themselves to+    work as if it were a stack of refinements. (See+    'Binrep.Type.Derived.NullTermPadded' for an example.)+-}++{- $struct-handlers++There are experimental "struct" handlers, which only work on data types that+look like C structs. That is,++  * every field must be constant length, and+  * no sums allowed.++The underlying runners for these are even faster-- they shouldn't do much more+work than the code a C compiler would generate for a similar @struct@. But they+are very inflexible (few binrep instances, hard to write by hand) and poorly+tested. Please be warned when using them. (And do consider sending bug reports+to the author!) -}

@@ -1,4 +1,4 @@-{-# LANGUAGE UndecidableInstances #-} -- for nested type families+{-# LANGUAGE UndecidableInstances #-} -- due to various type algebra {-# LANGUAGE AllowAmbiguousTypes  #-} -- for reification util  module Binrep.CBLen where@@ -15,12 +15,34 @@  import Refined +import Binrep.Common.Class.TypeErrors ( ENoEmpty )++import GHC.Generics+import GHC.TypeError+import Data.Kind ( type Type )++import Data.Type.Equality+import Data.Type.Bool++import Bytezap.Common.Generic ( type GTFoldMapCAddition )++import Binrep.Common.Via.Generically.NonSum+ class IsCBLen a where type CBLen a :: Natural -instance IsCBLen () where type CBLen () = 0+-- | Deriving via this instance necessitates @UndecidableInstances@.+instance Generic a => IsCBLen (GenericallyNonSum a) where+    type CBLen (GenericallyNonSum a) = CBLenGenericNonSum a++instance IsCBLen (Refined pr (Refined pl a))+  =>   IsCBLen (Refined (pl `And` pr) a) where+    type CBLen (Refined (pl `And` pr) a) = CBLen (Refined pr (Refined pl a))+ instance (IsCBLen l, IsCBLen r) => IsCBLen (l, r) where     type CBLen (l, r) = CBLen l + CBLen r +instance IsCBLen () where type CBLen () = 0+ instance IsCBLen Word8  where type CBLen Word8  = 2^0 instance IsCBLen  Int8  where type CBLen  Int8  = 2^0 instance IsCBLen Word16 where type CBLen Word16 = 2^1@@ -33,9 +55,6 @@ instance IsCBLen a => IsCBLen (ByteOrdered end a) where     type CBLen (ByteOrdered end a) = CBLen a -instance IsCBLen (Refined (pl `And` pr) a) where-    type CBLen (Refined (pl `And` pr) a) = CBLen (Refined pr (Refined pl a))- -- | Reify a type's constant byte length to the term level. cblen :: forall a. KnownNat (CBLen a) => Int cblen = natValInt @(CBLen a)@@ -55,3 +74,64 @@ type CBLenSym :: a ~> Natural data CBLenSym a type instance App CBLenSym a = CBLen a++{- $generic-cblen++Generically derive 'CBLen' type family instances.++A type having a valid 'CBLen' instance usually indicates one of the following:++  * it's a primitive, or extremely simple+  * it holds size information in its type+  * it's constructed from other constant byte length types++The first two cases must be handled manually. The third case is where Haskell+generics excel, and the one this module targets.++You may derive a 'CBLen' type generically for a non-sum type with++    instance IsCBLen a where type CBLen a = CBLenGenericNonSum a++You may attempt to derive a 'CBLen' type generically for a sum type with++    instance IsCBLen a where type CBLen a = CBLenGenericSum w a++As with other generic sum type handlers, you must provide the type used to store+the sum tag for sum types. That sum tag type must have a 'CBLen', and every+constructor must have the same 'CBLen' for a 'CBLen' to be calculated. Not many types will fit those criteria, and the code is not well-tested.+-}++-- | Using this necessitates @UndecidableInstances@.+type CBLenGenericSum (w :: Type) a = GCBLen w (Rep a)++-- | Using this necessitates @UndecidableInstances@.+type CBLenGenericNonSum a = GTFoldMapCAddition CBLenSym (Rep a)++type family GCBLen w (gf :: k -> Type) :: Natural where+    GCBLen w (D1 _ gf) = GCBLen w gf+    GCBLen _ V1        = TypeError ENoEmpty+    GCBLen w (l :+: r) = CBLen w + GCBLenCaseMaybe (GCBLenSum (l :+: r))+    GCBLen w (C1 _ gf) = GTFoldMapCAddition CBLenSym gf++--type family GCBLenSum (gf :: k -> Type) :: Maybe Natural where+type family GCBLenSum (gf :: k -> Type) where+    GCBLenSum (C1 ('MetaCons name _ _) gf) =+        JustX (GTFoldMapCAddition CBLenSym gf) name+    GCBLenSum (l :+: r) = MaybeEq (GCBLenSum l) (GCBLenSum r)++type family MaybeEq a b where+    MaybeEq (JustX n nName) (JustX m _) = If (n == m) (JustX n nName) NothingX+    MaybeEq _               _           = NothingX++-- | I don't know how to pattern match in types without writing type families.+type family GCBLenCaseMaybe a where+    GCBLenCaseMaybe (JustX n _) = n+    GCBLenCaseMaybe NothingX  =+        TypeError+            (     'Text "Two constructors didn't have equal constant size."+            ':$$: 'Text "Sry dunno how to thread errors thru LOL"+            )++-- TODO rewrite this stuff to thread error info through!+data JustX a b+data NothingX

@@ -1,75 +0,0 @@-{-# LANGUAGE UndecidableInstances #-} -- due to type algebra--{- | Generically derive 'CBLen' type family instances.--A type having a valid 'CBLen' instance usually indicates one of the following:--  * it's a primitive, or extremely simple-  * it holds size information in its type-  * it's constructed from other constant byte length types--The first two cases must be handled manually. The third case is where Haskell-generics excel, and the one this module targets.--You can (attempt to) derive a 'CBLen' type family instance generically for a-type via--    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.--Then try using it. Hopefully it works, or you get a useful type error. If not,-sorry. I don't have much faith in this code.---}--module Binrep.CBLen.Generic where--import Binrep.CBLen-import Binrep.Common.Class.TypeErrors ( ENoEmpty )--import GHC.Generics-import GHC.TypeLits-import Data.Kind--import Data.Type.Equality-import Data.Type.Bool--import Generic.Type.Assert.Error--type CBLenGeneric (w :: Type) a = GCBLen w (Rep a)-type CBLenGenericNonSum a = CBLenGeneric (GAssertErrorSum a) a--type family GCBLen w (f :: k -> Type) :: Natural where-    GCBLen _ U1         = 0-    GCBLen _ (K1 i c)   = CBLen c-    GCBLen w (l :*: r)  = GCBLen w l + GCBLen w r--    GCBLen w (l :+: r)  = CBLen w + GCBLenCaseMaybe (GCBLenSum w (l :+: r))--    GCBLen _ V1         = TypeError ENoEmpty-    GCBLen w (M1 _ _ f) = GCBLen w f----type family GCBLenSum w (f :: k -> Type) :: Maybe Natural where-type family GCBLenSum w (f :: k -> Type) where-    GCBLenSum w (C1 ('MetaCons name _ _) f)  = JustX (GCBLen w f) name-    GCBLenSum w (l :+: r) = MaybeEq (GCBLenSum w l) (GCBLenSum w r)--type family MaybeEq a b where-    MaybeEq (JustX n nName) (JustX m _) = If (n == m) (JustX n nName) NothingX-    MaybeEq _               _           = NothingX---- | I don't know how to pattern match in types without writing type families.-type family GCBLenCaseMaybe a where-    GCBLenCaseMaybe (JustX n _) = n-    GCBLenCaseMaybe NothingX  =-        TypeError-            (     'Text "Two constructors didn't have equal constant size."-            ':$$: 'Text "Sry dunno how to thread errors thru LOL"-            )---- TODO rewrite this stuff to thread error info through!-data JustX a b-data NothingX-

@@ -0,0 +1,3 @@+module Binrep.Common.Via.Generically.NonSum where++newtype GenericallyNonSum a = GenericallyNonSum { unGenericallyNonSum :: a }

@@ -7,7 +7,6 @@   ) where  import Binrep.Get.Error-import Data.Functor.Identity import Binrep.Util.ByteOrder import Binrep.Common.Via.Prim ( ViaPrim(..) ) import Raehik.Compat.Data.Primitive.Types ( Prim', sizeOf )@@ -26,10 +25,6 @@ import Binrep.Common.Class.TypeErrors ( ENoSum, ENoEmpty ) import GHC.TypeLits ( TypeError ) -import Data.Void-import Data.Word-import Data.Int- import GHC.Generics import Generic.Data.Function.Traverse import Generic.Type.Assert@@ -39,6 +34,12 @@ import Refined import Refined.Unsafe +import Data.Word+import Data.Int+import Data.Void+import Data.Functor.Identity+import Binrep.Common.Via.Generically.NonSum+ type Getter a = FP.Parser E a  class Get a where@@ -73,6 +74,12 @@        , GAssertNotVoid a, GAssertNotSum a     ) => Getter a getGenericNonSum = genericTraverseNonSum @Get++instance+  ( Generic a, GTraverseNonSum Get (Rep a)+  , GAssertNotVoid a, GAssertNotSum a+  ) => Get (GenericallyNonSum a) where+    get = GenericallyNonSum <$> getGenericNonSum  getGenericSum     :: forall pt a

@@ -25,6 +25,11 @@  import Generic.Type.Assert +import Binrep.Common.Via.Generically.NonSum++import Refined+import Refined.Unsafe+ type GetterC = Parser E  -- | constant size parser@@ -75,6 +80,16 @@   , GAssertNotVoid a, GAssertNotSum a   ) => GetC (Generically a) where     getC = Generically <$> getGenericStruct++instance+  ( Generic a, GParse GetC (Rep a)+  , GAssertNotVoid a, GAssertNotSum a+  ) => GetC (GenericallyNonSum a) where+    getC = GenericallyNonSum <$> getGenericStruct++instance GetC (Refined pr (Refined pl a))+  => GetC (Refined (pl `And` pr) a) where+    getC = (reallyUnsafeRefine . unrefine @pl . unrefine @pr) <$> getC  instance GetC () where     {-# INLINE getC #-}

@@ -4,7 +4,6 @@  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@@ -16,10 +15,6 @@ 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.Type.Assert@@ -31,6 +26,12 @@ import Refined import Refined.Unsafe +import Data.Word+import Data.Int+import Data.Void+import Data.Functor.Identity+import Binrep.Common.Via.Generically.NonSum+ type Putter = Poke RealWorld class Put a where put :: a -> Putter @@ -51,6 +52,12 @@     ) => a -> Putter putGenericNonSum = genericFoldMapNonSum @Put +instance+  ( Generic a, GFoldMapNonSum Put (Rep a)+  , GAssertNotVoid a, GAssertNotSum a+  ) => Put (GenericallyNonSum a) where+    put = putGenericNonSum . unGenericallyNonSum+ -- | Serialize a term of the sum type @a@ via its 'Generic' instance. -- -- You must provide a serializer for @a@'s constructors. This is regrettably@@ -62,9 +69,6 @@        , GAssertNotVoid a, GAssertSum a     ) => (String -> Putter) -> a -> Putter putGenericSum = genericFoldMapSum @Put---- We can't provide a Generically instance because the user must choose between--- sum and non-sum handlers.  newtype ViaPutC a = ViaPutC { unViaPutC :: a } instance (PutC a, KnownNat (CBLen a)) => Put (ViaPutC a) where

@@ -24,6 +24,11 @@  import Generic.Type.Assert +import Binrep.Common.Via.Generically.NonSum++import Refined+import Refined.Unsafe+ type PutterC = Struct.Poke RealWorld  -- | constant size putter@@ -51,6 +56,17 @@   , GAssertNotVoid a, GAssertNotSum a   ) => PutC (Generically a) where     putC (Generically a) = putGenericStruct a++instance+  ( Generic a, Struct.GPoke PutC (Rep a)+  , GAssertNotVoid a, GAssertNotSum a+  ) => PutC (GenericallyNonSum a) where+    putC = putGenericStruct . unGenericallyNonSum++instance PutC (Refined pr (Refined pl a))+  => PutC (Refined (pl `And` pr) a) where+    putC =+        putC . reallyUnsafeRefine @_ @pr . reallyUnsafeRefine @_ @pl . unrefine  instance Prim' a => PutC (ViaPrim a) where     putC = Struct.prim . unViaPrim

@@ -1,33 +1,26 @@-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableInstances #-} -- for CBLen instances  module Binrep.Test where  import Binrep import Binrep.Type.Magic-import Binrep.CBLen.Generic import GHC.Generics ( Generic ) import Data.Word import Binrep.Util.ByteOrder +import Binrep.Common.Via.Generically.NonSum+ data DMagic = DMagic   { dMagic1_8b :: Magic '[0xFF, 0, 1, 0, 1, 0, 1, 0xFF]   } deriving stock Generic--instance IsCBLen DMagic where type CBLen DMagic = CBLenGenericNonSum DMagic-instance PutC DMagic where putC = putGenericStruct+    deriving (IsCBLen, PutC) via GenericallyNonSum DMagic  data DMagicSum = DMagicSum1 (Magic '[0]) | DMagicSum2 (Magic '[0xFF])     deriving stock Generic -instance IsCBLen DMagicSum where-    type CBLen DMagicSum = CBLenGenericNonSum DMagicSum- data DStruct = DStruct   { dStruct1 :: Magic '[0xFF, 0, 1, 0xFF]   , dStruct2 :: ByteOrdered LE Word32   , dStruct3 :: ()   } deriving stock (Generic, Show)--instance IsCBLen DStruct where type CBLen DStruct = CBLenGenericNonSum DStruct-instance GetC DStruct where getC = getGenericStruct-deriving via ViaGetC DStruct instance Get DStruct+    deriving (IsCBLen, PutC, GetC) via GenericallyNonSum DStruct

@@ -0,0 +1,21 @@+{- | Null-terminated, then null-padded data.++This is defined using the composition of existing 'NullTerminate' and+'NullPad' predicates, plus the re-associating binrep instances for the 'And'+predicate combinator. It kind of just magically works.+-}++module Binrep.Type.Derived.NullTermPadded where++import Binrep.Type.NullTerminated+import Binrep.Type.NullPadded++import Refined++-- | Predicate for null-terminated, then null-padded data.+type NullTermPad n = NullTerminate `And` NullPad n++-- | Null-terminated data, which is then null-padded to the given length.+--+-- Instantiate with @ByteString@ for a null-padded C string.+type NullTermPadded n = Refined (NullTermPad n)

@@ -5,34 +5,29 @@  There are two main flavors of magics: -  * "random" bytes e.g. Zstandard: @28 B5 2F FD@-  * printable ASCII bytes e.g. Ogg: @4F 67 67 53@ -> OggS--For bytewise magics, use type-level 'Natural' lists.-For ASCII magics, use 'Symbol's (type-level strings).--Previously, I squashed these into a representationally-safe type. Now the check-only occurs during reification. So you are able to define invalid magics now-(bytes over 255, non-ASCII characters), and potentially use them, but you'll get-a clear type error like "no instance for ByteVal 256" when attempting to reify.+  * byte magics e.g. Zstandard: @28 B5 2F FD@+  * printable magics e.g. Ogg: @4F 67 67 53@ -> @OggS@ (in ASCII) -String magics are restricted to ASCII, and will type error during reification-otherwise. If you really want UTF-8, please read 'Binrep.Type.Magic.UTF8'.+For byte magics, use type-level 'Natural' lists.+For printable magics, use 'Symbol's (type-level strings). -} -module Binrep.Type.Magic where+module Binrep.Type.Magic+  ( Magic(Magic)+  , Magical(type MagicBytes)+  , type Length+  ) where -import Binrep-import FlatParse.Basic qualified as FP-import Util.TypeNats ( natValInt )+import Data.Type.Symbol.Utf8 ( type SymbolToUtf8 ) -import GHC.TypeLits+import Util.TypeNats ( natValInt )+import GHC.TypeLits ( type Natural, type Symbol, type KnownNat, type (+) )  import GHC.Generics ( Generic ) import Data.Data ( Data )- import Strongweak +import Binrep import Bytezap.Struct.TypeLits.Bytes ( ReifyBytesW64(reifyBytesW64) ) import Bytezap.Parser.Struct.TypeLits.Bytes   ( ParseReifyBytesW64(parseReifyBytesW64) )@@ -40,6 +35,7 @@ import Data.ByteString.Internal qualified as B import GHC.Exts ( Int(I#), plusAddr#, Ptr(Ptr) ) import Foreign.Marshal.Utils ( copyBytes )+import FlatParse.Basic qualified as FP  -- | A singleton data type representing a "magic number" via a phantom type. --@@ -98,43 +94,6 @@   , ReifyBytesW64 bs, KnownNat (Length bs)   ) => Get (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--{--I do lots of functions on lists, because they're structurally simple. But you-can't pass type-level functions as arguments between type families. singletons-solves a related (?) problem using defunctionalization, where you manually write-out the function applications or something. Essentially, you can't do this:--    type family Map (f :: x -> y) (a :: [x]) :: [y] where-        Map _ '[]       = '[]-        Map f (a ': as) = f a ': Map f as--So you have to write that out for every concrete function over lists.--TODO wellll we depend on defun-core now so may as well use that LOL--}--type family SymbolUnicodeCodepoints (a :: Symbol) :: [Natural] where-    SymbolUnicodeCodepoints a = CharListUnicodeCodepoints (SymbolAsCharList a)--type family CharListUnicodeCodepoints (a :: [Char]) :: [Natural] where-    CharListUnicodeCodepoints '[]       = '[]-    CharListUnicodeCodepoints (c ': cs) = CharToNat c ': CharListUnicodeCodepoints cs--type family SymbolAsCharList (a :: Symbol) :: [Char] where-    SymbolAsCharList a = SymbolAsCharList' (UnconsSymbol a)--type family SymbolAsCharList' (a :: Maybe (Char, Symbol)) :: [Char] where-    SymbolAsCharList' 'Nothing = '[]-    SymbolAsCharList' ('Just '(c, s)) = c ': SymbolAsCharList' (UnconsSymbol s)----------------------------------------------------------------------------------- -- | Types which define a magic value. class Magical (a :: k) where     -- | How to turn the type into a list of bytes.@@ -143,8 +102,10 @@ -- | Type-level naturals go as-is. (Make sure you don't go over 255, though!) 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,---   which will fail further down.-instance Magical (sym :: Symbol) where-    type MagicBytes sym = SymbolUnicodeCodepoints sym+-- | Type-level symbols are converted to UTF-8.+instance Magical (sym :: Symbol) where type MagicBytes sym = SymbolToUtf8 sym++-- | The length of a type-level list.+type family Length (a :: [k]) :: Natural where+    Length '[]       = 0+    Length (a ': as) = 1 + Length as

@@ -1,19 +1,5 @@ -- | Data null-padded to a given length. -{- TODO-Null padding using the underlying type's instances doesn't necessarily work.-'ByteString's must parse until the end of the string.-Or maybe that's correct, and we must use null terminated bytestrings with null-padding...? Huh.--...well, doing that fixes my issue. And thinking about it, I imagine that's how-C does it (you're still going to be wanting to deal with cstrings regardless of-null padding). Cool!!--OK, all good. But because of that, I should provide a convenience wrapper to put-nullpad+nullterm together.--}- {-# LANGUAGE OverloadedStrings #-}  module Binrep.Type.NullPadded where@@ -72,8 +58,8 @@         n = natValInt @n         len = blen a -instance (BLen a, KnownNat n, PutC a) => PutC (NullPadded n a) where-    putC ra = BZ.Struct.sequencePokes (putC a) len+instance (BLen a, KnownNat n, Put a) => PutC (NullPadded n a) where+    putC ra = BZ.Struct.sequencePokes (BZ.toStructPoke (put a)) len         (BZ.Struct.replicateByte paddingLen 0x00)       where         a = unrefine ra

@@ -1,12 +1,11 @@ {-# 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', type (+) )+import GHC.TypeNats ( Natural, KnownNat, natVal' ) import GHC.Exts ( proxy#, Proxy# )  natVal'' :: forall n. KnownNat n => Natural@@ -16,9 +15,3 @@ natValInt :: forall n. KnownNat n => Int 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