dahdit (empty) → 0.1.0

raw patch · 18 files changed

+2378/−0 lines, 18 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, dahdit, data-default, data-sword, free, mtl, primitive, tasty, tasty-hunit, transformers

Files

• LICENSE +30/−0
• README.md +17/−0
• Setup.hs +2/−0
• dahdit.cabal +130/−0
• src/Dahdit.hs +45/−0
• src/Dahdit/Binary.hs +91/−0
• src/Dahdit/BinaryRep.hs +37/−0
• src/Dahdit/Fancy.hs +186/−0
• src/Dahdit/Free.hs +144/−0
• src/Dahdit/Funs.hs +337/−0
• src/Dahdit/Generic.hs +98/−0
• src/Dahdit/Internal.hs +86/−0
• src/Dahdit/LiftedPrim.hs +126/−0
• src/Dahdit/Nums.hs +220/−0
• src/Dahdit/Proxy.hs +21/−0
• src/Dahdit/Run.hs +432/−0
• src/Dahdit/Sizes.hs +214/−0
• test/Main.hs +162/−0

@@ -0,0 +1,30 @@+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.

@@ -0,0 +1,17 @@+# dahdit++Binary parsing and serialization with integrated size.++This differs from `binary` in a few ways:++* It is required that all types implementing `Binary` must also implement `ByteSized`.+* Known-statically-sized types can implement `StaticByteSized` for size speedups.+* Examining `Put` can yield required byte size without serializing.+* It uses `ShortByteString` to avoid pinned memory.+* It supports parsing `PrimArray` for fast copies of repeated chunks of primitive data.+* Derivation uses `via` and not `anyclass` for better control of derived instances.+* Provides several additional types representing fixed-length strings or sequences (using `TypeLits`).++This generally works but should be considered experimental.++(dahs and dits are signal durations in Morse code)

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,130 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.0.+--+-- see: https://github.com/sol/hpack++name:           dahdit+version:        0.1.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+homepage:       https://github.com/ejconlon/dahdit#readme+bug-reports:    https://github.com/ejconlon/dahdit/issues+author:         Eric Conlon+maintainer:     ejconlon@gmail.com+copyright:      (c) 2022 Eric Conlon+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/ejconlon/dahdit++library+  exposed-modules:+      Dahdit+      Dahdit.Binary+      Dahdit.BinaryRep+      Dahdit.Fancy+      Dahdit.Free+      Dahdit.Funs+      Dahdit.Generic+      Dahdit.Internal+      Dahdit.LiftedPrim+      Dahdit.Nums+      Dahdit.Proxy+      Dahdit.Run+      Dahdit.Sizes+  other-modules:+      Paths_dahdit+  hs-source-dirs:+      src+  default-extensions:+      BangPatterns+      ConstraintKinds+      DataKinds+      DeriveFunctor+      DeriveFoldable+      DeriveGeneric+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      LambdaCase+      KindSignatures+      MultiParamTypeClasses+      Rank2Types+      ScopedTypeVariables+      StandaloneDeriving+      TupleSections+      TypeApplications+      TypeOperators+      TypeFamilies+  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.*+    , containers ==0.6.*+    , data-default ==0.7.*+    , data-sword ==0.2.*+    , free ==5.1.*+    , mtl ==2.2.*+    , primitive ==0.7.*+    , transformers ==0.5.*+  default-language: Haskell2010++test-suite dahdit-test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Paths_dahdit+  hs-source-dirs:+      test+  default-extensions:+      BangPatterns+      ConstraintKinds+      DataKinds+      DeriveFunctor+      DeriveFoldable+      DeriveGeneric+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      LambdaCase+      KindSignatures+      MultiParamTypeClasses+      Rank2Types+      ScopedTypeVariables+      StandaloneDeriving+      TupleSections+      TypeApplications+      TypeOperators+      TypeFamilies+  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.*+    , containers ==0.6.*+    , dahdit+    , data-default ==0.7.*+    , data-sword ==0.2.*+    , free ==5.1.*+    , mtl ==2.2.*+    , primitive ==0.7.*+    , tasty+    , tasty-hunit+    , transformers ==0.5.*+  default-language: Haskell2010

@@ -0,0 +1,45 @@+module Dahdit+  ( Word8+  , Int8+  , ByteString+  , ShortByteString+  , Seq (..)+  , ByteArray+  , PrimArray+  , Generic+  , Prim+  , Proxy (..)+  , module Dahdit.Binary+  , module Dahdit.BinaryRep+  , module Dahdit.Fancy+  , module Dahdit.Free+  , module Dahdit.Funs+  , module Dahdit.Generic+  , module Dahdit.LiftedPrim+  , module Dahdit.Nums+  , module Dahdit.Proxy+  , module Dahdit.Run+  , module Dahdit.Sizes+   ) where++import Dahdit.Binary+import Dahdit.BinaryRep+import Dahdit.Fancy+import Dahdit.Free (Get, Put, PutM)+import Dahdit.Funs hiding (unsafePutStaticArrayN, unsafePutStaticSeqN)+import Dahdit.Generic+import Dahdit.LiftedPrim+import Dahdit.Nums+import Dahdit.Proxy+import Dahdit.Run+import Dahdit.Sizes+import Data.ByteString (ByteString)+import Data.ByteString.Short (ShortByteString)+import Data.Int (Int8)+import Data.Primitive (Prim)+import Data.Primitive.ByteArray (ByteArray)+import Data.Primitive.PrimArray (PrimArray)+import Data.Proxy (Proxy (..))+import Data.Sequence (Seq (..))+import Data.Word (Word8)+import GHC.Generics (Generic)

@@ -0,0 +1,91 @@+module Dahdit.Binary+  ( Binary (..)+  , byteSizeViaPut+  ) 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.Run (runCount)+import Dahdit.Sizes (ByteCount, ByteSized)+import Data.Int (Int8)+import Data.Word (Word8)++class ByteSized a => Binary a where+  get :: Get a+  put :: a -> Put++byteSizeViaPut :: Binary a => a -> ByteCount+byteSizeViaPut = runCount . put++instance Binary () where+  get = pure ()+  put _ = pure ()++instance Binary Word8 where+  get = getWord8+  put = putWord8++instance Binary Int8 where+  get = getInt8+  put = putInt8++instance Binary Word16LE where+  get = getWord16LE+  put = putWord16LE++instance Binary Int16LE where+  get = getInt16LE+  put = putInt16LE++instance Binary Word24LE where+  get = getWord24LE+  put = putWord24LE++instance Binary Int24LE where+  get = getInt24LE+  put = putInt24LE++instance Binary Word32LE where+  get = getWord32LE+  put = putWord32LE++instance Binary Int32LE where+  get = getInt32LE+  put = putInt32LE++instance Binary FloatLE where+  get = getFloatLE+  put = putFloatLE++instance Binary Word16BE where+  get = getWord16BE+  put = putWord16BE++instance Binary Int16BE where+  get = getInt16BE+  put = putInt16BE++instance Binary Word24BE where+  get = getWord24BE+  put = putWord24BE++instance Binary Int24BE where+  get = getInt24BE+  put = putInt24BE++instance Binary Word32BE where+  get = getWord32BE+  put = putWord32BE++instance Binary Int32BE where+  get = getInt32BE+  put = putInt32BE++instance Binary FloatBE where+  get = getFloatBE+  put = putFloatBE

