dahdit 0.3.0 → 0.5.0

raw patch · 21 files changed

+1115/−922 lines, 21 filesdep +falsifydep +ghc-typelits-knownnatdep +textdep ~tastydep ~tasty-hunitdep ~vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: falsify, ghc-typelits-knownnat, text

Dependency ranges changed: tasty, tasty-hunit, vector

API changes (from Hackage documentation)

Files

• LICENSE +0/−30
• README.md +8/−1
• dahdit.cabal +11/−8
• src/Dahdit.hs +3/−1
• src/Dahdit/Binary.hs +57/−6
• src/Dahdit/BinaryRep.hs +7/−8
• src/Dahdit/Codec.hs +0/−130
• src/Dahdit/Fancy.hs +62/−33
• src/Dahdit/Free.hs +8/−6
• src/Dahdit/Funs.hs +22/−12
• src/Dahdit/Generic.hs +45/−35
• src/Dahdit/Iface.hs +165/−54
• src/Dahdit/Internal.hs +12/−11
• src/Dahdit/LiftedPrim.hs +21/−21
• src/Dahdit/LiftedPrimArray.hs +12/−15
• src/Dahdit/Mem.hs +103/−96
• src/Dahdit/Nums.hs +10/−10
• src/Dahdit/Proxy.hs +5/−0
• src/Dahdit/Run.hs +293/−202
• src/Dahdit/Sizes.hs +50/−192
• test/Main.hs +221/−51

@@ -1,30 +0,0 @@-Copyright Eric Conlon (c) 2022--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.--    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.--    * Neither the name of Eric Conlon nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -10,7 +10,14 @@ * It uses `ByteArray` internally to avoid generating new or retaining references to old pinned memory. * Examining `Put` can yield required byte size without serializing. * Derivation uses `via` and not `anyclass` for better control of derived instances.-* Optionally, types implementing `Binary` can also implement or derive `ByteSized` for size calculation.+* Types implementing `Binary` can implement `byteSized` for size calculation (or it will reflect on `put`). * Known-statically-sized types can implement `StaticByteSized` for size speedups. * Provides several additional types representing fixed-length strings or sequences (using `TypeLits`).++## Static sizes++You may find it necessary to discharge simple `KnownNat` constraints with a plugin like `ghc-typelits-knownnat`.+Add that package to your dependencies and add this to the top of the necessary files:++    {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} 

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.1.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           dahdit-version:        0.3.0+version:        0.5.0 synopsis:       Binary parsing and serialization with integrated size description:    Please see the README on GitHub at <https://github.com/ejconlon/dahdit#readme> category:       Data@@ -15,7 +15,6 @@ maintainer:     ejconlon@gmail.com copyright:      (c) 2022 Eric Conlon license:        BSD3-license-file:   LICENSE build-type:     Simple tested-with:     GHC == 9.2.7@@ -31,7 +30,6 @@       Dahdit       Dahdit.Binary       Dahdit.BinaryRep-      Dahdit.Codec       Dahdit.Fancy       Dahdit.Free       Dahdit.Funs@@ -83,10 +81,12 @@     , data-default ==0.7.*     , data-sword ==0.2.*     , free ==5.1.*+    , ghc-typelits-knownnat ==0.7.*     , mtl ==2.2.*     , primitive >=0.7 && <0.9+    , text >=1.2 && <2.1     , transformers ==0.5.*-    , vector ==0.12.*+    , vector >=0.12 && <0.14   default-language: Haskell2010  test-suite dahdit-test@@ -130,11 +130,14 @@     , dahdit     , data-default ==0.7.*     , data-sword ==0.2.*+    , falsify ==0.2.*     , free ==5.1.*+    , ghc-typelits-knownnat ==0.7.*     , mtl ==2.2.*     , primitive >=0.7 && <0.9-    , tasty-    , tasty-hunit+    , tasty ==1.4.*+    , tasty-hunit ==0.10.*+    , text >=1.2 && <2.1     , transformers ==0.5.*-    , vector ==0.12.*+    , vector >=0.12 && <0.14   default-language: Haskell2010

@@ -10,6 +10,8 @@   , Proxy (..)   , GetError (..)   , prettyGetError+  , GetIncRequest (..)+  , GetIncCb   , runCount   , module Dahdit.Binary   , module Dahdit.BinaryRep@@ -37,7 +39,7 @@ import Dahdit.LiftedPrimArray import Dahdit.Nums import Dahdit.Proxy-import Dahdit.Run (GetError (..), prettyGetError, runCount)+import Dahdit.Run (GetError (..), GetIncCb, GetIncRequest (..), prettyGetError, runCount) import Dahdit.Sizes import Data.ByteString (ByteString) import Data.ByteString.Short (ShortByteString)

