From b7f03525a87aec3161ca2c41f058dee1fd56aaeb Mon Sep 17 00:00:00 2001 From: Ben Orchard Date: Sat, 16 Mar 2024 19:32:25 +0000 Subject: [PATCH] oh it's so beautiful (more cleanup) --- binrep.cabal | 4 +- src/Binrep/Get.hs | 44 ++++++++++--- src/Binrep/Put.hs | 25 ++++---- src/Binrep/Type/Int.hs | 77 ----------------------- src/Binrep/Via.hs | 11 ---- src/Binrep/Via/Prim.hs | 4 ++ src/Raehik/Compat/FlatParse/Basic/Prim.hs | 11 ++++ 7 files changed, 65 insertions(+), 111 deletions(-) delete mode 100644 src/Binrep/Type/Int.hs delete mode 100644 src/Binrep/Via.hs create mode 100644 src/Binrep/Via/Prim.hs create mode 100644 src/Raehik/Compat/FlatParse/Basic/Prim.hs diff --git a/binrep.cabal b/binrep.cabal index 0fa8c9a..9950649 100644 --- a/binrep.cabal +++ b/binrep.cabal @@ -42,7 +42,6 @@ library Binrep.Get Binrep.Put Binrep.Type.Byte - Binrep.Type.Int Binrep.Type.Magic Binrep.Type.NullPadded Binrep.Type.NullTerminated @@ -62,8 +61,9 @@ library Binrep.Util.Class Binrep.Util.Generic Binrep.Util.Prefix - Binrep.Via + Binrep.Via.Prim Data.Aeson.Extra.SizedVector + Raehik.Compat.FlatParse.Basic.Prim Util.TypeNats other-modules: Paths_binrep diff --git a/src/Binrep/Get.hs b/src/Binrep/Get.hs index 31c249a..1e50fa8 100644 --- a/src/Binrep/Get.hs +++ b/src/Binrep/Get.hs @@ -7,10 +7,19 @@ module Binrep.Get , eBase , getEBase -- , GetWith(..), runGetWith + , getPrim , getGenericNonSum, getGenericSum ) where +import Data.Functor.Identity +import Binrep.Util.ByteOrder +import Binrep.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.Util.Class @@ -19,7 +28,6 @@ import GHC.TypeLits ( TypeError ) import Data.Void import Data.Word import Data.Int -import Bytezap import Data.Text ( Text ) @@ -200,6 +208,8 @@ instance Get Write where -} +instance Get a => Get (Identity a) where get = Identity <$> get + -- | Unit type parses nothing. instance Get () where {-# INLINE get #-} @@ -235,16 +245,32 @@ instance Get B.ByteString where {-# INLINE get #-} get = B.copy <$> FP.takeRest --- | Unsigned byte. -instance Get Word8 where get = getEBase FP.anyWord8 (ERanOut 1) +-- | 8-bit (1-byte) words do not require byte order in order to precisely +-- define their representation. +deriving via ViaPrim Word8 instance Get Word8 --- | Signed byte. -instance Get Int8 where get = getEBase FP.anyInt8 (ERanOut 1) +-- | 8-bit (1-byte) words do not require byte order in order to precisely +-- define their representation. +deriving via ViaPrim Int8 instance Get Int8 -{- -Multi-byte machine integers require an endianness to use. A common wrapper is -defined in "Binrep.Type.Int". --} +-- | 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) {- diff --git a/src/Binrep/Put.hs b/src/Binrep/Put.hs index 481833a..b64b5bd 100644 --- a/src/Binrep/Put.hs +++ b/src/Binrep/Put.hs @@ -13,10 +13,12 @@ simple 'BLen' instance (and if not, it shouldn't be a binrep type). module Binrep.Put where +import Data.Functor.Identity import Bytezap.Write import Raehik.Compat.Data.Primitive.Types ( Prim' ) -import Raehik.Compat.Data.Primitive.Types.Endian ( ByteOrdered(..), ByteSwap ) -import GHC.ByteOrder +import Binrep.Util.ByteOrder +import Raehik.Compat.Data.Primitive.Types.Endian ( ByteSwap ) +import Binrep.Via.Prim ( ViaPrim(..) ) import Data.ByteString qualified as B @@ -65,13 +67,13 @@ putGenericSum => (String -> Write') -> a -> Write' putGenericSum = genericFoldMapSum @'SumOnly @asserts --- | DerivingVia newtype for 'Put' types which can borrow from 'Prim''. -newtype PutViaPrim a = PutViaPrim { unPutViaPrim :: a } -instance Prim' a => Put (PutViaPrim a) where put = prim . unPutViaPrim +instance Prim' a => Put (ViaPrim a) where put = prim . unViaPrim 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 Write' where put = id -- | Unit type serializes to nothing. How zen. @@ -93,22 +95,21 @@ instance Put B.ByteString where -- | 8-bit (1-byte) words do not require byte order in order to precisely -- define their representation. -deriving via PutViaPrim Word8 instance Put Word8 +deriving via ViaPrim Word8 instance Put Word8 -- | 8-bit (1-byte) words do not require byte order in order to precisely -- define their representation. -deriving via PutViaPrim Int8 instance Put Int8 +deriving via ViaPrim Int8 instance Put Int8 --- TODO maybe via binreply for these two (but need to move instances then...?) -- | Byte order is irrelevant for 8-bit (1-byte) words. -deriving via PutViaPrim Word8 instance Put (ByteOrdered end Word8) +deriving via Identity Word8 instance Put (ByteOrdered end Word8) -- | Byte order is irrelevant for 8-bit (1-byte) words. -deriving via PutViaPrim Int8 instance Put (ByteOrdered end Int8) +deriving via Identity 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. -deriving via PutViaPrim (ByteOrdered 'LittleEndian a) +deriving via ViaPrim (ByteOrdered 'LittleEndian a) instance (Prim' a, ByteSwap a) => Put (ByteOrdered 'LittleEndian a) -deriving via PutViaPrim (ByteOrdered 'BigEndian a) +deriving via ViaPrim (ByteOrdered 'BigEndian a) instance (Prim' a, ByteSwap a) => Put (ByteOrdered 'BigEndian a) diff --git a/src/Binrep/Type/Int.hs b/src/Binrep/Type/Int.hs deleted file mode 100644 index 2616e24..0000000 --- a/src/Binrep/Type/Int.hs +++ /dev/null @@ -1,77 +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 ( Put(put) ) -import Bytezap.Write qualified as BZ -import Data.Primitive.Types qualified as Prim -import Data.Primitive.Types ( Prim ) -import Raehik.Compat.Data.Primitive.Types ( Prim' ) -import Binrep.Util.ByteOrder -import Raehik.Compat.Data.Primitive.Types.Endian ( ByteSwap ) - -import Binrep.BLen.Simple qualified as Simple -import Binrep.CBLen - -import Binrep.Get.Flatparse qualified as Flatparse -import FlatParse.Basic qualified as FP - -import Strongweak - -import Data.Word -import Data.Int -import Data.Aeson - -import GHC.Generics ( Generic ) -import Data.Data ( Data ) - -import Binrep.Via ( Binreply(..) ) - --- | Endianness doesn't matter for single bytes. -deriving via Binreply Word8 instance Flatparse.Get (ByteOrdered end Word8) - --- | Endianness doesn't matter for single bytes. -deriving via Binreply Int8 instance Flatparse.Get (ByteOrdered end Int8) - --- | Ask for a minimum length before running the given parser and wrapping the --- result in 'ByteOrdered'. -flatparseParseEndianMin - :: forall a end. Prim a - => Flatparse.Getter a -> Flatparse.Getter (ByteOrdered end a) -flatparseParseEndianMin f = - ByteOrdered <$> Flatparse.getEBase f (Flatparse.ERanOut n) - where n = Prim.sizeOf (undefined :: a) - -instance Flatparse.Get (Endian LE Word16) where - get = flatparseParseEndianMin FP.anyWord16le -instance Flatparse.Get (Endian BE Word16) where - get = flatparseParseEndianMin FP.anyWord16be - -instance Flatparse.Get (Endian LE Word32) where - get = flatparseParseEndianMin FP.anyWord32le -instance Flatparse.Get (Endian BE Word32) where - get = flatparseParseEndianMin FP.anyWord32be - -instance Flatparse.Get (Endian LE Word64) where - get = flatparseParseEndianMin FP.anyWord64le -instance Flatparse.Get (Endian BE Word64) where - get = flatparseParseEndianMin FP.anyWord64be - -instance Flatparse.Get (Endian LE Int16) where - get = flatparseParseEndianMin FP.anyInt16le -instance Flatparse.Get (Endian BE Int16) where - get = flatparseParseEndianMin FP.anyInt16be - -instance Flatparse.Get (Endian LE Int32) where - get = flatparseParseEndianMin FP.anyInt32le -instance Flatparse.Get (Endian BE Int32) where - get = flatparseParseEndianMin FP.anyInt32be - -instance Flatparse.Get (Endian LE Int64) where - get = flatparseParseEndianMin FP.anyInt64le -instance Flatparse.Get (Endian BE Int64) where - get = flatparseParseEndianMin FP.anyInt64be diff --git a/src/Binrep/Via.hs b/src/Binrep/Via.hs deleted file mode 100644 index 311d558..0000000 --- a/src/Binrep/Via.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Binrep.Via where - -import Binrep.CBLen qualified as BR -import Binrep.BLen.Simple qualified as BR.Simple -import Binrep.Put ( Put ) -import Binrep.Get ( Get ) - --- | Identity newtype for using with @DerivingVia@. -newtype Binreply a = Binreply { unBinreply :: a } - deriving stock Show - deriving (BR.IsCBLen, BR.Simple.BLen, Put, Get) via a diff --git a/src/Binrep/Via/Prim.hs b/src/Binrep/Via/Prim.hs new file mode 100644 index 0000000..1ae0a31 --- /dev/null +++ b/src/Binrep/Via/Prim.hs @@ -0,0 +1,4 @@ +module Binrep.Via.Prim where + +-- | DerivingVia newtype for types which can borrow from 'Prim''. +newtype ViaPrim a = ViaPrim { unViaPrim :: a } diff --git a/src/Raehik/Compat/FlatParse/Basic/Prim.hs b/src/Raehik/Compat/FlatParse/Basic/Prim.hs new file mode 100644 index 0000000..ccee13b --- /dev/null +++ b/src/Raehik/Compat/FlatParse/Basic/Prim.hs @@ -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)