@@ -0,0 +1,37 @@+{-# LANGUAGE UndecidableInstances #-}++module Dahdit.BinaryRep+  ( BinaryRep (..)+  , ViaBoundedEnum (..)+  , ViaBinaryRep (..)+  ) where++import Dahdit.Binary (Binary (..))+import Dahdit.Sizes (ByteSized (..), StaticByteSized (..))+import Data.Proxy (Proxy (..))++class Binary x => BinaryRep x a | a -> x where+  fromBinaryRep :: x -> Either String a+  toBinaryRep :: a -> x++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))+  toBinaryRep = fromIntegral . fromEnum . unViaBoundedEnum++newtype ViaBinaryRep a = ViaBinaryRep { unViaBinaryRep :: a }++instance (ByteSized x, BinaryRep x a) => ByteSized (ViaBinaryRep a) where+  byteSize = byteSize . toBinaryRep . unViaBinaryRep++instance (StaticByteSized x, BinaryRep x a) => StaticByteSized (ViaBinaryRep a) where+  staticByteSize _ = staticByteSize (Proxy :: Proxy x)++instance (BinaryRep x a, Binary x) => Binary (ViaBinaryRep a) where+  get = get >>= either fail (pure . ViaBinaryRep) . fromBinaryRep+  put = put . toBinaryRep . unViaBinaryRep

@@ -0,0 +1,186 @@+module Dahdit.Fancy+  ( TermBytes (..)+  , StaticBytes (..)+  , mkStaticBytes+  , normStaticBytes+  , StaticSeq (..)+  , StaticArray (..)+  , BoolByte (..)+  , ExactBytes (..)+  ) 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.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 (..))+import Data.Default (Default (..))+import Data.Primitive (Prim)+import Data.Primitive.ByteArray (ByteArray (..), byteArrayFromListN)+import Data.Primitive.PrimArray (PrimArray, replicatePrimArray)+import Data.Proxy (Proxy (..))+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Data.String (IsString)+import Data.Word (Word8)+import GHC.TypeLits (KnownNat, KnownSymbol, Nat, Symbol, natVal, symbolVal)++getUntilNull :: Get (Int, [Word8])+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)++mkSBS :: Int -> [Word8] -> ShortByteString+mkSBS n bs = let !(ByteArray ba) = byteArrayFromListN n bs in SBS ba++-- | 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 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, IsString)++instance Default TermBytes where+  def = TermBytes BSS.empty++instance ByteSized TermBytes where+  byteSize (TermBytes sbs) =+    let !bc = byteSize 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++  put (TermBytes sbs) = do+    putByteString sbs+    putWord8 0+    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 }+  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++normStaticBytes :: KnownNat n => StaticBytes n -> StaticBytes n+normStaticBytes sb@(StaticBytes sbs) = mkStaticBytes (proxyForNatF sb) sbs++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+  compare x y =+    let StaticBytes x' = normStaticBytes x+        StaticBytes y' = normStaticBytes y+    in compare x' y'++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 => Binary (StaticBytes n) where+  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 (fromIntegral (natVal (Proxy :: Proxy n))) def)++instance (KnownNat n, StaticByteSized a) => StaticByteSized (StaticSeq n a) where+  staticByteSize _ = fromIntegral (natVal (Proxy :: Proxy n)) * staticByteSize (Proxy :: Proxy a)++instance (KnownNat n, Binary a, StaticByteSized a, Default a) => Binary (StaticSeq n a) where+  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 }+  deriving stock (Show)+  deriving newtype (Eq)+  deriving (ByteSized) via (ViaStaticByteSized (StaticArray n a))++instance (KnownNat n, Prim a, Default a) => Default (StaticArray n a) where+  def = StaticArray (replicatePrimArray (fromIntegral (natVal (Proxy :: Proxy n))) def)++instance (KnownNat n, StaticByteSized a) => StaticByteSized (StaticArray n a) where+  staticByteSize _ = fromIntegral (natVal (Proxy :: Proxy n)) * staticByteSize (Proxy :: Proxy a)++instance (KnownNat n, Prim a, StaticByteSized a, Default a) => Binary (StaticArray n a) where+  get = fmap StaticArray (getStaticArray (fromIntegral (natVal (Proxy :: Proxy n))))+  put = unsafePutStaticArrayN (fromIntegral (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+  staticByteSize _ = 1++instance Binary BoolByte where+  get = fmap (BoolByte . (/= 0)) getWord8+  put (BoolByte b) = putWord8 (if b then 1 else 0)++newtype ExactBytes (s :: Symbol) = ExactBytes { unExactBytes :: () }+  deriving stock (Show)+  deriving newtype (Eq)+  deriving (ByteSized) via (ViaStaticByteSized (ExactBytes s))++instance Default (ExactBytes s) where+  def = ExactBytes ()++instance KnownSymbol s => StaticByteSized (ExactBytes s) where+  staticByteSize _ = fromIntegral (length (symbolVal (Proxy :: Proxy s)))++instance KnownSymbol s => Binary (ExactBytes s) where+  get = do+    let !s = symbolVal (Proxy :: Proxy s)+        !bc = fromIntegral (length s)+        !bs = BSS.pack (fmap c2w s)+    getExpect s (getByteString bc) bs+    pure $! ExactBytes ()+  put _ = do+    let !s = symbolVal (Proxy :: Proxy s)+    putByteString (BSS.pack (fmap c2w s))

@@ -0,0 +1,144 @@+module Dahdit.Free+  ( GetStaticSeqF (..)+  , GetStaticArrayF (..)+  , GetLookAheadF (..)+  , GetScopeF (..)+  , ScopeMode (..)+  , GetF (..)+  , Get (..)+  , PutStaticSeqF (..)+  , PutStaticArrayF (..)+  , PutStaticHintF (..)+  , PutF (..)+  , PutM (..)+  , Put+  ) 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.Sizes (ByteCount, ElementCount, StaticByteSized (..))+import Data.ByteString.Short (ShortByteString)+import Data.Int (Int8)+import Data.Primitive (ByteArray, Prim)+import Data.Primitive.PrimArray (PrimArray)+import Data.Proxy (Proxy (..))+import Data.Sequence (Seq)+import Data.Word (Word8)++data GetStaticSeqF a where+  GetStaticSeqF :: (StaticByteSized z) => !ElementCount -> 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 :: (StaticByteSized z, Prim z) => !ElementCount -> Proxy z -> (PrimArray z -> a) -> GetStaticArrayF a++instance Functor GetStaticArrayF where+  fmap f (GetStaticArrayF n p k) = GetStaticArrayF n p (f . k)++data GetLookAheadF a where+  GetLookAheadF :: Get z -> (z -> a) -> GetLookAheadF a++instance Functor GetLookAheadF where+  fmap f (GetLookAheadF g k) = GetLookAheadF g (f . k)++data GetScopeF a where+  GetScopeF :: !ScopeMode -> !ByteCount -> Get z -> (z -> a) -> GetScopeF a++instance Functor GetScopeF where+  fmap f (GetScopeF sm bc g k) = GetScopeF sm bc g (f . k)++data ScopeMode =+    ScopeModeExact+  | ScopeModeWithin+  deriving stock (Eq, Show)++data GetF a =+    GetFWord8 (Word8 -> a)+  | GetFInt8 (Int8 -> a)+  | GetFWord16LE (Word16LE -> a)+  | GetFInt16LE (Int16LE -> a)+  | GetFWord24LE (Word24LE -> a)+  | GetFInt24LE (Int24LE -> a)+  | GetFWord32LE (Word32LE -> a)+  | GetFInt32LE (Int32LE -> a)+  | GetFFloatLE (FloatLE -> a)+  | GetFWord16BE (Word16BE -> a)+  | GetFInt16BE (Int16BE -> a)+  | GetFWord24BE (Word24BE -> a)+  | GetFInt24BE (Int24BE -> a)+  | GetFWord32BE (Word32BE -> a)+  | GetFInt32BE (Int32BE -> a)+  | GetFFloatBE (FloatBE -> a)+  | GetFShortByteString !ByteCount (ShortByteString -> a)+  | GetFStaticSeq !(GetStaticSeqF a)+  | GetFStaticArray !(GetStaticArrayF a)+  | GetFByteArray !ByteCount (ByteArray -> a)+  | GetFScope !(GetScopeF a)+  | GetFSkip !ByteCount a+  | GetFLookAhead !(GetLookAheadF a)+  | GetFRemainingSize (ByteCount -> a)+  | GetFFail !String+  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)))++data PutStaticSeqF a where+  PutStaticSeqF :: StaticByteSized z => !ElementCount -> !(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 :: (StaticByteSized z, Prim z) => !ElementCount -> !(Maybe z) -> !(PrimArray z) -> a -> PutStaticArrayF a++instance Functor PutStaticArrayF where+  fmap f (PutStaticArrayF n z a k) = PutStaticArrayF n z a (f k)++data PutStaticHintF a where+  PutStaticHintF :: !ByteCount -> Put -> a -> PutStaticHintF a++instance Functor PutStaticHintF where+  fmap f (PutStaticHintF n p k) = PutStaticHintF n p (f k)++data PutF a =+    PutFWord8 !Word8 a+  | PutFInt8 !Int8 a+  | PutFWord16LE !Word16LE a+  | PutFInt16LE !Int16LE a+  | PutFWord24LE !Word24LE a+  | PutFInt24LE !Int24LE a+  | PutFWord32LE !Word32LE a+  | PutFInt32LE !Int32LE a+  | PutFFloatLE !FloatLE a+  | PutFWord16BE !Word16BE a+  | PutFInt16BE !Int16BE a+  | PutFWord24BE !Word24BE a+  | PutFInt24BE !Int24BE a+  | PutFWord32BE !Word32BE a+  | PutFInt32BE !Int32BE a+  | PutFFloatBE !FloatBE a+  | PutFShortByteString !ByteCount !ShortByteString a+  | PutFStaticSeq !(PutStaticSeqF a)+  | PutFStaticArray !(PutStaticArrayF a)+  | PutFByteArray !ByteCount !ByteArray a+  | PutFStaticHint !(PutStaticHintF a)+  deriving stock (Functor)++newtype PutM a = PutM { unPutM :: F PutF a }+  deriving newtype (Functor, Applicative, Monad)++instance Semigroup (PutM ()) where+  p <> q = p *> q++instance Monoid (PutM ()) where+  mappend = (<>)+  mempty = pure ()++type Put = PutM ()

@@ -0,0 +1,337 @@+module Dahdit.Funs+  ( getWord8+  , getInt8+  , getWord16LE+  , getInt16LE+  , getWord24LE+  , getInt24LE+  , getWord32LE+  , getInt32LE+  , getFloatLE+  , getWord16BE+  , getInt16BE+  , getWord24BE+  , getInt24BE+  , getWord32BE+  , getInt32BE+  , getFloatBE+  , getByteString+  , getSkip+  , getExact+  , getWithin+  , getSeq+  , getStaticSeq+  , getStaticArray+  , getByteArray+  , getLiftedPrimArray+  , getExpect+  , getLookAhead+  , getRemainingSize+  , getRemainingString+  , getRemainingSeq+  , getRemainingStaticSeq+  , getRemainingStaticArray+  , getRemainingByteArray+  , getRemainingLiftedPrimArray+  , getUnfold+  , putWord8+  , putInt8+  , putWord16LE+  , putInt16LE+  , putWord24LE+  , putInt24LE+  , putWord32LE+  , putInt32LE+  , putFloatLE+  , putWord16BE+  , putInt16BE+  , putWord24BE+  , putInt24BE+  , putWord32BE+  , putInt32BE+  , putFloatBE+  , putByteString+  , putFixedString+  , putSeq+  , putStaticSeq+  , unsafePutStaticSeqN+  , putStaticArray+  , unsafePutStaticArrayN+  , putByteArray+  , putLiftedPrimArray+  , putStaticHint+  ) 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.LiftedPrim (LiftedPrim (..), LiftedPrimArray (..))+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)+import qualified Data.ByteString.Short as BSS+import Data.Foldable (traverse_)+import Data.Int (Int8)+import Data.Primitive (Prim, sizeofByteArray, sizeofPrimArray)+import Data.Primitive.ByteArray (ByteArray)+import Data.Primitive.PrimArray (PrimArray)+import Data.Proxy (Proxy (..))+import Data.Sequence (Seq (..))+import qualified Data.Sequence as Seq+import Data.Word (Word8)++getWord8 :: Get Word8+getWord8 = Get (F (\x y -> y (GetFWord8 x)))++getInt8 :: Get Int8+getInt8 = Get (F (\x y -> y (GetFInt8 x)))++getWord16LE :: Get Word16LE+getWord16LE = Get (F (\x y -> y (GetFWord16LE x)))++getInt16LE :: Get Int16LE+getInt16LE = Get (F (\x y -> y (GetFInt16LE x)))++getWord24LE :: Get Word24LE+getWord24LE = Get (F (\x y -> y (GetFWord24LE x)))++getInt24LE :: Get Int24LE+getInt24LE = Get (F (\x y -> y (GetFInt24LE x)))++getWord32LE :: Get Word32LE+getWord32LE = Get (F (\x y -> y (GetFWord32LE x)))++getInt32LE :: Get Int32LE+getInt32LE = Get (F (\x y -> y (GetFInt32LE x)))++getFloatLE :: Get FloatLE+getFloatLE = Get (F (\x y -> y (GetFFloatLE x)))++getWord16BE :: Get Word16BE+getWord16BE = Get (F (\x y -> y (GetFWord16BE x)))++getInt16BE :: Get Int16BE+getInt16BE = Get (F (\x y -> y (GetFInt16BE x)))++getWord24BE :: Get Word24BE+getWord24BE = Get (F (\x y -> y (GetFWord24BE x)))++getInt24BE :: Get Int24BE+getInt24BE = Get (F (\x y -> y (GetFInt24BE x)))++getWord32BE :: Get Word32BE+getWord32BE = Get (F (\x y -> y (GetFWord32BE x)))++getInt32BE :: Get Int32BE+getInt32BE = Get (F (\x y -> y (GetFInt32BE x)))++getFloatBE :: Get FloatBE+getFloatBE = Get (F (\x y -> y (GetFFloatBE x)))++getByteString :: ByteCount -> Get ShortByteString+getByteString bc = Get (F (\x y -> y (GetFShortByteString bc x)))++getSkip :: ByteCount -> Get ()+getSkip bc = Get (F (\x y -> y (GetFSkip bc (x ()))))++getExact :: ByteCount -> Get a -> Get a+getExact bc g = Get (F (\x y -> y (GetFScope (GetScopeF ScopeModeExact bc g x))))++getWithin :: ByteCount -> Get a -> Get a+getWithin bc g = Get (F (\x y -> y (GetFScope (GetScopeF ScopeModeWithin bc g x))))++-- | Get Seq of dynamically-sized elements+getSeq :: ElementCount -> Get a -> Get (Seq a)+getSeq ec g = go Empty 0 where+  go !acc i =+    if i == ec+      then pure acc+      else do+        x <- g+        x `seq` go (acc :|> x) (i + 1)++-- | Get Seq of statically-sized elements+getStaticSeq :: (StaticByteSized a) => ElementCount -> 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 :: (StaticByteSized a, Prim a) => ElementCount -> Get (PrimArray 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 -> ElementCount -> Get (LiftedPrimArray a)+getLiftedPrimArray prox ec =+  let !bc = fromIntegral (elemSizeLifted prox * fromIntegral ec)+  in fmap LiftedPrimArray (getByteArray bc)++getLookAhead :: Get a -> Get a+getLookAhead g = Get (F (\x y -> y (GetFLookAhead (GetLookAheadF g x))))++getRemainingSize :: Get ByteCount+getRemainingSize = Get (F (\x y -> y (GetFRemainingSize x)))++getRemainingString :: Get ShortByteString+getRemainingString = getRemainingSize >>= getByteString++getRemainingSeq :: Get a -> Get (Seq a)+getRemainingSeq g = go Empty where+  go !acc = do+    bc <- getRemainingSize+    if bc == 0+      then pure acc+      else do+        x <- g+        x `seq` go (acc :|> x)++getRemainingStaticSeq :: (StaticByteSized a) => Get a -> Get (Seq a)+getRemainingStaticSeq g = do+  let !ebc = staticByteSize (proxyForF g)+  bc <- getRemainingSize+  let !left = rem bc ebc+  if left == 0+    then do+      let !ec = fromIntegral (div bc ebc)+      getStaticSeq ec g+    else fail ("Leftover bytes for remaining static seq (have " ++ show (unByteCount left) ++ ", need " ++ show (unByteCount ebc) ++ ")")++getRemainingStaticArray :: (StaticByteSized a, Prim a) => Proxy a -> Get (PrimArray a)+getRemainingStaticArray prox = do+  let !ebc = staticByteSize prox+  bc <- getRemainingSize+  let !left = rem bc ebc+  if left == 0+    then do+      let !ec = fromIntegral (div bc ebc)+      getStaticArray ec+    else fail ("Leftover bytes for remaining static array (have " ++ show (unByteCount left) ++ ", need " ++ show (unByteCount ebc) ++ ")")++getRemainingByteArray :: Get ByteArray+getRemainingByteArray = getRemainingSize >>= getByteArray++getRemainingLiftedPrimArray :: (LiftedPrim a) => Proxy a -> Get (LiftedPrimArray a)+getRemainingLiftedPrimArray prox = do+  let !ebc = fromIntegral (elemSizeLifted prox)+  bc <- getRemainingSize+  let !left = rem bc ebc+  if left == 0+    then do+      let !ec = fromIntegral (div bc ebc)+      getLiftedPrimArray prox ec+    else fail ("Leftover bytes for remaining lifted prim array (have " ++ show (unByteCount left) ++ ", need " ++ show (unByteCount ebc) ++ ")")++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))++getUnfold :: b -> (b -> Get (Either b a)) -> Get a+getUnfold b0 f = go b0 where+  go !b = do+    eba <- f b+    either go pure eba++putWord8 :: Word8 -> Put+putWord8 d = PutM (F (\x y -> y (PutFWord8 d (x ()))))++putInt8 :: Int8 -> Put+putInt8 d = PutM (F (\x y -> y (PutFInt8 d (x ()))))++putWord16LE :: Word16LE -> Put+putWord16LE d = PutM (F (\x y -> y (PutFWord16LE d (x ()))))++putInt16LE :: Int16LE -> Put+putInt16LE d = PutM (F (\x y -> y (PutFInt16LE d (x ()))))++putWord24LE :: Word24LE -> Put+putWord24LE d = PutM (F (\x y -> y (PutFWord24LE d (x ()))))++putInt24LE :: Int24LE -> Put+putInt24LE d = PutM (F (\x y -> y (PutFInt24LE d (x ()))))++putWord32LE :: Word32LE -> Put+putWord32LE d = PutM (F (\x y -> y (PutFWord32LE d (x ()))))++putInt32LE :: Int32LE -> Put+putInt32LE d = PutM (F (\x y -> y (PutFInt32LE d (x ()))))++putFloatLE :: FloatLE -> Put+putFloatLE d = PutM (F (\x y -> y (PutFFloatLE d (x ()))))++putWord16BE :: Word16BE -> Put+putWord16BE d = PutM (F (\x y -> y (PutFWord16BE d (x ()))))++putInt16BE :: Int16BE -> Put+putInt16BE d = PutM (F (\x y -> y (PutFInt16BE d (x ()))))++putWord24BE :: Word24BE -> Put+putWord24BE d = PutM (F (\x y -> y (PutFWord24BE d (x ()))))++putInt24BE :: Int24BE -> Put+putInt24BE d = PutM (F (\x y -> y (PutFInt24BE d (x ()))))++putWord32BE :: Word32BE -> Put+putWord32BE d = PutM (F (\x y -> y (PutFWord32BE d (x ()))))++putInt32BE :: Int32BE -> Put+putInt32BE d = PutM (F (\x y -> y (PutFInt32BE d (x ()))))++putFloatBE :: FloatBE -> Put+putFloatBE d = PutM (F (\x y -> y (PutFFloatBE d (x ()))))++putByteString :: ShortByteString -> Put+putByteString sbs =+  let !bc = fromIntegral (BSS.length sbs)+  in PutM (F (\x y -> y (PutFShortByteString bc sbs (x ()))))++putFixedString :: Word8 -> ByteCount -> ShortByteString -> Put+putFixedString pad bc sbs = do+  unless (bc == 0) $ do+    let !len = fromIntegral bc+        !lenSbs = BSS.length sbs+        !mostLen = min len lenSbs+        !mostBc = fromIntegral mostLen+    PutM (F (\x y -> y (PutFShortByteString mostBc sbs (x ()))))+    let !diff = len - lenSbs+    unless (diff <= 0) (replicateM_ diff (putWord8 pad))++-- | Put Seq of dynamically-sized elements+putSeq :: (a -> Put) -> Seq a -> Put+putSeq = traverse_++-- | Put Seq of statically-sized elements+putStaticSeq :: StaticByteSized a => (a -> Put) -> Seq a -> Put+putStaticSeq p s =+  let !n = fromIntegral (Seq.length 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 ())))))++-- | Put Array of statically-sized elements+putStaticArray :: (StaticByteSized a, Prim a) => PrimArray a -> Put+putStaticArray a =+  let !n = fromIntegral (sizeofPrimArray 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 ())))))++putByteArray :: ByteArray -> Put+putByteArray arr =+  let !bc = fromIntegral (sizeofByteArray arr)+  in PutM (F (\x y -> y (PutFByteArray bc arr (x ()))))++putLiftedPrimArray :: LiftedPrimArray a -> Put+putLiftedPrimArray = putByteArray . unLiftedPrimArray++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 ())))))