@@ -1,5 +1,6 @@ module Dahdit.Binary   ( Binary (..)+  , byteSizeFoldable   ) where @@ -76,9 +77,11 @@   , Word64BE (..)   , Word64LE (..)   )-import Dahdit.Sizes (ElemCount (..))+import Dahdit.Run (runCount)+import Dahdit.Sizes (ByteCount (..), ElemCount (..)) import Data.ByteString.Internal (c2w, w2c) import Data.Coerce (coerce)+import Data.Foldable (foldMap') import Data.Int (Int16, Int32, Int64, Int8) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap@@ -86,6 +89,7 @@ import qualified Data.IntSet as IntSet import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map+import Data.Semigroup (Sum (..)) import Data.Sequence (Seq (..)) import qualified Data.Sequence as Seq import Data.Set (Set)@@ -94,100 +98,125 @@ import Data.Word (Word16, Word32, Word64, Word8)  class Binary a where+  byteSize :: a -> ByteCount+  byteSize = runCount . put   get :: Get a   put :: a -> Put  -- Basic types  instance Binary () where+  byteSize _ = 0   get = pure ()   put _ = pure ()  instance Binary Word8 where+  byteSize _ = 1   get = getWord8   put = putWord8  instance Binary Int8 where+  byteSize _ = 1   get = getInt8   put = putInt8  instance Binary Word16LE where+  byteSize _ = 2   get = getWord16LE   put = putWord16LE  instance Binary Int16LE where+  byteSize _ = 2   get = getInt16LE   put = putInt16LE  instance Binary Word24LE where+  byteSize _ = 3   get = getWord24LE   put = putWord24LE  instance Binary Int24LE where+  byteSize _ = 3   get = getInt24LE   put = putInt24LE  instance Binary Word32LE where+  byteSize _ = 4   get = getWord32LE   put = putWord32LE  instance Binary Int32LE where+  byteSize _ = 4   get = getInt32LE   put = putInt32LE  instance Binary Word64LE where+  byteSize _ = 8   get = getWord64LE   put = putWord64LE  instance Binary Int64LE where+  byteSize _ = 8   get = getInt64LE   put = putInt64LE  instance Binary FloatLE where+  byteSize _ = 4   get = getFloatLE   put = putFloatLE  instance Binary DoubleLE where+  byteSize _ = 8   get = getDoubleLE   put = putDoubleLE  instance Binary Word16BE where+  byteSize _ = 2   get = getWord16BE   put = putWord16BE  instance Binary Int16BE where+  byteSize _ = 2   get = getInt16BE   put = putInt16BE  instance Binary Word24BE where+  byteSize _ = 3   get = getWord24BE   put = putWord24BE  instance Binary Int24BE where+  byteSize _ = 3   get = getInt24BE   put = putInt24BE  instance Binary Word32BE where+  byteSize _ = 4   get = getWord32BE   put = putWord32BE  instance Binary Int32BE where+  byteSize _ = 4   get = getInt32BE   put = putInt32BE  instance Binary Word64BE where+  byteSize _ = 8   get = getWord64BE   put = putWord64BE  instance Binary Int64BE where+  byteSize _ = 8   get = getInt64BE   put = putInt64BE  instance Binary FloatBE where+  byteSize _ = 4   get = getFloatBE   put = putFloatBE  instance Binary DoubleBE where+  byteSize _ = 8   get = getDoubleBE   put = putDoubleBE @@ -212,46 +241,58 @@ deriving via DoubleLE instance Binary Double  instance Binary Bool where+  byteSize _ = 1   get = fmap (/= 0) getWord8   put b = putWord8 (if b then 1 else 0)  instance Binary Char where+  byteSize _ = 1   get = fmap w2c getWord8   put = putWord8 . c2w  instance Binary Int where+  byteSize _ = 8   get = fmap fromIntegral getInt64LE   put = putInt64LE . fromIntegral -instance Binary a => Binary [a] where+instance (Binary a) => Binary [a] where+  byteSize as = 8 + byteSizeFoldable as   get = do     ec <- get @Int     getList (coerce ec) get   put s = put @Int (length s) *> putList put s -instance Binary a => Binary (Seq a) where+instance (Binary a) => Binary (Seq a) where+  byteSize as = 8 + byteSizeFoldable as   get = do     ec <- get @Int     getSeq (coerce ec) get   put s = put @Int (Seq.length s) *> putSeq put s -instance Binary a => Binary (Set a) where+instance (Binary a) => Binary (Set a) where+  byteSize = byteSize . Set.toAscList   get = fmap Set.fromDistinctAscList get   put = put . Set.toAscList  instance (Binary k, Binary v) => Binary (Map k v) where+  byteSize = byteSize . Map.toAscList   get = fmap Map.fromDistinctAscList get   put = put . Map.toAscList  instance Binary IntSet where+  byteSize = byteSize . IntSet.toAscList   get = fmap IntSet.fromDistinctAscList get   put = put . IntSet.toAscList -instance Binary v => Binary (IntMap v) where+instance (Binary v) => Binary (IntMap v) where+  byteSize = byteSize . IntMap.toAscList   get = fmap IntMap.fromDistinctAscList get   put = put . IntMap.toAscList -instance Binary a => Binary (Maybe a) where+instance (Binary a) => Binary (Maybe a) where+  byteSize = \case+    Nothing -> 1+    Just a -> 1 + byteSize a   get = do     tag <- get @Int     case tag of@@ -263,6 +304,9 @@     Just a -> put @Int 1 *> put a  instance (Binary b, Binary a) => Binary (Either b a) where+  byteSize = \case+    Left b -> 1 + byteSize b+    Right a -> 1 + byteSize a   get = do     tag <- get @Int     case tag of@@ -274,6 +318,7 @@     Right a -> put @Int 1 *> put a  instance (Binary a, Binary b) => Binary (a, b) where+  byteSize (a, b) = byteSize a + byteSize b   get = do     a <- get     b <- get@@ -281,6 +326,7 @@   put (a, b) = put a *> put b  instance (Binary a, Binary b, Binary c) => Binary (a, b, c) where+  byteSize (a, b, c) = byteSize a + byteSize b + byteSize c   get = do     a <- get     b <- get@@ -289,6 +335,7 @@   put (a, b, c) = put a *> put b *> put c  instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) where+  byteSize (a, b, c, d) = byteSize a + byteSize b + byteSize c + byteSize d   get = do     a <- get     b <- get@@ -298,6 +345,7 @@   put (a, b, c, d) = put a *> put b *> put c *> put d  instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a, b, c, d, e) where+  byteSize (a, b, c, d, e) = byteSize a + byteSize b + byteSize c + byteSize d + byteSize e   get = do     a <- get     b <- get@@ -306,3 +354,6 @@     e <- get     pure (a, b, c, d, e)   put (a, b, c, d, e) = put a *> put b *> put c *> put d *> put e++byteSizeFoldable :: (Foldable f, Binary a) => f a -> ByteCount+byteSizeFoldable = getSum . foldMap' (Sum . byteSize)

@@ -9,10 +9,10 @@ where  import Dahdit.Binary (Binary (..))-import Dahdit.Sizes (ByteSized (..), StaticByteSized (..))+import Dahdit.Sizes (StaticByteSized (..)) import Data.Proxy (Proxy (..)) -class Binary x => BinaryRep x a | a -> x where+class (Binary x) => BinaryRep x a | a -> x where   fromBinaryRep :: x -> Either String a   toBinaryRep :: a -> x @@ -32,14 +32,13 @@   fromBinaryRep = Right . ViaIntegral . fromIntegral   toBinaryRep = fromIntegral . unViaIntegral -newtype ViaBinaryRep a = ViaBinaryRep {unViaBinaryRep :: a}--instance (ByteSized x, BinaryRep x a) => ByteSized (ViaBinaryRep a) where-  byteSize = byteSize . toBinaryRep . unViaBinaryRep+newtype ViaBinaryRep x a = ViaBinaryRep {unViaBinaryRep :: a} -instance (StaticByteSized x, BinaryRep x a) => StaticByteSized (ViaBinaryRep a) where+instance (StaticByteSized x, BinaryRep x a) => StaticByteSized (ViaBinaryRep x a) where+  type StaticSize (ViaBinaryRep x a) = StaticSize x   staticByteSize _ = staticByteSize (Proxy :: Proxy x) -instance BinaryRep x a => Binary (ViaBinaryRep a) where+instance (BinaryRep x a) => Binary (ViaBinaryRep x a) where+  byteSize = byteSize . toBinaryRep . unViaBinaryRep   get = get >>= either fail (pure . ViaBinaryRep) . fromBinaryRep   put = put . toBinaryRep . unViaBinaryRep

@@ -1,130 +0,0 @@--- Experimental - bidirectional codecs--- See https://hackage.haskell.org/package/codec--- And https://blog.poisson.chat/posts/2016-10-12-bidirectional-serialization.html-module Dahdit.Codec-  ( Codec-  , build-  , binary-  , parse-  , produce-  , bindPair-  , bindTag-  , HasCodec (..)-  , ViaBinary (..)-  , ViaCodec (..)-  )-where--import Dahdit.Binary (Binary (..))-import Dahdit.Fancy (BoolByte, ExactBytes, StaticArray, StaticSeq, TermBytes)-import Dahdit.Free (Get, Put)-import Dahdit.LiftedPrim (LiftedPrim)-import Dahdit.Nums (FloatBE, FloatLE, Int16BE, Int16LE, Int24BE, Int24LE, Int32BE, Int32LE, Word16BE, Word16LE, Word24BE, Word24LE, Word32BE, Word32LE)-import Dahdit.Sizes (ByteSized (..), StaticByteSized)-import Data.Coerce (coerce)-import Data.Default (Default)-import Data.Int (Int8)-import Data.Word (Word8)-import GHC.TypeLits (KnownNat, KnownSymbol)--data Codec' x a = Codec'-  { parse' :: Get a-  , produce' :: x -> Put-  }--instance Functor (Codec' x) where-  fmap f c = c {parse' = fmap f (parse' c)}--instance Applicative (Codec' x) where-  pure a = Codec' (pure a) (const (pure ()))--  f <*> a =-    Codec'-      { parse' = parse' f <*> parse' a-      , produce' = \x -> produce' f x *> produce' a x-      }--type Codec a = Codec' a a--build :: Get a -> (a -> Put) -> Codec a-build = Codec'--binary :: Binary a => Codec a-binary = build get put--parse :: Codec a -> Get a-parse = parse'--produce :: Codec a -> a -> Put-produce = produce'--bindPair :: Codec a -> (a -> Codec b) -> Codec (a, b)-bindPair c f =-  Codec'-    (parse c >>= \a -> fmap (a,) (parse (f a)))-    (\(a, b) -> produce c a *> produce (f a) b)--bindTag :: (b -> a) -> Codec a -> (a -> Codec b) -> Codec b-bindTag t c f =-  Codec'-    (parse c >>= parse . f)-    (\b -> let a = t b in produce c a *> produce (f a) b)--class HasCodec a where-  codec :: Codec a--newtype ViaBinary a = ViaBinary {unViaBinary :: a}--instance Binary a => HasCodec (ViaBinary a) where-  codec = coerce (binary @a)--deriving via (ViaBinary Word8) instance HasCodec Word8--deriving via (ViaBinary Int8) instance HasCodec Int8--deriving via (ViaBinary Word16LE) instance HasCodec Word16LE--deriving via (ViaBinary Int16LE) instance HasCodec Int16LE--deriving via (ViaBinary Word24LE) instance HasCodec Word24LE--deriving via (ViaBinary Int24LE) instance HasCodec Int24LE--deriving via (ViaBinary Word32LE) instance HasCodec Word32LE--deriving via (ViaBinary Int32LE) instance HasCodec Int32LE--deriving via (ViaBinary FloatLE) instance HasCodec FloatLE--deriving via (ViaBinary Word16BE) instance HasCodec Word16BE--deriving via (ViaBinary Int16BE) instance HasCodec Int16BE--deriving via (ViaBinary Word24BE) instance HasCodec Word24BE--deriving via (ViaBinary Int24BE) instance HasCodec Int24BE--deriving via (ViaBinary Word32BE) instance HasCodec Word32BE--deriving via (ViaBinary Int32BE) instance HasCodec Int32BE--deriving via (ViaBinary FloatBE) instance HasCodec FloatBE--deriving via (ViaBinary TermBytes) instance HasCodec TermBytes--deriving via (ViaBinary (StaticSeq n a)) instance (KnownNat n, Binary a, StaticByteSized a, Default a) => HasCodec (StaticSeq n a)--deriving via (ViaBinary (StaticArray n a)) instance (KnownNat n, LiftedPrim a, Default a) => HasCodec (StaticArray n a)--deriving via (ViaBinary BoolByte) instance HasCodec BoolByte--deriving via (ViaBinary (ExactBytes s)) instance KnownSymbol s => HasCodec (ExactBytes s)--newtype ViaCodec a = ViaCodec {unViaCodec :: a}--instance ByteSized a => ByteSized (ViaCodec a) where-  byteSize = byteSize . unViaCodec--instance HasCodec a => Binary (ViaCodec a) where-  get = coerce (parse (codec @a))-  put = coerce (produce (codec @a))

@@ -1,5 +1,10 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoStarIsType #-}+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}+ module Dahdit.Fancy-  ( TermBytes (..)+  ( TermBytes8 (..)+  , TermBytes16 (..)   , StaticBytes (..)   , mkStaticBytes   , normStaticBytes@@ -28,7 +33,7 @@ import Dahdit.LiftedPrim (LiftedPrim) import Dahdit.LiftedPrimArray (LiftedPrimArray, replicateLiftedPrimArray) import Dahdit.Proxy (proxyForNatF)-import Dahdit.Sizes (ByteCount (..), ByteSized (..), StaticByteSized (..), ViaStaticByteSized (..))+import Dahdit.Sizes (ByteCount (..), StaticByteSized (..), byteSizeViaStatic) import Data.ByteString.Internal (c2w) import qualified Data.ByteString.Short as BSS import Data.ByteString.Short.Internal (ShortByteString (..))@@ -40,7 +45,7 @@ import qualified Data.Sequence as Seq import Data.String (IsString) import Data.Word (Word8)-import GHC.TypeLits (KnownNat, KnownSymbol, Nat, Symbol, natVal, symbolVal)+import GHC.TypeLits (ConsSymbol, KnownNat, KnownSymbol, Nat, Symbol, natVal, symbolVal, type (*), type (+))  getUntilNull :: Get (ByteCount, [Word8]) getUntilNull = go 0 []@@ -55,30 +60,49 @@ mkSBS n bs = let !(ByteArray ba) = byteArrayFromListN (coerce n) bs in SBS ba  -- | Bytes terminated with null byte.+newtype TermBytes8 = TermBytes8 {unTermBytes8 :: ShortByteString}+  deriving stock (Show)+  deriving newtype (Eq, Ord, IsString)++instance Default TermBytes8 where+  def = TermBytes8 BSS.empty++instance Binary TermBytes8 where+  byteSize (TermBytes8 sbs) = ByteCount (BSS.length sbs + 1)++  get = do+    (i, acc) <- getUntilNull+    let sbs = mkSBS i acc+    pure (TermBytes8 sbs)++  put (TermBytes8 sbs) = do+    putByteString sbs+    putWord8 0++-- | Bytes terminated with null byte. -- NOTE: Terminated with TWO null bytes if the string is even length -- to align to Word16 boundaries, as required for RIFF format, for example.-newtype TermBytes = TermBytes {unTermBytes :: ShortByteString}+newtype TermBytes16 = TermBytes16 {unTermBytes16 :: ShortByteString}   deriving stock (Show)   deriving newtype (Eq, Ord, IsString) -instance Default TermBytes where-  def = TermBytes BSS.empty+instance Default TermBytes16 where+  def = TermBytes16 BSS.empty -instance ByteSized TermBytes where-  byteSize (TermBytes sbs) =-    let bc = byteSize sbs + 1+instance Binary TermBytes16 where+  byteSize (TermBytes16 sbs) =+    let bc = ByteCount (BSS.length sbs + 1)     in  if even bc then bc else bc + 1 -instance Binary TermBytes where   get = do     (i, acc) <- getUntilNull     unless (odd i) $ do       w <- getWord8       unless (w == 0) (fail "TermBytes missing word pad")     let sbs = mkSBS i acc-    pure (TermBytes sbs)+    pure (TermBytes16 sbs) -  put (TermBytes sbs) = do+  put (TermBytes16 sbs) = do     putByteString sbs     putWord8 0     unless (odd (BSS.length sbs)) (putWord8 0)@@ -88,9 +112,7 @@   deriving stock (Show)   deriving newtype (IsString) -deriving via (ViaStaticByteSized (StaticBytes n)) instance KnownNat n => ByteSized (StaticBytes n)--mkStaticBytes :: KnownNat n => Proxy n -> ShortByteString -> StaticBytes n+mkStaticBytes :: (KnownNat n) => Proxy n -> ShortByteString -> StaticBytes n mkStaticBytes prox sbs =   let n = fromInteger (natVal prox)   in  if BSS.length sbs == n@@ -103,16 +125,16 @@                   then x1                   else x1 <> BSS.replicate (n - l) 0 -normStaticBytes :: KnownNat n => StaticBytes n -> StaticBytes n+normStaticBytes :: (KnownNat n) => StaticBytes n -> StaticBytes n normStaticBytes sb@(StaticBytes sbs) = mkStaticBytes (proxyForNatF sb) sbs -instance KnownNat n => Eq (StaticBytes n) where+instance (KnownNat n) => Eq (StaticBytes n) where   x == y =     let StaticBytes x' = normStaticBytes x         StaticBytes y' = normStaticBytes y     in  x' == y' -instance KnownNat n => Ord (StaticBytes n) where+instance (KnownNat n) => Ord (StaticBytes n) where   compare x y =     let StaticBytes x' = normStaticBytes x         StaticBytes y' = normStaticBytes y@@ -121,25 +143,26 @@ instance Default (StaticBytes n) where   def = StaticBytes BSS.empty -instance KnownNat n => StaticByteSized (StaticBytes n) where-  staticByteSize _ = fromInteger (natVal (Proxy :: Proxy n))+instance (KnownNat n) => StaticByteSized (StaticBytes n) where+  type StaticSize (StaticBytes n) = n -instance KnownNat n => Binary (StaticBytes n) where+instance (KnownNat n) => Binary (StaticBytes n) where+  byteSize = byteSizeViaStatic   get = fmap StaticBytes (getByteString (fromInteger (natVal (Proxy :: Proxy n))))   put fb@(StaticBytes sbs) = putFixedString 0 (fromInteger (natVal fb)) sbs  newtype StaticSeq (n :: Nat) a = StaticSeq {unStaticSeq :: Seq a}   deriving stock (Show)   deriving newtype (Eq, Functor, Foldable)-  deriving (ByteSized) via (ViaStaticByteSized (StaticSeq n a))  instance (KnownNat n, Default a) => Default (StaticSeq n a) where   def = StaticSeq (Seq.replicate (fromInteger (natVal (Proxy :: Proxy n))) def)  instance (KnownNat n, StaticByteSized a) => StaticByteSized (StaticSeq n a) where-  staticByteSize _ = fromInteger (natVal (Proxy :: Proxy n)) * staticByteSize (Proxy :: Proxy a)+  type StaticSize (StaticSeq n a) = n * StaticSize a  instance (KnownNat n, Binary a, StaticByteSized a, Default a) => Binary (StaticSeq n a) where+  byteSize = byteSizeViaStatic   get = fmap StaticSeq (getStaticSeq (fromInteger (natVal (Proxy :: Proxy n))) get)   put = unsafePutStaticSeqN (fromInteger (natVal (Proxy :: Proxy n))) (Just def) put . unStaticSeq @@ -147,45 +170,51 @@   deriving stock (Show)   deriving newtype (Eq) -deriving via (ViaStaticByteSized (StaticArray n a)) instance (KnownNat n, StaticByteSized a) => ByteSized (StaticArray n a)- instance (KnownNat n, LiftedPrim a, Default a) => Default (StaticArray n a) where   def = StaticArray (replicateLiftedPrimArray (fromInteger (natVal (Proxy :: Proxy n))) def)  instance (KnownNat n, StaticByteSized a) => StaticByteSized (StaticArray n a) where-  staticByteSize _ = fromInteger (natVal (Proxy :: Proxy n)) * staticByteSize (Proxy :: Proxy a)+  type StaticSize (StaticArray n a) = n * StaticSize a  instance (KnownNat n, LiftedPrim a, Default a) => Binary (StaticArray n a) where+  byteSize = byteSizeViaStatic   get = fmap StaticArray (getStaticArray (fromInteger (natVal (Proxy :: Proxy n))))   put = unsafePutStaticArrayN (fromInteger (natVal (Proxy :: Proxy n))) (Just def) . unStaticArray  newtype BoolByte = BoolByte {unBoolByte :: Bool}   deriving stock (Show)   deriving newtype (Eq)-  deriving (ByteSized) via (ViaStaticByteSized BoolByte)  instance Default BoolByte where   def = BoolByte False  instance StaticByteSized BoolByte where+  type StaticSize BoolByte = 1   staticByteSize _ = 1  instance Binary BoolByte where+  byteSize = byteSizeViaStatic   get = fmap (BoolByte . (/= 0)) getWord8   put (BoolByte b) = putWord8 (if b then 1 else 0) -newtype ExactBytes (s :: Symbol) = ExactBytes {unExactBytes :: ()}+newtype ExactBytes (n :: Nat) (s :: Symbol) = ExactBytes {unExactBytes :: ()}   deriving stock (Show)   deriving newtype (Eq)-  deriving (ByteSized) via (ViaStaticByteSized (ExactBytes s)) -instance Default (ExactBytes s) where+instance Default (ExactBytes n s) where   def = ExactBytes () -instance KnownSymbol s => StaticByteSized (ExactBytes s) where-  staticByteSize _ = coerce (length (symbolVal (Proxy :: Proxy s)))+class SymLen (n :: Nat) (s :: Symbol) | s -> n -instance KnownSymbol s => Binary (ExactBytes s) where+instance {-# OVERLAPPING #-} SymLen 0 ""++instance (SymLen n s, m ~ n + 1, t ~ ConsSymbol c s) => SymLen m t++instance (SymLen n s, KnownSymbol s, KnownNat n) => StaticByteSized (ExactBytes n s) where+  type StaticSize (ExactBytes n s) = n++instance (SymLen n s, KnownSymbol s, KnownNat n) => Binary (ExactBytes n s) where+  byteSize = byteSizeViaStatic   get = do     let s = symbolVal (Proxy :: Proxy s)         bc = coerce (length s)

@@ -46,16 +46,18 @@ import Data.Primitive (ByteArray) import Data.Proxy (Proxy (..)) import Data.Sequence (Seq)+import Data.Text (Text)+import qualified Data.Text as T import Data.Word (Word8)  data GetStaticSeqF a where-  GetStaticSeqF :: StaticByteSized z => !ElemCount -> Get z -> (Seq z -> a) -> GetStaticSeqF a+  GetStaticSeqF :: (StaticByteSized z) => !ElemCount -> Get z -> (Seq z -> a) -> GetStaticSeqF a  instance Functor GetStaticSeqF where   fmap f (GetStaticSeqF n g k) = GetStaticSeqF n g (f . k)  data GetStaticArrayF a where-  GetStaticArrayF :: LiftedPrim z => !ElemCount -> Proxy z -> (LiftedPrimArray z -> a) -> GetStaticArrayF a+  GetStaticArrayF :: (LiftedPrim z) => !ElemCount -> Proxy z -> (LiftedPrimArray z -> a) -> GetStaticArrayF a  instance Functor GetStaticArrayF where   fmap f (GetStaticArrayF n p k) = GetStaticArrayF n p (f . k)@@ -108,23 +110,23 @@   | GetFSkip !ByteCount a   | GetFLookAhead !(GetLookAheadF a)   | GetFRemainingSize (ByteCount -> a)-  | GetFFail !String+  | GetFFail !Text   deriving stock (Functor)  newtype Get a = Get {unGet :: F GetF a}   deriving newtype (Functor, Applicative, Monad)  instance MonadFail Get where-  fail msg = Get (F (\_ y -> y (GetFFail msg)))+  fail msg = Get (F (\_ y -> y (GetFFail (T.pack msg))))  data PutStaticSeqF a where-  PutStaticSeqF :: StaticByteSized z => !ElemCount -> !(Maybe z) -> (z -> Put) -> !(Seq z) -> a -> PutStaticSeqF a+  PutStaticSeqF :: (StaticByteSized z) => !ElemCount -> !(Maybe z) -> (z -> Put) -> !(Seq z) -> a -> PutStaticSeqF a  instance Functor PutStaticSeqF where   fmap f (PutStaticSeqF n z p s k) = PutStaticSeqF n z p s (f k)  data PutStaticArrayF a where-  PutStaticArrayF :: LiftedPrim z => !ElemCount -> !(Maybe z) -> !(LiftedPrimArray z) -> a -> PutStaticArrayF a+  PutStaticArrayF :: (LiftedPrim z) => !ElemCount -> !(Maybe z) -> !(LiftedPrimArray z) -> a -> PutStaticArrayF a  instance Functor PutStaticArrayF where   fmap f (PutStaticArrayF n z a k) = PutStaticArrayF n z a (f k)

@@ -21,6 +21,7 @@   , getInt64BE   , getFloatBE   , getDoubleBE+  , getText   , getByteString   , getSkip   , getExact@@ -63,6 +64,7 @@   , putInt64BE   , putFloatBE   , putDoubleBE+  , putText   , putByteString   , putFixedString   , putList@@ -77,7 +79,7 @@   ) where -import Control.Monad (replicateM_, unless)+import Control.Monad (replicateM_, unless, (>=>)) import Control.Monad.Free.Church (F (..)) import Dahdit.Free   ( Get (..)@@ -130,6 +132,8 @@ import Data.Proxy (Proxy (..)) import Data.Sequence (Seq (..)) import qualified Data.Sequence as Seq+import Data.Text (Text)+import qualified Data.Text.Encoding as TE import Data.Word (Word8)  getWord8 :: Get Word8@@ -198,6 +202,9 @@ getDoubleBE :: Get DoubleBE getDoubleBE = Get (F (\x y -> y (GetFDoubleBE x))) +getText :: ByteCount -> Get Text+getText = getByteString >=> either (fail . ("Invalid UTF-8: " ++) . show) pure . TE.decodeUtf8' . BSS.fromShort+ getByteString :: ByteCount -> Get ShortByteString getByteString bc = Get (F (\x y -> y (GetFShortByteString bc x))) @@ -233,17 +240,17 @@         go (acc :|> x) (i + 1)  -- | Get Seq of statically-sized elements-getStaticSeq :: StaticByteSized a => ElemCount -> Get a -> Get (Seq a)+getStaticSeq :: (StaticByteSized a) => ElemCount -> Get a -> Get (Seq a) getStaticSeq n g = Get (F (\x y -> y (GetFStaticSeq (GetStaticSeqF n g x))))  -- | Get PrimArray of statically-sized elements-getStaticArray :: LiftedPrim a => ElemCount -> Get (LiftedPrimArray a)+getStaticArray :: (LiftedPrim a) => ElemCount -> Get (LiftedPrimArray a) getStaticArray n = Get (F (\x y -> y (GetFStaticArray (GetStaticArrayF n (Proxy :: Proxy a) x))))  getByteArray :: ByteCount -> Get ByteArray getByteArray bc = Get (F (\x y -> y (GetFByteArray bc x))) -getLiftedPrimArray :: LiftedPrim a => Proxy a -> ElemCount -> Get (LiftedPrimArray a)+getLiftedPrimArray :: (LiftedPrim a) => Proxy a -> ElemCount -> Get (LiftedPrimArray a) getLiftedPrimArray prox ec =   let bc = staticByteSize prox * coerce ec   in  fmap LiftedPrimArray (getByteArray bc)@@ -268,7 +275,7 @@         x <- g         go (acc :|> x) -getRemainingStaticSeq :: StaticByteSized a => Get a -> Get (Seq a)+getRemainingStaticSeq :: (StaticByteSized a) => Get a -> Get (Seq a) getRemainingStaticSeq g = do   let ebc = staticByteSize (proxyForF g)   bc <- getRemainingSize@@ -277,7 +284,7 @@     then getStaticSeq (coerce (div bc ebc)) g     else fail ("Leftover bytes for remaining static seq (have " ++ show (unByteCount left) ++ ", need " ++ show (unByteCount ebc) ++ ")") -getRemainingStaticArray :: LiftedPrim a => Proxy a -> Get (LiftedPrimArray a)+getRemainingStaticArray :: (LiftedPrim a) => Proxy a -> Get (LiftedPrimArray a) getRemainingStaticArray prox = do   let ebc = staticByteSize prox   bc <- getRemainingSize@@ -289,7 +296,7 @@ getRemainingByteArray :: Get ByteArray getRemainingByteArray = getRemainingSize >>= getByteArray -getRemainingLiftedPrimArray :: LiftedPrim a => Proxy a -> Get (LiftedPrimArray a)+getRemainingLiftedPrimArray :: (LiftedPrim a) => Proxy a -> Get (LiftedPrimArray a) getRemainingLiftedPrimArray prox = do   let ebc = staticByteSize prox   bc <- getRemainingSize@@ -380,6 +387,9 @@ putDoubleBE :: DoubleBE -> Put putDoubleBE d = PutM (F (\x y -> y (PutFDoubleBE d (x ())))) +putText :: Text -> Put+putText = putByteString . BSS.toShort . TE.encodeUtf8+ putByteString :: ShortByteString -> Put putByteString sbs =   let bc = coerce (BSS.length sbs)@@ -405,21 +415,21 @@ putSeq = traverse_  -- | Put Seq of statically-sized elements-putStaticSeq :: StaticByteSized a => (a -> Put) -> Seq a -> Put+putStaticSeq :: (StaticByteSized a) => (a -> Put) -> Seq a -> Put putStaticSeq p s =   let n = coerce (Seq.length s)   in  unsafePutStaticSeqN n Nothing p s -unsafePutStaticSeqN :: StaticByteSized a => ElemCount -> Maybe a -> (a -> Put) -> Seq a -> Put+unsafePutStaticSeqN :: (StaticByteSized a) => ElemCount -> Maybe a -> (a -> Put) -> Seq a -> Put unsafePutStaticSeqN n mz p s = PutM (F (\x y -> y (PutFStaticSeq (PutStaticSeqF n mz p s (x ())))))  -- | Put Array of statically-sized elements-putStaticArray :: LiftedPrim a => LiftedPrimArray a -> Put+putStaticArray :: (LiftedPrim a) => LiftedPrimArray a -> Put putStaticArray a =   let ec = lengthLiftedPrimArray a   in  unsafePutStaticArrayN ec Nothing a -unsafePutStaticArrayN :: LiftedPrim a => ElemCount -> Maybe a -> LiftedPrimArray a -> Put+unsafePutStaticArrayN :: (LiftedPrim a) => ElemCount -> Maybe a -> LiftedPrimArray a -> Put unsafePutStaticArrayN n mz a = PutM (F (\x y -> y (PutFStaticArray (PutStaticArrayF n mz a (x ())))))  putByteArray :: ByteArray -> Put@@ -430,7 +440,7 @@ putLiftedPrimArray :: LiftedPrimArray a -> Put putLiftedPrimArray = putByteArray . unLiftedPrimArray -putStaticHint :: StaticByteSized a => (a -> Put) -> a -> Put+putStaticHint :: (StaticByteSized a) => (a -> Put) -> a -> Put putStaticHint p a =   let bc = staticByteSize (proxyForFun p)   in  PutM (F (\x y -> y (PutFStaticHint (PutStaticHintF bc (p a) (x ())))))

@@ -1,4 +1,5 @@ {-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}  module Dahdit.Generic   ( ViaGeneric (..)@@ -11,19 +12,35 @@ import Dahdit.Free (Get, Put) import Dahdit.Funs (putStaticHint) import Dahdit.Nums (Word16LE, Word32LE)-import Dahdit.Sizes (ByteCount, ByteSized (..), StaticByteSized (..))+import Dahdit.Proxy (proxyForRepF)+import Dahdit.Sizes (ByteCount, StaticByteSized (..)) import Data.Bits (Bits (..)) import Data.Kind (Type) import Data.Proxy (Proxy (..)) import Data.Word (Word8) import GHC.Generics (C1, Generic (..), K1 (..), M1 (..), U1 (..), (:*:) (..), (:+:) (..))+import GHC.TypeLits (KnownNat, Nat, natVal, type (+)) --- | Use: deriving (ByteSized, Binary) via (ViaGeneric Foo)+-- | Use: deriving (Binary) via (ViaGeneric Foo) newtype ViaGeneric a = ViaGeneric {unViaGeneric :: a} --- | Use: deriving (ByteSized, StaticByteSized, Binary) via (ViaStaticGeneric Foo)+instance (Generic t, GByteSized (Rep t), GBinary (Rep t)) => Binary (ViaGeneric t) where+  byteSize = gbyteSize . from . unViaGeneric+  get = fmap (ViaGeneric . to) gget+  put = gput . from . unViaGeneric++-- | Use: deriving (StaticByteSized, Binary) via (ViaStaticGeneric Foo) newtype ViaStaticGeneric a = ViaStaticGeneric {unViaStaticGeneric :: a} +instance (Generic t, GStaticByteSized (Rep t), GBinary (Rep t)) => Binary (ViaStaticGeneric t) where+  byteSize sg = gstaticByteSize (proxyForRepF sg (from (unViaStaticGeneric sg)))+  get = fmap (ViaStaticGeneric . to) gget+  put = putStaticHint (gput . from . unViaStaticGeneric)++instance (GStaticByteSized (Rep t)) => StaticByteSized (ViaStaticGeneric t) where+  type StaticSize (ViaStaticGeneric t) = GStaticSize (Rep t)+  staticByteSize _ = gstaticByteSize (Proxy :: Proxy (Rep t))+ -- ByteSized:  class GByteSized f where@@ -34,11 +51,11 @@   gbyteSize _ = 0  -- Product-instance (GByteSized a, GByteSized b) => GByteSized (a :*: b) where+instance (GByteSized a, GByteSized b, o ~ n + m) => GByteSized (a :*: b) where   gbyteSize (x :*: y) = gbyteSize x + gbyteSize y  -- Metadata-instance GByteSized a => GByteSized (M1 i c a) where+instance (GByteSized a) => GByteSized (M1 i c a) where   gbyteSize = gbyteSize . unM1  -- Sum@@ -49,34 +66,35 @@       R1 b -> gbyteSize b  -- Field-instance ByteSized a => GByteSized (K1 i a) where+instance (Binary a) => GByteSized (K1 i a) where   gbyteSize = byteSize . unK1 -instance (Generic t, GByteSized (Rep t)) => ByteSized (ViaGeneric t) where-  byteSize = gbyteSize . from . unViaGeneric--instance (Generic t, GByteSized (Rep t)) => ByteSized (ViaStaticGeneric t) where-  byteSize = gbyteSize . from . unViaStaticGeneric- -- StaticByteSized: -class GByteSized f => GStaticByteSized (f :: Type -> Type) where+class (KnownNat (GStaticSize f)) => GStaticByteSized (f :: Type -> Type) where+  type GStaticSize f :: Nat   gstaticByteSize :: Proxy f -> ByteCount+  gstaticByteSize = fromInteger . natVal . gstaticByteProxy +gstaticByteProxy :: Proxy f -> Proxy (GStaticSize f)+gstaticByteProxy _ = Proxy+ instance GStaticByteSized U1 where-  gstaticByteSize _ = 0+  type GStaticSize U1 = 0  instance (GStaticByteSized a, GStaticByteSized b) => GStaticByteSized (a :*: b) where-  gstaticByteSize _ = gstaticByteSize (Proxy :: Proxy a) + gstaticByteSize (Proxy :: Proxy b)+  type GStaticSize (a :*: b) = GStaticSize a + GStaticSize b -instance GStaticByteSized a => GStaticByteSized (M1 i c a) where-  gstaticByteSize _ = gstaticByteSize (Proxy :: Proxy a)+instance (GStaticByteSized a) => GStaticByteSized (M1 i c a) where+  type GStaticSize (M1 i c a) = GStaticSize a -instance StaticByteSized a => GStaticByteSized (K1 i a) where-  gstaticByteSize _ = staticByteSize (Proxy :: Proxy a)+-- GHC BUG: KnownNat is not actually redundant+instance (StaticByteSized a) => GStaticByteSized (K1 i a) where+  type GStaticSize (K1 i a) = StaticSize a -instance (Generic t, GStaticByteSized (Rep t)) => StaticByteSized (ViaStaticGeneric t) where-  staticByteSize _ = gstaticByteSize (Proxy :: Proxy (Rep t))+-- This one line is the reason all the nat constraints are threaded through this codebase+instance (GStaticByteSized a, GStaticByteSized b, GStaticSize a ~ GStaticSize b) => GStaticByteSized (a :+: b) where+  type GStaticSize (a :+: b) = GStaticSize a  -- Binary: @@ -92,22 +110,14 @@   gget = liftA2 (:*:) gget gget   gput (x :*: y) = gput x *> gput y -instance GBinary a => GBinary (M1 i c a) where+instance (GBinary a) => GBinary (M1 i c a) where   gget = fmap M1 gget   gput = gput . unM1 -instance Binary a => GBinary (K1 i a) where+instance (Binary a) => GBinary (K1 i a) where   gget = fmap K1 get   gput = put . unK1 -instance (Generic t, GBinary (Rep t)) => Binary (ViaGeneric t) where-  get = fmap (ViaGeneric . to) gget-  put = gput . from . unViaGeneric--instance (Generic t, GStaticByteSized (Rep t), GBinary (Rep t)) => Binary (ViaStaticGeneric t) where-  get = fmap (ViaStaticGeneric . to) gget-  put = putStaticHint (gput . from . unViaStaticGeneric)- -- Everything that follows is borrowed from the binary package, which -- borrows from the cereal package! @@ -141,7 +151,7 @@    where     size = unTagged (sumSize :: Tagged (a :+: b)) -sizeError :: Show size => String -> size -> error+sizeError :: (Show size) => String -> size -> error sizeError s size = error ("Can't " ++ s ++ " a type with " ++ show size ++ " constructors")  checkGetSum@@ -172,7 +182,7 @@     sizeL = size `shiftR` 1     sizeR = size - sizeL -instance GBinary a => GSumBinary (C1 c a) where+instance (GBinary a) => GSumBinary (C1 c a) where   getSum _ _ = gget   putSum !code _ x = put code <> gput x @@ -187,7 +197,7 @@ instance SumSize (C1 c a) where   sumSize = Tagged 1 -sumSizeFor :: SumSize f => f a -> Tagged f+sumSizeFor :: (SumSize f) => f a -> Tagged f sumSizeFor = const sumSize  taggedBytes :: Tagged f -> ByteCount@@ -197,5 +207,5 @@   | size - 1 <= (maxBound :: Word32LE) = 4   | otherwise = sizeError "size" size -sumSizeBytes :: SumSize f => f a -> ByteCount+sumSizeBytes :: (SumSize f) => f a -> ByteCount sumSizeBytes = taggedBytes . sumSizeFor

@@ -1,141 +1,252 @@ module Dahdit.Iface-  ( BinaryTarget (..)+  ( BinaryGetTarget (..)   , getTarget+  , BinaryPutTarget (..)   , putTarget-  , MutBinaryTarget (..)+  , MutBinaryPutTarget (..)   , mutPutTargetOffset   , mutPutTarget+  , getEnd   , decode+  , decodeInc+  , decodeEnd   , decodeFile+  , decodeFileEnd   , encode   , encodeFile   , mutEncode   ) where -import Control.Monad.Primitive (PrimBase, PrimMonad (..))-import Control.Monad.ST (runST)+import Control.Monad (unless, (>=>))+import Control.Monad.Primitive (MonadPrim, PrimMonad (..), RealWorld) import Dahdit.Binary (Binary (..)) import Dahdit.Free (Get, Put)-import Dahdit.Mem (allocBAMem, allocPtrMem, freezeBAMem, freezeBSMem, freezeSBSMem, freezeVecMem, mutAllocBAMem, mutAllocVecMem, mutFreezeBAMem, mutFreezeVecMem, viewBSMem, viewSBSMem, viewVecMem)-import Dahdit.Run (GetError, runCount, runGetInternal, runPutInternal)-import Dahdit.Sizes (ByteCount (..), ByteSized (..))+import Dahdit.Funs (getRemainingSize)+import Dahdit.Mem (MemPtr (..), MutableMem (..), emptyMemPtr, mutViewVecMem, viewBSMem, viewSBSMem, viewVecMem, withBAMem, withBSMem, withSBSMem, withVecMem)+import Dahdit.Run (GetError, GetIncCb, GetIncChunk (..), newGetIncEnv, runCount, runGetIncInternal, runGetInternal, runPutInternal)+import Dahdit.Sizes (ByteCount (..)) import Data.ByteString (ByteString) import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC import Data.ByteString.Short (ShortByteString)-import qualified Data.ByteString.Short as BSS import Data.Coerce (coerce)-import Data.Primitive.ByteArray (ByteArray, MutableByteArray, sizeofByteArray)+import Data.Primitive.ByteArray (ByteArray, MutableByteArray, emptyByteArray, sizeofByteArray)+import Data.Text (Text)+import qualified Data.Text.Encoding as TE import Data.Vector.Storable (Vector) import qualified Data.Vector.Storable as VS-import Data.Vector.Storable.Mutable (MVector)+import Data.Vector.Storable.Mutable (IOVector) import Data.Word (Word8) --- | Abstracts over the sources we can read from / sinks we can render to.-class BinaryTarget z where-  -- | Put an action to the sink with the given length.-  -- Prefer 'putTarget' to safely count capacity, or use 'encode' to use byte size.-  putTargetUnsafe :: Put -> ByteCount -> z-+-- | Abstracts over the sources we can read from.+class (PrimMonad m) => BinaryGetTarget z m where   -- | Get a value from the source given a starting offset, returning a result and final offset.   -- On error, the offset will indicate where in the source the error occurred.-  getTargetOffset :: ByteCount -> Get a -> z -> (Either GetError a, ByteCount)+  getTargetOffset :: ByteCount -> Get a -> z -> m (Either GetError a, ByteCount) +  -- | Get a value incrementally from sources yielded by the given callback, returning a+  -- result, final offset in the whole stream, and final offset in the current chunk.+  -- Takes an optional maximum capacity.+  getTargetInc :: Maybe ByteCount -> Get a -> GetIncCb z m -> m (Either GetError a, ByteCount, ByteCount)+ -- | Get a value from the source, returning a result and final offset.-getTarget :: BinaryTarget z => Get a -> z -> (Either GetError a, ByteCount)+getTarget :: (BinaryGetTarget z m) => Get a -> z -> m (Either GetError a, ByteCount) getTarget = getTargetOffset 0 +-- | Abstracts over the immutable sinks we can render to.+class (BinaryGetTarget z m) => BinaryPutTarget z m where+  -- | Put an action to the sink with the given length.+  -- Prefer 'putTarget' to safely count capacity, or use 'encode' to use byte size.+  putTargetUnsafe :: Put -> ByteCount -> m z+ -- | Put an action to the sink with calculated capacity.-putTarget :: BinaryTarget z => Put -> z+putTarget :: (BinaryPutTarget z m) => Put -> m z putTarget p = putTargetUnsafe p (runCount p) -class MutBinaryTarget m z where+class (BinaryGetTarget z m) => MutBinaryPutTarget z m where   mutPutTargetOffsetUnsafe :: ByteCount -> Put -> ByteCount -> z -> m ByteCount -mutPutTargetOffset :: MutBinaryTarget m z => ByteCount -> Put -> z -> m ByteCount+mutPutTargetOffset :: (MutBinaryPutTarget z m) => ByteCount -> Put -> z -> m ByteCount mutPutTargetOffset off p = mutPutTargetOffsetUnsafe off p (runCount p) -mutPutTarget :: MutBinaryTarget m z => Put -> z -> m ByteCount+mutPutTarget :: (MutBinaryPutTarget z m) => Put -> z -> m ByteCount mutPutTarget = mutPutTargetOffset 0 -instance BinaryTarget ShortByteString where+instance BinaryGetTarget String IO where+  getTargetOffset = runGetString+  getTargetInc = runGetIncString++instance BinaryPutTarget String IO where+  putTargetUnsafe = runPutString++instance BinaryGetTarget Text IO where+  getTargetOffset = runGetText+  getTargetInc = runGetIncText++instance BinaryPutTarget Text IO where+  putTargetUnsafe = runPutText++instance (PrimMonad m) => BinaryGetTarget ShortByteString m where   getTargetOffset = runGetSBS+  getTargetInc = runGetIncSBS++instance (PrimMonad m) => BinaryPutTarget ShortByteString m where   putTargetUnsafe = runPutSBS -instance BinaryTarget ByteString where+instance BinaryGetTarget ByteString IO where   getTargetOffset = runGetBS+  getTargetInc = runGetIncBS++instance BinaryPutTarget ByteString IO where   putTargetUnsafe = runPutBS -instance BinaryTarget ByteArray where+instance (PrimMonad m) => BinaryGetTarget ByteArray m where   getTargetOffset = runGetBA+  getTargetInc = runGetIncBA++instance (PrimMonad m) => BinaryPutTarget ByteArray m where   putTargetUnsafe = runPutBA -instance BinaryTarget (Vector Word8) where+instance BinaryGetTarget (Vector Word8) IO where   getTargetOffset = runGetVec+  getTargetInc = runGetIncVec++instance BinaryPutTarget (Vector Word8) IO where   putTargetUnsafe = runPutVec -instance (PrimBase m, s ~ PrimState m) => MutBinaryTarget m (MutableByteArray s) where+instance (MonadPrim s m) => BinaryGetTarget (MutableByteArray s) m where+  getTargetOffset bc g z = unsafeUseFrozenMem z (getTargetOffset bc g)+  getTargetInc mbc g cb = getTargetInc mbc g (cb >=> maybe (pure Nothing) (fmap Just . unsafeFreezeMem))++instance (MonadPrim s m) => MutBinaryPutTarget (MutableByteArray s) m where   mutPutTargetOffsetUnsafe = runMutPutBA -instance (PrimBase m, s ~ PrimState m) => MutBinaryTarget m (MVector s Word8) where+instance BinaryGetTarget (IOVector Word8) IO where+  getTargetOffset bc g z = unsafeUseFrozenMem z (getTargetOffset bc g)+  getTargetInc mbc g cb = getTargetInc mbc g (cb >=> maybe (pure Nothing) (fmap Just . unsafeFreezeMem))++instance MutBinaryPutTarget (IOVector Word8) IO where   mutPutTargetOffsetUnsafe = runMutPutVec +-- | Wrapper that asserts a get action has consumed to the end.+getEnd :: Get a -> Get a+getEnd getter = do+  a <- getter+  b <- getRemainingSize+  unless (b == 0) (fail ("Expected end of input but had bytes remaining: " ++ show (unByteCount b)))+  pure a+ -- | Decode a value from a source returning a result and consumed byte count.-decode :: (Binary a, BinaryTarget z) => z -> (Either GetError a, ByteCount)+decode :: (Binary a, BinaryGetTarget z m) => z -> m (Either GetError a, ByteCount) decode = getTarget get +-- | Decode a value incrementally from sources yielded by a callback.+decodeInc :: (Binary a, BinaryGetTarget z m) => Maybe ByteCount -> GetIncCb z m -> m (Either GetError a, ByteCount, ByteCount)+decodeInc mayCap = getTargetInc mayCap get++-- | 'decode' but expect the end of input.+decodeEnd :: (Binary a, BinaryGetTarget z m) => z -> m (Either GetError a, ByteCount)+decodeEnd = getTarget (getEnd get)+ -- | Decode a value from a file.-decodeFile :: Binary a => FilePath -> IO (Either GetError a, ByteCount)+decodeFile :: (Binary a) => FilePath -> IO (Either GetError a, ByteCount) decodeFile = runGetFile get +-- | 'decodeFile' but expect the end of file.+decodeFileEnd :: (Binary a) => FilePath -> IO (Either GetError a, ByteCount)+decodeFileEnd = runGetFile (getEnd get)+ -- | Encode a value to a sink.-encode :: (Binary a, ByteSized a, BinaryTarget z) => a -> z+encode :: (Binary a, BinaryPutTarget z m) => a -> m z encode a = putTargetUnsafe (put a) (byteSize a)  -- | Encode a value to a file.-encodeFile :: (Binary a, ByteSized a) => a -> FilePath -> IO ()+encodeFile :: (Binary a) => a -> FilePath -> IO () encodeFile a = runPutFile (put a) (byteSize a)  -- | Encode a value to a mutable buffer, returning number of bytes filled.-mutEncode :: (Binary a, ByteSized a, MutBinaryTarget m z) => a -> z -> m ByteCount+mutEncode :: (Binary a, MutBinaryPutTarget z m) => a -> z -> m ByteCount mutEncode a = mutPutTargetOffsetUnsafe 0 (put a) (byteSize a) -runGetBA :: ByteCount -> Get a -> ByteArray -> (Either GetError a, ByteCount)+runGetString :: ByteCount -> Get a -> String -> IO (Either GetError a, ByteCount)+runGetString off act = runGetBS off act . BSC.pack++runGetText :: ByteCount -> Get a -> Text -> IO (Either GetError a, ByteCount)+runGetText off act = runGetBS off act . TE.encodeUtf8++runGetBA :: (PrimMonad m) => ByteCount -> Get a -> ByteArray -> m (Either GetError a, ByteCount) runGetBA off act ba = runGetInternal off act (coerce (sizeofByteArray ba)) ba -runGetSBS :: ByteCount -> Get a -> ShortByteString -> (Either GetError a, ByteCount)-runGetSBS off act sbs = runGetInternal off act (coerce (BSS.length sbs)) (viewSBSMem sbs)+runGetSBS :: (PrimMonad m) => ByteCount -> Get a -> ShortByteString -> m (Either GetError a, ByteCount)+runGetSBS off act = runGetBA off act . viewSBSMem -runGetBS :: ByteCount -> Get a -> ByteString -> (Either GetError a, ByteCount)+runGetBS :: ByteCount -> Get a -> ByteString -> IO (Either GetError a, ByteCount) runGetBS off act bs = runGetInternal off act (coerce (BS.length bs)) (viewBSMem bs) -runGetVec :: ByteCount -> Get a -> Vector Word8 -> (Either GetError a, ByteCount)+runGetVec :: ByteCount -> Get a -> Vector Word8 -> IO (Either GetError a, ByteCount) runGetVec off act vec = runGetInternal off act (coerce (VS.length vec)) (viewVecMem vec)  runGetFile :: Get a -> FilePath -> IO (Either GetError a, ByteCount) runGetFile act fp = do   bs <- BS.readFile fp-  pure (runGetBS 0 act bs)+  runGetBS 0 act bs -runPutBA :: Put -> ByteCount -> ByteArray-runPutBA act len = runST (runPutInternal 0 act len allocBAMem freezeBAMem)+runGetIncString :: Maybe ByteCount -> Get a -> GetIncCb String IO -> IO (Either GetError a, ByteCount, ByteCount)+runGetIncString mayCap g cb = runGetIncBS mayCap g (fmap (fmap BSC.pack) . cb) -runPutSBS :: Put -> ByteCount -> ShortByteString-runPutSBS act len = runST (runPutInternal 0 act len allocBAMem freezeSBSMem)+runGetIncText :: Maybe ByteCount -> Get a -> GetIncCb Text IO -> IO (Either GetError a, ByteCount, ByteCount)+runGetIncText mayCap g cb = runGetIncBS mayCap g (fmap (fmap TE.encodeUtf8) . cb) -runPutBS :: Put -> ByteCount -> ByteString-runPutBS act len = runST (runPutInternal 0 act len allocPtrMem freezeBSMem)+runGetIncBA :: (PrimMonad m) => Maybe ByteCount -> Get a -> GetIncCb ByteArray m -> m (Either GetError a, ByteCount, ByteCount)+runGetIncBA mayCap act cb = do+  env <- newGetIncEnv mayCap (GetIncChunk 0 0 emptyByteArray)+  let view s = GetIncChunk 0 (coerce (sizeofByteArray s)) s+  let cb' = fmap (fmap view) . cb+  runGetIncInternal act env cb' -runPutVec :: Put -> ByteCount -> Vector Word8-runPutVec act len = runST (runPutInternal 0 act len allocPtrMem freezeVecMem)+runGetIncSBS :: (PrimMonad m) => Maybe ByteCount -> Get a -> GetIncCb ShortByteString m -> m (Either GetError a, ByteCount, ByteCount)+runGetIncSBS mayCap act cb = runGetIncBA mayCap act (fmap (fmap viewSBSMem) . cb) +runGetIncMemPtr :: Maybe ByteCount -> Get a -> GetIncCb (MemPtr RealWorld) IO -> IO (Either GetError a, ByteCount, ByteCount)+runGetIncMemPtr mayCap act cb = do+  mem <- emptyMemPtr+  env <- newGetIncEnv mayCap (GetIncChunk 0 0 mem)+  let view mem'@(MemPtr _ off len) = GetIncChunk 0 (len - off) mem'+  let cb' = fmap (fmap view) . cb+  runGetIncInternal act env cb'++runGetIncBS :: Maybe ByteCount -> Get a -> GetIncCb ByteString IO -> IO (Either GetError a, ByteCount, ByteCount)+runGetIncBS mayCap act cb = runGetIncMemPtr mayCap act (fmap (fmap viewBSMem) . cb)++runGetIncVec :: Maybe ByteCount -> Get a -> GetIncCb (Vector Word8) IO -> IO (Either GetError a, ByteCount, ByteCount)+runGetIncVec mayCap act cb = runGetIncMemPtr mayCap act (fmap (fmap viewVecMem) . cb)++runPutString :: Put -> ByteCount -> IO String+runPutString act len = fmap BSC.unpack (runPutBS act len)++runPutText :: Put -> ByteCount -> IO Text+runPutText act len = fmap TE.decodeUtf8 (runPutBS act len)++runPutBA :: (PrimMonad m) => Put -> ByteCount -> m ByteArray+runPutBA act len = withBAMem len (runPutInternal 0 act len)++runPutSBS :: (PrimMonad m) => Put -> ByteCount -> m ShortByteString+runPutSBS act len = withSBSMem len (runPutInternal 0 act len)++runPutBS :: Put -> ByteCount -> IO ByteString+runPutBS act len = withBSMem len (runPutInternal 0 act len)++runPutVec :: Put -> ByteCount -> IO (Vector Word8)+runPutVec act len = withVecMem len (runPutInternal 0 act len)+ runPutFile :: Put -> ByteCount -> FilePath -> IO ()-runPutFile act cap fp =-  let bs = runPutBS act cap-  in  BS.writeFile fp bs+runPutFile act cap fp = do+  bs <- runPutBS act cap+  BS.writeFile fp bs -runMutPutBA :: PrimBase m => ByteCount -> Put -> ByteCount -> MutableByteArray (PrimState m) -> m ByteCount-runMutPutBA off act len marr = runPutInternal off act len (mutAllocBAMem marr) mutFreezeBAMem+runMutPutBA :: (MonadPrim s m) => ByteCount -> Put -> ByteCount -> MutableByteArray s -> m ByteCount+runMutPutBA = runPutInternal -runMutPutVec :: PrimBase m => ByteCount -> Put -> ByteCount -> MVector (PrimState m) Word8 -> m ByteCount-runMutPutVec off act len mvec = runPutInternal off act len (mutAllocVecMem mvec) mutFreezeVecMem+runMutPutVec :: ByteCount -> Put -> ByteCount -> IOVector Word8 -> IO ByteCount+runMutPutVec off act len mvec = runPutInternal off act len (mutViewVecMem mvec)

@@ -5,15 +5,16 @@ import Data.ShortWord (Int24, Word24) import Data.Word (Word16, Word32, Word64, Word8) import GHC.Float (castDoubleToWord64, castFloatToWord32, castWord32ToFloat, castWord64ToDouble)+import GHC.TypeLits (Nat) -newtype ViaFromIntegral x y = ViaFromIntegral {unViaFromIntegral :: y}+newtype ViaFromIntegral (n :: Nat) x y = ViaFromIntegral {unViaFromIntegral :: y}   deriving newtype (Num)  -- Types that can swap endianness - swapEndian is its own inverse-class Num w => SwapEndian w where+class (Num w) => SwapEndian w where   swapEndian :: w -> w -instance (SwapEndian x, Integral x, Integral y) => SwapEndian (ViaFromIntegral x y) where+instance (SwapEndian x, Integral x, Integral y) => SwapEndian (ViaFromIntegral n x y) where   swapEndian = ViaFromIntegral . fromIntegral @x @y . swapEndian . fromIntegral @y @x . unViaFromIntegral  instance SwapEndian Word8 where@@ -27,28 +28,28 @@     let (!b0, !b1) = unMkWord16LE w     in  mkWord16LE b1 b0 -deriving via (ViaFromIntegral Word16 Int16) instance SwapEndian Int16+deriving via (ViaFromIntegral n Word16 Int16) instance SwapEndian Int16  instance SwapEndian Word24 where   swapEndian w =     let (!b0, !b1, !b2) = unMkWord24LE w     in  mkWord24LE b2 b1 b0 -deriving via (ViaFromIntegral Word24 Int24) instance SwapEndian Int24+deriving via (ViaFromIntegral n Word24 Int24) instance SwapEndian Int24  instance SwapEndian Word32 where   swapEndian w =     let (!b0, !b1, !b2, !b3) = unMkWord32LE w     in  mkWord32LE b3 b2 b1 b0 -deriving via (ViaFromIntegral Word32 Int32) instance SwapEndian Int32+deriving via (ViaFromIntegral n Word32 Int32) instance SwapEndian Int32  instance SwapEndian Word64 where   swapEndian w =     let (!b0, !b1, !b2, !b3, !b4, !b5, !b6, !b7) = unMkWord64LE w     in  mkWord64LE b7 b6 b5 b4 b3 b2 b1 b0 -deriving via (ViaFromIntegral Word64 Int64) instance SwapEndian Int64+deriving via (ViaFromIntegral n Word64 Int64) instance SwapEndian Int64  instance SwapEndian Float where   swapEndian w =@@ -128,16 +129,16 @@ unMkDoubleLE :: Double -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8) unMkDoubleLE f = unMkWord64LE (castDoubleToWord64 f) -class (Num le, Num be) => EndianPair le be | le -> be, be -> le where+class (Num le, Num be) => EndianPair (n :: Nat) le be | le -> n, be -> n, le -> be, be -> le where   toLittleEndian :: be -> le   toBigEndian :: le -> be -newtype ViaEndianPair le be = ViaEndianPair {unViaEndianPair :: be}+newtype ViaEndianPair (n :: Nat) le be = ViaEndianPair {unViaEndianPair :: be} -instance EndianPair Word8 Word8 where+instance EndianPair 1 Word8 Word8 where   toLittleEndian = id   toBigEndian = id -instance EndianPair Int8 Int8 where+instance EndianPair 1 Int8 Int8 where   toLittleEndian = id   toBigEndian = id

@@ -52,13 +52,13 @@  -- | This is a stripped-down version of 'Prim' that is possible for a human to implement. -- It's all about reading and writing structures from lifted byte arrays and pointers.-class StaticByteSized a => LiftedPrim a where+class (StaticByteSized a) => LiftedPrim a where   indexArrayLiftedInBytes :: ByteArray -> ByteCount -> a-  writeArrayLiftedInBytes :: PrimMonad m => MutableByteArray (PrimState m) -> ByteCount -> a -> m ()+  writeArrayLiftedInBytes :: (PrimMonad m) => MutableByteArray (PrimState m) -> ByteCount -> a -> m ()   indexPtrLiftedInBytes :: Ptr Word8 -> ByteCount -> a-  writePtrLiftedInBytes :: PrimMonad m => Ptr Word8 -> ByteCount -> a -> m ()+  writePtrLiftedInBytes :: (PrimMonad m) => Ptr Word8 -> ByteCount -> a -> m () -indexArrayLiftedInElems :: LiftedPrim a => Proxy a -> ByteArray -> ElemCount -> a+indexArrayLiftedInElems :: (LiftedPrim a) => Proxy a -> ByteArray -> ElemCount -> a indexArrayLiftedInElems prox arr pos =   indexArrayLiftedInBytes arr (coerce pos * staticByteSize prox) @@ -66,7 +66,7 @@ writeArrayLiftedInElems arr pos val =   writeArrayLiftedInBytes arr (coerce pos * staticByteSize (proxyFor val)) val -indexPtrLiftedInElems :: LiftedPrim a => Proxy a -> Ptr Word8 -> ElemCount -> a+indexPtrLiftedInElems :: (LiftedPrim a) => Proxy a -> Ptr Word8 -> ElemCount -> a indexPtrLiftedInElems prox ptr pos =   indexPtrLiftedInBytes ptr (coerce pos * staticByteSize prox) @@ -87,7 +87,7 @@   writePtrLiftedInBytes ptr = writeOffPtr (coerce ptr) . coerce  -- | NOTE: Relies on same byte width of both types!-instance (Integral x, LiftedPrim x, Integral y) => LiftedPrim (ViaFromIntegral x y) where+instance (Integral x, LiftedPrim x, Integral y, n ~ StaticSize x) => LiftedPrim (ViaFromIntegral n x y) where   indexArrayLiftedInBytes arr off = ViaFromIntegral (fromIntegral (indexArrayLiftedInBytes arr off :: x))   writeArrayLiftedInBytes arr off val = let x = fromIntegral (unViaFromIntegral val) :: x in writeArrayLiftedInBytes arr off x   indexPtrLiftedInBytes ptr = ViaFromIntegral . fromIntegral @x @y . indexPtrLiftedInBytes ptr@@ -287,39 +287,39 @@           *> writeOffPtr ptr (coerce off + 6) b6           *> writeOffPtr ptr (coerce off + 7) b7 -instance (LiftedPrim le, EndianPair le be) => LiftedPrim (ViaEndianPair le be) where+instance (LiftedPrim le, EndianPair n le be, n ~ StaticSize le) => LiftedPrim (ViaEndianPair n le be) where   indexArrayLiftedInBytes arr off = ViaEndianPair (toBigEndian (indexArrayLiftedInBytes arr off))   writeArrayLiftedInBytes arr off = writeArrayLiftedInBytes arr off . toLittleEndian . unViaEndianPair   indexPtrLiftedInBytes ptr off = ViaEndianPair (toBigEndian (indexPtrLiftedInBytes ptr off))   writePtrLiftedInBytes ptr off = writePtrLiftedInBytes ptr off . toLittleEndian . unViaEndianPair -deriving via (ViaFromIntegral Word16LE Int16LE) instance LiftedPrim Int16LE+deriving via (ViaFromIntegral 2 Word16LE Int16LE) instance LiftedPrim Int16LE -deriving via (ViaFromIntegral Word24LE Int24LE) instance LiftedPrim Int24LE+deriving via (ViaFromIntegral 3 Word24LE Int24LE) instance LiftedPrim Int24LE -deriving via (ViaFromIntegral Word32LE Int32LE) instance LiftedPrim Int32LE+deriving via (ViaFromIntegral 4 Word32LE Int32LE) instance LiftedPrim Int32LE -deriving via (ViaFromIntegral Word64LE Int64LE) instance LiftedPrim Int64LE+deriving via (ViaFromIntegral 8 Word64LE Int64LE) instance LiftedPrim Int64LE -deriving via (ViaEndianPair Word16LE Word16BE) instance LiftedPrim Word16BE+deriving via (ViaEndianPair 2 Word16LE Word16BE) instance LiftedPrim Word16BE -deriving via (ViaEndianPair Int16LE Int16BE) instance LiftedPrim Int16BE+deriving via (ViaEndianPair 2 Int16LE Int16BE) instance LiftedPrim Int16BE -deriving via (ViaEndianPair Word24LE Word24BE) instance LiftedPrim Word24BE+deriving via (ViaEndianPair 3 Word24LE Word24BE) instance LiftedPrim Word24BE -deriving via (ViaEndianPair Int24LE Int24BE) instance LiftedPrim Int24BE+deriving via (ViaEndianPair 3 Int24LE Int24BE) instance LiftedPrim Int24BE -deriving via (ViaEndianPair Word32LE Word32BE) instance LiftedPrim Word32BE+deriving via (ViaEndianPair 4 Word32LE Word32BE) instance LiftedPrim Word32BE -deriving via (ViaEndianPair Int32LE Int32BE) instance LiftedPrim Int32BE+deriving via (ViaEndianPair 4 Int32LE Int32BE) instance LiftedPrim Int32BE -deriving via (ViaEndianPair Word64LE Word64BE) instance LiftedPrim Word64BE+deriving via (ViaEndianPair 8 Word64LE Word64BE) instance LiftedPrim Word64BE -deriving via (ViaEndianPair Int64LE Int64BE) instance LiftedPrim Int64BE+deriving via (ViaEndianPair 8 Int64LE Int64BE) instance LiftedPrim Int64BE -deriving via (ViaEndianPair FloatLE FloatBE) instance LiftedPrim FloatBE+deriving via (ViaEndianPair 4 FloatLE FloatBE) instance LiftedPrim FloatBE -deriving via (ViaEndianPair DoubleLE DoubleBE) instance LiftedPrim DoubleBE+deriving via (ViaEndianPair 8 DoubleLE DoubleBE) instance LiftedPrim DoubleBE  -- | Fill a byte array with the given value setByteArrayLifted :: (PrimMonad m, LiftedPrim a) => MutableByteArray (PrimState m) -> ByteCount -> ByteCount -> a -> m ()

@@ -25,7 +25,7 @@   , writeArrayLiftedInElems   ) import Dahdit.Proxy (proxyFor, proxyForF)-import Dahdit.Sizes (ByteCount (..), ByteSized (..), ElemCount (..), StaticByteSized (..))+import Dahdit.Sizes (ByteCount (..), ElemCount (..), StaticByteSized (..)) import Data.Coerce (coerce) import Data.Default (Default (..)) import Data.Foldable (for_)@@ -52,34 +52,31 @@ instance Default (LiftedPrimArray a) where   def = emptyLiftedPrimArray -instance ByteSized (LiftedPrimArray a) where-  byteSize = sizeofLiftedPrimArray- newtype MutableLiftedPrimArray m a = MutableLiftedPrimArray {unMutableLiftedPrimArray :: MutableByteArray m}   deriving newtype (Eq)  emptyLiftedPrimArray :: LiftedPrimArray a emptyLiftedPrimArray = LiftedPrimArray emptyByteArray -indexLiftedPrimArray :: LiftedPrim a => LiftedPrimArray a -> ElemCount -> a+indexLiftedPrimArray :: (LiftedPrim a) => LiftedPrimArray a -> ElemCount -> a indexLiftedPrimArray (LiftedPrimArray arr) = indexArrayLiftedInElems Proxy arr  writeLiftedPrimArray :: (LiftedPrim a, PrimMonad m) => MutableLiftedPrimArray (PrimState m) a -> ElemCount -> a -> m () writeLiftedPrimArray (MutableLiftedPrimArray arr) = writeArrayLiftedInElems arr -freezeLiftedPrimArray :: PrimMonad m => MutableLiftedPrimArray (PrimState m) a -> ElemCount -> ElemCount -> m (LiftedPrimArray a)+freezeLiftedPrimArray :: (PrimMonad m) => MutableLiftedPrimArray (PrimState m) a -> ElemCount -> ElemCount -> m (LiftedPrimArray a) freezeLiftedPrimArray (MutableLiftedPrimArray arr) off len = fmap LiftedPrimArray (freezeByteArray arr (coerce off) (coerce len)) -unsafeFreezeLiftedPrimArray :: PrimMonad m => MutableLiftedPrimArray (PrimState m) a -> m (LiftedPrimArray a)+unsafeFreezeLiftedPrimArray :: (PrimMonad m) => MutableLiftedPrimArray (PrimState m) a -> m (LiftedPrimArray a) unsafeFreezeLiftedPrimArray (MutableLiftedPrimArray arr) = fmap LiftedPrimArray (unsafeFreezeByteArray arr) -thawLiftedPrimArray :: PrimMonad m => LiftedPrimArray a -> ElemCount -> ElemCount -> m (MutableLiftedPrimArray (PrimState m) a)+thawLiftedPrimArray :: (PrimMonad m) => LiftedPrimArray a -> ElemCount -> ElemCount -> m (MutableLiftedPrimArray (PrimState m) a) thawLiftedPrimArray (LiftedPrimArray arr) off len = fmap MutableLiftedPrimArray (thawByteArray arr (coerce off) (coerce len)) -unsafeThawLiftedPrimArray :: PrimMonad m => LiftedPrimArray a -> m (MutableLiftedPrimArray (PrimState m) a)+unsafeThawLiftedPrimArray :: (PrimMonad m) => LiftedPrimArray a -> m (MutableLiftedPrimArray (PrimState m) a) unsafeThawLiftedPrimArray (LiftedPrimArray arr) = fmap MutableLiftedPrimArray (unsafeThawByteArray arr) -liftedPrimArrayFromListN :: LiftedPrim a => ElemCount -> [a] -> LiftedPrimArray a+liftedPrimArrayFromListN :: (LiftedPrim a) => ElemCount -> [a] -> LiftedPrimArray a liftedPrimArrayFromListN n xs = LiftedPrimArray $ runByteArray $ do   let elemSize = staticByteSize (proxyForF xs)       len = coerce n * coerce elemSize@@ -91,22 +88,22 @@     modifySTRef' offRef (elemSize +)   pure arr -liftedPrimArrayFromList :: LiftedPrim a => [a] -> LiftedPrimArray a+liftedPrimArrayFromList :: (LiftedPrim a) => [a] -> LiftedPrimArray a liftedPrimArrayFromList xs = liftedPrimArrayFromListN (coerce (length xs)) xs -generateLiftedPrimArray :: LiftedPrim a => ElemCount -> (ElemCount -> a) -> LiftedPrimArray a+generateLiftedPrimArray :: (LiftedPrim a) => ElemCount -> (ElemCount -> a) -> LiftedPrimArray a generateLiftedPrimArray n f = liftedPrimArrayFromListN n (fmap f [0 .. n - 1])  sizeofLiftedPrimArray :: LiftedPrimArray a -> ByteCount sizeofLiftedPrimArray (LiftedPrimArray arr) = coerce (sizeofByteArray arr) -lengthLiftedPrimArray :: LiftedPrim a => LiftedPrimArray a -> ElemCount+lengthLiftedPrimArray :: (LiftedPrim a) => LiftedPrimArray a -> ElemCount lengthLiftedPrimArray pa@(LiftedPrimArray arr) =   let elemSize = coerce (staticByteSize (proxyForF pa))       arrSize = sizeofByteArray arr   in  coerce (div arrSize elemSize) -cloneLiftedPrimArray :: LiftedPrim a => LiftedPrimArray a -> ElemCount -> ElemCount -> LiftedPrimArray a+cloneLiftedPrimArray :: (LiftedPrim a) => LiftedPrimArray a -> ElemCount -> ElemCount -> LiftedPrimArray a cloneLiftedPrimArray pa@(LiftedPrimArray arr) off len =   let elemSize = staticByteSize (proxyForF pa)       byteOff = coerce off * elemSize@@ -114,7 +111,7 @@       arr' = cloneByteArray arr (coerce byteOff) (coerce byteLen)   in  LiftedPrimArray arr' -replicateLiftedPrimArray :: LiftedPrim a => ElemCount -> a -> LiftedPrimArray a+replicateLiftedPrimArray :: (LiftedPrim a) => ElemCount -> a -> LiftedPrimArray a replicateLiftedPrimArray len val = LiftedPrimArray $ runByteArray $ do   let elemSize = staticByteSize (proxyFor val)       byteLen = coerce len * elemSize

@@ -1,103 +1,118 @@ module Dahdit.Mem-  ( IxPtr (..)+  ( MemPtr (..)+  , emptyMemPtr+  , MutableMem (..)   , ReadMem (..)   , readSBSMem   , viewSBSMem   , viewBSMem   , viewVecMem+  , mutViewVecMem   , WriteMem (..)   , writeSBSMem-  , allocBAMem-  , allocPtrMem-  , freezeBAMem-  , freezeSBSMem-  , freezeBSMem-  , freezeVecMem-  , mutAllocBAMem-  , mutFreezeBAMem-  , mutAllocVecMem-  , mutFreezeVecMem+  , withBAMem+  , withSBSMem+  , withVecMem+  , withBSMem   ) where -import Control.Monad.Primitive (PrimMonad (..), unsafeIOToPrim)-import Control.Monad.ST (runST)+import Control.Monad.Primitive (MonadPrim, PrimMonad (..), RealWorld) import Dahdit.LiftedPrim (LiftedPrim (..), setByteArrayLifted) import Dahdit.Proxy (proxyFor) import Dahdit.Sizes (ByteCount (..), staticByteSize) import Data.ByteString (ByteString) import qualified Data.ByteString.Internal as BSI import Data.ByteString.Short.Internal (ShortByteString (..))-import qualified Data.ByteString.Unsafe as BSU import Data.Coerce (coerce) import Data.Foldable (for_)-import Data.Primitive.ByteArray (ByteArray (..), MutableByteArray, cloneByteArray, copyByteArray, copyByteArrayToPtr, freezeByteArray, newByteArray, sizeofMutableByteArray, unsafeFreezeByteArray)+import Data.Primitive.ByteArray (ByteArray (..), MutableByteArray, cloneByteArray, copyByteArray, copyByteArrayToPtr, freezeByteArray, newByteArray, unsafeFreezeByteArray, unsafeThawByteArray) import Data.Primitive.Ptr (copyPtrToMutableByteArray)-import Data.Vector.Storable (MVector, Vector)+import Data.Vector.Storable (Vector) import qualified Data.Vector.Storable as VS+import Data.Vector.Storable.Mutable (IOVector) import qualified Data.Vector.Storable.Mutable as VSM import Data.Word (Word8)-import Foreign.ForeignPtr (newForeignPtr)-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-import Foreign.Marshal.Alloc (callocBytes, finalizerFree, free)+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrBytes, withForeignPtr) import Foreign.Ptr (Ptr, plusPtr) --- | A wrapper over 'Ptr' with an additional phantom type index to align with 'ST' state.-newtype IxPtr s = IxPtr {unIxPtr :: Ptr Word8}-  deriving stock (Show)-  deriving newtype (Eq, Ord)+data MemPtr s = MemPtr+  { mpForeign :: !(ForeignPtr Word8)+  , mpOffset :: !ByteCount+  , mpLength :: !ByteCount+  }+  deriving stock (Eq, Ord, Show) -class ReadMem r where-  indexMemInBytes :: LiftedPrim a => r -> ByteCount -> a-  cloneArrayMemInBytes :: r -> ByteCount -> ByteCount -> ByteArray+emptyMemPtr :: IO (MemPtr RealWorld)+emptyMemPtr = allocPtrMem 0 -instance ReadMem ByteArray where-  indexMemInBytes = indexArrayLiftedInBytes-  cloneArrayMemInBytes arr off len = cloneByteArray arr (coerce off) (coerce len)+withMemPtr :: MemPtr RealWorld -> (Ptr Word8 -> IO a) -> IO a+withMemPtr (MemPtr fp off _) f = withForeignPtr fp (\ptr -> f (plusPtr ptr (coerce off))) -clonePtr :: Ptr Word8 -> ByteCount -> ByteCount -> ByteArray-clonePtr ptr off len = runST $ do-  let wptr = coerce (plusPtr ptr (coerce off)) :: Ptr Word8+class (PrimMonad m) => MutableMem r w m | w m -> r where+  unsafeThawMem :: r -> m w+  unsafeUseThawedMem :: r -> (w -> m a) -> m a+  unsafeUseThawedMem r f = unsafeThawMem r >>= f+  unsafeFreezeMem :: w -> m r+  unsafeUseFrozenMem :: w -> (r -> m a) -> m a+  unsafeUseFrozenMem w f = unsafeFreezeMem w >>= f++instance (MonadPrim s m) => MutableMem ByteArray (MutableByteArray s) m where+  unsafeThawMem = unsafeThawByteArray+  unsafeFreezeMem = unsafeFreezeByteArray++instance MutableMem (VS.Vector Word8) (IOVector Word8) IO where+  unsafeThawMem = VS.unsafeThaw+  unsafeFreezeMem = VS.unsafeFreeze++class (PrimMonad m) => ReadMem r m where+  indexMemInBytes :: (LiftedPrim a) => r -> ByteCount -> m a+  cloneArrayMemInBytes :: r -> ByteCount -> ByteCount -> m ByteArray++instance (PrimMonad m) => ReadMem ByteArray m where+  indexMemInBytes arr off = pure (indexArrayLiftedInBytes arr off)+  cloneArrayMemInBytes arr off len = pure (cloneByteArray arr (coerce off) (coerce len))++cloneMemPtr :: MemPtr RealWorld -> ByteCount -> ByteCount -> IO ByteArray+cloneMemPtr mem off len = do   marr <- newByteArray (coerce len)-  copyPtrToMutableByteArray marr 0 wptr (coerce len)+  withMemPtr mem $ \ptr -> do+    let wptr = plusPtr ptr (coerce off) :: Ptr Word8+    copyPtrToMutableByteArray marr 0 wptr (coerce len)   unsafeFreezeByteArray marr -instance ReadMem (Ptr Word8) where-  indexMemInBytes = indexPtrLiftedInBytes-  cloneArrayMemInBytes = clonePtr+instance ReadMem (MemPtr RealWorld) IO where+  indexMemInBytes mem off = withMemPtr mem (\ptr -> pure (indexPtrLiftedInBytes ptr off))+  cloneArrayMemInBytes = cloneMemPtr -readSBSMem :: ReadMem r => r -> ByteCount -> ByteCount -> ShortByteString-readSBSMem mem off len = let !(ByteArray frozArr) = cloneArrayMemInBytes mem off len in SBS frozArr+readSBSMem :: (ReadMem r m) => r -> ByteCount -> ByteCount -> m ShortByteString+readSBSMem mem off len = do+  ByteArray frozArr <- cloneArrayMemInBytes mem off len+  pure (SBS frozArr)  viewSBSMem :: ShortByteString -> ByteArray viewSBSMem (SBS harr) = ByteArray harr -viewBSMem :: ByteString -> Ptr Word8-viewBSMem bs =-  let (fp, _) = BSI.toForeignPtr0 bs-  in  unsafeForeignPtrToPtr fp+viewBSMem :: ByteString -> MemPtr RealWorld+viewBSMem bs = let (fp, off, len) = BSI.toForeignPtr bs in MemPtr fp (coerce off) (coerce len) -viewVecMem :: Vector Word8 -> Ptr Word8-viewVecMem vec =-  let (fp, _) = VS.unsafeToForeignPtr0 vec-  in  unsafeForeignPtrToPtr fp+viewVecMem :: Vector Word8 -> MemPtr RealWorld+viewVecMem vec = let (fp, off, len) = VS.unsafeToForeignPtr vec in MemPtr fp (coerce off) (coerce len) -mutViewVecMem :: MVector s Word8 -> Ptr Word8-mutViewVecMem mvec =-  let (fp, _) = VSM.unsafeToForeignPtr0 mvec-  in  unsafeForeignPtrToPtr fp+mutViewVecMem :: IOVector Word8 -> MemPtr RealWorld+mutViewVecMem mvec = let (fp, off, len) = VSM.unsafeToForeignPtr mvec in MemPtr fp (coerce off) (coerce len) -class PrimMonad m => WriteMem q m where-  writeMemInBytes :: LiftedPrim a => a -> q (PrimState m) -> ByteCount -> m ()+class (PrimMonad m) => WriteMem q m where+  writeMemInBytes :: (LiftedPrim a) => a -> q (PrimState m) -> ByteCount -> m ()   copyArrayMemInBytes :: ByteArray -> ByteCount -> ByteCount -> q (PrimState m) -> ByteCount -> m ()-  setMemInBytes :: LiftedPrim a => ByteCount -> a -> q (PrimState m) -> ByteCount -> m ()+  setMemInBytes :: (LiftedPrim a) => ByteCount -> a -> q (PrimState m) -> ByteCount -> m () -instance PrimMonad m => WriteMem MutableByteArray m where+instance (PrimMonad m) => WriteMem MutableByteArray m where   writeMemInBytes val mem off = writeArrayLiftedInBytes mem off val   copyArrayMemInBytes arr arrOff arrLen mem off = copyByteArray mem (coerce off) arr (coerce arrOff) (coerce arrLen)   setMemInBytes len val mem off = setByteArrayLifted mem off len val -copyPtr :: PrimMonad m => ByteArray -> ByteCount -> ByteCount -> Ptr Word8 -> ByteCount -> m ()+copyPtr :: (PrimMonad m) => ByteArray -> ByteCount -> ByteCount -> Ptr Word8 -> ByteCount -> m () copyPtr arr arrOff arrLen ptr off =   let wptr = coerce (plusPtr ptr (coerce off)) :: Ptr Word8   in  copyByteArrayToPtr wptr arr (coerce arrOff) (coerce arrLen)@@ -109,54 +124,46 @@   for_ [0 .. elemLen - 1] $ \pos ->     writePtrLiftedInBytes ptr (off + pos * elemSize) val -instance PrimMonad m => WriteMem IxPtr m where-  writeMemInBytes val mem off = writePtrLiftedInBytes (unIxPtr mem) off val-  copyArrayMemInBytes arr arrOff arrLen = copyPtr arr arrOff arrLen . unIxPtr-  setMemInBytes len val = setPtr len val . unIxPtr+instance WriteMem MemPtr IO where+  writeMemInBytes val mem off = withMemPtr mem (\ptr -> writePtrLiftedInBytes ptr off val)+  copyArrayMemInBytes arr arrOff arrLen mem off = withMemPtr mem (\ptr -> copyPtr arr arrOff arrLen ptr off)+  setMemInBytes len val mem off = withMemPtr mem (\ptr -> setPtr len val ptr off) -writeSBSMem :: WriteMem q m => ShortByteString -> ByteCount -> q (PrimState m) -> ByteCount -> m ()+writeSBSMem :: (WriteMem q m) => ShortByteString -> ByteCount -> q (PrimState m) -> ByteCount -> m () writeSBSMem (SBS harr) = copyArrayMemInBytes (ByteArray harr) 0 -freezeBAMem :: PrimMonad m => MutableByteArray (PrimState m) -> ByteCount -> ByteCount -> m ByteArray-freezeBAMem marr (ByteCount startOff) (ByteCount endOff) =-  if startOff == 0 && endOff == sizeofMutableByteArray marr+withBAMem :: (MonadPrim s m) => ByteCount -> (MutableByteArray s -> m ByteCount) -> m ByteArray+withBAMem len use = do+  marr <- newByteArray (coerce len)+  len' <- use marr+  if len' == len     then unsafeFreezeByteArray marr-    else freezeByteArray marr startOff (endOff - startOff)--freezeSBSMem :: PrimMonad m => MutableByteArray (PrimState m) -> ByteCount -> ByteCount -> m ShortByteString-freezeSBSMem marr startOff endOff = fmap (\(ByteArray harr) -> SBS harr) (freezeBAMem marr startOff endOff)--freezeBSMem :: PrimMonad m => IxPtr (PrimState m) -> ByteCount -> ByteCount -> m ByteString-freezeBSMem (IxPtr ptr) startOff endOff =-  unsafeIOToPrim $-    BSU.unsafePackCStringFinalizer-      (plusPtr ptr (unByteCount startOff))-      (unByteCount (endOff - startOff))-      (free ptr)--freezeVecMem :: PrimMonad m => IxPtr (PrimState m) -> ByteCount -> ByteCount -> m (Vector Word8)-freezeVecMem (IxPtr ptr) _ len = unsafeIOToPrim (fmap (\fp -> VS.unsafeFromForeignPtr0 fp (coerce len)) (newForeignPtr finalizerFree ptr))+    else freezeByteArray marr 0 (coerce len') -allocPtrMem :: PrimMonad m => ByteCount -> ByteCount -> m (IxPtr (PrimState m), Maybe (IO ()))-allocPtrMem off len = do-  let cap = off + len-  ptr <- unsafeIOToPrim (callocBytes (unByteCount cap))-  pure (IxPtr ptr, Just (free ptr))+withSBSMem :: (MonadPrim s m) => ByteCount -> (MutableByteArray s -> m ByteCount) -> m ShortByteString+withSBSMem len use = fmap (\(ByteArray arr) -> SBS arr) (withBAMem len use) -allocBAMem :: PrimMonad m => ByteCount -> ByteCount -> m (MutableByteArray (PrimState m), Maybe (IO ()))-allocBAMem off len = do-  let cap = off + len-  arr <- newByteArray (unByteCount cap)-  pure (arr, Nothing)+allocPtrMem :: ByteCount -> IO (MemPtr RealWorld)+allocPtrMem len = do+  fp <- mallocForeignPtrBytes (coerce len)+  pure (MemPtr fp 0 len) -mutAllocBAMem :: PrimMonad m => MutableByteArray (PrimState m) -> ByteCount -> ByteCount -> m (MutableByteArray (PrimState m), Maybe (IO ()))-mutAllocBAMem u _ _ = pure (u, Nothing)+freezeVecMem :: MemPtr RealWorld -> ByteCount -> Vector Word8+freezeVecMem (MemPtr fp off _) len =+  VS.unsafeFromForeignPtr fp (coerce off) (coerce (off + len)) -mutFreezeBAMem :: PrimMonad m => MutableByteArray (PrimState m) -> ByteCount -> ByteCount -> m ByteCount-mutFreezeBAMem _ _ = pure+freezeBSMem :: MemPtr RealWorld -> ByteCount -> ByteString+freezeBSMem (MemPtr fp off _) len =+  BSI.fromForeignPtr fp (coerce off) (coerce (off + len)) -mutAllocVecMem :: PrimMonad m => MVector (PrimState m) Word8 -> ByteCount -> ByteCount -> m (IxPtr (PrimState m), Maybe (IO ()))-mutAllocVecMem u _ _ = pure (IxPtr (mutViewVecMem u), Nothing)+withVecMem :: ByteCount -> (MemPtr RealWorld -> IO ByteCount) -> IO (Vector Word8)+withVecMem len use = do+  mem <- allocPtrMem len+  len' <- use mem+  pure (freezeVecMem mem len') -mutFreezeVecMem :: PrimMonad m => IxPtr (PrimState m) -> ByteCount -> ByteCount -> m ByteCount-mutFreezeVecMem _ _ = pure+withBSMem :: ByteCount -> (MemPtr RealWorld -> IO ByteCount) -> IO ByteString+withBSMem len use = do+  mem <- allocPtrMem len+  len' <- use mem+  pure (freezeBSMem mem len')

@@ -126,42 +126,42 @@   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Real, Fractional, Floating, RealFrac, Default) -instance EndianPair Word16LE Word16BE where+instance EndianPair 2 Word16LE Word16BE where   toLittleEndian = Word16LE . swapEndian . unWord16BE   toBigEndian = Word16BE . swapEndian . unWord16LE -instance EndianPair Int16LE Int16BE where+instance EndianPair 2 Int16LE Int16BE where   toLittleEndian = Int16LE . swapEndian . unInt16BE   toBigEndian = Int16BE . swapEndian . unInt16LE -instance EndianPair Word24LE Word24BE where+instance EndianPair 3 Word24LE Word24BE where   toLittleEndian = Word24LE . swapEndian . unWord24BE   toBigEndian = Word24BE . swapEndian . unWord24LE -instance EndianPair Int24LE Int24BE where+instance EndianPair 3 Int24LE Int24BE where   toLittleEndian = Int24LE . swapEndian . unInt24BE   toBigEndian = Int24BE . swapEndian . unInt24LE -instance EndianPair Word32LE Word32BE where+instance EndianPair 4 Word32LE Word32BE where   toLittleEndian = Word32LE . swapEndian . unWord32BE   toBigEndian = Word32BE . swapEndian . unWord32LE -instance EndianPair Int32LE Int32BE where+instance EndianPair 4 Int32LE Int32BE where   toLittleEndian = Int32LE . swapEndian . unInt32BE   toBigEndian = Int32BE . swapEndian . unInt32LE -instance EndianPair Word64LE Word64BE where+instance EndianPair 8 Word64LE Word64BE where   toLittleEndian = Word64LE . swapEndian . unWord64BE   toBigEndian = Word64BE . swapEndian . unWord64LE -instance EndianPair Int64LE Int64BE where+instance EndianPair 8 Int64LE Int64BE where   toLittleEndian = Int64LE . swapEndian . unInt64BE   toBigEndian = Int64BE . swapEndian . unInt64LE -instance EndianPair FloatLE FloatBE where+instance EndianPair 4 FloatLE FloatBE where   toLittleEndian = FloatLE . swapEndian . unFloatBE   toBigEndian = FloatBE . swapEndian . unFloatLE -instance EndianPair DoubleLE DoubleBE where+instance EndianPair 8 DoubleLE DoubleBE where   toLittleEndian = DoubleLE . swapEndian . unDoubleBE   toBigEndian = DoubleBE . swapEndian . unDoubleLE

@@ -1,12 +1,14 @@ module Dahdit.Proxy   ( proxyFor   , proxyForF+  , proxyForRepF   , proxyForFun   , proxyForNatF   ) where  import Data.Proxy (Proxy (..))+import GHC.Generics (Generic (..)) import GHC.TypeLits (Nat)  proxyFor :: a -> Proxy a@@ -14,6 +16,9 @@  proxyForF :: f a -> Proxy a proxyForF _ = Proxy++proxyForRepF :: f t -> Rep t a -> Proxy (Rep t)+proxyForRepF _ _ = Proxy  proxyForFun :: (a -> x) -> Proxy a proxyForFun _ = Proxy

@@ -1,26 +1,34 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-}  module Dahdit.Run   ( GetError (..)   , prettyGetError   , runGetInternal+  , GetIncEnv (..)+  , newGetIncEnv+  , GetIncChunk (..)+  , GetIncRequest (..)+  , GetIncSuspend (..)+  , GetIncCb+  , runGetIncInternal   , runCount   , runPutInternal   ) where  import Control.Applicative (Alternative (..))-import Control.Exception (Exception (..), onException)+import Control.Exception (Exception (..)) import Control.Monad (replicateM_, unless) import Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError)-import Control.Monad.Free.Church (F (..))-import Control.Monad.Primitive (PrimBase, PrimMonad (..), unsafeIOToPrim, unsafePrimToIO)+import Control.Monad.Free.Church (F (..), iterM)+import Control.Monad.Free.Class (MonadFree (..))+import Control.Monad.Primitive (MonadPrim, PrimMonad (..)) import Control.Monad.Reader (MonadReader (..), ReaderT (..), asks)-import Control.Monad.ST.Strict (ST, runST) import Control.Monad.State.Strict (MonadState, State, runState) import qualified Control.Monad.State.Strict as State-import Control.Monad.Trans (lift)-import Control.Monad.Trans.Free (FreeT (..), iterT, wrap)+import Control.Monad.Trans (MonadTrans (..))+import Control.Monad.Trans.Free.Church (FT (..), iterT) import Control.Monad.Trans.Maybe (MaybeT (..)) import Dahdit.Free   ( Get (..)@@ -67,9 +75,11 @@ import Data.Foldable (for_, toList) import Data.Int (Int8) import Data.Maybe (fromJust)-import Data.Primitive.MutVar (MutVar, newMutVar, readMutVar, writeMutVar)-import Data.STRef.Strict (STRef, newSTRef, readSTRef, writeSTRef)+import Data.Primitive.MutVar (MutVar, modifyMutVar', newMutVar, readMutVar, writeMutVar)+import Data.Sequence (Seq (..)) import qualified Data.Sequence as Seq+import Data.Text (Text)+import qualified Data.Text as T import Data.Word (Word8)  -- Sizes:@@ -92,132 +102,231 @@ -- Get:  data GetError-  = GetErrorParseNeed !String !ByteCount !ByteCount-  | GetErrorScopedMismatch !ByteCount !ByteCount-  | GetErrorFail !String+  = GetErrorLocalCap !Text !ByteCount !ByteCount+  | GetErrorScopedMismatch !ScopeMode !ByteCount !ByteCount+  | GetErrorFail !Text+  | GetErrorGlobalCap !Text !ByteCount !ByteCount+  | GetErrorRemaining !ByteCount   deriving stock (Eq, Show)  instance Exception GetError where-  displayException = prettyGetError+  displayException = T.unpack . prettyGetError -prettyGetError :: GetError -> String+prettyGetError :: GetError -> Text prettyGetError = \case-  GetErrorParseNeed nm ac bc -> "End of input parsing " ++ nm ++ " (have " ++ show (unByteCount ac) ++ " bytes, need " ++ show (unByteCount bc) ++ ")"-  GetErrorScopedMismatch ac bc -> "Did not parse enough scoped input (read " ++ show (unByteCount ac) ++ " bytes, expected " ++ show (unByteCount bc) ++ ")"-  GetErrorFail msg -> "User error: " ++ msg+  GetErrorLocalCap nm ac bc -> "End of chunk parsing " <> nm <> " (have " <> T.pack (show (unByteCount ac)) <> " bytes, need " <> T.pack (show (unByteCount bc)) <> ")"+  GetErrorScopedMismatch sm ac bc ->+    let ty = case sm of ScopeModeExact -> "exact"; ScopeModeWithin -> "within"+    in  "Did not parse " <> ty <> " scoped input (read " <> T.pack (show (unByteCount ac)) <> " bytes, expected " <> T.pack (show (unByteCount bc)) <> ")"+  GetErrorFail msg -> "User error: " <> msg+  GetErrorGlobalCap nm ac bc -> "Hit limit parsing " <> nm <> " (allowed " <> T.pack (show (unByteCount ac)) <> " bytes, need " <> T.pack (show (unByteCount bc)) <> ")"+  GetErrorRemaining ac -> "Cannot read remaining length in stream context (read " <> T.pack (show (unByteCount ac)) <> ")" -data GetEnv s r = GetEnv-  { geOff :: !(STRef s ByteCount)-  -- ^ Offset from buffer start (in bytes)-  , geCap :: !ByteCount-  -- ^ Capacity of buffer segment-  , geArray :: !r+-- | Get from a single buffer+runGetInternal :: (ReadMem r m) => ByteCount -> Get a -> ByteCount -> r -> m (Either GetError a, ByteCount)+runGetInternal off act cap mem = do+  let chunk = GetIncChunk off cap mem+  env <- newGetIncEnv (Just (cap - off)) chunk+  (ea, _, off') <- runGetIncInternal act env (const (pure Nothing))+  pure (ea, off')++-- Get inc++data GetIncChunk r = GetIncChunk+  { gicLocalOff :: !ByteCount+  -- ^ Offset from start of local buffer to data+  , gicLocalCap :: !ByteCount+  -- ^ Capacity of local buffer+  , gicArray :: !r   -- ^ Source buffer   } -newGetEnv :: ByteCount -> ByteCount -> r -> ST s (GetEnv s r)-newGetEnv off cap mem = do-  offRef <- newSTRef off-  pure (GetEnv offRef cap mem)+data GetIncEnv s r = GetIncEnv+  { gieGlobalAbs :: !(MutVar s ByteCount)+  -- ^ Offset from start of parsing (0) to current position+  , gieGlobalRel :: !(MutVar s ByteCount)+  -- ^ Offset from start of parsing (0) to start of buffer+  -- It will always be the case that gloRel <= gloAbs+  , gieGlobalCap :: !(MutVar s (Seq ByteCount))+  -- ^ Stack of maximum capcacity (across all chunks)+  -- Top of stack is end of sequence.+  -- This will be narrowed to check scoped length.+  , gieCurChunk :: !(MutVar s (GetIncChunk r))+  -- ^ Current chunk+  , gieLookAhead :: !(MutVar s (Seq ByteCount))+  -- ^ Stack of look ahead points (in absolute position)+  -- Top of stack is end of sequence.+  } -newtype GetEff s r a = GetEff {unGetEff :: ReaderT (GetEnv s r) (ExceptT GetError (ST s)) a}-  deriving newtype (Functor, Applicative, Monad, MonadReader (GetEnv s r), MonadError GetError)+newGetIncEnv :: (MonadPrim s m) => Maybe ByteCount -> GetIncChunk r -> m (GetIncEnv s r)+newGetIncEnv mayCap chunk = do+  gloAbsVar <- newMutVar 0+  gloRelVar <- newMutVar 0+  gloCapVar <- newMutVar (maybe Empty Seq.singleton mayCap)+  curChunkVar <- newMutVar chunk+  lookAheadVar <- newMutVar Empty+  pure (GetIncEnv gloAbsVar gloRelVar gloCapVar curChunkVar lookAheadVar) -runGetEff :: GetEff s r a -> GetEnv s r -> ST s (Either GetError a)-runGetEff act env = runExceptT (runReaderT (unGetEff act) env)+-- | A request for more data. Includes absolute position, offset in the current buffer, and required length.+data GetIncRequest = GetIncRequest+  { girAbsPos :: !ByteCount+  , girBaseOff :: !ByteCount+  , girNeedLength :: !ByteCount+  }+  deriving stock (Eq, Ord, Show) -instance MonadFail (GetEff s r) where-  fail = GetEff . throwError . GetErrorFail+-- | See 'GetIncCb' - this is the functor-ized version so we can suspend execution.+data GetIncSuspend z x = GetIncSuspend !GetIncRequest !(Maybe z -> x)+  deriving stock (Functor) -stGetEff :: ST s a -> GetEff s r a-stGetEff = GetEff . lift . lift+type GetIncSuspendChunk r = GetIncSuspend (GetIncChunk r) -newtype GetRun s r a = GetRun {unGetRun :: FreeT GetF (GetEff s r) a}-  deriving newtype (Functor, Applicative, Monad)+-- Should not implement 'MonadReader' so we can prevent scoped operations like 'local'+newtype GetIncM s r m a = GetIncM {unGetIncM :: ReaderT (GetIncEnv s r) (ExceptT GetError (FT (GetIncSuspendChunk r) m)) a}+  deriving newtype+    ( Functor+    , Applicative+    , Monad+    , MonadError GetError+    , MonadFree (GetIncSuspendChunk r)+    ) -guardReadBytes :: String -> ByteCount -> GetEff s r ByteCount+instance MonadTrans (GetIncM s r) where+  lift = GetIncM . lift . lift . lift++-- | Return new chunk containing enough data (or nothing).+type GetIncCb z m = GetIncRequest -> m (Maybe z)++type GetIncCbChunk r m = GetIncCb (GetIncChunk r) m++pushMutVar :: (MonadPrim s m) => MutVar s (Seq a) -> a -> m ()+pushMutVar v a = modifyMutVar' v (:|> a)++popMutVar :: (MonadPrim s m) => MutVar s (Seq a) -> m ()+popMutVar v = modifyMutVar' v (\case Empty -> Empty; as :|> _ -> as)++peekMutVar :: (MonadPrim s m) => MutVar s (Seq a) -> m (Maybe a)+peekMutVar = fmap (\case Empty -> Nothing; _ :|> a -> Just a) . readMutVar++runGetIncM :: (MonadPrim s m) => GetIncM s r m a -> GetIncEnv s r -> GetIncCbChunk r m -> m (Either GetError a)+runGetIncM m env cb =+  runFT+    (runExceptT (runReaderT (unGetIncM m) env))+    pure+    (\k2 (GetIncSuspend req k1) -> cb req >>= k2 . k1)++guardReadBytes :: (MonadPrim s m) => Text -> ByteCount -> GetIncM s r m (ByteCount, GetIncChunk r, ByteCount) guardReadBytes nm bc = do-  GetEnv offRef cap _ <- ask-  off <- stGetEff (readSTRef offRef)-  let ac = cap - off-  if bc > ac-    then throwError (GetErrorParseNeed nm ac bc)-    else pure off+  GetIncEnv gloAbsRef gloRelRef capStackRef chunkRef lookStackRef <- GetIncM ask+  -- First check if we're in cap+  gloAbsStart <- lift (readMutVar gloAbsRef)+  let gloAbsEnd = gloAbsStart + bc+  mayCap <- lift (peekMutVar capStackRef)+  case mayCap of+    Just cap | gloAbsEnd > cap -> throwError (GetErrorGlobalCap nm cap gloAbsEnd)+    _ -> pure ()+  -- Now check that we have enough in the local buf+  gloRel <- lift (readMutVar gloRelRef)+  oldChunk@(GetIncChunk oldOff oldCap _) <- lift (readMutVar chunkRef)+  let oldLocOffStart = gloAbsStart - gloRel + oldOff+      oldLocOffEnd = oldLocOffStart + bc+  (newChunk, newLocOffStart) <-+    if oldLocOffEnd <= oldCap+      then pure (oldChunk, oldLocOffStart)+      else do+        lookStack <- lift (readMutVar lookStackRef)+        let gloBaseStart = case lookStack of Empty -> gloAbsStart; x :<| _ -> x+            baseOffStart = gloBaseStart - gloRel + oldOff+            baseOffEnd = gloAbsStart - gloRel + oldOff + bc+        let needLength = baseOffEnd - baseOffStart+            req = GetIncRequest gloAbsStart baseOffStart needLength+        wrap $ GetIncSuspend req $ \case+          Nothing -> throwError (GetErrorLocalCap nm oldCap baseOffEnd)+          Just newChunk@(GetIncChunk newOff newCap _) -> do+            let newEnd = newOff + needLength+            unless (newEnd <= newCap) (throwError (GetErrorLocalCap nm newCap newOff))+            lift (writeMutVar chunkRef newChunk)+            lift (writeMutVar gloRelRef gloBaseStart)+            pure (newChunk, gicLocalOff newChunk)+  pure (gloAbsEnd, newChunk, newLocOffStart) -readBytes :: String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a+-- Memory read function takes local start offset+readBytes :: (MonadPrim s m) => Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a readBytes nm bc f = do-  off <- guardReadBytes nm bc-  GetEnv offRef _ mem <- ask-  stGetEff $ do-    let a = f mem off-        newOff = off + bc-    writeSTRef offRef newOff-    pure a+  (gloAbsEnd, newChunk, newLocOffStart) <- guardReadBytes nm bc+  let mem = gicArray newChunk+  a <- lift (f mem newLocOffStart)+  gloAbsRef <- GetIncM (asks gieGlobalAbs)+  lift (writeMutVar gloAbsRef gloAbsEnd)+  pure a -readScope :: ReadMem r => GetScopeF (GetEff s r a) -> GetEff s r a+readScope :: (MonadPrim s m, ReadMem r m) => GetScopeF (GetIncM s r m a) -> GetIncM s r m a readScope (GetScopeF sm bc g k) = do-  GetEnv offRef oldCap _ <- ask-  oldOff <- stGetEff (readSTRef offRef)-  let oldAvail = oldCap - oldOff-  if bc > oldAvail-    then throwError (GetErrorParseNeed "scope" oldAvail bc)-    else do-      let newCap = oldOff + bc-      a <- local (\ge -> ge {geCap = newCap}) (mkGetEff g)-      case sm of-        ScopeModeWithin -> k a-        ScopeModeExact -> do-          newOff <- stGetEff (readSTRef offRef)-          let actualBc = newOff - oldOff-          if actualBc == bc-            then k a-            else throwError (GetErrorScopedMismatch actualBc bc)+  GetIncEnv gloAbsRef _ capStackRef _ _ <- GetIncM ask+  gloAbsStart <- lift (readMutVar gloAbsRef)+  let gloAbsMax = gloAbsStart + bc+  mayCap <- lift (peekMutVar capStackRef)+  case mayCap of+    Just cap+      | sm == ScopeModeExact && gloAbsMax > cap ->+          throwError (GetErrorGlobalCap "scope" cap gloAbsMax)+    _ -> pure ()+  lift (pushMutVar capStackRef gloAbsMax)+  a <- interpGetInc g+  lift (popMutVar capStackRef)+  gloAbsEnd <- lift (readMutVar gloAbsRef)+  let actualBc = gloAbsEnd - gloAbsStart+  if (sm == ScopeModeExact && actualBc == bc) || (sm == ScopeModeWithin && actualBc <= bc)+    then k a+    else throwError (GetErrorScopedMismatch sm actualBc bc) -readStaticSeq :: ReadMem r => GetStaticSeqF (GetEff s r a) -> GetEff s r a+readStaticSeq :: (MonadPrim s m, ReadMem r m) => GetStaticSeqF (GetIncM s r m a) -> GetIncM s r m a readStaticSeq gss@(GetStaticSeqF ec g k) = do   let bc = getStaticSeqSize gss   _ <- guardReadBytes "static sequence" bc-  ss <- Seq.replicateA (coerce ec) (mkGetEff g)+  ss <- Seq.replicateA (coerce ec) (interpGetInc g)   k ss -readStaticArray :: ReadMem r => GetStaticArrayF (GetEff s r a) -> GetEff s r a+readStaticArray :: (MonadPrim s m, ReadMem r m) => GetStaticArrayF (GetIncM s r m a) -> GetIncM s r m a readStaticArray gsa@(GetStaticArrayF _ _ k) = do   let bc = getStaticArraySize gsa   sa <- readBytes "static vector" bc (\mem off -> cloneArrayMemInBytes mem off bc)   k (LiftedPrimArray sa) -readLookAhead :: ReadMem r => GetLookAheadF (GetEff s r a) -> GetEff s r a+readLookAhead :: (MonadPrim s m, ReadMem r m) => GetLookAheadF (GetIncM s r m a) -> GetIncM s r m a readLookAhead (GetLookAheadF g k) = do-  offRef <- asks geOff-  startOff <- stGetEff (readSTRef offRef)-  a <- mkGetEff g-  stGetEff (writeSTRef offRef startOff)+  GetIncEnv gloAbsRef _ _ _ lookStackRef <- GetIncM ask+  gloAbs <- lift (readMutVar gloAbsRef)+  lift (pushMutVar lookStackRef gloAbs)+  a <- interpGetInc g+  lift (popMutVar lookStackRef)+  lift (writeMutVar gloAbsRef gloAbs)   k a -execGetRun :: ReadMem r => GetF (GetEff s r a) -> GetEff s r a-execGetRun = \case-  GetFWord8 k -> readBytes "Word8" 1 (indexMemInBytes @_ @Word8) >>= k-  GetFInt8 k -> readBytes "Int8" 1 (indexMemInBytes @_ @Int8) >>= k-  GetFWord16LE k -> readBytes "Word16LE" 2 (indexMemInBytes @_ @Word16LE) >>= k-  GetFInt16LE k -> readBytes "Int16LE" 2 (indexMemInBytes @_ @Int16LE) >>= k-  GetFWord24LE k -> readBytes "Word24LE" 3 (indexMemInBytes @_ @Word24LE) >>= k-  GetFInt24LE k -> readBytes "Int24LE" 3 (indexMemInBytes @_ @Int24LE) >>= k-  GetFWord32LE k -> readBytes "Word32LE" 4 (indexMemInBytes @_ @Word32LE) >>= k-  GetFInt32LE k -> readBytes "Int32LE" 4 (indexMemInBytes @_ @Int32LE) >>= k-  GetFWord64LE k -> readBytes "Word64LE" 8 (indexMemInBytes @_ @Word64LE) >>= k-  GetFInt64LE k -> readBytes "Int64LE" 8 (indexMemInBytes @_ @Int64LE) >>= k-  GetFFloatLE k -> readBytes "FloatLE" 4 (indexMemInBytes @_ @FloatLE) >>= k-  GetFDoubleLE k -> readBytes "DoubleLE" 8 (indexMemInBytes @_ @DoubleLE) >>= k-  GetFWord16BE k -> readBytes "Word16BE" 2 (indexMemInBytes @_ @Word16BE) >>= k-  GetFInt16BE k -> readBytes "Int16BE" 2 (indexMemInBytes @_ @Int16BE) >>= k-  GetFWord24BE k -> readBytes "Word24BE" 3 (indexMemInBytes @_ @Word24BE) >>= k-  GetFInt24BE k -> readBytes "Int24BE" 3 (indexMemInBytes @_ @Int24BE) >>= k-  GetFWord32BE k -> readBytes "Word32BE" 4 (indexMemInBytes @_ @Word32BE) >>= k-  GetFInt32BE k -> readBytes "Int32BE" 4 (indexMemInBytes @_ @Int32BE) >>= k-  GetFWord64BE k -> readBytes "Word64BE" 8 (indexMemInBytes @_ @Word64BE) >>= k-  GetFInt64BE k -> readBytes "Int64BE" 8 (indexMemInBytes @_ @Int64BE) >>= k-  GetFFloatBE k -> readBytes "FloatBE" 4 (indexMemInBytes @_ @FloatBE) >>= k-  GetFDoubleBE k -> readBytes "DoubleBE" 8 (indexMemInBytes @_ @DoubleBE) >>= k+interpGetInc :: (MonadPrim s m, ReadMem r m) => Get a -> GetIncM s r m a+interpGetInc (Get g) = flip iterM g $ \case+  GetFWord8 k -> readBytes "Word8" 1 (indexMemInBytes @_ @_ @Word8) >>= k+  GetFInt8 k -> readBytes "Int8" 1 (indexMemInBytes @_ @_ @Int8) >>= k+  GetFWord16LE k -> readBytes "Word16LE" 2 (indexMemInBytes @_ @_ @Word16LE) >>= k+  GetFInt16LE k -> readBytes "Int16LE" 2 (indexMemInBytes @_ @_ @Int16LE) >>= k+  GetFWord24LE k -> readBytes "Word24LE" 3 (indexMemInBytes @_ @_ @Word24LE) >>= k+  GetFInt24LE k -> readBytes "Int24LE" 3 (indexMemInBytes @_ @_ @Int24LE) >>= k+  GetFWord32LE k -> readBytes "Word32LE" 4 (indexMemInBytes @_ @_ @Word32LE) >>= k+  GetFInt32LE k -> readBytes "Int32LE" 4 (indexMemInBytes @_ @_ @Int32LE) >>= k+  GetFWord64LE k -> readBytes "Word64LE" 8 (indexMemInBytes @_ @_ @Word64LE) >>= k+  GetFInt64LE k -> readBytes "Int64LE" 8 (indexMemInBytes @_ @_ @Int64LE) >>= k+  GetFFloatLE k -> readBytes "FloatLE" 4 (indexMemInBytes @_ @_ @FloatLE) >>= k+  GetFDoubleLE k -> readBytes "DoubleLE" 8 (indexMemInBytes @_ @_ @DoubleLE) >>= k+  GetFWord16BE k -> readBytes "Word16BE" 2 (indexMemInBytes @_ @_ @Word16BE) >>= k+  GetFInt16BE k -> readBytes "Int16BE" 2 (indexMemInBytes @_ @_ @Int16BE) >>= k+  GetFWord24BE k -> readBytes "Word24BE" 3 (indexMemInBytes @_ @_ @Word24BE) >>= k+  GetFInt24BE k -> readBytes "Int24BE" 3 (indexMemInBytes @_ @_ @Int24BE) >>= k+  GetFWord32BE k -> readBytes "Word32BE" 4 (indexMemInBytes @_ @_ @Word32BE) >>= k+  GetFInt32BE k -> readBytes "Int32BE" 4 (indexMemInBytes @_ @_ @Int32BE) >>= k+  GetFWord64BE k -> readBytes "Word64BE" 8 (indexMemInBytes @_ @_ @Word64BE) >>= k+  GetFInt64BE k -> readBytes "Int64BE" 8 (indexMemInBytes @_ @_ @Int64BE) >>= k+  GetFFloatBE k -> readBytes "FloatBE" 4 (indexMemInBytes @_ @_ @FloatBE) >>= k+  GetFDoubleBE k -> readBytes "DoubleBE" 8 (indexMemInBytes @_ @_ @DoubleBE) >>= k   GetFShortByteString bc k ->     readBytes "ShortByteString" bc (\mem off -> readSBSMem mem off bc) >>= k   GetFStaticSeq gss -> readStaticSeq gss@@ -225,35 +334,28 @@   GetFByteArray bc k ->     readBytes "ByteArray" bc (\mem off -> cloneArrayMemInBytes mem off bc) >>= k   GetFScope gs -> readScope gs-  GetFSkip bc k -> readBytes "skip" bc (\_ _ -> ()) *> k+  GetFSkip bc k -> readBytes "skip" bc (\_ _ -> pure ()) >> k   GetFLookAhead gla -> readLookAhead gla   GetFRemainingSize k -> do-    GetEnv offRef cap _ <- ask-    off <- stGetEff (readSTRef offRef)-    k (cap - off)-  GetFFail msg -> fail msg--runGetRun :: ReadMem r => GetRun s r a -> GetEnv s r -> ST s (Either GetError a)-runGetRun = runGetEff . iterGetRun--iterGetRun :: ReadMem r => GetRun s r a -> GetEff s r a-iterGetRun act = iterT execGetRun (unGetRun act)--mkGetRun :: Get a -> GetRun s r a-mkGetRun (Get (F w)) = GetRun (w pure wrap)--mkGetEff :: ReadMem r => Get a -> GetEff s r a-mkGetEff = iterGetRun . mkGetRun+    GetIncEnv gloAbsRef _ capStackRef _ _ <- GetIncM ask+    gloAbs <- lift (readMutVar gloAbsRef)+    capStack <- lift (readMutVar capStackRef)+    case capStack of+      Empty -> throwError (GetErrorRemaining gloAbs)+      _ :|> cap -> k (cap - gloAbs)+  GetFFail msg -> throwError (GetErrorFail msg) -runGetInternal :: ReadMem r => ByteCount -> Get a -> ByteCount -> r -> (Either GetError a, ByteCount)-runGetInternal off act cap mem = runST $ do-  let eff = mkGetEff act-  env <- newGetEnv off cap mem-  ea <- runGetEff eff env-  bc <- readSTRef (geOff env)-  pure (ea, bc)+runGetIncInternal :: (MonadPrim s m, ReadMem r m) => Get a -> GetIncEnv s r -> GetIncCbChunk r m -> m (Either GetError a, ByteCount, ByteCount)+runGetIncInternal getter env cb = do+  let m = interpGetInc getter+  res <- runGetIncM m env cb+  gloAbs <- readMutVar (gieGlobalAbs env)+  gloRel <- readMutVar (gieGlobalRel env)+  curChunk <- readMutVar (gieCurChunk env)+  let baseOff = gloAbs - gloRel + gicLocalOff curChunk+  pure (res, gloAbs, baseOff) --- Put unsafe:+-- Put:  data PutEnv s q = PutEnv   { peOff :: !(MutVar s ByteCount)@@ -264,7 +366,7 @@   -- ^ Destination buffer   } -newPutEnv :: PrimMonad m => ByteCount -> ByteCount -> q (PrimState m) -> m (PutEnv (PrimState m) q)+newPutEnv :: (PrimMonad m) => ByteCount -> ByteCount -> q (PrimState m) -> m (PutEnv (PrimState m) q) newPutEnv off cap mem = do   offRef <- newMutVar off   pure (PutEnv offRef cap mem)@@ -277,13 +379,13 @@ runPutEff :: PutEff q m a -> PutEnv (PrimState m) q -> m a runPutEff act = runReaderT (unPutEff act) -stPutEff :: Monad m => m a -> PutEff q m a+stPutEff :: (Monad m) => m a -> PutEff q m a stPutEff = PutEff . lift -newtype PutRun q m a = PutRun {unPutRun :: FreeT PutF (PutEff q m) a}+newtype PutRun q m a = PutRun {unPutRun :: FT PutF (PutEff q m) a}   deriving newtype (Functor, Applicative, Monad) -writeBytes :: PrimMonad m => ByteCount -> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()+writeBytes :: (PrimMonad m) => ByteCount -> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m () writeBytes bc f = do   PutEnv offRef _ mem <- ask   stPutEff $ do@@ -292,7 +394,7 @@     let newOff = off + bc     writeMutVar offRef newOff -writeStaticSeq :: WriteMem q m => PutStaticSeqF (PutEff q m a) -> PutEff q m a+writeStaticSeq :: (WriteMem q m) => PutStaticSeqF (PutEff q m a) -> PutEff q m a writeStaticSeq (PutStaticSeqF n mz p s k) = do   for_ (take (coerce n) (toList s)) $ \a -> do     mkPutEff (p a)@@ -302,7 +404,7 @@     replicateM_ (coerce n - e) q   k -writeStaticArray :: WriteMem q m => PutStaticArrayF (PutEff q m a) -> PutEff q m a+writeStaticArray :: (WriteMem q m) => PutStaticArrayF (PutEff q m a) -> PutEff q m a writeStaticArray psa@(PutStaticArrayF needElems mz a@(LiftedPrimArray ba) k) = do   let elemSize = putStaticArrayElemSize psa       haveElems = sizeofLiftedPrimArray a@@ -317,52 +419,52 @@       Just z -> writeBytes extraBc (setMemInBytes extraBc z)   k -execPutRun :: WriteMem q m => PutF (PutEff q m a) -> PutEff q m a+execPutRun :: (WriteMem q m) => PutF (PutEff q m a) -> PutEff q m a execPutRun = \case-  PutFWord8 x k -> writeBytes 1 (writeMemInBytes x) *> k-  PutFInt8 x k -> writeBytes 1 (writeMemInBytes x) *> k-  PutFWord16LE x k -> writeBytes 2 (writeMemInBytes x) *> k-  PutFInt16LE x k -> writeBytes 2 (writeMemInBytes x) *> k-  PutFWord24LE x k -> writeBytes 3 (writeMemInBytes x) *> k-  PutFInt24LE x k -> writeBytes 3 (writeMemInBytes x) *> k-  PutFWord32LE x k -> writeBytes 4 (writeMemInBytes x) *> k-  PutFInt32LE x k -> writeBytes 4 (writeMemInBytes x) *> k-  PutFWord64LE x k -> writeBytes 8 (writeMemInBytes x) *> k-  PutFInt64LE x k -> writeBytes 8 (writeMemInBytes x) *> k-  PutFFloatLE x k -> writeBytes 4 (writeMemInBytes x) *> k-  PutFDoubleLE x k -> writeBytes 8 (writeMemInBytes x) *> k-  PutFWord16BE x k -> writeBytes 2 (writeMemInBytes x) *> k-  PutFInt16BE x k -> writeBytes 2 (writeMemInBytes x) *> k-  PutFWord24BE x k -> writeBytes 3 (writeMemInBytes x) *> k-  PutFInt24BE x k -> writeBytes 3 (writeMemInBytes x) *> k-  PutFWord32BE x k -> writeBytes 4 (writeMemInBytes x) *> k-  PutFInt32BE x k -> writeBytes 4 (writeMemInBytes x) *> k-  PutFWord64BE x k -> writeBytes 8 (writeMemInBytes x) *> k-  PutFInt64BE x k -> writeBytes 8 (writeMemInBytes x) *> k-  PutFFloatBE x k -> writeBytes 4 (writeMemInBytes x) *> k-  PutFDoubleBE x k -> writeBytes 8 (writeMemInBytes x) *> k+  PutFWord8 x k -> writeBytes 1 (writeMemInBytes x) >> k+  PutFInt8 x k -> writeBytes 1 (writeMemInBytes x) >> k+  PutFWord16LE x k -> writeBytes 2 (writeMemInBytes x) >> k+  PutFInt16LE x k -> writeBytes 2 (writeMemInBytes x) >> k+  PutFWord24LE x k -> writeBytes 3 (writeMemInBytes x) >> k+  PutFInt24LE x k -> writeBytes 3 (writeMemInBytes x) >> k+  PutFWord32LE x k -> writeBytes 4 (writeMemInBytes x) >> k+  PutFInt32LE x k -> writeBytes 4 (writeMemInBytes x) >> k+  PutFWord64LE x k -> writeBytes 8 (writeMemInBytes x) >> k+  PutFInt64LE x k -> writeBytes 8 (writeMemInBytes x) >> k+  PutFFloatLE x k -> writeBytes 4 (writeMemInBytes x) >> k+  PutFDoubleLE x k -> writeBytes 8 (writeMemInBytes x) >> k+  PutFWord16BE x k -> writeBytes 2 (writeMemInBytes x) >> k+  PutFInt16BE x k -> writeBytes 2 (writeMemInBytes x) >> k+  PutFWord24BE x k -> writeBytes 3 (writeMemInBytes x) >> k+  PutFInt24BE x k -> writeBytes 3 (writeMemInBytes x) >> k+  PutFWord32BE x k -> writeBytes 4 (writeMemInBytes x) >> k+  PutFInt32BE x k -> writeBytes 4 (writeMemInBytes x) >> k+  PutFWord64BE x k -> writeBytes 8 (writeMemInBytes x) >> k+  PutFInt64BE x k -> writeBytes 8 (writeMemInBytes x) >> k+  PutFFloatBE x k -> writeBytes 4 (writeMemInBytes x) >> k+  PutFDoubleBE x k -> writeBytes 8 (writeMemInBytes x) >> k   PutFShortByteString bc sbs k ->-    writeBytes bc (writeSBSMem sbs bc) *> k+    writeBytes bc (writeSBSMem sbs bc) >> k   PutFStaticSeq pss -> writeStaticSeq pss   PutFStaticArray psa -> writeStaticArray psa   PutFByteArray bc barr k ->-    writeBytes bc (copyArrayMemInBytes barr 0 bc) *> k-  PutFStaticHint (PutStaticHintF _ p k) -> mkPutEff p *> k+    writeBytes bc (copyArrayMemInBytes barr 0 bc) >> k+  PutFStaticHint (PutStaticHintF _ p k) -> mkPutEff p >> k -runPutRun :: WriteMem q m => PutRun q m a -> PutEnv (PrimState m) q -> m a+runPutRun :: (WriteMem q m) => PutRun q m a -> PutEnv (PrimState m) q -> m a runPutRun = runPutEff . iterPutRun -iterPutRun :: WriteMem q m => PutRun q m a -> PutEff q m a+iterPutRun :: (WriteMem q m) => PutRun q m a -> PutEff q m a iterPutRun act = iterT execPutRun (unPutRun act) -mkPutRun :: Monad m => PutM a -> PutRun q m a+mkPutRun :: PutM a -> PutRun q m a mkPutRun (PutM (F w)) = PutRun (w pure wrap) -mkPutEff :: WriteMem q m => PutM a -> PutEff q m a+mkPutEff :: (WriteMem q m) => PutM a -> PutEff q m a mkPutEff = iterPutRun . mkPutRun -runPutUnsafe :: WriteMem q m => ByteCount -> Put -> ByteCount -> q (PrimState m) -> m ByteCount-runPutUnsafe off act len mem = do+runPutInternal :: (WriteMem q m) => ByteCount -> Put -> ByteCount -> q (PrimState m) -> m ByteCount+runPutInternal off act len mem = do   let eff = mkPutRun act       cap = off + len   st@(PutEnv offRef _ _) <- newPutEnv off cap mem@@ -377,42 +479,42 @@ runCountEff :: CountEff a -> ByteCount -> (Maybe a, ByteCount) runCountEff act = runState (runMaybeT (unCountEff act)) -newtype CountRun a = CountRun {unCountRun :: FreeT PutF CountEff a}+newtype CountRun a = CountRun {unCountRun :: FT PutF CountEff a}   deriving newtype (Functor, Applicative, Monad)  execCountRun :: PutF (CountEff a) -> CountEff a execCountRun = \case-  PutFWord8 _ k -> State.modify' (1 +) *> k-  PutFInt8 _ k -> State.modify' (1 +) *> k-  PutFWord16LE _ k -> State.modify' (2 +) *> k-  PutFInt16LE _ k -> State.modify' (2 +) *> k-  PutFWord24LE _ k -> State.modify' (3 +) *> k-  PutFInt24LE _ k -> State.modify' (3 +) *> k-  PutFWord32LE _ k -> State.modify' (4 +) *> k-  PutFInt32LE _ k -> State.modify' (4 +) *> k-  PutFWord64LE _ k -> State.modify' (8 +) *> k-  PutFInt64LE _ k -> State.modify' (8 +) *> k-  PutFFloatLE _ k -> State.modify' (4 +) *> k-  PutFDoubleLE _ k -> State.modify' (8 +) *> k-  PutFWord16BE _ k -> State.modify' (2 +) *> k-  PutFInt16BE _ k -> State.modify' (2 +) *> k-  PutFWord24BE _ k -> State.modify' (3 +) *> k-  PutFInt24BE _ k -> State.modify' (3 +) *> k-  PutFWord32BE _ k -> State.modify' (4 +) *> k-  PutFInt32BE _ k -> State.modify' (4 +) *> k-  PutFWord64BE _ k -> State.modify' (8 +) *> k-  PutFInt64BE _ k -> State.modify' (8 +) *> k-  PutFFloatBE _ k -> State.modify' (4 +) *> k-  PutFDoubleBE _ k -> State.modify' (8 +) *> k-  PutFShortByteString bc _ k -> State.modify' (bc +) *> k+  PutFWord8 _ k -> State.modify' (1 +) >> k+  PutFInt8 _ k -> State.modify' (1 +) >> k+  PutFWord16LE _ k -> State.modify' (2 +) >> k+  PutFInt16LE _ k -> State.modify' (2 +) >> k+  PutFWord24LE _ k -> State.modify' (3 +) >> k+  PutFInt24LE _ k -> State.modify' (3 +) >> k+  PutFWord32LE _ k -> State.modify' (4 +) >> k+  PutFInt32LE _ k -> State.modify' (4 +) >> k+  PutFWord64LE _ k -> State.modify' (8 +) >> k+  PutFInt64LE _ k -> State.modify' (8 +) >> k+  PutFFloatLE _ k -> State.modify' (4 +) >> k+  PutFDoubleLE _ k -> State.modify' (8 +) >> k+  PutFWord16BE _ k -> State.modify' (2 +) >> k+  PutFInt16BE _ k -> State.modify' (2 +) >> k+  PutFWord24BE _ k -> State.modify' (3 +) >> k+  PutFInt24BE _ k -> State.modify' (3 +) >> k+  PutFWord32BE _ k -> State.modify' (4 +) >> k+  PutFInt32BE _ k -> State.modify' (4 +) >> k+  PutFWord64BE _ k -> State.modify' (8 +) >> k+  PutFInt64BE _ k -> State.modify' (8 +) >> k+  PutFFloatBE _ k -> State.modify' (4 +) >> k+  PutFDoubleBE _ k -> State.modify' (8 +) >> k+  PutFShortByteString bc _ k -> State.modify' (bc +) >> k   PutFStaticSeq pss@(PutStaticSeqF _ _ _ _ k) ->     let bc = putStaticSeqSize pss-    in  State.modify' (bc +) *> k+    in  State.modify' (bc +) >> k   PutFStaticArray psv@(PutStaticArrayF _ _ _ k) ->     let bc = putStaticArraySize psv-    in  State.modify' (bc +) *> k-  PutFByteArray bc _ k -> State.modify' (bc +) *> k-  PutFStaticHint (PutStaticHintF bc _ k) -> State.modify' (bc +) *> k+    in  State.modify' (bc +) >> k+  PutFByteArray bc _ k -> State.modify' (bc +) >> k+  PutFStaticHint (PutStaticHintF bc _ k) -> State.modify' (bc +) >> k  runCountRun :: CountRun a -> ByteCount -> (Maybe a, ByteCount) runCountRun = runCountEff . iterCountRun@@ -431,14 +533,3 @@   let eff = mkCountRun act       (_, bc) = runCountRun eff 0   in  bc---- Put safe:--primOnExc :: PrimBase m => m a -> Maybe (IO ()) -> m a-primOnExc prim = maybe prim $ \onExc ->-  unsafeIOToPrim (onException (unsafePrimToIO prim) onExc)--runPutInternal :: (PrimBase m, WriteMem q m) => ByteCount -> Put -> ByteCount -> (ByteCount -> ByteCount -> m (q (PrimState m), Maybe (IO ()))) -> (q (PrimState m) -> ByteCount -> ByteCount -> m z) -> m z-runPutInternal off act len mkMem useMem = do-  (mem, rel) <- mkMem off len-  primOnExc (runPutUnsafe off act len mem >>= useMem mem off) rel

@@ -1,10 +1,9 @@+{-# LANGUAGE UndecidableInstances #-}+ module Dahdit.Sizes   ( ByteCount (..)   , ElemCount (..)-  , ByteSized (..)   , StaticByteSized (..)-  , ViaStaticByteSized (..)-  , byteSizeFoldable   , staticByteSizeFoldable   , byteSizeViaStatic   )@@ -34,25 +33,13 @@   , Word64LE   ) import Dahdit.Proxy (proxyFor, proxyForF)-import Data.ByteString.Short (ShortByteString)-import qualified Data.ByteString.Short as BSS import Data.Coerce (coerce) import Data.Default (Default)-import Data.Foldable (foldMap') import Data.Int (Int16, Int32, Int64, Int8)-import Data.IntMap (IntMap)-import qualified Data.IntMap as IntMap-import Data.IntSet (IntSet)-import qualified Data.IntSet as IntSet-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map import Data.Proxy (Proxy (..))-import Data.Semigroup (Sum (..))-import Data.Sequence (Seq)-import Data.Set (Set)-import qualified Data.Set as Set import Data.ShortWord (Int24, Word24) import Data.Word (Word16, Word32, Word64, Word8)+import GHC.TypeLits (KnownNat, Nat, natVal)  -- Counts @@ -64,279 +51,150 @@   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Default) --- ByteSized--class ByteSized a where-  byteSize :: a -> ByteCount--instance ByteSized () where-  byteSize _ = 0--instance ByteSized Word8 where-  byteSize _ = 1--instance ByteSized Int8 where-  byteSize _ = 1--instance ByteSized Word16 where-  byteSize _ = 2--instance ByteSized Int16 where-  byteSize _ = 2--instance ByteSized Word24 where-  byteSize _ = 3--instance ByteSized Int24 where-  byteSize _ = 3--instance ByteSized Word32 where-  byteSize _ = 4--instance ByteSized Int32 where-  byteSize _ = 4--instance ByteSized Word64 where-  byteSize _ = 8--instance ByteSized Int64 where-  byteSize _ = 8--instance ByteSized Float where-  byteSize _ = 4--instance ByteSized Double where-  byteSize _ = 8--instance ByteSized Bool where-  byteSize _ = 1--instance ByteSized Char where-  byteSize _ = 1--instance ByteSized Int where-  byteSize _ = 8--instance ByteSized Word16LE where-  byteSize _ = 2--instance ByteSized Int16LE where-  byteSize _ = 2--instance ByteSized Word24LE where-  byteSize _ = 3--instance ByteSized Int24LE where-  byteSize _ = 3--instance ByteSized Word32LE where-  byteSize _ = 4--instance ByteSized Int32LE where-  byteSize _ = 4--instance ByteSized Word64LE where-  byteSize _ = 8--instance ByteSized Int64LE where-  byteSize _ = 8--instance ByteSized FloatLE where-  byteSize _ = 4--instance ByteSized DoubleLE where-  byteSize _ = 8--instance StaticByteSized x => ByteSized (ViaFromIntegral x y) where-  byteSize = byteSizeViaStatic--instance StaticByteSized le => ByteSized (ViaEndianPair le be) where-  byteSize = byteSizeViaStatic--deriving via (ViaEndianPair Word16LE Word16BE) instance ByteSized Word16BE--deriving via (ViaEndianPair Int16LE Int16BE) instance ByteSized Int16BE--deriving via (ViaEndianPair Word24LE Word24BE) instance ByteSized Word24BE--deriving via (ViaEndianPair Int24LE Int24BE) instance ByteSized Int24BE--deriving via (ViaEndianPair Word32LE Word32BE) instance ByteSized Word32BE--deriving via (ViaEndianPair Int32LE Int32BE) instance ByteSized Int32BE--deriving via (ViaEndianPair Word64LE Word64BE) instance ByteSized Word64BE--deriving via (ViaEndianPair Int64LE Int64BE) instance ByteSized Int64BE--deriving via (ViaEndianPair FloatLE FloatBE) instance ByteSized FloatBE--deriving via (ViaEndianPair DoubleLE DoubleBE) instance ByteSized DoubleBE--instance ByteSized ShortByteString where-  byteSize = coerce . BSS.length--instance ByteSized a => ByteSized [a] where-  byteSize = byteSizeFoldable--instance ByteSized a => ByteSized (Seq a) where-  byteSize = byteSizeFoldable--instance ByteSized a => ByteSized (Maybe a) where-  byteSize = \case-    Nothing -> 1-    Just a -> 1 + byteSize a--instance (ByteSized b, ByteSized a) => ByteSized (Either b a) where-  byteSize = \case-    Left b -> 1 + byteSize b-    Right a -> 1 + byteSize a--instance (ByteSized a, ByteSized b) => ByteSized (a, b) where-  byteSize (a, b) = byteSize a + byteSize b--instance (ByteSized a, ByteSized b, ByteSized c) => ByteSized (a, b, c) where-  byteSize (a, b, c) = byteSize a + byteSize b + byteSize c--instance (ByteSized a, ByteSized b, ByteSized c, ByteSized d) => ByteSized (a, b, c, d) where-  byteSize (a, b, c, d) = byteSize a + byteSize b + byteSize c + byteSize d--instance (ByteSized a, ByteSized b, ByteSized c, ByteSized d, ByteSized e) => ByteSized (a, b, c, d, e) where-  byteSize (a, b, c, d, e) = byteSize a + byteSize b + byteSize c + byteSize d + byteSize e--instance ByteSized a => ByteSized (Set a) where-  byteSize = byteSize . Set.toAscList--instance (ByteSized k, ByteSized v) => ByteSized (Map k v) where-  byteSize = byteSize . Map.toAscList--instance ByteSized IntSet where-  byteSize = byteSize . IntSet.toAscList--instance ByteSized v => ByteSized (IntMap v) where-  byteSize = byteSize . IntMap.toAscList- -- StaticByteSized -class ByteSized a => StaticByteSized a where+class (KnownNat (StaticSize a)) => StaticByteSized a where+  type StaticSize a :: Nat   staticByteSize :: Proxy a -> ByteCount+  staticByteSize = fromInteger . natVal . staticByteProxy +staticByteProxy :: Proxy a -> Proxy (StaticSize a)+staticByteProxy _ = Proxy+ instance StaticByteSized () where+  type StaticSize () = 0   staticByteSize _ = 0  instance StaticByteSized Word8 where+  type StaticSize Word8 = 1   staticByteSize _ = 1  instance StaticByteSized Int8 where+  type StaticSize Int8 = 1   staticByteSize _ = 1  instance StaticByteSized Word16 where+  type StaticSize Word16 = 2   staticByteSize _ = 2  instance StaticByteSized Int16 where+  type StaticSize Int16 = 2   staticByteSize _ = 2  instance StaticByteSized Word24 where+  type StaticSize Word24 = 3   staticByteSize _ = 3  instance StaticByteSized Int24 where+  type StaticSize Int24 = 3   staticByteSize _ = 3  instance StaticByteSized Word32 where+  type StaticSize Word32 = 4   staticByteSize _ = 4  instance StaticByteSized Int32 where+  type StaticSize Int32 = 4   staticByteSize _ = 4  instance StaticByteSized Word64 where+  type StaticSize Word64 = 8   staticByteSize _ = 8  instance StaticByteSized Int64 where+  type StaticSize Int64 = 8   staticByteSize _ = 8  instance StaticByteSized Float where+  type StaticSize Float = 4   staticByteSize _ = 4  instance StaticByteSized Double where+  type StaticSize Double = 8   staticByteSize _ = 8  instance StaticByteSized Bool where+  type StaticSize Bool = 1   staticByteSize _ = 1  instance StaticByteSized Char where+  type StaticSize Char = 1   staticByteSize _ = 1  instance StaticByteSized Int where+  type StaticSize Int = 8   staticByteSize _ = 8  instance StaticByteSized Word16LE where+  type StaticSize Word16LE = 2   staticByteSize _ = 2  instance StaticByteSized Int16LE where+  type StaticSize Int16LE = 2   staticByteSize _ = 2  instance StaticByteSized Word24LE where+  type StaticSize Word24LE = 3   staticByteSize _ = 3  instance StaticByteSized Int24LE where+  type StaticSize Int24LE = 3   staticByteSize _ = 3  instance StaticByteSized Word32LE where+  type StaticSize Word32LE = 4   staticByteSize _ = 4  instance StaticByteSized Int32LE where+  type StaticSize Int32LE = 4   staticByteSize _ = 4  instance StaticByteSized Word64LE where+  type StaticSize Word64LE = 8   staticByteSize _ = 8  instance StaticByteSized Int64LE where+  type StaticSize Int64LE = 8   staticByteSize _ = 8  instance StaticByteSized FloatLE where+  type StaticSize FloatLE = 4   staticByteSize _ = 4  instance StaticByteSized DoubleLE where+  type StaticSize DoubleLE = 8   staticByteSize _ = 8 -instance StaticByteSized x => StaticByteSized (ViaFromIntegral x y) where+instance (StaticByteSized x, n ~ StaticSize x) => StaticByteSized (ViaFromIntegral n x y) where+  type StaticSize (ViaFromIntegral n x y) = n   staticByteSize _ = staticByteSize (Proxy :: Proxy x) -instance StaticByteSized le => StaticByteSized (ViaEndianPair le be) where+instance (StaticByteSized le, n ~ StaticSize le) => StaticByteSized (ViaEndianPair n le be) where+  type StaticSize (ViaEndianPair n le be) = n   staticByteSize _ = staticByteSize (Proxy :: Proxy le) -deriving via (ViaEndianPair Word16LE Word16BE) instance StaticByteSized Word16BE--deriving via (ViaEndianPair Int16LE Int16BE) instance StaticByteSized Int16BE--deriving via (ViaEndianPair Word24LE Word24BE) instance StaticByteSized Word24BE--deriving via (ViaEndianPair Int24LE Int24BE) instance StaticByteSized Int24BE--deriving via (ViaEndianPair Word32LE Word32BE) instance StaticByteSized Word32BE+deriving via (ViaEndianPair 2 Word16LE Word16BE) instance StaticByteSized Word16BE -deriving via (ViaEndianPair Int32LE Int32BE) instance StaticByteSized Int32BE+deriving via (ViaEndianPair 2 Int16LE Int16BE) instance StaticByteSized Int16BE -deriving via (ViaEndianPair Word64LE Word64BE) instance StaticByteSized Word64BE+deriving via (ViaEndianPair 3 Word24LE Word24BE) instance StaticByteSized Word24BE -deriving via (ViaEndianPair Int64LE Int64BE) instance StaticByteSized Int64BE+deriving via (ViaEndianPair 3 Int24LE Int24BE) instance StaticByteSized Int24BE -deriving via (ViaEndianPair FloatLE FloatBE) instance StaticByteSized FloatBE+deriving via (ViaEndianPair 4 Word32LE Word32BE) instance StaticByteSized Word32BE -deriving via (ViaEndianPair DoubleLE DoubleBE) instance StaticByteSized DoubleBE+deriving via (ViaEndianPair 4 Int32LE Int32BE) instance StaticByteSized Int32BE --- Via+deriving via (ViaEndianPair 8 Word64LE Word64BE) instance StaticByteSized Word64BE -newtype ViaStaticByteSized a = ViaStaticByteSized {unViaStaticByteSized :: a}+deriving via (ViaEndianPair 8 Int64LE Int64BE) instance StaticByteSized Int64BE -instance StaticByteSized a => ByteSized (ViaStaticByteSized a) where-  byteSize _ = staticByteSize (Proxy :: Proxy a)+deriving via (ViaEndianPair 4 FloatLE FloatBE) instance StaticByteSized FloatBE -byteSizeFoldable :: (Foldable f, ByteSized a) => f a -> ByteCount-byteSizeFoldable = getSum . foldMap' (Sum . byteSize)+deriving via (ViaEndianPair 8 DoubleLE DoubleBE) instance StaticByteSized DoubleBE  staticByteSizeFoldable :: (Foldable f, StaticByteSized a) => f a -> ByteCount staticByteSizeFoldable fa = staticByteSize (proxyForF fa) * coerce (length fa) -byteSizeViaStatic :: StaticByteSized a => a -> ByteCount+byteSizeViaStatic :: (StaticByteSized a) => a -> ByteCount byteSizeViaStatic = staticByteSize . proxyFor

@@ -1,12 +1,17 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UndecidableInstances #-}+ module Main (main) where -import Control.Monad.Primitive (PrimState)+import Control.Applicative (liftA2)+import Control.Monad (replicateM, (>=>))+import Control.Monad.Primitive (RealWorld) import Dahdit   ( Binary (..)-  , BinaryTarget (..)+  , BinaryGetTarget (..)+  , BinaryPutTarget (..)   , BoolByte (..)   , ByteCount (..)-  , ByteSized (..)   , ByteString   , DoubleBE (..)   , DoubleLE (..)@@ -15,6 +20,7 @@   , Generic   , Get   , GetError (..)+  , GetIncRequest (..)   , Int16BE   , Int16LE   , Int24BE@@ -24,22 +30,27 @@   , Int64BE   , Int64LE   , LiftedPrimArray (..)-  , MutBinaryTarget (..)+  , MutBinaryPutTarget (..)   , Proxy (..)   , Put   , ShortByteString   , StaticByteSized (..)   , StaticBytes (..)+  , TermBytes16 (..)+  , TermBytes8 (..)   , ViaGeneric (..)   , ViaStaticGeneric (..)   , Word16BE-  , Word16LE+  , Word16LE (..)   , Word24BE   , Word24LE   , Word32BE-  , Word32LE+  , Word32LE (..)   , Word64BE   , Word64LE+  , decodeEnd+  , decodeInc+  , encode   , getByteArray   , getByteString   , getDoubleBE@@ -64,6 +75,7 @@   , getStaticArray   , getStaticSeq   , getTarget+  , getText   , getWithin   , getWord16BE   , getWord16LE@@ -97,6 +109,7 @@   , putSeq   , putStaticArray   , putStaticSeq+  , putText   , putWord16BE   , putWord16LE   , putWord24BE@@ -114,59 +127,73 @@ import Data.ByteString.Short (ShortByteString (..)) import qualified Data.ByteString.Short as BSS import Data.Coerce (coerce)+import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef) import Data.Int (Int16, Int32, Int64, Int8) import Data.Primitive.ByteArray (ByteArray (..), MutableByteArray, byteArrayFromList, freezeByteArray, newByteArray, sizeofMutableByteArray) import Data.Proxy (asProxyTypeOf)+import Data.Sequence (Seq (..)) import qualified Data.Sequence as Seq import Data.ShortWord (Int24, Word24) import Data.Vector.Storable (Vector) import qualified Data.Vector.Storable as VS-import Data.Vector.Storable.Mutable (MVector)+import Data.Vector.Storable.Mutable (IOVector) import qualified Data.Vector.Storable.Mutable as VSM import Data.Word (Word16, Word32, Word64, Word8) import GHC.Float (castWord32ToFloat, castWord64ToDouble)+import System.IO.Unsafe (unsafePerformIO)+import Test.Falsify.Generator (Gen)+import qualified Test.Falsify.Generator as FG+import qualified Test.Falsify.Predicate as FC+import Test.Falsify.Property (Property)+import qualified Test.Falsify.Property as FP+import qualified Test.Falsify.Range as FR import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.Falsify (testProperty) import Test.Tasty.HUnit (testCase, (@?=)) -class BinaryTarget z => CaseTarget z where-  initSource :: [Word8] -> z-  consumeSink :: z -> [Word8]+class (Eq z, Show z) => CaseTarget z where+  initSource :: [Word8] -> IO z+  consumeSink :: z -> IO [Word8]+  sliceBuffer :: z -> ByteCount -> ByteCount -> IO z  instance CaseTarget ShortByteString where-  initSource = BSS.pack-  consumeSink = BSS.unpack+  initSource = pure . BSS.pack+  consumeSink = pure . BSS.unpack+  sliceBuffer buf off len = pure (BSS.take (coerce len) (BSS.drop (coerce off) buf))  instance CaseTarget ByteString where-  initSource = BS.pack-  consumeSink = BS.unpack+  initSource = pure . BS.pack+  consumeSink = pure . BS.unpack+  sliceBuffer buf off len = pure (BS.take (coerce len) (BS.drop (coerce off) buf))  instance CaseTarget (Vector Word8) where-  initSource = VS.fromList-  consumeSink = VS.toList+  initSource = pure . VS.fromList+  consumeSink = pure . VS.toList+  sliceBuffer buf off len = pure (VS.take (coerce len) (VS.drop (coerce off) buf)) -class MutBinaryTarget IO u => MutCaseTarget u where+class MutCaseTarget u where   newSink :: ByteCount -> IO u   freezeSink :: u -> IO [Word8] -instance (s ~ PrimState IO) => MutCaseTarget (MutableByteArray s) where+instance MutCaseTarget (MutableByteArray RealWorld) where   newSink = newByteArray . unByteCount   freezeSink u = fmap (\(ByteArray arr) -> BSS.unpack (SBS arr)) (freezeByteArray u 0 (sizeofMutableByteArray u)) -instance (s ~ PrimState IO) => MutCaseTarget (MVector s Word8) where+instance MutCaseTarget (IOVector Word8) where   newSink = VSM.new . unByteCount-  freezeSink = fmap consumeSink . VS.freeze+  freezeSink = VS.freeze >=> consumeSink  data DynFoo = DynFoo !Word8 !Word16LE   deriving stock (Eq, Show, Generic)-  deriving (ByteSized, Binary) via (ViaGeneric DynFoo)+  deriving (Binary) via (ViaGeneric DynFoo)  data StaFoo = StaFoo !Word8 !Word16LE   deriving stock (Eq, Show, Generic)-  deriving (ByteSized, StaticByteSized, Binary) via (ViaStaticGeneric StaFoo)+  deriving (StaticByteSized, Binary) via (ViaStaticGeneric StaFoo)  data TagFoo = TagFooOne !Word8 | TagFooTwo !Word16LE   deriving stock (Eq, Show, Generic)-  deriving (ByteSized, Binary) via (ViaGeneric TagFoo)+  deriving (Binary) via (ViaGeneric TagFoo)  type StaBytes = StaticBytes 2 @@ -176,11 +203,11 @@ data GetCase where   GetCase :: (Show a, Eq a) => String -> Get a -> Maybe (ByteCount, ByteCount, a) -> [Word8] -> GetCase -runGetCase :: CaseTarget z => Proxy z -> GetCase -> TestTree+runGetCase :: (BinaryGetTarget z IO, CaseTarget z) => Proxy z -> GetCase -> TestTree runGetCase p (GetCase name getter mayRes buf) = testCase name $ do-  let src = initSource buf `asProxyTypeOf` p-      totLen = coerce (length buf)-      (result, actOff) = getTarget getter src+  src <- initSource buf+  let totLen = coerce (length buf)+  (result, actOff) <- getTarget getter (src `asProxyTypeOf` p)   case (result, mayRes) of     (Left _, Nothing) -> pure ()     (Left err, Just (_, _, expecVal)) -> fail ("Got error <" ++ show err ++ ">, expected value <" ++ show expecVal ++ ">")@@ -193,18 +220,18 @@ data PutCase where   PutCase :: String -> Put -> [Word8] -> PutCase -runPutCase :: CaseTarget z => Proxy z -> PutCase -> TestTree+runPutCase :: (BinaryPutTarget z IO, CaseTarget z) => Proxy z -> PutCase -> TestTree runPutCase p (PutCase name putter expecBs) = testCase name $ do   let expecBc = coerce (length expecBs)       estBc = runCount putter   estBc @?= expecBc-  let actSink = putTargetUnsafe putter expecBc `asProxyTypeOf` p-      actBs = consumeSink actSink-      actBc = coerce (length actBs)+  actSink <- putTargetUnsafe putter expecBc+  actBs <- consumeSink (actSink `asProxyTypeOf` p)+  let actBc = coerce (length actBs)   actBs @?= expecBs   actBc @?= expecBc -mutRunPutCase :: MutCaseTarget z => Proxy z -> PutCase -> TestTree+mutRunPutCase :: (MutBinaryPutTarget z IO, MutCaseTarget z) => Proxy z -> PutCase -> TestTree mutRunPutCase p (PutCase name putter expecBs) = testCase name $ do   let expecBc = coerce (length expecBs)   actSink <- fmap (`asProxyTypeOf` p) (newSink expecBc)@@ -255,7 +282,6 @@     , testCase "Int64BE" (byteSize @Int64BE 0 @?= 8)     , testCase "FloatBE" (byteSize (FloatBE (castWord32ToFloat 0)) @?= 4)     , testCase "DoubleBE" (byteSize (DoubleBE (castWord64ToDouble 0)) @?= 8)-    , testCase "ShortByteString" (byteSize @ShortByteString (BSS.pack [0xEC, 0x5D]) @?= 2)     , testCase "DynFoo" (byteSize (DynFoo 0xBB 0x5DEC) @?= 3)     , testCase "StaFoo" (byteSize (StaFoo 0xBB 0x5DEC) @?= 3)     , testCase "StaBytes" (byteSize (mkStaBytes "hi") @?= 2)@@ -340,6 +366,7 @@   , GetCase "DoubleLE" getDoubleLE (Just (8, 0, DoubleLE (castWord64ToDouble 0x5DEC6EFD12345678))) [0x78, 0x56, 0x34, 0x12, 0xFD, 0x6E, 0xEC, 0x5D]   , GetCase "DoubleBE" getDoubleBE (Just (8, 0, DoubleBE (castWord64ToDouble 0x5DEC6EFD12345678))) [0x5D, 0xEC, 0x6E, 0xFD, 0x12, 0x34, 0x56, 0x78]   , GetCase "ShortByteString" (getByteString 2) (Just (2, 1, BSS.pack [0xEC, 0x5D])) [0xEC, 0x5D, 0xBB]+  , GetCase "Text" (getText 2) (Just (2, 1, "hi")) [0x68, 0x69, 0xBB]   , GetCase "Two Word8" ((,) <$> getWord8 <*> getWord8) (Just (2, 0, (0x5D, 0xBB))) [0x5D, 0xBB]   , GetCase "Two Word16LE" ((,) <$> getWord16LE <*> getWord16LE) (Just (4, 0, (0x5DEC, 0x4020))) [0xEC, 0x5D, 0x20, 0x40]   , GetCase "Seq" (getSeq 2 getWord16LE) (Just (4, 0, Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40]@@ -349,7 +376,9 @@   , GetCase "StaFoo" (get @StaFoo) (Just (3, 0, StaFoo 0xBB 0x5DEC)) [0xBB, 0xEC, 0x5D]   , GetCase "getRemainingSize" getRemainingSize (Just (0, 3, 3)) [0xBB, 0xEC, 0x5D]   , GetCase "getSkip" (getSkip 2) (Just (2, 1, ())) [0xBB, 0xEC, 0x5D]-  , GetCase "getLookAhead" (getLookAhead getWord16LE) (Just (0, 3, 0x5DEC)) [0xEC, 0x5D, 0xBB]+  , GetCase "getLookAhead 0" (getLookAhead getWord16LE) (Just (0, 3, 0x5DEC)) [0xEC, 0x5D, 0xBB]+  , GetCase "getLookAhead 1" (getWord8 >> getLookAhead getWord16LE) (Just (1, 2, 0xBB5D)) [0xEC, 0x5D, 0xBB]+  , GetCase "getLookAhead 2" (getLookAhead (getWord8 >> getWord16LE)) (Just (0, 3, 0xBB5D)) [0xEC, 0x5D, 0xBB]   , GetCase "getExact eq" (getExact 2 getWord16LE) (Just (2, 1, 0x5DEC)) [0xEC, 0x5D, 0xBB]   , GetCase "getExact lt" (getExact 1 getWord16LE) Nothing [0xEC, 0x5D, 0xBB]   , GetCase "getExact gt" (getExact 3 getWord16LE) Nothing [0xEC, 0x5D, 0xBB]@@ -363,9 +392,23 @@   , GetCase "StaBytes" (get @StaBytes) (Just (2, 1, mkStaBytes "hi")) [0x68, 0x69, 0x21]   , GetCase "TagFoo (one)" (get @TagFoo) (Just (2, 0, TagFooOne 7)) [0x00, 0x07]   , GetCase "TagFoo (two)" (get @TagFoo) (Just (3, 0, TagFooTwo 7)) [0x01, 0x07, 0x00]+  , GetCase "TB8 0" (get @TermBytes8) (Just (1, 0, TermBytes8 BSS.empty)) [0]+  , GetCase "TB8 1" (get @TermBytes8) (Just (2, 0, TermBytes8 (BSS.pack [1]))) [1, 0]+  , GetCase "TB8 2" (get @TermBytes8) (Just (3, 0, TermBytes8 (BSS.pack [1, 2]))) [1, 2, 0]+  , GetCase "TB8 3" (get @TermBytes8) (Just (4, 0, TermBytes8 (BSS.pack [1, 2, 3]))) [1, 2, 3, 0]+  , GetCase "TB16 0" (get @TermBytes16) (Just (2, 0, TermBytes16 BSS.empty)) [0, 0]+  , GetCase "TB16 1" (get @TermBytes16) (Just (2, 0, TermBytes16 (BSS.pack [1]))) [1, 0]+  , GetCase "TB16 2" (get @TermBytes16) (Just (4, 0, TermBytes16 (BSS.pack [1, 2]))) [1, 2, 0, 0]+  , GetCase "TB16 3" (get @TermBytes16) (Just (4, 0, TermBytes16 (BSS.pack [1, 2, 3]))) [1, 2, 3, 0]+  , GetCase "Seq Word16LE" (get @(Seq Word16LE)) (Just (12, 0, Seq.fromList [0xEC, 0x5D])) [2, 0, 0, 0, 0, 0, 0, 0, 0xEC, 0, 0x5D, 0]+  , GetCase+      "Seq WordX"+      (get @(Seq WordX))+      (Just (18, 0, Seq.fromList [WordX32 0, WordX32 0]))+      [2, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 4, 0, 0, 0, 0]   ] -testGet :: CaseTarget z => String -> Proxy z -> TestTree+testGet :: (BinaryGetTarget z IO, CaseTarget z) => String -> Proxy z -> TestTree testGet n p = testGroup ("get (" ++ n ++ ")") (fmap (runGetCase p) getCases)  putCases :: [PutCase]@@ -393,6 +436,7 @@   , PutCase "DoubleLE" (putDoubleLE (DoubleLE (castWord64ToDouble 0x5DEC6EFD12345678))) [0x78, 0x56, 0x34, 0x12, 0xFD, 0x6E, 0xEC, 0x5D]   , PutCase "DoubleBE" (putDoubleBE (DoubleBE (castWord64ToDouble 0x5DEC6EFD12345678))) [0x5D, 0xEC, 0x6E, 0xFD, 0x12, 0x34, 0x56, 0x78]   , PutCase "ShortByteString" (putByteString (BSS.pack [0xEC, 0x5D])) [0xEC, 0x5D]+  , PutCase "Text" (putText "hi") [0x68, 0x69]   , PutCase "Two Word8" (putWord8 0x5D *> putWord8 0xBB) [0x5D, 0xBB]   , PutCase "Two Word16LE" (putWord16LE 0x5DEC *> putWord16LE 0x4020) [0xEC, 0x5D, 0x20, 0x40]   , PutCase "Seq" (putSeq putWord16LE (Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40]@@ -409,9 +453,40 @@   , PutCase "StaBytes (more)" (put (mkStaBytes "hi!")) [0x68, 0x69]   , PutCase "TagFoo (one)" (put (TagFooOne 7)) [0x00, 0x07]   , PutCase "TagFoo (two)" (put (TagFooTwo 7)) [0x01, 0x07, 0x00]+  , PutCase "TB8 0" (put (TermBytes8 BSS.empty)) [0]+  , PutCase "TB8 1" (put (TermBytes8 (BSS.pack [1]))) [1, 0]+  , PutCase "TB8 2" (put (TermBytes8 (BSS.pack [1, 2]))) [1, 2, 0]+  , PutCase "TB8 3" (put (TermBytes8 (BSS.pack [1, 2, 3]))) [1, 2, 3, 0]+  , PutCase "TB16 0" (put (TermBytes16 BSS.empty)) [0, 0]+  , PutCase "TB16 1" (put (TermBytes16 (BSS.pack [1]))) [1, 0]+  , PutCase "TB16 2" (put (TermBytes16 (BSS.pack [1, 2]))) [1, 2, 0, 0]+  , PutCase "TB16 3" (put (TermBytes16 (BSS.pack [1, 2, 3]))) [1, 2, 3, 0]+  , PutCase "Seq Word16LE" (put @(Seq Word16LE) (Seq.fromList [0xEC, 0x5D])) [2, 0, 0, 0, 0, 0, 0, 0, 0xEC, 0, 0x5D, 0]+  , PutCase+      "Seq WordX"+      (put @(Seq WordX) (Seq.fromList [WordX32 0, WordX32 0]))+      [ 2+      , 0+      , 0+      , 0+      , 0+      , 0+      , 0+      , 0+      , 4+      , 0+      , 0+      , 0+      , 0+      , 4+      , 0+      , 0+      , 0+      , 0+      ]   ] -testPut :: CaseTarget z => String -> Proxy z -> TestTree+testPut :: (BinaryPutTarget z IO, CaseTarget z) => String -> Proxy z -> TestTree testPut n p = testGroup ("put (" ++ n ++ ")") (fmap (runPutCase p) putCases)  testLiftedPrimArray :: TestTree@@ -421,24 +496,109 @@   sizeofLiftedPrimArray arr @?= 6   lengthLiftedPrimArray arr @?= 3 -testGetOffset :: CaseTarget z => String -> Proxy z -> TestTree+testGetOffset :: (BinaryGetTarget z IO, CaseTarget z) => String -> Proxy z -> TestTree testGetOffset n p = testCase ("get offset (" ++ n ++ ")") $ do   let buf = [0x12, 0x34, 0x56, 0x78]-      src = initSource buf `asProxyTypeOf` p-      (ez1, c1) = getTargetOffset 0 getWord8 src+  src <- initSource buf+  (ez1, c1) <- getTargetOffset 0 getWord8 (src `asProxyTypeOf` p)   ez1 @?= Right 0x12   c1 @?= 1-  let (ez2, c2) = getTargetOffset 1 getWord16LE src+  (ez2, c2) <- getTargetOffset 1 getWord16LE src   ez2 @?= Right 0x5634   c2 @?= 3-  let (ez3, c3) = getTargetOffset 3 getWord16LE src-  ez3 @?= Left (GetErrorParseNeed "Word16LE" 1 2)+  (ez3, c3) <- getTargetOffset 3 getWord16LE src+  ez3 @?= Left (GetErrorGlobalCap "Word16LE" 1 2)   c3 @?= 3 -testMutPut :: MutCaseTarget u => String -> Proxy u -> TestTree+data WordX+  = WordX8 !Word8+  | WordX16 !Word16LE+  | WordX32 !Word32LE+  deriving stock (Eq, Ord, Show)++instance Binary WordX where+  byteSize =+    succ . \case+      WordX8 _ -> 1+      WordX16 _ -> 2+      WordX32 _ -> 4+  get = do+    w <- get @Word8+    case w of+      1 -> fmap WordX8 get+      2 -> fmap WordX16 get+      4 -> fmap WordX32 get+      _ -> fail ("Bad size for WordX: " ++ show w)+  put = \case+    WordX8 w -> put @Word8 1 >> put w+    WordX16 w -> put @Word8 2 >> put w+    WordX32 w -> put @Word8 4 >> put w++wordXGen :: Gen WordX+wordXGen = FG.choose gen8 (FG.choose gen16 gen32)+ where+  gen8 = fmap WordX8 (FG.inRange (FR.between (0, maxBound)))+  gen16 = fmap (WordX16 . Word16LE) (FG.inRange (FR.between (0, maxBound)))+  gen32 = fmap (WordX32 . Word32LE) (FG.inRange (FR.between (0, maxBound)))++takeDiff :: (CaseTarget z) => z -> ByteCount -> ByteCount -> ByteCount -> [ByteCount] -> IO ([ByteCount], (ByteCount, z))+takeDiff z pos had diff = go 0+ where+  go !acc = \case+    y : ys | acc < diff -> go (acc + y) ys+    ys -> do+      zz <- sliceBuffer z pos (had + acc)+      pure (ys, (acc, zz))++assertEq :: (Eq a, Show a) => a -> a -> Property ()+assertEq x y = FP.assert (FC.eq FC..$ ("LHS", x) FC..$ ("RHS", y))++hackLiftIO :: IO a -> Property a+hackLiftIO = pure . unsafePerformIO++testGetInc :: (BinaryPutTarget z IO, CaseTarget z) => String -> Proxy z -> TestTree+testGetInc n p = testProperty ("get inc (" ++ n ++ ")") $ do+  -- Generate some random elements+  numElems <- FP.gen @Int (FG.inRange (FR.between (0, 20)))+  xs <- FP.gen (replicateM numElems wordXGen)+  -- First some sanity checks that encode/decode work+  assertEq (length xs) numElems+  wholeBuf <- hackLiftIO (encode xs)+  (exs, totLen) <- hackLiftIO (decodeEnd (wholeBuf `asProxyTypeOf` p))+  case exs of+    Left err -> fail (show err)+    Right xs' -> do+      assertEq xs' xs+      assertEq totLen (byteSize xs)+  wholeBuf' <- hackLiftIO (sliceBuffer wholeBuf 0 totLen)+  assertEq wholeBuf' wholeBuf+  -- Shuffle list to come up with splits and test incremental+  ys <- FP.gen (FG.shuffle (8 : fmap byteSize xs))+  ysRef <- hackLiftIO (newIORef ys)+  sentRef <- hackLiftIO (newIORef 0)+  let cb (GetIncRequest pos _ len) = do+        sent <- readIORef sentRef+        let had = sent - pos+        let diff = len - had+        ys' <- readIORef ysRef+        (ys'', (bufLen, buf)) <- takeDiff wholeBuf pos had diff ys'+        writeIORef ysRef ys''+        modifyIORef' sentRef (+ bufLen)+        pure $+          if bufLen == 0+            then Nothing+            else Just (buf `asProxyTypeOf` p)+  (ezs, totLen', _) <- hackLiftIO (decodeInc (Just totLen) cb)+  case ezs of+    Left err -> fail (show err)+    Right zs -> do+      assertEq zs xs+      assertEq totLen' totLen++testMutPut :: (MutBinaryPutTarget z IO, MutCaseTarget z) => String -> Proxy z -> TestTree testMutPut n p = testGroup ("mut put (" ++ n ++ ")") (fmap (mutRunPutCase p) putCases) -testMutPutOffset :: MutCaseTarget u => String -> Proxy u -> TestTree+testMutPutOffset :: (MutBinaryPutTarget z IO, MutCaseTarget z) => String -> Proxy z -> TestTree testMutPutOffset n p = testCase ("mut put offset (" ++ n ++ ")") $ do   u <- newSink 4   c1 <- mutPutTargetOffset 0 (putWord8 0x12) u@@ -446,11 +606,20 @@   c2 <- mutPutTargetOffset 1 (putWord16LE 0x5634) u   c2 @?= 3   x <- freezeSink (u `asProxyTypeOf` p)-  x @?= [0x12, 0x34, 0x56, 0]-  pure ()+  take 3 x @?= [0x12, 0x34, 0x56]+  -- Use this opportunity to test getting+  (w, h) <- getTarget (liftA2 (,) (get @Word8) (get @Word16LE)) u+  w @?= Right (0x12, 0x5634)+  h @?= 3+  (y, i) <- getTargetOffset 0 (get @Word8) u+  y @?= Right 0x12+  i @?= 1+  (z, j) <- getTargetOffset 1 (get @Word16LE) u+  z @?= Right 0x5634+  j @?= 3  data TargetDef where-  TargetDef :: CaseTarget z => String -> Proxy z -> TargetDef+  TargetDef :: (BinaryPutTarget z IO, CaseTarget z) => String -> Proxy z -> TargetDef  targets :: [TargetDef] targets =@@ -460,12 +629,12 @@   ]  data MutTargetDef where-  MutTargetDef :: MutCaseTarget u => String -> Proxy u -> MutTargetDef+  MutTargetDef :: (MutBinaryPutTarget z IO, MutCaseTarget z) => String -> Proxy z -> MutTargetDef  mutTargets :: [MutTargetDef] mutTargets =-  [ MutTargetDef "MutableByteArray" (Proxy :: Proxy (MutableByteArray (PrimState IO)))-  , MutTargetDef "MVector" (Proxy :: Proxy (MVector (PrimState IO) Word8))+  [ MutTargetDef "MutableByteArray" (Proxy :: Proxy (MutableByteArray RealWorld))+  , MutTargetDef "IOVector" (Proxy :: Proxy (IOVector Word8))   ]  testDahdit :: TestTree@@ -476,8 +645,9 @@   targetTrees =     targets >>= \(TargetDef name prox) ->       [ testGet name prox-      , testPut name prox       , testGetOffset name prox+      , testGetInc name prox+      , testPut name prox       ]   mutTargetTrees =     mutTargets >>= \(MutTargetDef name prox) ->