packages feed

dahdit 0.1.2 → 0.1.3

raw patch · 17 files changed

+677/−291 lines, 17 filesdep ~bytestringsetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bytestring

API changes (from Hackage documentation)

+ Dahdit.Codec: ViaBinary :: a -> ViaBinary a
+ Dahdit.Codec: ViaCodec :: a -> ViaCodec a
+ Dahdit.Codec: [unViaBinary] :: ViaBinary a -> a
+ Dahdit.Codec: [unViaCodec] :: ViaCodec a -> a
+ Dahdit.Codec: binary :: Binary a => Codec a
+ Dahdit.Codec: bindPair :: Codec a -> (a -> Codec b) -> Codec (a, b)
+ Dahdit.Codec: bindTag :: (b -> a) -> Codec a -> (a -> Codec b) -> Codec b
+ Dahdit.Codec: build :: Get a -> (a -> Put) -> Codec a
+ Dahdit.Codec: class HasCodec a
+ Dahdit.Codec: codec :: HasCodec a => Codec a
+ Dahdit.Codec: instance (Dahdit.Sizes.ByteSized a, Dahdit.Codec.HasCodec a) => Dahdit.Binary.Binary (Dahdit.Codec.ViaCodec a)
+ Dahdit.Codec: instance (GHC.TypeNats.KnownNat n, Dahdit.Binary.Binary a, Dahdit.Sizes.StaticByteSized a, Data.Default.Class.Default a) => Dahdit.Codec.HasCodec (Dahdit.Fancy.StaticSeq n a)
+ Dahdit.Codec: instance (GHC.TypeNats.KnownNat n, Data.Primitive.Types.Prim a, Dahdit.Sizes.StaticByteSized a, Data.Default.Class.Default a) => Dahdit.Codec.HasCodec (Dahdit.Fancy.StaticArray n a)
+ Dahdit.Codec: instance Dahdit.Binary.Binary a => Dahdit.Codec.HasCodec (Dahdit.Codec.ViaBinary a)
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Fancy.BoolByte
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Fancy.TermBytes
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.FloatBE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.FloatLE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.Int16BE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.Int16LE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.Int24BE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.Int24LE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.Int32BE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.Int32LE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.Word16BE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.Word16LE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.Word24BE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.Word24LE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.Word32BE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec Dahdit.Nums.Word32LE
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec GHC.Int.Int8
+ Dahdit.Codec: instance Dahdit.Codec.HasCodec GHC.Word.Word8
+ Dahdit.Codec: instance Dahdit.Sizes.ByteSized a => Dahdit.Sizes.ByteSized (Dahdit.Codec.ViaCodec a)
+ Dahdit.Codec: instance GHC.Base.Applicative (Dahdit.Codec.Codec' x)
+ Dahdit.Codec: instance GHC.Base.Functor (Dahdit.Codec.Codec' x)
+ Dahdit.Codec: instance GHC.TypeLits.KnownSymbol s => Dahdit.Codec.HasCodec (Dahdit.Fancy.ExactBytes s)
+ Dahdit.Codec: newtype ViaBinary a
+ Dahdit.Codec: newtype ViaCodec a
+ Dahdit.Codec: parse :: Codec a -> Get a
+ Dahdit.Codec: produce :: Codec a -> a -> Put
+ Dahdit.Codec: type Codec a = Codec' a a

Files

− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
dahdit.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           dahdit-version:        0.1.2+version:        0.1.3 synopsis:       Binary parsing and serialization with integrated size description:    Please see the README on GitHub at <https://github.com/ejconlon/dahdit#readme> category:       Data@@ -17,6 +17,8 @@ license:        BSD3 license-file:   LICENSE build-type:     Simple+tested-with:+    GHC == 9.2.7 extra-source-files:     README.md @@ -29,6 +31,7 @@       Dahdit       Dahdit.Binary       Dahdit.BinaryRep+      Dahdit.Codec       Dahdit.Fancy       Dahdit.Free       Dahdit.Funs@@ -71,7 +74,7 @@   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds -fwrite-ide-info -hiedir=.hie   build-depends:       base >=4.12 && <5-    , bytestring >=0.10 && <0.12+    , bytestring ==0.11.*     , containers ==0.6.*     , data-default ==0.7.*     , data-sword ==0.2.*@@ -116,7 +119,7 @@   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds -fwrite-ide-info -hiedir=.hie -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.12 && <5-    , bytestring >=0.10 && <0.12+    , bytestring ==0.11.*     , containers ==0.6.*     , dahdit     , data-default ==0.7.*
src/Dahdit.hs view
@@ -20,7 +20,8 @@   , module Dahdit.Proxy   , module Dahdit.Run   , module Dahdit.Sizes-   ) where+  )+where  import Dahdit.Binary import Dahdit.BinaryRep
src/Dahdit/Binary.hs view
@@ -1,15 +1,60 @@ module Dahdit.Binary   ( Binary (..)   , byteSizeViaPut-  ) where+  )+where  import Dahdit.Free (Get, Put)-import Dahdit.Funs (getFloatBE, getFloatLE, getInt16BE, getInt16LE, getInt24BE, getInt24LE, getInt32BE, getInt32LE,-                    getInt8, getWord16BE, getWord16LE, getWord24BE, getWord24LE, getWord32BE, getWord32LE, getWord8,-                    putFloatBE, putFloatLE, putInt16BE, putInt16LE, putInt24BE, putInt24LE, putInt32BE, putInt32LE,-                    putInt8, putWord16BE, putWord16LE, putWord24BE, putWord24LE, putWord32BE, putWord32LE, putWord8)-import Dahdit.Nums (FloatBE (..), FloatLE, Int16BE (..), Int16LE, Int24BE (..), Int24LE, Int32BE (..), Int32LE,-                    Word16BE (..), Word16LE, Word24BE (..), Word24LE, Word32BE (..), Word32LE)+import Dahdit.Funs+  ( getFloatBE+  , getFloatLE+  , getInt16BE+  , getInt16LE+  , getInt24BE+  , getInt24LE+  , getInt32BE+  , getInt32LE+  , getInt8+  , getWord16BE+  , getWord16LE+  , getWord24BE+  , getWord24LE+  , getWord32BE+  , getWord32LE+  , getWord8+  , putFloatBE+  , putFloatLE+  , putInt16BE+  , putInt16LE+  , putInt24BE+  , putInt24LE+  , putInt32BE+  , putInt32LE+  , putInt8+  , putWord16BE+  , putWord16LE+  , putWord24BE+  , putWord24LE+  , putWord32BE+  , putWord32LE+  , putWord8+  )+import Dahdit.Nums+  ( FloatBE (..)+  , FloatLE+  , Int16BE (..)+  , Int16LE+  , Int24BE (..)+  , Int24LE+  , Int32BE (..)+  , Int32LE+  , Word16BE (..)+  , Word16LE+  , Word24BE (..)+  , Word24LE+  , Word32BE (..)+  , Word32LE+  ) import Dahdit.Run (runCount) import Dahdit.Sizes (ByteCount, ByteSized) import Data.Int (Int8)
src/Dahdit/BinaryRep.hs view
@@ -4,7 +4,8 @@   ( BinaryRep (..)   , ViaBoundedEnum (..)   , ViaBinaryRep (..)-  ) where+  )+where  import Dahdit.Binary (Binary (..)) import Dahdit.Sizes (ByteSized (..), StaticByteSized (..))@@ -14,17 +15,17 @@   fromBinaryRep :: x -> Either String a   toBinaryRep :: a -> x -newtype ViaBoundedEnum x a = ViaBoundedEnum { unViaBoundedEnum :: a }+newtype ViaBoundedEnum x a = ViaBoundedEnum {unViaBoundedEnum :: a}  instance (Binary x, Integral x, Bounded a, Enum a) => BinaryRep x (ViaBoundedEnum x a) where   fromBinaryRep x =     let i = fromIntegral x-    in if i < fromEnum (minBound :: a) || i > fromEnum (maxBound :: a)-      then Left ("Invalid enum value: " ++ show i)-      else Right (ViaBoundedEnum (toEnum i))+    in  if i < fromEnum (minBound :: a) || i > fromEnum (maxBound :: a)+          then Left ("Invalid enum value: " ++ show i)+          else Right (ViaBoundedEnum (toEnum i))   toBinaryRep = fromIntegral . fromEnum . unViaBoundedEnum -newtype ViaBinaryRep a = ViaBinaryRep { unViaBinaryRep :: a }+newtype ViaBinaryRep a = ViaBinaryRep {unViaBinaryRep :: a}  instance BinaryRep x a => ByteSized (ViaBinaryRep a) where   byteSize = byteSize . toBinaryRep . unViaBinaryRep
+ src/Dahdit/Codec.hs view
@@ -0,0 +1,130 @@+-- 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.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.Primitive (Prim)+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, Prim a, StaticByteSized 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 (ByteSized a, HasCodec a) => Binary (ViaCodec a) where+  get = coerce (parse (codec @a))+  put = coerce (produce (codec @a))
src/Dahdit/Fancy.hs view
@@ -7,16 +7,26 @@   , StaticArray (..)   , BoolByte (..)   , ExactBytes (..)-  ) where+  )+where  import Control.Monad (unless) import Dahdit.Binary (Binary (..)) import Dahdit.Free (Get)-import Dahdit.Funs (getByteString, getExpect, getStaticArray, getStaticSeq, getWord8, putByteString, putFixedString,-                    putWord8, unsafePutStaticArrayN, unsafePutStaticSeqN)+import Dahdit.Funs+  ( getByteString+  , getExpect+  , getStaticArray+  , getStaticSeq+  , getWord8+  , putByteString+  , putFixedString+  , putWord8+  , unsafePutStaticArrayN+  , unsafePutStaticSeqN+  ) import Dahdit.Proxy (proxyForNatF) import Dahdit.Sizes (ByteSized (..), StaticByteSized (..), ViaStaticByteSized (..))-import qualified Data.ByteString as BS import Data.ByteString.Internal (c2w) import qualified Data.ByteString.Short as BSS import Data.ByteString.Short.Internal (ShortByteString (..))@@ -32,14 +42,15 @@ import GHC.TypeLits (KnownNat, KnownSymbol, Nat, Symbol, natVal, symbolVal)  getUntilNull :: Get (Int, [Word8])-getUntilNull = go 0 [] where+getUntilNull = go 0 []+ where   go !i !racc = do     w <- getWord8     if w == 0       then         let !acc = reverse racc-        in pure (i, acc)-      else go (i + 1) (w:racc)+        in  pure (i, acc)+      else go (i + 1) (w : racc)  mkSBS :: Int -> [Word8] -> ShortByteString mkSBS n bs = let !(ByteArray ba) = byteArrayFromListN n bs in SBS ba@@ -47,7 +58,7 @@ -- | 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 TermBytes = TermBytes {unTermBytes :: ShortByteString}   deriving stock (Show)   deriving newtype (Eq, Ord, IsString) @@ -57,7 +68,7 @@ instance ByteSized TermBytes where   byteSize (TermBytes sbs) =     let !bc = byteSize sbs + 1-    in if even bc then bc else bc + 1+    in  if even bc then bc else bc + 1  instance Binary TermBytes where   get = do@@ -74,24 +85,23 @@     unless (odd (BSS.length sbs)) (putWord8 0)  -- | A fixed-length bytestring (truncated or zero-padded on put if length does not match).-newtype StaticBytes (n :: Nat) = StaticBytes { unStaticBytes :: ShortByteString }+newtype StaticBytes (n :: Nat) = StaticBytes {unStaticBytes :: ShortByteString}   deriving stock (Show)   deriving newtype (IsString)   deriving (ByteSized) via (ViaStaticByteSized (StaticBytes n))  mkStaticBytes :: KnownNat n => Proxy n -> ShortByteString -> StaticBytes n mkStaticBytes prox sbs =-  -- TODO replace with the Short versions when the lib is updated to 0.11   let n = fromInteger (natVal prox)-  in if BSS.length sbs == n-    then StaticBytes sbs-    else-      let bs = BSS.fromShort sbs-          x1 = BS.take n bs-          l = BS.length x1-      in StaticBytes $ BSS.toShort $ if l == n-        then x1-        else x1 <> BS.replicate (n - l) 0+  in  if BSS.length sbs == n+        then StaticBytes sbs+        else+          let x1 = BSS.take n sbs+              l = BSS.length x1+          in  StaticBytes $+                if l == n+                  then x1+                  else x1 <> BSS.replicate (n - l) 0  normStaticBytes :: KnownNat n => StaticBytes n -> StaticBytes n normStaticBytes sb@(StaticBytes sbs) = mkStaticBytes (proxyForNatF sb) sbs@@ -100,13 +110,13 @@   x == y =     let StaticBytes x' = normStaticBytes x         StaticBytes y' = normStaticBytes y-    in x' == y'+    in  x' == y'  instance KnownNat n => Ord (StaticBytes n) where   compare x y =     let StaticBytes x' = normStaticBytes x         StaticBytes y' = normStaticBytes y-    in compare x' y'+    in  compare x' y'  instance Default (StaticBytes n) where   def = StaticBytes BSS.empty@@ -118,7 +128,7 @@   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 }+newtype StaticSeq (n :: Nat) a = StaticSeq {unStaticSeq :: Seq a}   deriving stock (Show)   deriving newtype (Eq, Functor, Foldable)   deriving (ByteSized) via (ViaStaticByteSized (StaticSeq n a))@@ -133,7 +143,7 @@   get = fmap StaticSeq (getStaticSeq (fromIntegral (natVal (Proxy :: Proxy n))) get)   put = unsafePutStaticSeqN (fromIntegral (natVal (Proxy :: Proxy n))) (Just def) put . unStaticSeq -newtype StaticArray (n :: Nat) a = StaticArray { unStaticArray :: PrimArray a }+newtype StaticArray (n :: Nat) a = StaticArray {unStaticArray :: PrimArray a}   deriving stock (Show)   deriving newtype (Eq)   deriving (ByteSized) via (ViaStaticByteSized (StaticArray n a))@@ -148,7 +158,7 @@   get = fmap StaticArray (getStaticArray (fromIntegral (natVal (Proxy :: Proxy n))))   put = unsafePutStaticArrayN (fromIntegral (natVal (Proxy :: Proxy n))) (Just def) . unStaticArray -newtype BoolByte = BoolByte { unBoolByte :: Bool }+newtype BoolByte = BoolByte {unBoolByte :: Bool}   deriving stock (Show)   deriving newtype (Eq)   deriving (ByteSized) via (ViaStaticByteSized BoolByte)@@ -163,7 +173,7 @@   get = fmap (BoolByte . (/= 0)) getWord8   put (BoolByte b) = putWord8 (if b then 1 else 0) -newtype ExactBytes (s :: Symbol) = ExactBytes { unExactBytes :: () }+newtype ExactBytes (s :: Symbol) = ExactBytes {unExactBytes :: ()}   deriving stock (Show)   deriving newtype (Eq)   deriving (ByteSized) via (ViaStaticByteSized (ExactBytes s))
src/Dahdit/Free.hs view
@@ -12,11 +12,26 @@   , PutF (..)   , PutM (..)   , Put-  ) where+  )+where  import Control.Monad.Free.Church (F (..))-import Dahdit.Nums (FloatBE, FloatLE, Int16BE, Int16LE, Int24BE, Int24LE, Int32BE, Int32LE, Word16BE, Word16LE,-                    Word24BE, Word24LE, Word32BE, Word32LE)+import Dahdit.Nums+  ( FloatBE+  , FloatLE+  , Int16BE+  , Int16LE+  , Int24BE+  , Int24LE+  , Int32BE+  , Int32LE+  , Word16BE+  , Word16LE+  , Word24BE+  , Word24LE+  , Word32BE+  , Word32LE+  ) import Dahdit.Sizes (ByteCount, ElementCount, StaticByteSized (..)) import Data.ByteString.Short (ShortByteString) import Data.Int (Int8)@@ -50,13 +65,13 @@ instance Functor GetScopeF where   fmap f (GetScopeF sm bc g k) = GetScopeF sm bc g (f . k) -data ScopeMode =-    ScopeModeExact+data ScopeMode+  = ScopeModeExact   | ScopeModeWithin   deriving stock (Eq, Show) -data GetF a =-    GetFWord8 (Word8 -> a)+data GetF a+  = GetFWord8 (Word8 -> a)   | GetFInt8 (Int8 -> a)   | GetFWord16LE (Word16LE -> a)   | GetFInt16LE (Int16LE -> a)@@ -83,7 +98,7 @@   | GetFFail !String   deriving stock (Functor) -newtype Get a = Get { unGet :: F GetF a }+newtype Get a = Get {unGet :: F GetF a}   deriving newtype (Functor, Applicative, Monad)  instance MonadFail Get where@@ -107,8 +122,8 @@ instance Functor PutStaticHintF where   fmap f (PutStaticHintF n p k) = PutStaticHintF n p (f k) -data PutF a =-    PutFWord8 !Word8 a+data PutF a+  = PutFWord8 !Word8 a   | PutFInt8 !Int8 a   | PutFWord16LE !Word16LE a   | PutFInt16LE !Int16LE a@@ -131,7 +146,7 @@   | PutFStaticHint !(PutStaticHintF a)   deriving stock (Functor) -newtype PutM a = PutM { unPutM :: F PutF a }+newtype PutM a = PutM {unPutM :: F PutF a}   deriving newtype (Functor, Applicative, Monad)  instance Semigroup (PutM ()) where
src/Dahdit/Funs.hs view
@@ -60,16 +60,43 @@   , putByteArray   , putLiftedPrimArray   , putStaticHint-  ) where+  )+where  import Control.Monad (replicateM_, unless) import Control.Monad.Free.Church (F (..))-import Dahdit.Free (Get (..), GetF (..), GetLookAheadF (..), GetScopeF (..), GetStaticArrayF (..), GetStaticSeqF (..),-                    Put, PutF (..), PutM (..), PutStaticArrayF (..), PutStaticHintF (..), PutStaticSeqF (..),-                    ScopeMode (..))+import Dahdit.Free+  ( Get (..)+  , GetF (..)+  , GetLookAheadF (..)+  , GetScopeF (..)+  , GetStaticArrayF (..)+  , GetStaticSeqF (..)+  , Put+  , PutF (..)+  , PutM (..)+  , PutStaticArrayF (..)+  , PutStaticHintF (..)+  , PutStaticSeqF (..)+  , ScopeMode (..)+  ) import Dahdit.LiftedPrim (LiftedPrim (..), LiftedPrimArray (..))-import Dahdit.Nums (FloatBE, FloatLE, Int16BE, Int16LE, Int24BE, Int24LE, Int32BE, Int32LE, Word16BE, Word16LE,-                    Word24BE, Word24LE, Word32BE, Word32LE)+import Dahdit.Nums+  ( FloatBE+  , FloatLE+  , Int16BE+  , Int16LE+  , Int24BE+  , Int24LE+  , Int32BE+  , Int32LE+  , Word16BE+  , Word16LE+  , Word24BE+  , Word24LE+  , Word32BE+  , Word32LE+  ) import Dahdit.Proxy (proxyForF, proxyForFun) import Dahdit.Sizes (ByteCount (..), ElementCount (..), StaticByteSized (..)) import Data.ByteString.Short (ShortByteString)@@ -146,7 +173,8 @@  -- | Get Seq of dynamically-sized elements getSeq :: ElementCount -> Get a -> Get (Seq a)-getSeq ec g = go Empty 0 where+getSeq ec g = go Empty 0+ where   go !acc i =     if i == ec       then pure acc@@ -168,7 +196,7 @@ getLiftedPrimArray :: LiftedPrim a => Proxy a -> ElementCount -> Get (LiftedPrimArray a) getLiftedPrimArray prox ec =   let !bc = fromIntegral (elemSizeLifted prox * fromIntegral ec)-  in fmap LiftedPrimArray (getByteArray bc)+  in  fmap LiftedPrimArray (getByteArray bc)  getLookAhead :: Get a -> Get a getLookAhead g = Get (F (\x y -> y (GetFLookAhead (GetLookAheadF g x))))@@ -180,7 +208,8 @@ getRemainingString = getRemainingSize >>= getByteString  getRemainingSeq :: Get a -> Get (Seq a)-getRemainingSeq g = go Empty where+getRemainingSeq g = go Empty+ where   go !acc = do     bc <- getRemainingSize     if bc == 0@@ -228,11 +257,13 @@ getExpect :: (Eq a, Show a) => String -> Get a -> a -> Get () getExpect typ getter expec = do   actual <- getter-  unless (expec == actual)-    (fail ("Expected " ++ " " ++ typ ++  " " ++ show expec ++ " but found " ++ show actual))+  unless+    (expec == actual)+    (fail ("Expected " ++ " " ++ typ ++ " " ++ show expec ++ " but found " ++ show actual))  getUnfold :: b -> (b -> Get (Either b a)) -> Get a-getUnfold b0 f = go b0 where+getUnfold b0 f = go b0+ where   go !b = do     eba <- f b     either go pure eba@@ -288,7 +319,7 @@ putByteString :: ShortByteString -> Put putByteString sbs =   let !bc = fromIntegral (BSS.length sbs)-  in PutM (F (\x y -> y (PutFShortByteString bc sbs (x ()))))+  in  PutM (F (\x y -> y (PutFShortByteString bc sbs (x ()))))  putFixedString :: Word8 -> ByteCount -> ShortByteString -> Put putFixedString pad bc sbs = do@@ -309,7 +340,7 @@ putStaticSeq :: StaticByteSized a => (a -> Put) -> Seq a -> Put putStaticSeq p s =   let !n = fromIntegral (Seq.length s)-  in unsafePutStaticSeqN n Nothing p s+  in  unsafePutStaticSeqN n Nothing p s  unsafePutStaticSeqN :: StaticByteSized a => ElementCount -> Maybe a -> (a -> Put) -> Seq a -> Put unsafePutStaticSeqN n mz p s = PutM (F (\x y -> y (PutFStaticSeq (PutStaticSeqF n mz p s (x ())))))@@ -318,7 +349,7 @@ putStaticArray :: (StaticByteSized a, Prim a) => PrimArray a -> Put putStaticArray a =   let !n = fromIntegral (sizeofPrimArray a)-  in unsafePutStaticArrayN n Nothing a+  in  unsafePutStaticArrayN n Nothing a  unsafePutStaticArrayN :: (StaticByteSized a, Prim a) => ElementCount -> Maybe a -> PrimArray a -> Put unsafePutStaticArrayN n mz a = PutM (F (\x y -> y (PutFStaticArray (PutStaticArrayF n mz a (x ())))))@@ -326,7 +357,7 @@ putByteArray :: ByteArray -> Put putByteArray arr =   let !bc = fromIntegral (sizeofByteArray arr)-  in PutM (F (\x y -> y (PutFByteArray bc arr (x ()))))+  in  PutM (F (\x y -> y (PutFByteArray bc arr (x ()))))  putLiftedPrimArray :: LiftedPrimArray a -> Put putLiftedPrimArray = putByteArray . unLiftedPrimArray@@ -334,4 +365,4 @@ putStaticHint :: StaticByteSized a => (a -> Put) -> a -> Put putStaticHint p =   let !bc = staticByteSize (proxyForFun p)-  in \a -> PutM (F (\x y -> y (PutFStaticHint (PutStaticHintF bc (p a) (x ())))))+  in  \a -> PutM (F (\x y -> y (PutFStaticHint (PutStaticHintF bc (p a) (x ())))))
src/Dahdit/Generic.hs view
@@ -3,7 +3,8 @@ module Dahdit.Generic   ( ViaGeneric (..)   , ViaStaticGeneric (..)-  ) where+  )+where  import Control.Applicative (liftA2) import Dahdit.Binary (Binary (..))@@ -12,13 +13,13 @@ import Dahdit.Sizes (ByteCount, ByteSized (..), StaticByteSized (..)) import Data.Kind (Type) import Data.Proxy (Proxy (..))-import GHC.Generics ((:*:) (..), Generic (..), K1 (..), M1 (..), U1 (..))+import GHC.Generics (Generic (..), K1 (..), M1 (..), U1 (..), (:*:) (..))  -- | Use: deriving (ByteSized, Binary) via (ViaGeneric Foo)-newtype ViaGeneric a = ViaGeneric { unViaGeneric :: a }+newtype ViaGeneric a = ViaGeneric {unViaGeneric :: a}  -- | Use: deriving (ByteSized, StaticByteSized, Binary) via (ViaStaticGeneric Foo)-newtype ViaStaticGeneric a = ViaStaticGeneric { unViaStaticGeneric :: a }+newtype ViaStaticGeneric a = ViaStaticGeneric {unViaStaticGeneric :: a}  -- ByteSized: 
src/Dahdit/Internal.hs view
@@ -6,7 +6,7 @@ import Data.Word (Word16, Word32, Word8) import GHC.Float (castFloatToWord32, castWord32ToFloat) -newtype ViaFromIntegral x y = ViaFromIntegral { unViaFromIntegral :: y }+newtype ViaFromIntegral x y = ViaFromIntegral {unViaFromIntegral :: y}   deriving newtype (Num)  -- Types that can swap endianness - swapEndian is its own inverse@@ -25,28 +25,28 @@ instance SwapEndian Word16 where   swapEndian w =     let (b0, b1) = unMkWord16LE w-    in mkWord16LE b1 b0+    in  mkWord16LE b1 b0  deriving via (ViaFromIntegral Word16 Int16) instance SwapEndian Int16  instance SwapEndian Word24 where   swapEndian w =     let (b0, b1, b2) = unMkWord24LE w-    in mkWord24LE b2 b1 b0+    in  mkWord24LE b2 b1 b0  deriving via (ViaFromIntegral Word24 Int24) instance SwapEndian Int24  instance SwapEndian Word32 where   swapEndian w =     let (b0, b1, b2, b3) = unMkWord32LE w-    in mkWord32LE b3 b2 b1 b0+    in  mkWord32LE b3 b2 b1 b0  deriving via (ViaFromIntegral Word32 Int32) instance SwapEndian Int32  instance SwapEndian Float where   swapEndian w =     let (b0, b1, b2, b3) = unMkFloatLE w-    in mkFloatLE b3 b2 b1 b0+    in  mkFloatLE b3 b2 b1 b0  mkWord16LE :: Word8 -> Word8 -> Word16 mkWord16LE b0 b1 = (fromIntegral b1 `unsafeShiftL` 8) .|. fromIntegral b0@@ -55,7 +55,7 @@ unMkWord16LE w =   let !b0 = fromIntegral w       !b1 = fromIntegral (w `shiftR` 8)-  in (b0, b1)+  in  (b0, b1)  mkWord24LE :: Word8 -> Word8 -> Word8 -> Word24 mkWord24LE b0 b1 b2 = fromIntegral (mkWord32LE b0 b1 b2 0)@@ -64,12 +64,14 @@ unMkWord24LE w =   let !v = fromIntegral w       (b0, b1, b2, _) = unMkWord32LE v-  in (b0, b1, b2)+  in  (b0, b1, b2)  mkWord32LE :: Word8 -> Word8 -> Word8 -> Word8 -> Word32 mkWord32LE b0 b1 b2 b3 =-  (fromIntegral b3 `unsafeShiftL` 24) .|. (fromIntegral b2 `unsafeShiftL` 16) .|.-    (fromIntegral b1 `unsafeShiftL` 8) .|. fromIntegral b0+  (fromIntegral b3 `unsafeShiftL` 24)+    .|. (fromIntegral b2 `unsafeShiftL` 16)+    .|. (fromIntegral b1 `unsafeShiftL` 8)+    .|. fromIntegral b0  unMkWord32LE :: Word32 -> (Word8, Word8, Word8, Word8) unMkWord32LE w =@@ -77,7 +79,7 @@       !b1 = fromIntegral (w `shiftR` 8)       !b2 = fromIntegral (w `shiftR` 16)       !b3 = fromIntegral (w `shiftR` 24)-  in (b0, b1, b2, b3)+  in  (b0, b1, b2, b3)  mkFloatLE :: Word8 -> Word8 -> Word8 -> Word8 -> Float mkFloatLE b0 b1 b2 b3 = castWord32ToFloat (mkWord32LE b0 b1 b2 b3)
src/Dahdit/LiftedPrim.hs view
@@ -14,7 +14,8 @@   , generateLiftedPrimArray   , sizeofLiftedPrimArray   , cloneLiftedPrimArray-  ) where+  )+where  import Control.Monad.Primitive (PrimMonad (..)) import Dahdit.Internal (ViaFromIntegral (..))@@ -22,9 +23,21 @@ import Data.Default (Default (..)) import Data.Foldable (for_) import Data.Int (Int8)-import Data.Primitive.ByteArray (ByteArray, MutableByteArray, cloneByteArray, emptyByteArray, freezeByteArray,-                                 indexByteArray, newByteArray, runByteArray, sizeofByteArray, thawByteArray,-                                 unsafeFreezeByteArray, unsafeThawByteArray, writeByteArray)+import Data.Primitive.ByteArray+  ( ByteArray+  , MutableByteArray+  , cloneByteArray+  , emptyByteArray+  , freezeByteArray+  , indexByteArray+  , newByteArray+  , runByteArray+  , sizeofByteArray+  , thawByteArray+  , unsafeFreezeByteArray+  , unsafeThawByteArray+  , writeByteArray+  ) import Data.Proxy (Proxy (..)) import Data.STRef (modifySTRef', newSTRef, readSTRef) import Data.Word (Word8)@@ -37,12 +50,12 @@   indexByteArrayLiftedInElems :: ByteArray -> Int -> a   indexByteArrayLiftedInElems arr pos =     let !sz = elemSizeLifted (Proxy :: Proxy a)-    in indexByteArrayLiftedInBytes arr (pos * sz)+    in  indexByteArrayLiftedInBytes arr (pos * sz)   writeByteArrayLiftedInBytes :: PrimMonad m => a -> MutableByteArray (PrimState m) -> Int -> m ()   writeByteArrayLiftedInElems :: PrimMonad m => a -> MutableByteArray (PrimState m) -> Int -> m ()   writeByteArrayLiftedInElems val arr pos =     let !sz = elemSizeLifted (Proxy :: Proxy a)-    in writeByteArrayLiftedInBytes val arr (pos * sz)+    in  writeByteArrayLiftedInBytes val arr (pos * sz)  instance LiftedPrim Word8 where   elemSizeLifted _ = 1@@ -62,14 +75,14 @@   indexByteArrayLiftedInBytes arr pos = ViaFromIntegral (fromIntegral (indexByteArrayLiftedInBytes arr pos :: x))   writeByteArrayLiftedInBytes val arr pos = let !x = fromIntegral (unViaFromIntegral val) :: x in writeByteArrayLiftedInBytes x arr pos -newtype LiftedPrimArray a = LiftedPrimArray { unLiftedPrimArray :: ByteArray }+newtype LiftedPrimArray a = LiftedPrimArray {unLiftedPrimArray :: ByteArray}   deriving stock (Show)   deriving newtype (Eq, Semigroup, Monoid)  instance Default (LiftedPrimArray a) where   def = emptyLiftedPrimArray -newtype MutableLiftedPrimArray m a = MutableLiftedPrimArray { unMutableLiftedPrimArray :: MutableByteArray m }+newtype MutableLiftedPrimArray m a = MutableLiftedPrimArray {unMutableLiftedPrimArray :: MutableByteArray m}   deriving newtype (Eq)  emptyLiftedPrimArray :: LiftedPrimArray a@@ -102,7 +115,7 @@   for_ xs $ \x -> do     off <- readSTRef offRef     writeByteArrayLiftedInBytes x arr off-    modifySTRef' offRef (elemSize+)+    modifySTRef' offRef (elemSize +)   pure arr  liftedPrimArrayFromList :: LiftedPrim a => [a] -> LiftedPrimArray a@@ -115,7 +128,7 @@ sizeofLiftedPrimArray pa@(LiftedPrimArray arr) =   let !elemSize = elemSizeLifted (proxyForF pa)       !arrSize = sizeofByteArray arr-  in div arrSize elemSize+  in  div arrSize elemSize  cloneLiftedPrimArray :: LiftedPrim a => LiftedPrimArray a -> Int -> Int -> LiftedPrimArray a cloneLiftedPrimArray pa@(LiftedPrimArray arr) off len =@@ -123,4 +136,4 @@       !byteOff = off * elemSize       !byteLen = len * elemSize       !arr' = cloneByteArray arr byteOff byteLen-  in LiftedPrimArray arr'+  in  LiftedPrimArray arr'
src/Dahdit/Nums.hs view
@@ -19,10 +19,21 @@   , Word32BE (..)   , Int32BE (..)   , FloatBE (..)-  ) where+  )+where -import Dahdit.Internal (ViaFromIntegral (..), mkFloatLE, mkWord16LE, mkWord24LE, mkWord32LE, swapEndian, unMkFloatLE,-                        unMkWord16LE, unMkWord24LE, unMkWord32LE)+import Dahdit.Internal+  ( ViaFromIntegral (..)+  , mkFloatLE+  , mkWord16LE+  , mkWord24LE+  , mkWord32LE+  , swapEndian+  , unMkFloatLE+  , unMkWord16LE+  , unMkWord24LE+  , unMkWord32LE+  ) import Dahdit.LiftedPrim (LiftedPrim (..)) import Data.Bits (Bits (..)) import Data.Default (Default (..))@@ -37,7 +48,7 @@   toLittleEndian :: be -> le   toBigEndian :: le -> be -newtype Word16LE = Word16LE { unWord16LE :: Word16 }+newtype Word16LE = Word16LE {unWord16LE :: Word16}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits, Default, Prim) @@ -47,18 +58,18 @@   indexByteArrayLiftedInBytes arr pos =     let !b0 = indexByteArray arr pos         !b1 = indexByteArray arr (pos + 1)-    in Word16LE (mkWord16LE b0 b1)+    in  Word16LE (mkWord16LE b0 b1)    writeByteArrayLiftedInBytes w arr pos =     let !(b0, b1) = unMkWord16LE (unWord16LE w)-    in writeByteArray arr pos b0 *> writeByteArray arr (pos + 1) b1+    in  writeByteArray arr pos b0 *> writeByteArray arr (pos + 1) b1 -newtype Int16LE = Int16LE { unInt16LE :: Int16 }+newtype Int16LE = Int16LE {unInt16LE :: Int16}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits, Default, Prim)   deriving (LiftedPrim) via (ViaFromIntegral Word16LE Int16LE) -newtype Word24LE = Word24LE { unWord24LE :: Word24 }+newtype Word24LE = Word24LE {unWord24LE :: Word24}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits) @@ -72,7 +83,7 @@     let !b0 = indexByteArray arr pos         !b1 = indexByteArray arr (pos + 1)         !b2 = indexByteArray arr (pos + 2)-    in Word24LE (mkWord24LE b0 b1 b2)+    in  Word24LE (mkWord24LE b0 b1 b2)    writeByteArrayLiftedInBytes w arr pos = do     let !(b0, b1, b2) = unMkWord24LE (unWord24LE w)@@ -80,7 +91,7 @@     writeByteArray arr (pos + 1) b1     writeByteArray arr (pos + 2) b2 -newtype Int24LE = Int24LE { unInt24LE :: Int24 }+newtype Int24LE = Int24LE {unInt24LE :: Int24}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits)   deriving (LiftedPrim) via (ViaFromIntegral Word24LE Int24LE)@@ -88,7 +99,7 @@ instance Default Int24LE where   def = 0 -newtype Word32LE = Word32LE { unWord32LE :: Word32 }+newtype Word32LE = Word32LE {unWord32LE :: Word32}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits, Default, Prim) @@ -100,7 +111,7 @@         !b1 = indexByteArray arr (pos + 1)         !b2 = indexByteArray arr (pos + 2)         !b3 = indexByteArray arr (pos + 3)-    in Word32LE (mkWord32LE b0 b1 b2 b3)+    in  Word32LE (mkWord32LE b0 b1 b2 b3)    writeByteArrayLiftedInBytes w arr pos = do     let !(b0, b1, b2, b3) = unMkWord32LE (unWord32LE w)@@ -109,12 +120,12 @@     writeByteArray arr (pos + 2) b2     writeByteArray arr (pos + 3) b3 -newtype Int32LE = Int32LE { unInt32LE :: Int32 }+newtype Int32LE = Int32LE {unInt32LE :: Int32}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits, Default, Prim)   deriving (LiftedPrim) via (ViaFromIntegral Word32LE Int32LE) -newtype FloatLE = FloatLE { unFloatLE :: Float }+newtype FloatLE = FloatLE {unFloatLE :: Float}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Real, Fractional, Floating, RealFrac, Default, Prim) @@ -126,7 +137,7 @@         !b1 = indexByteArray arr (pos + 1)         !b2 = indexByteArray arr (pos + 2)         !b3 = indexByteArray arr (pos + 3)-    in FloatLE (mkFloatLE b0 b1 b2 b3)+    in  FloatLE (mkFloatLE b0 b1 b2 b3)    writeByteArrayLiftedInBytes f arr pos = do     let !(b0, b1, b2, b3) = unMkFloatLE (unFloatLE f)@@ -135,17 +146,17 @@     writeByteArray arr (pos + 2) b2     writeByteArray arr (pos + 3) b3 -newtype Word16BE = Word16BE { unWord16BE :: Word16 }+newtype Word16BE = Word16BE {unWord16BE :: Word16}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits, Default)   deriving (LiftedPrim) via (ViaEndianPair Word16LE Word16BE) -newtype Int16BE = Int16BE { unInt16BE :: Int16 }+newtype Int16BE = Int16BE {unInt16BE :: Int16}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits, Default)   deriving (LiftedPrim) via (ViaEndianPair Int16LE Int16BE) -newtype Word24BE = Word24BE { unWord24BE :: Word24 }+newtype Word24BE = Word24BE {unWord24BE :: Word24}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits)   deriving (LiftedPrim) via (ViaEndianPair Word24LE Word24BE)@@ -153,7 +164,7 @@ instance Default Word24BE where   def = 0 -newtype Int24BE = Int24BE { unInt24BE :: Int24 }+newtype Int24BE = Int24BE {unInt24BE :: Int24}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits)   deriving (LiftedPrim) via (ViaEndianPair Int24LE Int24BE)@@ -161,17 +172,17 @@ instance Default Int24BE where   def = 0 -newtype Word32BE = Word32BE { unWord32BE :: Word32 }+newtype Word32BE = Word32BE {unWord32BE :: Word32}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits, Default)   deriving (LiftedPrim) via (ViaEndianPair Word32LE Word32BE) -newtype Int32BE = Int32BE { unInt32BE :: Int32 }+newtype Int32BE = Int32BE {unInt32BE :: Int32}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits, Default)   deriving (LiftedPrim) via (ViaEndianPair Int32LE Int32BE) -newtype FloatBE = FloatBE { unFloatBE :: Float }+newtype FloatBE = FloatBE {unFloatBE :: Float}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Real, Fractional, Floating, RealFrac, Default, Prim)   deriving (LiftedPrim) via (ViaEndianPair FloatLE FloatBE)@@ -212,7 +223,7 @@   toLittleEndian = FloatLE . swapEndian . unFloatBE   toBigEndian = FloatBE . swapEndian . unFloatLE -newtype ViaEndianPair le be = ViaEndianPair { unViaEndianPair :: be }+newtype ViaEndianPair le be = ViaEndianPair {unViaEndianPair :: be}  instance (LiftedPrim le, EndianPair le be) => LiftedPrim (ViaEndianPair le be) where   elemSizeLifted _ = elemSizeLifted (Proxy :: Proxy le)
src/Dahdit/Proxy.hs view
@@ -3,7 +3,8 @@   , proxyForF   , proxyForFun   , proxyForNatF-  ) where+  )+where  import Data.Proxy (Proxy (..)) import GHC.TypeLits (Nat)
src/Dahdit/Run.hs view
@@ -7,7 +7,8 @@   , runCount   , runPut   , runPutFile-  ) where+  )+where  import Control.Applicative (Alternative (..)) import Control.Exception (Exception (..), throwIO)@@ -21,12 +22,38 @@ import Control.Monad.Trans (lift) import Control.Monad.Trans.Free (FreeT (..), iterT, wrap) import Control.Monad.Trans.Maybe (MaybeT (..))-import Dahdit.Free (Get (..), GetF (..), GetLookAheadF (..), GetScopeF (..), GetStaticArrayF (..), GetStaticSeqF (..),-                    Put, PutF (..), PutM (..), PutStaticArrayF (..), PutStaticHintF (..), PutStaticSeqF (..),-                    ScopeMode (..))+import Dahdit.Free+  ( Get (..)+  , GetF (..)+  , GetLookAheadF (..)+  , GetScopeF (..)+  , GetStaticArrayF (..)+  , GetStaticSeqF (..)+  , Put+  , PutF (..)+  , PutM (..)+  , PutStaticArrayF (..)+  , PutStaticHintF (..)+  , PutStaticSeqF (..)+  , ScopeMode (..)+  ) import Dahdit.LiftedPrim (LiftedPrim (..))-import Dahdit.Nums (FloatBE, FloatLE, Int16BE, Int16LE (..), Int24BE, Int24LE, Int32BE, Int32LE, Word16BE,-                    Word16LE (..), Word24BE, Word24LE, Word32BE, Word32LE)+import Dahdit.Nums+  ( FloatBE+  , FloatLE+  , Int16BE+  , Int16LE (..)+  , Int24BE+  , Int24LE+  , Int32BE+  , Int32LE+  , Word16BE+  , Word16LE (..)+  , Word24BE+  , Word24LE+  , Word32BE+  , Word32LE+  ) import Dahdit.Proxy (proxyForF) import Dahdit.Sizes (ByteCount (..), staticByteSize) import qualified Data.ByteString as BS@@ -35,11 +62,20 @@ import Data.Foldable (for_, toList) import Data.Int (Int8) import Data.Maybe (fromJust)-import Data.Primitive.ByteArray (ByteArray (..), MutableByteArray, cloneByteArray, copyByteArray, indexByteArray,-                                 newByteArray, setByteArray, unsafeFreezeByteArray, writeByteArray)+import Data.Primitive.ByteArray+  ( ByteArray (..)+  , MutableByteArray+  , cloneByteArray+  , copyByteArray+  , indexByteArray+  , newByteArray+  , setByteArray+  , unsafeFreezeByteArray+  , writeByteArray+  ) import Data.Primitive.PrimArray (PrimArray (..), sizeofPrimArray)-import qualified Data.Sequence as Seq import Data.STRef.Strict (STRef, newSTRef, readSTRef, writeSTRef)+import qualified Data.Sequence as Seq import Data.Word (Word8)  -- Sizes:@@ -47,17 +83,17 @@ getStaticSeqSize :: GetStaticSeqF a -> Int getStaticSeqSize (GetStaticSeqF ec g _) =   let !z = fromIntegral (staticByteSize (proxyForF g))-  in z * fromIntegral ec+  in  z * fromIntegral ec  getStaticArraySize :: GetStaticArrayF a -> Int getStaticArraySize (GetStaticArrayF n prox _) =   let !z = fromIntegral (staticByteSize prox)-  in z * fromIntegral n+  in  z * fromIntegral n  putStaticSeqSize :: PutStaticSeqF a -> Int putStaticSeqSize (PutStaticSeqF n _ _ s _) =   let !z = fromIntegral (staticByteSize (proxyForF s))-  in z * fromIntegral n+  in  z * fromIntegral n  putStaticArrayElemSize :: PutStaticArrayF a -> Int putStaticArrayElemSize (PutStaticArrayF _ _ a _) =@@ -66,12 +102,12 @@ putStaticArraySize :: PutStaticArrayF a -> Int putStaticArraySize (PutStaticArrayF n _ a _) =   let !z = fromIntegral (staticByteSize (proxyForF a))-  in z * fromIntegral n+  in  z * fromIntegral n  -- Get: -data GetError =-    GetErrorParseNeed !String !ByteCount !ByteCount+data GetError+  = GetErrorParseNeed !String !ByteCount !ByteCount   | GetErrorScopedMismatch !ByteCount !ByteCount   | GetErrorFail !String   deriving stock (Eq, Show)@@ -97,7 +133,7 @@   pos <- newSTRef 0   pure $! GetEnv len pos (ByteArray arr) -newtype GetEff s a = GetEff { unGetEff :: ReaderT (GetEnv s) (ExceptT GetError (ST s)) a }+newtype GetEff s a = GetEff {unGetEff :: ReaderT (GetEnv s) (ExceptT GetError (ST s)) a}   deriving newtype (Functor, Applicative, Monad, MonadReader (GetEnv s), MonadError GetError)  runGetEff :: GetEff s a -> GetEnv s -> ST s (Either GetError a)@@ -109,7 +145,7 @@ stGetEff :: ST s a -> GetEff s a stGetEff = GetEff . lift . lift -newtype GetRun s a = GetRun { unGetRun :: FreeT GetF (GetEff s) a }+newtype GetRun s a = GetRun {unGetRun :: FreeT GetF (GetEff s) a}   deriving newtype (Functor, Applicative, Monad)  guardReadBytes :: String -> Int -> GetEff s Int@@ -144,7 +180,7 @@     then throwError (GetErrorParseNeed "scope" (fromIntegral oldAvail) bc)     else do       let !newLen = oldPos + intBc-      a <- local (\ge -> ge { geLen = newLen }) (mkGetEff g)+      a <- local (\ge -> ge {geLen = newLen}) (mkGetEff g)       case sm of         ScopeModeWithin -> k a         ScopeModeExact -> do@@ -195,12 +231,12 @@   GetFFloatBE k -> readBytes "FloatBE" 4 (indexByteArrayLiftedInBytes @FloatBE) >>= k   GetFShortByteString bc k ->     let !len = fromIntegral bc-    in readBytes "ShortByteString" len (readShortByteString len) >>= k+    in  readBytes "ShortByteString" len (readShortByteString len) >>= k   GetFStaticSeq gss -> readStaticSeq gss   GetFStaticArray gsa -> readStaticArray gsa   GetFByteArray bc k ->     let !len = fromIntegral bc-    in readBytes "ByteArray" len (\arr pos -> cloneByteArray arr pos len) >>= k+    in  readBytes "ByteArray" len (\arr pos -> cloneByteArray arr pos len) >>= k   GetFScope gs -> readScope gs   GetFSkip bc k -> readBytes "skip" (fromIntegral bc) (\_ _ -> ()) *> k   GetFLookAhead gla -> readLookAhead gla@@ -234,9 +270,9 @@ runGetIO :: Get a -> ShortByteString -> IO (a, ByteCount) runGetIO m bs =   let (!ea, !bc) = runGet m bs-  in case ea of-    Left e -> throwIO e-    Right a -> pure (a, bc)+  in  case ea of+        Left e -> throwIO e+        Right a -> pure (a, bc)  runGetFile :: Get a -> FilePath -> IO (a, ByteCount) runGetFile m fp = do@@ -255,7 +291,7 @@ newPutEnv :: Int -> ST s (PutEnv s) newPutEnv len = PutEnv len <$> newSTRef 0 <*> newByteArray len -newtype PutEff s a = PutEff { unPutEff :: ReaderT (PutEnv s) (ST s) a }+newtype PutEff s a = PutEff {unPutEff :: ReaderT (PutEnv s) (ST s) a}   deriving newtype (Functor, Applicative, Monad, MonadReader (PutEnv s))  runPutEff :: PutEff s a -> PutEnv s -> ST s a@@ -264,7 +300,7 @@ stPutEff :: ST s a -> PutEff s a stPutEff = PutEff . lift -newtype PutRun s a = PutRun { unPutRun :: FreeT PutF (PutEff s) a }+newtype PutRun s a = PutRun {unPutRun :: FreeT PutF (PutEff s) a}   deriving newtype (Functor, Applicative, Monad)  writeBytes :: Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()@@ -324,12 +360,12 @@   PutFFloatBE x k -> writeBytes 4 (writeByteArrayLiftedInBytes x) *> k   PutFShortByteString bc sbs k ->     let !len = fromIntegral bc-    in writeBytes len (writeShortByteString sbs len) *> k+    in  writeBytes len (writeShortByteString sbs len) *> k   PutFStaticSeq pss -> writeStaticSeq pss   PutFStaticArray psa -> writeStaticArray psa   PutFByteArray bc barr k ->     let !len = fromIntegral bc-    in writeBytes len (\arr pos -> copyByteArray arr pos barr 0 len) *> k+    in  writeBytes len (\arr pos -> copyByteArray arr pos barr 0 len) *> k   PutFStaticHint (PutStaticHintF _ p k) -> mkPutEff p *> k  runPutRun :: PutRun s a -> PutEnv s -> ST s a@@ -357,48 +393,48 @@  -- Count: -newtype CountEff a = CountEff { unCountEff :: MaybeT (State Int) a }+newtype CountEff a = CountEff {unCountEff :: MaybeT (State Int) a}   deriving newtype (Functor, Applicative, Monad, Alternative, MonadState Int)  runCountEff :: CountEff a -> Int -> (Maybe a, Int) runCountEff m = runState (runMaybeT (unCountEff m)) -newtype CountRun a = CountRun { unCountRun :: FreeT PutF CountEff a }+newtype CountRun a = CountRun {unCountRun :: FreeT 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-  PutFFloatLE _ k -> State.modify' (4+) *> 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-  PutFFloatBE _ k -> State.modify' (4+) *> 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+  PutFFloatLE _ k -> State.modify' (4 +) *> 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+  PutFFloatBE _ k -> State.modify' (4 +) *> k   PutFShortByteString bc _ k ->     let !len = fromIntegral bc-    in State.modify' (len+) *> k+    in  State.modify' (len +) *> k   PutFStaticSeq pss@(PutStaticSeqF _ _ _ _ k) ->     let !len = putStaticSeqSize pss-    in State.modify' (len+) *> k+    in  State.modify' (len +) *> k   PutFStaticArray psv@(PutStaticArrayF _ _ _ k) ->     let !len = putStaticArraySize psv-    in State.modify' (len+) *> k+    in  State.modify' (len +) *> k   PutFByteArray bc _ k ->     let !len = fromIntegral bc-    in State.modify' (len+) *> k+    in  State.modify' (len +) *> k   PutFStaticHint (PutStaticHintF bc _ k) ->     let !len = fromIntegral bc-    in State.modify' (len+) *> k+    in  State.modify' (len +) *> k  runCountRun :: CountRun a -> Int -> (Maybe a, Int) runCountRun = runCountEff . iterCountRun@@ -416,7 +452,7 @@ runCount m =   let !n = mkCountRun m       (_, !bc) = runCountRun n 0-  in fromIntegral bc+  in  fromIntegral bc  -- Put safe: @@ -429,4 +465,4 @@ runPutFile fp m =   let !bs = runPut m       !bs' = BSS.fromShort bs-  in BS.writeFile fp bs'+  in  BS.writeFile fp bs'
src/Dahdit/Sizes.hs view
@@ -7,11 +7,26 @@   , ViaStaticByteSized (..)   , byteSizeFoldable   , staticByteSizeFoldable-  ) where+  )+where  import Dahdit.LiftedPrim (LiftedPrim, LiftedPrimArray, sizeofLiftedPrimArray)-import Dahdit.Nums (FloatBE, FloatLE, Int16BE, Int16LE, Int24BE, Int24LE, Int32BE, Int32LE, Word16BE, Word16LE,-                    Word24BE, Word24LE, Word32BE, Word32LE)+import Dahdit.Nums+  ( FloatBE+  , FloatLE+  , Int16BE+  , Int16LE+  , Int24BE+  , Int24LE+  , Int32BE+  , Int32LE+  , Word16BE+  , Word16LE+  , Word24BE+  , Word24LE+  , Word32BE+  , Word32LE+  ) import Dahdit.Proxy (proxyFor, proxyForF) import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as BSS@@ -26,11 +41,11 @@ import qualified Data.Sequence as Seq import Data.Word (Word16, Word32, Word64, Word8) -newtype ElementCount = ElementCount { unElementCount :: Word64 }+newtype ElementCount = ElementCount {unElementCount :: Word64}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bounded, Default) -newtype ByteCount = ByteCount { unByteCount :: Word64 }+newtype ByteCount = ByteCount {unByteCount :: Word64}   deriving stock (Show)   deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bounded, Default) @@ -113,19 +128,19 @@   byteSize ss =     let !elen = staticByteSize (Proxy :: Proxy a)         !alen = fromIntegral (Seq.length ss)-    in elen * alen+    in  elen * alen  instance (StaticByteSized a, Prim a) => ByteSized (PrimArray a) where   byteSize pa =     let !elen = staticByteSize (Proxy :: Proxy a)         !alen = fromIntegral (sizeofPrimArray pa)-    in elen * alen+    in  elen * alen  instance (StaticByteSized a, LiftedPrim a) => ByteSized (LiftedPrimArray a) where   byteSize lpa =     let !elen = staticByteSize (Proxy :: Proxy a)         !alen = fromIntegral (sizeofLiftedPrimArray lpa)-    in elen * alen+    in  elen * alen  class ByteSized a => StaticByteSized a where   staticByteSize :: Proxy a -> ByteCount@@ -202,7 +217,7 @@ instance StaticByteSized FloatBE where   staticByteSize _ = 4 -newtype ViaStaticByteSized a = ViaStaticByteSized { unViaStaticByteSized :: a }+newtype ViaStaticByteSized a = ViaStaticByteSized {unViaStaticByteSized :: a}  instance StaticByteSized a => ByteSized (ViaStaticByteSized a) where   byteSize _ = staticByteSize (Proxy :: Proxy a)
test/Main.hs view
@@ -1,15 +1,80 @@ module Main (main) where -import Dahdit (Binary (..), BoolByte (BoolByte), ByteCount, ByteSized (..), FloatBE (..), FloatLE (..), Generic, Get,-               Int16LE, Int32LE, Int8, Proxy (..), Put, ShortByteString, StaticByteSized (..), ViaGeneric (..),-               ViaStaticGeneric (..), Word16LE, Word32LE, Word8, getByteArray, getByteString, getExact, getFloatBE,-               getFloatLE, getInt16BE, getInt16LE, getInt24BE, getInt24LE, getInt32BE, getInt32LE, getInt8,-               getLiftedPrimArray, getLookAhead, getRemainingSize, getSeq, getSkip, getStaticArray, getStaticSeq,-               getWithin, getWord16BE, getWord16LE, getWord24BE, getWord24LE, getWord32BE, getWord32LE, getWord8,-               liftedPrimArrayFromList, putByteArray, putByteString, putFloatBE, putFloatLE, putInt16BE, putInt16LE,-               putInt24BE, putInt24LE, putInt32BE, putInt32LE, putInt8, putLiftedPrimArray, putSeq, putStaticArray,-               putStaticSeq, putWord16BE, putWord16LE, putWord24BE, putWord24LE, putWord32BE, putWord32LE, putWord8,-               runCount, runGet, runPut)+import Dahdit+  ( Binary (..)+  , BoolByte (BoolByte)+  , ByteCount+  , ByteSized (..)+  , FloatBE (..)+  , FloatLE (..)+  , Generic+  , Get+  , Int16LE+  , Int32LE+  , Int8+  , Proxy (..)+  , Put+  , ShortByteString+  , StaticByteSized (..)+  , ViaGeneric (..)+  , ViaStaticGeneric (..)+  , Word16LE+  , Word32LE+  , Word8+  , getByteArray+  , getByteString+  , getExact+  , getFloatBE+  , getFloatLE+  , getInt16BE+  , getInt16LE+  , getInt24BE+  , getInt24LE+  , getInt32BE+  , getInt32LE+  , getInt8+  , getLiftedPrimArray+  , getLookAhead+  , getRemainingSize+  , getSeq+  , getSkip+  , getStaticArray+  , getStaticSeq+  , getWithin+  , getWord16BE+  , getWord16LE+  , getWord24BE+  , getWord24LE+  , getWord32BE+  , getWord32LE+  , getWord8+  , liftedPrimArrayFromList+  , putByteArray+  , putByteString+  , putFloatBE+  , putFloatLE+  , putInt16BE+  , putInt16LE+  , putInt24BE+  , putInt24LE+  , putInt32BE+  , putInt32LE+  , putInt8+  , putLiftedPrimArray+  , putSeq+  , putStaticArray+  , putStaticSeq+  , putWord16BE+  , putWord16LE+  , putWord24BE+  , putWord24LE+  , putWord32BE+  , putWord32LE+  , putWord8+  , runCount+  , runGet+  , runPut+  ) import qualified Data.ByteString.Short as BSS import Data.Primitive.ByteArray (byteArrayFromList) import Data.Primitive.PrimArray (primArrayFromList)@@ -51,112 +116,120 @@   actBc @?= expecBc  testDahditByteSize :: TestTree-testDahditByteSize = testGroup "byteSize"-  [ testCase "Word8" (byteSize @Word8 0x5D @?= 1)-  , testCase "Int8" (byteSize @Int8 0x5D @?= 1)-  , testCase "Word16LE" (byteSize @Word16LE 0x5DEC @?= 2)-  , testCase "Int16LE" (byteSize @Int16LE 0x5DEC @?= 2)-  , testCase "Word32LE" (byteSize @Word32LE 0x5DEC6EFD @?= 4)-  , testCase "Int32LE" (byteSize @Int32LE 0x5DEC6EFD @?= 4)-  , testCase "FloatLE" (byteSize (FloatLE (castWord32ToFloat 0x5DEC6EFD)) @?= 4)-  , testCase "ShortByteString" (byteSize @ShortByteString (BSS.pack [0xEC, 0x5D]) @?= 2)-  , testCase "DynFoo" (byteSize (DynFoo 0xBB 0x5DEC) @?= 3)-  , testCase "StaFoo" (byteSize (StaFoo 0xBB 0x5DEC) @?= 3)-  ]+testDahditByteSize =+  testGroup+    "byteSize"+    [ testCase "Word8" (byteSize @Word8 0x5D @?= 1)+    , testCase "Int8" (byteSize @Int8 0x5D @?= 1)+    , testCase "Word16LE" (byteSize @Word16LE 0x5DEC @?= 2)+    , testCase "Int16LE" (byteSize @Int16LE 0x5DEC @?= 2)+    , testCase "Word32LE" (byteSize @Word32LE 0x5DEC6EFD @?= 4)+    , testCase "Int32LE" (byteSize @Int32LE 0x5DEC6EFD @?= 4)+    , testCase "FloatLE" (byteSize (FloatLE (castWord32ToFloat 0x5DEC6EFD)) @?= 4)+    , testCase "ShortByteString" (byteSize @ShortByteString (BSS.pack [0xEC, 0x5D]) @?= 2)+    , testCase "DynFoo" (byteSize (DynFoo 0xBB 0x5DEC) @?= 3)+    , testCase "StaFoo" (byteSize (StaFoo 0xBB 0x5DEC) @?= 3)+    ]  testDahditStaticByteSize :: TestTree-testDahditStaticByteSize = testGroup "staticByteSize"-  [ testCase "Word8" (staticByteSize @Word8 Proxy @?= 1)-  , testCase "Int8" (staticByteSize @Int8 Proxy @?= 1)-  , testCase "Word16LE" (staticByteSize @Word16LE Proxy @?= 2)-  , testCase "Int16LE" (staticByteSize @Int16LE Proxy @?= 2)-  , testCase "Word32LE" (staticByteSize @Word32LE Proxy @?= 4)-  , testCase "Int32LE" (staticByteSize @Int32LE Proxy @?= 4)-  , testCase "FloatLE" (staticByteSize @FloatLE Proxy @?= 4)-  , testCase "StaFoo" (staticByteSize @StaFoo Proxy @?= 3)-  , testCase "BoolByte" (staticByteSize @BoolByte Proxy @?= 1)-  ]+testDahditStaticByteSize =+  testGroup+    "staticByteSize"+    [ testCase "Word8" (staticByteSize @Word8 Proxy @?= 1)+    , testCase "Int8" (staticByteSize @Int8 Proxy @?= 1)+    , testCase "Word16LE" (staticByteSize @Word16LE Proxy @?= 2)+    , testCase "Int16LE" (staticByteSize @Int16LE Proxy @?= 2)+    , testCase "Word32LE" (staticByteSize @Word32LE Proxy @?= 4)+    , testCase "Int32LE" (staticByteSize @Int32LE Proxy @?= 4)+    , testCase "FloatLE" (staticByteSize @FloatLE Proxy @?= 4)+    , testCase "StaFoo" (staticByteSize @StaFoo Proxy @?= 3)+    , testCase "BoolByte" (staticByteSize @BoolByte Proxy @?= 1)+    ]  testDahditGet :: TestTree-testDahditGet = testGroup "get"-  [ testCase "Word8 zero" (runGetCase getWord8 Nothing [])-  , testCase "Word8 one" (runGetCase getWord8 (Just (1, 0, 0x5D)) [0x5D])-  , testCase "Word8 two" (runGetCase getWord8 (Just (1, 1, 0x5D)) [0x5D, 0xBB])-  , testCase "Int8" (runGetCase getInt8 (Just (1, 0, 0x5D)) [0x5D])-  , testCase "Word16LE zero" (runGetCase getWord16LE Nothing [])-  , testCase "Word16LE one" (runGetCase getWord16LE Nothing [0x5D])-  , testCase "Word16LE two" (runGetCase getWord16LE (Just (2, 0, 0x5DEC)) [0xEC, 0x5D])-  , testCase "Word16LE three" (runGetCase getWord16LE (Just (2, 1, 0x5DEC)) [0xEC, 0x5D, 0xBB])-  , testCase "Int16LE" (runGetCase getInt16LE (Just (2, 1, 0x5DEC)) [0xEC, 0x5D, 0xBB])-  , testCase "Word16BE" (runGetCase getWord16BE (Just (2, 1, 0x5DEC)) [0x5D, 0xEC, 0xBB])-  , testCase "Int16BE" (runGetCase getInt16BE (Just (2, 1, 0x5DEC)) [0x5D, 0xEC, 0xBB])-  , testCase "Word24LE" (runGetCase getWord24LE (Just (3, 1, 0xEC6EFD)) [0xFD, 0x6E, 0xEC, 0x5D])-  , testCase "Int24LE" (runGetCase getInt24LE (Just (3, 1, 0xEC6EFD)) [0xFD, 0x6E, 0xEC, 0x5D])-  , testCase "Word24BE" (runGetCase getWord24BE (Just (3, 1, 0xEC6EFD)) [0xEC, 0x6E, 0xFD, 0x5D])-  , testCase "Int24BE" (runGetCase getInt24BE (Just (3, 1, 0xEC6EFD)) [0xEC, 0x6E, 0xFD, 0x5D])-  , testCase "Word32LE" (runGetCase getWord32LE (Just (4, 0, 0x5DEC6EFD)) [0xFD, 0x6E, 0xEC, 0x5D])-  , testCase "Int32LE" (runGetCase getInt32LE (Just (4, 0, 0x5DEC6EFD)) [0xFD, 0x6E, 0xEC, 0x5D])-  , testCase "Word32BE" (runGetCase getWord32BE (Just (4, 0, 0x5DEC6EFD)) [0x5D, 0xEC, 0x6E, 0xFD])-  , testCase "Int32BE" (runGetCase getInt32BE (Just (4, 0, 0x5DEC6EFD)) [0x5D, 0xEC, 0x6E, 0xFD])-  , testCase "FloatLE" (runGetCase getFloatLE (Just (4, 0, FloatLE (castWord32ToFloat 0x5DEC6EFD))) [0xFD, 0x6E, 0xEC, 0x5D])-  , testCase "FloatBE" (runGetCase getFloatBE (Just (4, 0, FloatBE (castWord32ToFloat 0x5DEC6EFD))) [0x5D, 0xEC, 0x6E, 0xFD])-  , testCase "ShortByteString" (runGetCase (getByteString 2) (Just (2, 1, BSS.pack [0xEC, 0x5D])) [0xEC, 0x5D, 0xBB])-  , testCase "Two Word8" (runGetCase ((,) <$> getWord8 <*> getWord8) (Just (2, 0, (0x5D, 0xBB))) [0x5D, 0xBB])-  , testCase "Two Word16LE" (runGetCase ((,) <$> getWord16LE <*> getWord16LE) (Just (4, 0, (0x5DEC, 0x4020))) [0xEC, 0x5D, 0x20, 0x40])-  , testCase "Seq" (runGetCase (getSeq 2 getWord16LE) (Just (4, 0, Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40])-  , testCase "StaticSeq" (runGetCase (getStaticSeq 2 getWord16LE) (Just (4, 0, Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40])-  , testCase "StaticArray" (runGetCase (getStaticArray @Word16LE 2) (Just (4, 0, primArrayFromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40])-  , testCase "DynFoo" (runGetCase (get @DynFoo) (Just (3, 0, DynFoo 0xBB 0x5DEC)) [0xBB, 0xEC, 0x5D])-  , testCase "StaFoo" (runGetCase (get @StaFoo) (Just (3, 0, StaFoo 0xBB 0x5DEC)) [0xBB, 0xEC, 0x5D])-  , testCase "getRemainingSize" (runGetCase getRemainingSize (Just (0, 3, 3)) [0xBB, 0xEC, 0x5D])-  , testCase "getSkip" (runGetCase (getSkip 2) (Just (2, 1, ())) [0xBB, 0xEC, 0x5D])-  , testCase "getLookAhead" (runGetCase (getLookAhead getWord16LE) (Just (0, 3, 0x5DEC)) [0xEC, 0x5D, 0xBB])-  , testCase "getExact eq" (runGetCase (getExact 2 getWord16LE) (Just (2, 1, 0x5DEC)) [0xEC, 0x5D, 0xBB])-  , testCase "getExact lt" (runGetCase (getExact 1 getWord16LE) Nothing [0xEC, 0x5D, 0xBB])-  , testCase "getExact gt" (runGetCase (getExact 3 getWord16LE) Nothing [0xEC, 0x5D, 0xBB])-  , testCase "getWithin eq" (runGetCase (getWithin 2 getWord16LE) (Just (2, 1, 0x5DEC)) [0xEC, 0x5D, 0xBB])-  , testCase "getWithin lt" (runGetCase (getWithin 1 getWord16LE) Nothing [0xEC, 0x5D, 0xBB])-  , testCase "getWithin gt" (runGetCase (getWithin 3 getWord16LE) (Just (2, 1, 0x5DEC)) [0xEC, 0x5D, 0xBB])-  , testCase "BoolByte True" (runGetCase (get @BoolByte) (Just (1, 0, BoolByte True)) [0x01])-  , testCase "BoolByte False" (runGetCase (get @BoolByte) (Just (1, 0, BoolByte False)) [0x00])-  , testCase "getByteArray" (runGetCase (getByteArray 3) (Just (3, 1, byteArrayFromList @Word8 [0xFD, 0x6E, 0xEC])) [0xFD, 0x6E, 0xEC, 0x5D])-  , testCase "getLiftedPrimArray" (runGetCase (getLiftedPrimArray (Proxy :: Proxy Word16LE) 3) (Just (6, 1, liftedPrimArrayFromList @Word16LE [0xFD, 0x6E, 0xEC])) [0xFD, 0x00, 0x6E, 0x00, 0xEC, 0x00, 0x5D])-  ]+testDahditGet =+  testGroup+    "get"+    [ testCase "Word8 zero" (runGetCase getWord8 Nothing [])+    , testCase "Word8 one" (runGetCase getWord8 (Just (1, 0, 0x5D)) [0x5D])+    , testCase "Word8 two" (runGetCase getWord8 (Just (1, 1, 0x5D)) [0x5D, 0xBB])+    , testCase "Int8" (runGetCase getInt8 (Just (1, 0, 0x5D)) [0x5D])+    , testCase "Word16LE zero" (runGetCase getWord16LE Nothing [])+    , testCase "Word16LE one" (runGetCase getWord16LE Nothing [0x5D])+    , testCase "Word16LE two" (runGetCase getWord16LE (Just (2, 0, 0x5DEC)) [0xEC, 0x5D])+    , testCase "Word16LE three" (runGetCase getWord16LE (Just (2, 1, 0x5DEC)) [0xEC, 0x5D, 0xBB])+    , testCase "Int16LE" (runGetCase getInt16LE (Just (2, 1, 0x5DEC)) [0xEC, 0x5D, 0xBB])+    , testCase "Word16BE" (runGetCase getWord16BE (Just (2, 1, 0x5DEC)) [0x5D, 0xEC, 0xBB])+    , testCase "Int16BE" (runGetCase getInt16BE (Just (2, 1, 0x5DEC)) [0x5D, 0xEC, 0xBB])+    , testCase "Word24LE" (runGetCase getWord24LE (Just (3, 1, 0xEC6EFD)) [0xFD, 0x6E, 0xEC, 0x5D])+    , testCase "Int24LE" (runGetCase getInt24LE (Just (3, 1, 0xEC6EFD)) [0xFD, 0x6E, 0xEC, 0x5D])+    , testCase "Word24BE" (runGetCase getWord24BE (Just (3, 1, 0xEC6EFD)) [0xEC, 0x6E, 0xFD, 0x5D])+    , testCase "Int24BE" (runGetCase getInt24BE (Just (3, 1, 0xEC6EFD)) [0xEC, 0x6E, 0xFD, 0x5D])+    , testCase "Word32LE" (runGetCase getWord32LE (Just (4, 0, 0x5DEC6EFD)) [0xFD, 0x6E, 0xEC, 0x5D])+    , testCase "Int32LE" (runGetCase getInt32LE (Just (4, 0, 0x5DEC6EFD)) [0xFD, 0x6E, 0xEC, 0x5D])+    , testCase "Word32BE" (runGetCase getWord32BE (Just (4, 0, 0x5DEC6EFD)) [0x5D, 0xEC, 0x6E, 0xFD])+    , testCase "Int32BE" (runGetCase getInt32BE (Just (4, 0, 0x5DEC6EFD)) [0x5D, 0xEC, 0x6E, 0xFD])+    , testCase "FloatLE" (runGetCase getFloatLE (Just (4, 0, FloatLE (castWord32ToFloat 0x5DEC6EFD))) [0xFD, 0x6E, 0xEC, 0x5D])+    , testCase "FloatBE" (runGetCase getFloatBE (Just (4, 0, FloatBE (castWord32ToFloat 0x5DEC6EFD))) [0x5D, 0xEC, 0x6E, 0xFD])+    , testCase "ShortByteString" (runGetCase (getByteString 2) (Just (2, 1, BSS.pack [0xEC, 0x5D])) [0xEC, 0x5D, 0xBB])+    , testCase "Two Word8" (runGetCase ((,) <$> getWord8 <*> getWord8) (Just (2, 0, (0x5D, 0xBB))) [0x5D, 0xBB])+    , testCase "Two Word16LE" (runGetCase ((,) <$> getWord16LE <*> getWord16LE) (Just (4, 0, (0x5DEC, 0x4020))) [0xEC, 0x5D, 0x20, 0x40])+    , testCase "Seq" (runGetCase (getSeq 2 getWord16LE) (Just (4, 0, Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40])+    , testCase "StaticSeq" (runGetCase (getStaticSeq 2 getWord16LE) (Just (4, 0, Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40])+    , testCase "StaticArray" (runGetCase (getStaticArray @Word16LE 2) (Just (4, 0, primArrayFromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40])+    , testCase "DynFoo" (runGetCase (get @DynFoo) (Just (3, 0, DynFoo 0xBB 0x5DEC)) [0xBB, 0xEC, 0x5D])+    , testCase "StaFoo" (runGetCase (get @StaFoo) (Just (3, 0, StaFoo 0xBB 0x5DEC)) [0xBB, 0xEC, 0x5D])+    , testCase "getRemainingSize" (runGetCase getRemainingSize (Just (0, 3, 3)) [0xBB, 0xEC, 0x5D])+    , testCase "getSkip" (runGetCase (getSkip 2) (Just (2, 1, ())) [0xBB, 0xEC, 0x5D])+    , testCase "getLookAhead" (runGetCase (getLookAhead getWord16LE) (Just (0, 3, 0x5DEC)) [0xEC, 0x5D, 0xBB])+    , testCase "getExact eq" (runGetCase (getExact 2 getWord16LE) (Just (2, 1, 0x5DEC)) [0xEC, 0x5D, 0xBB])+    , testCase "getExact lt" (runGetCase (getExact 1 getWord16LE) Nothing [0xEC, 0x5D, 0xBB])+    , testCase "getExact gt" (runGetCase (getExact 3 getWord16LE) Nothing [0xEC, 0x5D, 0xBB])+    , testCase "getWithin eq" (runGetCase (getWithin 2 getWord16LE) (Just (2, 1, 0x5DEC)) [0xEC, 0x5D, 0xBB])+    , testCase "getWithin lt" (runGetCase (getWithin 1 getWord16LE) Nothing [0xEC, 0x5D, 0xBB])+    , testCase "getWithin gt" (runGetCase (getWithin 3 getWord16LE) (Just (2, 1, 0x5DEC)) [0xEC, 0x5D, 0xBB])+    , testCase "BoolByte True" (runGetCase (get @BoolByte) (Just (1, 0, BoolByte True)) [0x01])+    , testCase "BoolByte False" (runGetCase (get @BoolByte) (Just (1, 0, BoolByte False)) [0x00])+    , testCase "getByteArray" (runGetCase (getByteArray 3) (Just (3, 1, byteArrayFromList @Word8 [0xFD, 0x6E, 0xEC])) [0xFD, 0x6E, 0xEC, 0x5D])+    , testCase "getLiftedPrimArray" (runGetCase (getLiftedPrimArray (Proxy :: Proxy Word16LE) 3) (Just (6, 1, liftedPrimArrayFromList @Word16LE [0xFD, 0x6E, 0xEC])) [0xFD, 0x00, 0x6E, 0x00, 0xEC, 0x00, 0x5D])+    ]  testDahditPut :: TestTree-testDahditPut = testGroup "put"-  [ testCase "Word8" (runPutCase (putWord8 0x5D) [0x5D])-  , testCase "Int8" (runPutCase (putInt8 0x5D) [0x5D])-  , testCase "Word16LE" (runPutCase (putWord16LE 0x5DEC) [0xEC, 0x5D])-  , testCase "Int16LE" (runPutCase (putInt16LE 0x5DEC) [0xEC, 0x5D])-  , testCase "Word16BE" (runPutCase (putWord16BE 0x5DEC) [0x5D, 0xEC])-  , testCase "Int16BE" (runPutCase (putInt16BE 0x5DEC) [0x5D, 0xEC])-  , testCase "Word24LE" (runPutCase (putWord24LE 0xEC6EFD) [0xFD, 0x6E, 0xEC])-  , testCase "Int24LE" (runPutCase (putInt24LE 0xEC6EFD) [0xFD, 0x6E, 0xEC])-  , testCase "Word24BE" (runPutCase (putWord24BE 0xEC6EFD) [0xEC, 0x6E, 0xFD])-  , testCase "Int24BE" (runPutCase (putInt24BE 0xEC6EFD) [0xEC, 0x6E, 0xFD])-  , testCase "Word32LE" (runPutCase (putWord32LE 0x5DEC6EFD) [0xFD, 0x6E, 0xEC, 0x5D])-  , testCase "Int32LE" (runPutCase (putInt32LE 0x5DEC6EFD) [0xFD, 0x6E, 0xEC, 0x5D])-  , testCase "Word32BE" (runPutCase (putWord32BE 0x5DEC6EFD) [0x5D, 0xEC, 0x6E, 0xFD])-  , testCase "Int32BE" (runPutCase (putInt32BE 0x5DEC6EFD) [0x5D, 0xEC, 0x6E, 0xFD])-  , testCase "FloatLE" (runPutCase (putFloatLE (FloatLE (castWord32ToFloat 0x5DEC6EFD))) [0xFD, 0x6E, 0xEC, 0x5D])-  , testCase "FloatBE" (runPutCase (putFloatBE (FloatBE (castWord32ToFloat 0x5DEC6EFD))) [0x5D, 0xEC, 0x6E, 0xFD])-  , testCase "ShortByteString" (runPutCase (putByteString (BSS.pack [0xEC, 0x5D])) [0xEC, 0x5D])-  , testCase "Two Word8" (runPutCase (putWord8 0x5D *> putWord8 0xBB) [0x5D, 0xBB])-  , testCase "Two Word16LE" (runPutCase (putWord16LE 0x5DEC *> putWord16LE 0x4020) [0xEC, 0x5D, 0x20, 0x40])-  , testCase "Seq" (runPutCase (putSeq putWord16LE (Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40])-  , testCase "StaticSeq" (runPutCase (putStaticSeq putWord16LE (Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40])-  , testCase "StaticArray" (runPutCase (putStaticArray @Word16LE (primArrayFromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40])-  , testCase "DynFoo" (runPutCase (put (DynFoo 0xBB 0x5DEC)) [0xBB, 0xEC, 0x5D])-  , testCase "StaFoo" (runPutCase (put (StaFoo 0xBB 0x5DEC)) [0xBB, 0xEC, 0x5D])-  , testCase "BoolByte True" (runPutCase (put (BoolByte True)) [0x01])-  , testCase "BoolByte False" (runPutCase (put (BoolByte False)) [0x00])-  , testCase "putByteArray" (runPutCase (putByteArray (byteArrayFromList @Word8 [0xFD, 0x6E, 0xEC])) [0xFD, 0x6E, 0xEC])-  , testCase "putLiftedPrimArray" (runPutCase (putLiftedPrimArray (liftedPrimArrayFromList @Word16LE [0xFD, 0x6E, 0xEC])) [0xFD, 0x00, 0x6E, 0x00, 0xEC, 0x00])-  ]+testDahditPut =+  testGroup+    "put"+    [ testCase "Word8" (runPutCase (putWord8 0x5D) [0x5D])+    , testCase "Int8" (runPutCase (putInt8 0x5D) [0x5D])+    , testCase "Word16LE" (runPutCase (putWord16LE 0x5DEC) [0xEC, 0x5D])+    , testCase "Int16LE" (runPutCase (putInt16LE 0x5DEC) [0xEC, 0x5D])+    , testCase "Word16BE" (runPutCase (putWord16BE 0x5DEC) [0x5D, 0xEC])+    , testCase "Int16BE" (runPutCase (putInt16BE 0x5DEC) [0x5D, 0xEC])+    , testCase "Word24LE" (runPutCase (putWord24LE 0xEC6EFD) [0xFD, 0x6E, 0xEC])+    , testCase "Int24LE" (runPutCase (putInt24LE 0xEC6EFD) [0xFD, 0x6E, 0xEC])+    , testCase "Word24BE" (runPutCase (putWord24BE 0xEC6EFD) [0xEC, 0x6E, 0xFD])+    , testCase "Int24BE" (runPutCase (putInt24BE 0xEC6EFD) [0xEC, 0x6E, 0xFD])+    , testCase "Word32LE" (runPutCase (putWord32LE 0x5DEC6EFD) [0xFD, 0x6E, 0xEC, 0x5D])+    , testCase "Int32LE" (runPutCase (putInt32LE 0x5DEC6EFD) [0xFD, 0x6E, 0xEC, 0x5D])+    , testCase "Word32BE" (runPutCase (putWord32BE 0x5DEC6EFD) [0x5D, 0xEC, 0x6E, 0xFD])+    , testCase "Int32BE" (runPutCase (putInt32BE 0x5DEC6EFD) [0x5D, 0xEC, 0x6E, 0xFD])+    , testCase "FloatLE" (runPutCase (putFloatLE (FloatLE (castWord32ToFloat 0x5DEC6EFD))) [0xFD, 0x6E, 0xEC, 0x5D])+    , testCase "FloatBE" (runPutCase (putFloatBE (FloatBE (castWord32ToFloat 0x5DEC6EFD))) [0x5D, 0xEC, 0x6E, 0xFD])+    , testCase "ShortByteString" (runPutCase (putByteString (BSS.pack [0xEC, 0x5D])) [0xEC, 0x5D])+    , testCase "Two Word8" (runPutCase (putWord8 0x5D *> putWord8 0xBB) [0x5D, 0xBB])+    , testCase "Two Word16LE" (runPutCase (putWord16LE 0x5DEC *> putWord16LE 0x4020) [0xEC, 0x5D, 0x20, 0x40])+    , testCase "Seq" (runPutCase (putSeq putWord16LE (Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40])+    , testCase "StaticSeq" (runPutCase (putStaticSeq putWord16LE (Seq.fromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40])+    , testCase "StaticArray" (runPutCase (putStaticArray @Word16LE (primArrayFromList [0x5DEC, 0x4020])) [0xEC, 0x5D, 0x20, 0x40])+    , testCase "DynFoo" (runPutCase (put (DynFoo 0xBB 0x5DEC)) [0xBB, 0xEC, 0x5D])+    , testCase "StaFoo" (runPutCase (put (StaFoo 0xBB 0x5DEC)) [0xBB, 0xEC, 0x5D])+    , testCase "BoolByte True" (runPutCase (put (BoolByte True)) [0x01])+    , testCase "BoolByte False" (runPutCase (put (BoolByte False)) [0x00])+    , testCase "putByteArray" (runPutCase (putByteArray (byteArrayFromList @Word8 [0xFD, 0x6E, 0xEC])) [0xFD, 0x6E, 0xEC])+    , testCase "putLiftedPrimArray" (runPutCase (putLiftedPrimArray (liftedPrimArrayFromList @Word16LE [0xFD, 0x6E, 0xEC])) [0xFD, 0x00, 0x6E, 0x00, 0xEC, 0x00])+    ]  testDahdit :: TestTree-testDahdit = testGroup "Dahdit" [ testDahditByteSize, testDahditStaticByteSize, testDahditGet, testDahditPut ]+testDahdit = testGroup "Dahdit" [testDahditByteSize, testDahditStaticByteSize, testDahditGet, testDahditPut]  main :: IO () main = defaultMain testDahdit