@@ -0,0 +1,98 @@+{-# LANGUAGE UndecidableInstances #-}++module Dahdit.Generic+  ( ViaGeneric (..)+  , ViaStaticGeneric (..)+  ) where++import Control.Applicative (liftA2)+import Dahdit.Binary (Binary (..))+import Dahdit.Free (Get, Put)+import Dahdit.Funs (putStaticHint)+import Dahdit.Sizes (ByteCount, ByteSized (..), StaticByteSized (..))+import Data.Kind (Type)+import Data.Proxy (Proxy (..))+import GHC.Generics ((:*:) (..), Generic (..), K1 (..), M1 (..), U1 (..))++-- | Use: deriving (ByteSized, Binary) via (ViaGeneric Foo)+newtype ViaGeneric a = ViaGeneric { unViaGeneric :: a }++-- | Use: deriving (ByteSized, StaticByteSized, Binary) via (ViaStaticGeneric Foo)+newtype ViaStaticGeneric a = ViaStaticGeneric { unViaStaticGeneric :: a }++-- ByteSized:++class GByteSized f where+  gbyteSize :: f a -> ByteCount++-- Unit+instance GByteSized U1 where+  gbyteSize _ = 0++-- Product+instance (GByteSized a, GByteSized b) => GByteSized (a :*: b) where+  gbyteSize (x :*: y) = gbyteSize x + gbyteSize y++-- Metadata+instance GByteSized a => GByteSized (M1 i c a) where+  gbyteSize = gbyteSize . unM1++-- Field+instance ByteSized 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+  gstaticByteSize :: Proxy f -> ByteCount++instance GStaticByteSized U1 where+  gstaticByteSize _ = 0++instance (GStaticByteSized a, GStaticByteSized b) => GStaticByteSized (a :*: b) where+  gstaticByteSize _ = gstaticByteSize (Proxy :: Proxy a) + gstaticByteSize (Proxy :: Proxy b)++instance GStaticByteSized a => GStaticByteSized (M1 i c a) where+  gstaticByteSize _ = gstaticByteSize (Proxy :: Proxy a)++instance StaticByteSized a => GStaticByteSized (K1 i a) where+  gstaticByteSize _ = staticByteSize (Proxy :: Proxy a)++instance (Generic t, GStaticByteSized (Rep t)) => StaticByteSized (ViaStaticGeneric t) where+  staticByteSize _ = gstaticByteSize (Proxy :: Proxy (Rep t))++-- Binary:++class GByteSized f => GBinary (f :: Type -> Type) where+  gget :: Get (f a)+  gput :: f a -> Put++instance GBinary U1 where+  gget = pure U1+  gput _ = pure ()++instance (GBinary a, GBinary b) => GBinary (a :*: b) where+  gget = liftA2 (:*:) gget gget+  gput (x :*: y) = gput x *> gput y++instance GBinary a => GBinary (M1 i c a) where+  gget = fmap M1 gget+  gput = gput . unM1++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)

@@ -0,0 +1,86 @@+module Dahdit.Internal where++import Data.Bits (Bits (..))+import Data.Int (Int16, Int32, Int8)+import Data.ShortWord (Int24, Word24)+import Data.Word (Word16, Word32, Word8)+import GHC.Float (castFloatToWord32, castWord32ToFloat)++newtype ViaFromIntegral x y = ViaFromIntegral { unViaFromIntegral :: y }+  deriving newtype (Num)++-- Types that can swap endianness - swapEndian is its own inverse+class Num w => SwapEndian w where+  swapEndian :: w -> w++instance (SwapEndian x, Integral x, Integral y) => SwapEndian (ViaFromIntegral x y) where+  swapEndian = ViaFromIntegral . fromIntegral @x @y . swapEndian . fromIntegral @y @x . unViaFromIntegral++instance SwapEndian Word8 where+  swapEndian = id++instance SwapEndian Int8 where+  swapEndian = id++instance SwapEndian Word16 where+  swapEndian w =+    let (b0, b1) = unMkWord16LE w+    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++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++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++mkWord16LE :: Word8 -> Word8 -> Word16+mkWord16LE b0 b1 = (fromIntegral b1 `unsafeShiftL` 8) .|. fromIntegral b0++unMkWord16LE :: Word16 -> (Word8, Word8)+unMkWord16LE w =+  let !b0 = fromIntegral w+      !b1 = fromIntegral (w `shiftR` 8)+  in (b0, b1)++mkWord24LE :: Word8 -> Word8 -> Word8 -> Word24+mkWord24LE b0 b1 b2 = fromIntegral (mkWord32LE b0 b1 b2 0)++unMkWord24LE :: Word24 -> (Word8, Word8, Word8)+unMkWord24LE w =+  let !v = fromIntegral w+      (b0, b1, b2, _) = unMkWord32LE v+  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++unMkWord32LE :: Word32 -> (Word8, Word8, Word8, Word8)+unMkWord32LE w =+  let !b0 = fromIntegral w+      !b1 = fromIntegral (w `shiftR` 8)+      !b2 = fromIntegral (w `shiftR` 16)+      !b3 = fromIntegral (w `shiftR` 24)+  in (b0, b1, b2, b3)++mkFloatLE :: Word8 -> Word8 -> Word8 -> Word8 -> Float+mkFloatLE b0 b1 b2 b3 = castWord32ToFloat (mkWord32LE b0 b1 b2 b3)++unMkFloatLE :: Float -> (Word8, Word8, Word8, Word8)+unMkFloatLE f = unMkWord32LE (castFloatToWord32 f)

@@ -0,0 +1,126 @@+module Dahdit.LiftedPrim+  ( LiftedPrim (..)+  , LiftedPrimArray (..)+  , MutableLiftedPrimArray (..)+  , emptyLiftedPrimArray+  , indexLiftedPrimArray+  , writeLiftedPrimArray+  , freezeLiftedPrimArray+  , thawLiftedPrimArray+  , unsafeFreezeLiftedPrimArray+  , unsafeThawLiftedPrimArray+  , liftedPrimArrayFromListN+  , liftedPrimArrayFromList+  , generateLiftedPrimArray+  , sizeofLiftedPrimArray+  , cloneLiftedPrimArray+  ) where++import Control.Monad.Primitive (PrimMonad (..))+import Dahdit.Internal (ViaFromIntegral (..))+import Dahdit.Proxy (proxyForF)+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.Proxy (Proxy (..))+import Data.STRef (modifySTRef', newSTRef, readSTRef)+import Data.Word (Word8)++-- | 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 byte arrays.+class LiftedPrim a where+  elemSizeLifted :: Proxy a -> Int+  indexByteArrayLiftedInBytes :: ByteArray -> Int -> a+  indexByteArrayLiftedInElems :: ByteArray -> Int -> a+  indexByteArrayLiftedInElems arr pos =+    let !sz = elemSizeLifted (Proxy :: Proxy a)+    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)++instance LiftedPrim Word8 where+  elemSizeLifted _ = 1+  indexByteArrayLiftedInBytes = indexByteArray+  writeByteArrayLiftedInBytes val arr pos = writeByteArray arr pos val++instance LiftedPrim Int8 where+  elemSizeLifted _ = 1+  indexByteArrayLiftedInBytes = indexByteArray+  indexByteArrayLiftedInElems = indexByteArray+  writeByteArrayLiftedInBytes val arr pos = writeByteArray arr pos val+  writeByteArrayLiftedInElems val arr pos = writeByteArray arr pos val++-- | NOTE: Relies on same byte width of both types!+instance (Num x, Integral x, LiftedPrim x, Num y, Integral y) => LiftedPrim (ViaFromIntegral x y) where+  elemSizeLifted _ = elemSizeLifted (Proxy :: Proxy x)+  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 }+  deriving stock (Show)+  deriving newtype (Eq, Semigroup, Monoid)++instance Default (LiftedPrimArray a) where+  def = emptyLiftedPrimArray++newtype MutableLiftedPrimArray m a = MutableLiftedPrimArray { unMutableLiftedPrimArray :: MutableByteArray m }+  deriving newtype (Eq)++emptyLiftedPrimArray :: LiftedPrimArray a+emptyLiftedPrimArray = LiftedPrimArray emptyByteArray++indexLiftedPrimArray :: LiftedPrim a => LiftedPrimArray a -> Int -> a+indexLiftedPrimArray (LiftedPrimArray arr) = indexByteArrayLiftedInElems arr++writeLiftedPrimArray :: (LiftedPrim a, PrimMonad m) => a -> MutableLiftedPrimArray (PrimState m) a -> Int -> m ()+writeLiftedPrimArray val (MutableLiftedPrimArray arr) = writeByteArrayLiftedInElems val arr++freezeLiftedPrimArray :: PrimMonad m => MutableLiftedPrimArray (PrimState m) a -> Int -> Int -> m (LiftedPrimArray a)+freezeLiftedPrimArray (MutableLiftedPrimArray arr) off len = fmap LiftedPrimArray (freezeByteArray arr off len)++unsafeFreezeLiftedPrimArray :: PrimMonad m => MutableLiftedPrimArray (PrimState m) a -> m (LiftedPrimArray a)+unsafeFreezeLiftedPrimArray (MutableLiftedPrimArray arr) = fmap LiftedPrimArray (unsafeFreezeByteArray arr)++thawLiftedPrimArray :: PrimMonad m => LiftedPrimArray a -> Int -> Int -> m (MutableLiftedPrimArray (PrimState m) a)+thawLiftedPrimArray (LiftedPrimArray arr) off len = fmap MutableLiftedPrimArray (thawByteArray arr off len)++unsafeThawLiftedPrimArray :: PrimMonad m => LiftedPrimArray a -> m (MutableLiftedPrimArray (PrimState m) a)+unsafeThawLiftedPrimArray (LiftedPrimArray arr) = fmap MutableLiftedPrimArray (unsafeThawByteArray arr)++liftedPrimArrayFromListN :: LiftedPrim a => Int -> [a] -> LiftedPrimArray a+liftedPrimArrayFromListN n xs = LiftedPrimArray $ runByteArray $ do+  let !elemSize = elemSizeLifted (proxyForF xs)+      !len = n * elemSize+  arr <- newByteArray len+  offRef <- newSTRef 0+  for_ xs $ \x -> do+    off <- readSTRef offRef+    writeByteArrayLiftedInBytes x arr off+    modifySTRef' offRef (elemSize+)+  pure arr++liftedPrimArrayFromList :: LiftedPrim a => [a] -> LiftedPrimArray a+liftedPrimArrayFromList xs = liftedPrimArrayFromListN (length xs) xs++generateLiftedPrimArray :: LiftedPrim a => Int -> (Int -> a) -> LiftedPrimArray a+generateLiftedPrimArray n f = liftedPrimArrayFromListN n (fmap f [0 .. n - 1])++sizeofLiftedPrimArray :: LiftedPrim a => LiftedPrimArray a -> Int+sizeofLiftedPrimArray pa@(LiftedPrimArray arr) =+  let !elemSize = elemSizeLifted (proxyForF pa)+      !arrSize = sizeofByteArray arr+  in div arrSize elemSize++cloneLiftedPrimArray :: LiftedPrim a => LiftedPrimArray a -> Int -> Int -> LiftedPrimArray a+cloneLiftedPrimArray pa@(LiftedPrimArray arr) off len =+  let !elemSize = elemSizeLifted (proxyForF pa)+      !byteOff = off * elemSize+      !byteLen = len * elemSize+      !arr' = cloneByteArray arr byteOff byteLen+  in LiftedPrimArray arr'

@@ -0,0 +1,220 @@+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Derived instances rely on the host system being little-endian.+-- If it's not, well... some CPP is in order.+module Dahdit.Nums+  ( EndianPair (..)+  , Word16LE (..)+  , Int16LE (..)+  , Word24LE (..)+  , Int24LE (..)+  , Word32LE (..)+  , Int32LE (..)+  , FloatLE (..)+  , Word16BE (..)+  , Int16BE (..)+  , Word24BE (..)+  , Int24BE (..)+  , Word32BE (..)+  , Int32BE (..)+  , FloatBE (..)+  ) where++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 (..))+import Data.Int (Int16, Int32, Int8)+import Data.Primitive.ByteArray (indexByteArray, writeByteArray)+import Data.Primitive.Types (Prim (..))+import Data.Proxy (Proxy (..))+import Data.ShortWord (Int24, Word24)+import Data.Word (Word16, Word32, Word8)++class (Num le, Num be) => EndianPair le be | le -> be, be -> le where+  toLittleEndian :: be -> le+  toBigEndian :: le -> be++newtype Word16LE = Word16LE { unWord16LE :: Word16 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits, Default, Prim)++instance LiftedPrim Word16LE where+  elemSizeLifted _ = 2++  indexByteArrayLiftedInBytes arr pos =+    let !b0 = indexByteArray arr pos+        !b1 = indexByteArray arr (pos + 1)+    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++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 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits)++instance Default Word24LE where+  def = 0++instance LiftedPrim Word24LE where+  elemSizeLifted _ = 3++  indexByteArrayLiftedInBytes arr pos =+    let !b0 = indexByteArray arr pos+        !b1 = indexByteArray arr (pos + 1)+        !b2 = indexByteArray arr (pos + 2)+    in Word24LE (mkWord24LE b0 b1 b2)++  writeByteArrayLiftedInBytes w arr pos = do+    let !(b0, b1, b2) = unMkWord24LE (unWord24LE w)+    writeByteArray arr pos b0+    writeByteArray arr (pos + 1) b1+    writeByteArray arr (pos + 2) b2++newtype Int24LE = Int24LE { unInt24LE :: Int24 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits)+  deriving (LiftedPrim) via (ViaFromIntegral Word24LE Int24LE)++instance Default Int24LE where+  def = 0++newtype Word32LE = Word32LE { unWord32LE :: Word32 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits, Default, Prim)++instance LiftedPrim Word32LE where+  elemSizeLifted _ = 4++  indexByteArrayLiftedInBytes arr pos =+    let !b0 = indexByteArray arr pos+        !b1 = indexByteArray arr (pos + 1)+        !b2 = indexByteArray arr (pos + 2)+        !b3 = indexByteArray arr (pos + 3)+    in Word32LE (mkWord32LE b0 b1 b2 b3)++  writeByteArrayLiftedInBytes w arr pos = do+    let !(b0, b1, b2, b3) = unMkWord32LE (unWord32LE w)+    writeByteArray arr pos b0+    writeByteArray arr (pos + 1) b1+    writeByteArray arr (pos + 2) b2+    writeByteArray arr (pos + 3) b3++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 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, Num, Real, Fractional, Floating, RealFrac, Default, Prim)++instance LiftedPrim FloatLE where+  elemSizeLifted _ = 4++  indexByteArrayLiftedInBytes arr pos =+    let !b0 = indexByteArray arr pos+        !b1 = indexByteArray arr (pos + 1)+        !b2 = indexByteArray arr (pos + 2)+        !b3 = indexByteArray arr (pos + 3)+    in FloatLE (mkFloatLE b0 b1 b2 b3)++  writeByteArrayLiftedInBytes f arr pos = do+    let !(b0, b1, b2, b3) = unMkFloatLE (unFloatLE f)+    writeByteArray arr pos b0+    writeByteArray arr (pos + 1) b1+    writeByteArray arr (pos + 2) b2+    writeByteArray arr (pos + 3) b3++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 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits, Default)+  deriving (LiftedPrim) via (ViaEndianPair Int16LE Int16BE)++newtype Word24BE = Word24BE { unWord24BE :: Word24 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits)+  deriving (LiftedPrim) via (ViaEndianPair Word24LE Word24BE)++instance Default Word24BE where+  def = 0++newtype Int24BE = Int24BE { unInt24BE :: Int24 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits)+  deriving (LiftedPrim) via (ViaEndianPair Int24LE Int24BE)++instance Default Int24BE where+  def = 0++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 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bits, Default)+  deriving (LiftedPrim) via (ViaEndianPair Int32LE Int32BE)++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)++instance EndianPair Word8 Word8 where+  toLittleEndian = id+  toBigEndian = id++instance EndianPair Int8 Int8 where+  toLittleEndian = id+  toBigEndian = id++instance EndianPair Word16LE Word16BE where+  toLittleEndian = Word16LE . swapEndian . unWord16BE+  toBigEndian = Word16BE . swapEndian . unWord16LE++instance EndianPair Int16LE Int16BE where+  toLittleEndian = Int16LE . swapEndian . unInt16BE+  toBigEndian = Int16BE . swapEndian . unInt16LE++instance EndianPair Word24LE Word24BE where+  toLittleEndian = Word24LE . swapEndian . unWord24BE+  toBigEndian = Word24BE . swapEndian . unWord24LE++instance EndianPair Int24LE Int24BE where+  toLittleEndian = Int24LE . swapEndian . unInt24BE+  toBigEndian = Int24BE . swapEndian . unInt24LE++instance EndianPair Word32LE Word32BE where+  toLittleEndian = Word32LE . swapEndian . unWord32BE+  toBigEndian = Word32BE . swapEndian . unWord32LE++instance EndianPair Int32LE Int32BE where+  toLittleEndian = Int32LE . swapEndian . unInt32BE+  toBigEndian = Int32BE . swapEndian . unInt32LE++instance EndianPair FloatLE FloatBE where+  toLittleEndian = FloatLE . swapEndian . unFloatBE+  toBigEndian = FloatBE . swapEndian . unFloatLE++newtype ViaEndianPair le be = ViaEndianPair { unViaEndianPair :: be }++instance (LiftedPrim le, EndianPair le be) => LiftedPrim (ViaEndianPair le be) where+  elemSizeLifted _ = elemSizeLifted (Proxy :: Proxy le)+  indexByteArrayLiftedInBytes arr pos = ViaEndianPair (toBigEndian (indexByteArrayLiftedInBytes arr pos))+  writeByteArrayLiftedInBytes (ViaEndianPair bval) = writeByteArrayLiftedInBytes (toLittleEndian bval)

@@ -0,0 +1,21 @@+module Dahdit.Proxy+  ( proxyFor+  , proxyForF+  , proxyForFun+  , proxyForNatF+  ) where++import Data.Proxy (Proxy (..))+import GHC.TypeLits (Nat)++proxyFor :: a -> Proxy a+proxyFor _ = Proxy++proxyForF :: f a -> Proxy a+proxyForF _ = Proxy++proxyForFun :: (a -> x) -> Proxy a+proxyForFun _ = Proxy++proxyForNatF :: forall (n :: Nat) f. f n -> Proxy n+proxyForNatF _ = Proxy

@@ -0,0 +1,432 @@+module Dahdit.Run+  ( GetError (..)+  , prettyGetError+  , runGet+  , runGetIO+  , runGetFile+  , runCount+  , runPut+  , runPutFile+  ) where++import Control.Applicative (Alternative (..))+import Control.Exception (Exception (..), throwIO)+import Control.Monad (replicateM_, unless)+import Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError)+import Control.Monad.Free.Church (F (..))+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.Maybe (MaybeT (..))+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.Proxy (proxyForF)+import Dahdit.Sizes (ByteCount (..), staticByteSize)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Short as BSS+import Data.ByteString.Short.Internal (ShortByteString (..))+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.PrimArray (PrimArray (..), sizeofPrimArray)+import qualified Data.Sequence as Seq+import Data.STRef.Strict (STRef, newSTRef, readSTRef, writeSTRef)+import Data.Word (Word8)++-- Sizes:++getStaticSeqSize :: GetStaticSeqF a -> Int+getStaticSeqSize (GetStaticSeqF ec g _) =+  let !z = fromIntegral (staticByteSize (proxyForF g))+  in z * fromIntegral ec++getStaticArraySize :: GetStaticArrayF a -> Int+getStaticArraySize (GetStaticArrayF n prox _) =+  let !z = fromIntegral (staticByteSize prox)+  in z * fromIntegral n++putStaticSeqSize :: PutStaticSeqF a -> Int+putStaticSeqSize (PutStaticSeqF n _ _ s _) =+  let !z = fromIntegral (staticByteSize (proxyForF s))+  in z * fromIntegral n++putStaticArrayElemSize :: PutStaticArrayF a -> Int+putStaticArrayElemSize (PutStaticArrayF _ _ a _) =+  fromIntegral (staticByteSize (proxyForF a))++putStaticArraySize :: PutStaticArrayF a -> Int+putStaticArraySize (PutStaticArrayF n _ a _) =+  let !z = fromIntegral (staticByteSize (proxyForF a))+  in z * fromIntegral n++-- Get:++data GetError =+    GetErrorParseNeed !String !ByteCount !ByteCount+  | GetErrorScopedMismatch !ByteCount !ByteCount+  | GetErrorFail !String+  deriving stock (Eq, Show)++instance Exception GetError where+  displayException = prettyGetError++prettyGetError :: GetError -> String+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++data GetEnv s = GetEnv+  { geLen :: !Int+  , gePos :: !(STRef s Int)+  , geArray :: !ByteArray+  }++newGetEnv :: ShortByteString -> ST s (GetEnv s)+newGetEnv sbs@(SBS arr) = do+  let !len = BSS.length sbs+  pos <- newSTRef 0+  pure $! GetEnv len pos (ByteArray arr)++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)+runGetEff m l = runExceptT (runReaderT (unGetEff m) l)++instance MonadFail (GetEff s) where+  fail = GetEff . throwError . GetErrorFail++stGetEff :: ST s a -> GetEff s a+stGetEff = GetEff . lift . lift++newtype GetRun s a = GetRun { unGetRun :: FreeT GetF (GetEff s) a }+  deriving newtype (Functor, Applicative, Monad)++guardReadBytes :: String -> Int -> GetEff s Int+guardReadBytes nm bc = do+  GetEnv l posRef _ <- ask+  pos <- stGetEff (readSTRef posRef)+  let !ac = l - pos+  if bc > ac+    then throwError (GetErrorParseNeed nm (fromIntegral ac) (fromIntegral bc))+    else pure pos++readBytes :: String -> Int -> (ByteArray -> Int -> a) -> GetEff s a+readBytes nm bc f = do+  pos <- guardReadBytes nm bc+  GetEnv _ posRef arr <- ask+  stGetEff $ do+    let !a = f arr pos+        !newPos = pos + bc+    writeSTRef posRef newPos+    pure a++readShortByteString :: Int -> ByteArray -> Int -> ShortByteString+readShortByteString len arr pos = let !(ByteArray frozArr) = cloneByteArray arr pos len in SBS frozArr++readScope :: GetScopeF (GetEff s a) -> GetEff s a+readScope (GetScopeF sm bc g k) = do+  let intBc = fromIntegral bc+  GetEnv oldLen posRef _ <- ask+  oldPos <- stGetEff (readSTRef posRef)+  let !oldAvail = oldLen - oldPos+  if intBc > oldAvail+    then throwError (GetErrorParseNeed "scope" (fromIntegral oldAvail) bc)+    else do+      let !newLen = oldPos + intBc+      a <- local (\ge -> ge { geLen = newLen }) (mkGetEff g)+      case sm of+        ScopeModeWithin -> k a+        ScopeModeExact -> do+          newPos <- stGetEff (readSTRef posRef)+          let !actualBc = newPos - oldPos+          if actualBc == intBc+            then k a+            else throwError (GetErrorScopedMismatch (fromIntegral actualBc) bc)++readStaticSeq :: GetStaticSeqF (GetEff s a) -> GetEff s a+readStaticSeq gss@(GetStaticSeqF ec g k) = do+  let !bc = getStaticSeqSize gss+  _ <- guardReadBytes "static sequence" bc+  ss <- Seq.replicateA (fromIntegral ec) (mkGetEff g)+  k ss++readStaticArray :: GetStaticArrayF (GetEff s a) -> GetEff s a+readStaticArray gsa@(GetStaticArrayF _ _ k) = do+  let !bc = getStaticArraySize gsa+  sa <- readBytes "static vector" bc (\arr pos -> let !(ByteArray frozArr) = cloneByteArray arr pos bc in PrimArray frozArr)+  k sa++readLookAhead :: GetLookAheadF (GetEff s a) -> GetEff s a+readLookAhead (GetLookAheadF g k) = do+  posRef <- asks gePos+  startPos <- stGetEff (readSTRef posRef)+  a <- mkGetEff g+  stGetEff (writeSTRef posRef startPos)+  k a++execGetRun :: GetF (GetEff s a) -> GetEff s a+execGetRun = \case+  GetFWord8 k -> readBytes "Word8" 1 (indexByteArray @Word8) >>= k+  GetFInt8 k -> readBytes "Int8" 1 (indexByteArray @Int8) >>= k+  GetFWord16LE k -> readBytes "Word16LE" 2 (indexByteArrayLiftedInBytes @Word16LE) >>= k+  GetFInt16LE k -> readBytes "Int16LE" 2 (indexByteArrayLiftedInBytes @Int16LE) >>= k+  GetFWord24LE k -> readBytes "Word24LE" 3 (indexByteArrayLiftedInBytes @Word24LE) >>= k+  GetFInt24LE k -> readBytes "Int24LE" 3 (indexByteArrayLiftedInBytes @Int24LE) >>= k+  GetFWord32LE k -> readBytes "Word32LE" 4 (indexByteArrayLiftedInBytes @Word32LE) >>= k+  GetFInt32LE k -> readBytes "Int32LE" 4 (indexByteArrayLiftedInBytes @Int32LE) >>= k+  GetFFloatLE k -> readBytes "FloatLE" 4 (indexByteArrayLiftedInBytes @FloatLE) >>= k+  GetFWord16BE k -> readBytes "Word16BE" 2 (indexByteArrayLiftedInBytes @Word16BE) >>= k+  GetFInt16BE k -> readBytes "Int16BE" 2 (indexByteArrayLiftedInBytes @Int16BE) >>= k+  GetFWord24BE k -> readBytes "Word24BE" 3 (indexByteArrayLiftedInBytes @Word24BE) >>= k+  GetFInt24BE k -> readBytes "Int24BE" 3 (indexByteArrayLiftedInBytes @Int24BE) >>= k+  GetFWord32BE k -> readBytes "Word32BE" 4 (indexByteArrayLiftedInBytes @Word32BE) >>= k+  GetFInt32BE k -> readBytes "Int32BE" 4 (indexByteArrayLiftedInBytes @Int32BE) >>= k+  GetFFloatBE k -> readBytes "FloatBE" 4 (indexByteArrayLiftedInBytes @FloatBE) >>= k+  GetFShortByteString bc k ->+    let !len = fromIntegral bc+    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+  GetFScope gs -> readScope gs+  GetFSkip bc k -> readBytes "skip" (fromIntegral bc) (\_ _ -> ()) *> k+  GetFLookAhead gla -> readLookAhead gla+  GetFRemainingSize k -> do+    GetEnv len posRef _ <- ask+    pos <- stGetEff (readSTRef posRef)+    let !bc = fromIntegral (len - pos)+    k bc+  GetFFail msg -> fail msg++runGetRun :: GetRun s a -> GetEnv s -> ST s (Either GetError a)+runGetRun = runGetEff . iterGetRun++iterGetRun :: GetRun s a -> GetEff s a+iterGetRun m = iterT execGetRun (unGetRun m)++mkGetRun :: Get a -> GetRun s a+mkGetRun (Get (F w)) = GetRun (w pure wrap)++mkGetEff :: Get a -> GetEff s a+mkGetEff = iterGetRun . mkGetRun++runGet :: Get a -> ShortByteString -> (Either GetError a, ByteCount)+runGet m bs = runST $ do+  let !n = mkGetEff m+  env <- newGetEnv bs+  ea <- runGetEff n env+  bc <- readSTRef (gePos env)+  pure (ea, fromIntegral bc)++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)++runGetFile :: Get a -> FilePath -> IO (a, ByteCount)+runGetFile m fp = do+  bs <- BS.readFile fp+  let !bss = BSS.toShort bs+  runGetIO m bss++-- Put unsafe:++data PutEnv s = PutEnv+  { peLen :: !Int+  , pePos :: !(STRef s Int)+  , peArray :: !(MutableByteArray s)+  }++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 }+  deriving newtype (Functor, Applicative, Monad, MonadReader (PutEnv s))++runPutEff :: PutEff s a -> PutEnv s -> ST s a+runPutEff m = runReaderT (unPutEff m)++stPutEff :: ST s a -> PutEff s a+stPutEff = PutEff . lift++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 ()+writeBytes bc f = do+  PutEnv _ posRef arr <- ask+  stPutEff $ do+    pos <- readSTRef posRef+    f arr pos+    let !newPos = pos + bc+    writeSTRef posRef newPos++writeShortByteString :: ShortByteString -> Int -> MutableByteArray s -> Int -> ST s ()+writeShortByteString (SBS frozArr) len arr pos = copyByteArray arr pos (ByteArray frozArr) 0 len++writeStaticSeq :: PutStaticSeqF (PutEff s a) -> PutEff s a+writeStaticSeq (PutStaticSeqF n mz p s k) = do+  let n' = fromIntegral n+  for_ (take n' (toList s)) $ \a -> do+    let !x = p a+    mkPutEff x+  let !e = Seq.length s+  unless (n' <= e) $ do+    let !q = mkPutEff (p (fromJust mz))+    replicateM_ (n' - e) q+  k++writeStaticArray :: PutStaticArrayF (PutEff s a) -> PutEff s a+writeStaticArray psa@(PutStaticArrayF needElems mz a@(PrimArray frozArr) k) = do+  let !elemSize = putStaticArrayElemSize psa+      !haveElems = sizeofPrimArray a+      !useElems = min haveElems (fromIntegral needElems)+      !useBc = elemSize * useElems+  writeBytes useBc (\arr pos -> copyByteArray arr pos (ByteArray frozArr) 0 useBc)+  let !needBc = putStaticArraySize psa+  unless (useBc == needBc) $ do+    let !extraBc = needBc - useBc+    writeBytes extraBc (\arr pos -> setByteArray arr (pos + useBc) (pos + extraBc) (fromJust mz))+  k++execPutRun :: PutF (PutEff s a) -> PutEff s a+execPutRun = \case+  PutFWord8 x k -> writeBytes 1 (\arr pos -> writeByteArray arr pos x) *> k+  PutFInt8 x k -> writeBytes 1 (\arr pos -> writeByteArray arr pos x) *> k+  PutFWord16LE x k -> writeBytes 2 (writeByteArrayLiftedInBytes x) *> k+  PutFInt16LE x k -> writeBytes 2 (writeByteArrayLiftedInBytes x) *> k+  PutFWord24LE x k -> writeBytes 3 (writeByteArrayLiftedInBytes x) *> k+  PutFInt24LE x k -> writeBytes 3 (writeByteArrayLiftedInBytes x) *> k+  PutFWord32LE x k -> writeBytes 4 (writeByteArrayLiftedInBytes x) *> k+  PutFInt32LE x k -> writeBytes 4 (writeByteArrayLiftedInBytes x) *> k+  PutFFloatLE x k -> writeBytes 4 (writeByteArrayLiftedInBytes x) *> k+  PutFWord16BE x k -> writeBytes 2 (writeByteArrayLiftedInBytes x) *> k+  PutFInt16BE x k -> writeBytes 2 (writeByteArrayLiftedInBytes x) *> k+  PutFWord24BE x k -> writeBytes 3 (writeByteArrayLiftedInBytes x) *> k+  PutFInt24BE x k -> writeBytes 3 (writeByteArrayLiftedInBytes x) *> k+  PutFWord32BE x k -> writeBytes 4 (writeByteArrayLiftedInBytes x) *> k+  PutFInt32BE x k -> writeBytes 4 (writeByteArrayLiftedInBytes x) *> k+  PutFFloatBE x k -> writeBytes 4 (writeByteArrayLiftedInBytes x) *> k+  PutFShortByteString bc sbs k ->+    let !len = fromIntegral bc+    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+  PutFStaticHint (PutStaticHintF _ p k) -> mkPutEff p *> k++runPutRun :: PutRun s a -> PutEnv s -> ST s a+runPutRun = runPutEff . iterPutRun++iterPutRun :: PutRun s a -> PutEff s a+iterPutRun m = iterT execPutRun (unPutRun m)++mkPutRun :: PutM a -> PutRun s a+mkPutRun (PutM (F w)) = PutRun (w pure wrap)++mkPutEff :: PutM a -> PutEff s a+mkPutEff = iterPutRun . mkPutRun++runPutUnsafe :: Put -> ByteCount -> ShortByteString+runPutUnsafe m bc = runST $ do+  let !len = fromIntegral bc+      !n = mkPutRun m+  st@(PutEnv _ posRef arr) <- newPutEnv len+  runPutRun n st+  pos <- readSTRef posRef+  unless (pos == len) (error ("Invalid put length: (given " ++ show len ++ ", used " ++ show pos ++ ")"))+  ByteArray frozArr <- unsafeFreezeByteArray arr+  pure $! SBS frozArr++-- Count:++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 }+  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+  PutFShortByteString bc _ k ->+    let !len = fromIntegral bc+    in State.modify' (len+) *> k+  PutFStaticSeq pss@(PutStaticSeqF _ _ _ _ k) ->+    let !len = putStaticSeqSize pss+    in State.modify' (len+) *> k+  PutFStaticArray psv@(PutStaticArrayF _ _ _ k) ->+    let !len = putStaticArraySize psv+    in State.modify' (len+) *> k+  PutFByteArray bc _ k ->+    let !len = fromIntegral bc+    in State.modify' (len+) *> k+  PutFStaticHint (PutStaticHintF bc _ k) ->+    let !len = fromIntegral bc+    in State.modify' (len+) *> k++runCountRun :: CountRun a -> Int -> (Maybe a, Int)+runCountRun = runCountEff . iterCountRun++iterCountRun :: CountRun a -> CountEff a+iterCountRun m = iterT execCountRun (unCountRun m)++mkCountRun :: PutM a -> CountRun a+mkCountRun (PutM (F w)) = CountRun (w pure wrap)++mkCountEff :: PutM a -> CountEff a+mkCountEff = iterCountRun . mkCountRun++runCount :: Put -> ByteCount+runCount m =+  let !n = mkCountRun m+      (_, !bc) = runCountRun n 0+  in fromIntegral bc++-- Put safe:++runPut :: Put -> ShortByteString+runPut m = let !bc = runCount m in runPutUnsafe m bc++-- Put file:++runPutFile :: FilePath -> Put -> IO ()+runPutFile fp m =+  let !bs = runPut m+      !bs' = BSS.fromShort bs+  in BS.writeFile fp bs'

