work on Put.Struct

CHANGELOG.md

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

binrep.cabal

@@ -8,7 +8,7 @@ name:           binrep
 version:        0.5.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

package.yaml

@@ -5,7 +5,7 @@ description: Please see README.md.
 extra-source-files:
 - README.md
 - CHANGELOG.md
-category: Data, Serialization
+category: Data, Serialization, Generics
 tested-with: GHC ==9.4.4
 license: MIT
 license-file: LICENSE

src/Binrep.hs

@@ -2,12 +2,14 @@ module Binrep
   ( 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.Put
+import Binrep.Put.Struct
 import Binrep.Get
 
 {- TODO

src/Binrep/BLen.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE UndecidableInstances #-} -- for 'ViaCBLen', 'TypeError'
-{-# LANGUAGE AllowAmbiguousTypes #-} -- for 'cblen', 'natValInt'
 
 {- | Byte length as a simple pure function, no bells or whistles.
 
@@ -25,7 +24,6 @@ module Binrep.BLen
 
 import Binrep.CBLen
 import GHC.TypeNats
-import Util.TypeNats ( natValInt )
 
 import Binrep.Common.Class.TypeErrors ( ENoSum, ENoEmpty )
 import GHC.TypeLits ( TypeError )
@@ -115,7 +113,3 @@ deriving via ViaCBLen (ByteOrdered end a)
 -- (e.g. "Binrep.Type.Sized").
 newtype ViaCBLen a = ViaCBLen { unViaCBLen :: a }
 instance KnownNat (CBLen a) => BLen (ViaCBLen a) where 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

src/Binrep/CBLen.hs

@@ -29,10 +29,14 @@ instance IsCBLen  Int64 where type CBLen  Int64 = 2^3
 instance IsCBLen a => IsCBLen (ByteOrdered end a) where
     type CBLen (ByteOrdered end a) = CBLen a
 
-reifyCBLen# :: forall a. KnownNat (CBLen a) => Int#
-reifyCBLen# = i#
+-- | Reify a type's constant byte length to the term level.
+cblen :: forall a n. KnownNat (CBLen a) => Int
+cblen = natValInt @(CBLen a)
+
+cblen# :: forall a. KnownNat (CBLen a) => Int#
+cblen# = i#
   where !(I# i#) = natValInt @(CBLen a)
 
-reifyCBLenProxy# :: forall a. KnownNat (CBLen a) => Proxy# a -> Int#
-reifyCBLenProxy# _ = i#
+cblenProxy# :: forall a. KnownNat (CBLen a) => Proxy# a -> Int#
+cblenProxy# _ = i#
   where !(I# i#) = natValInt @(CBLen a)

src/Binrep/Put.hs

@@ -96,10 +96,10 @@ deriving via ViaPrim Word8 instance Put Word8
 deriving via ViaPrim  Int8 instance Put  Int8
 
 -- | Byte order is irrelevant for 8-bit (1-byte) words.
-deriving via Identity Word8 instance Put (ByteOrdered end Word8)
+deriving via Word8 instance Put (ByteOrdered end Word8)
 
 -- | Byte order is irrelevant for 8-bit (1-byte) words.
-deriving via Identity  Int8 instance Put (ByteOrdered end  Int8)
+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.

src/Binrep/Put/Struct.hs

@@ -1,25 +1,41 @@
+{-# 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 Raehik.Compat.Data.Primitive.Types ( Prim' )
-import GHC.Generics
 import Binrep.CBLen
-import Binrep.Common.Via.Prim ( ViaPrim(..) )
 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' = reifyCBLenProxy#
+    sizeOf' = cblenProxy#
 
 -- | Serialize a term of the struct-like type @a@ via its 'Generic' instance.
 putGenericStruct
@@ -31,3 +47,41 @@ 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)

src/Binrep/Type/Sized.hs

@@ -33,7 +33,11 @@ instance (BLen a, KnownNat n) => Predicate (Size n) a where
 instance IsCBLen (Sized n a) where type CBLen (Sized n a) = n
 deriving via ViaCBLen (Sized n a) instance KnownNat n => BLen (Sized n a)
 
-instance (Put a, KnownNat n) => Put (Sized n a) where
+instance PutC a => PutC (Sized n a) where
+    putC = putC . unrefine
+
+-- TODO obtain thru PutC instead? unsure how to do this exactly
+instance Put a => Put (Sized n a) where
     put = put . unrefine
 
 instance (Get a, KnownNat n) => Get (Sized n a) where