@@ -0,0 +1,214 @@+module Dahdit.Sizes+  ( ElementCount (..)+  , ByteCount (..)+  , StaticByteSized (..)+  , byteSizeViaStatic+  , ByteSized (..)+  , ViaStaticByteSized (..)+  , byteSizeFoldable+  , staticByteSizeFoldable+  ) 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.Proxy (proxyFor, proxyForF)+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as BSS+import Data.Default (Default)+import Data.Foldable (foldMap')+import Data.Int (Int16, Int32, Int64, Int8)+import Data.Primitive (Prim)+import Data.Primitive.PrimArray (PrimArray, sizeofPrimArray)+import Data.Proxy (Proxy (..))+import Data.Semigroup (Sum (..))+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Data.Word (Word16, Word32, Word64, Word8)++newtype ElementCount = ElementCount { unElementCount :: Word64 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bounded, Default)++newtype ByteCount = ByteCount { unByteCount :: Word64 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, Num, Enum, Real, Integral, Bounded, Default)++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 Word32 where+  byteSize _ = 4++instance ByteSized Int32 where+  byteSize _ = 4++instance ByteSized Word64 where+  byteSize _ = 8++instance ByteSized Int64 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 FloatLE where+  byteSize _ = 4++instance ByteSized Word16BE where+  byteSize _ = 2++instance ByteSized Int16BE where+  byteSize _ = 2++instance ByteSized Word24BE where+  byteSize _ = 3++instance ByteSized Int24BE where+  byteSize _ = 3++instance ByteSized Word32BE where+  byteSize _ = 4++instance ByteSized Int32BE where+  byteSize _ = 4++instance ByteSized FloatBE where+  byteSize _ = 4++instance ByteSized ShortByteString where+  byteSize = fromIntegral . BSS.length++instance StaticByteSized a => ByteSized (Seq a) where+  byteSize ss =+    let !elen = staticByteSize (Proxy :: Proxy a)+        !alen = fromIntegral (Seq.length ss)+    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++instance (StaticByteSized a, LiftedPrim a) => ByteSized (LiftedPrimArray a) where+  byteSize lpa =+    let !elen = staticByteSize (Proxy :: Proxy a)+        !alen = fromIntegral (sizeofLiftedPrimArray lpa)+    in elen * alen++class ByteSized a => StaticByteSized a where+  staticByteSize :: Proxy a -> ByteCount++byteSizeViaStatic :: StaticByteSized a => a -> ByteCount+byteSizeViaStatic = staticByteSize . proxyFor++instance StaticByteSized () where+  staticByteSize _ = 0++instance StaticByteSized Word8 where+  staticByteSize _ = 1++instance StaticByteSized Int8 where+  staticByteSize _ = 1++instance StaticByteSized Word16 where+  staticByteSize _ = 2++instance StaticByteSized Int16 where+  staticByteSize _ = 2++instance StaticByteSized Word32 where+  staticByteSize _ = 4++instance StaticByteSized Int32 where+  staticByteSize _ = 4++instance StaticByteSized Word64 where+  staticByteSize _ = 8++instance StaticByteSized Int64 where+  staticByteSize _ = 8++instance StaticByteSized Word16LE where+  staticByteSize _ = 2++instance StaticByteSized Int16LE where+  staticByteSize _ = 2++instance StaticByteSized Word24LE where+  staticByteSize _ = 3++instance StaticByteSized Int24LE where+  staticByteSize _ = 3++instance StaticByteSized Word32LE where+  staticByteSize _ = 4++instance StaticByteSized Int32LE where+  staticByteSize _ = 4++instance StaticByteSized FloatLE where+  staticByteSize _ = 4++instance StaticByteSized Word16BE where+  staticByteSize _ = 2++instance StaticByteSized Int16BE where+  staticByteSize _ = 2++instance StaticByteSized Word24BE where+  staticByteSize _ = 3++instance StaticByteSized Int24BE where+  staticByteSize _ = 3++instance StaticByteSized Word32BE where+  staticByteSize _ = 4++instance StaticByteSized Int32BE where+  staticByteSize _ = 4++instance StaticByteSized FloatBE where+  staticByteSize _ = 4++newtype ViaStaticByteSized a = ViaStaticByteSized { unViaStaticByteSized :: a }++instance StaticByteSized a => ByteSized (ViaStaticByteSized a) where+  byteSize _ = staticByteSize (Proxy :: Proxy a)++byteSizeFoldable :: (Foldable f, ByteSized a) => f a -> ByteCount+byteSizeFoldable = getSum . foldMap' (Sum . byteSize)++staticByteSizeFoldable :: (Foldable f, StaticByteSized a) => f a -> ByteCount+staticByteSizeFoldable fa = staticByteSize (proxyForF fa) * fromIntegral (length fa)

@@ -0,0 +1,162 @@+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 qualified Data.ByteString.Short as BSS+import Data.Primitive.ByteArray (byteArrayFromList)+import Data.Primitive.PrimArray (primArrayFromList)+import qualified Data.Sequence as Seq+import GHC.Float (castWord32ToFloat)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++data DynFoo = DynFoo !Word8 !Word16LE+  deriving stock (Eq, Show, Generic)+  deriving (ByteSized, Binary) via (ViaGeneric DynFoo)++data StaFoo = StaFoo !Word8 !Word16LE+  deriving stock (Eq, Show, Generic)+  deriving (ByteSized, StaticByteSized, Binary) via (ViaStaticGeneric StaFoo)++runGetCase :: (Show a, Eq a) => Get a -> Maybe (ByteCount, ByteCount, a) -> [Word8] -> IO ()+runGetCase getter mayRes bsl = do+  let bs = BSS.pack bsl+      (result, actBc) = runGet getter bs+  case (result, mayRes) of+    (Left _, Nothing) -> pure ()+    (Left err, Just (_, _, expecVal)) -> fail ("Got error <" ++ show err ++ ">, expected value <" ++ show expecVal ++ ">")+    (Right actVal, Nothing) -> fail ("Got value <" ++ show actVal ++ ">, expected error")+    (Right actVal, Just (expecBc, expecLeft, expecVal)) -> do+      actVal @?= expecVal+      actBc @?= expecBc+      BSS.length bs - fromIntegral actBc @?= fromIntegral expecLeft++runPutCase :: Put -> [Word8] -> IO ()+runPutCase putter expecList = do+  let expecBc = fromIntegral (length expecList)+      expecBs = BSS.pack expecList+      estBc = runCount putter+  estBc @?= expecBc+  let actBs = runPut putter+      actBc = byteSize actBs+  actBs @?= expecBs+  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)+  ]++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)+  ]++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])+  ]++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])+  ]++testDahdit :: TestTree+testDahdit = testGroup "Dahdit" [ testDahditByteSize, testDahditStaticByteSize, testDahditGet, testDahditPut ]++main :: IO ()+main = defaultMain testDahdit