packages feed

ptr-peeker (empty) → 0.1

raw patch · 8 files changed

+927/−0 lines, 8 filesdep +QuickCheckdep +basedep +bytestring

Dependencies added: QuickCheck, base, bytestring, cereal, criterion, ptr, ptr-peeker, quickcheck-instances, rerebase, store, tasty, tasty-hunit, tasty-quickcheck, text, vector

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2021, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ ptr-peeker.cabal view
@@ -0,0 +1,130 @@+cabal-version: 3.0+name: ptr-peeker+version: 0.1+synopsis: High-performance composable binary data deserializers+description:+  A high-performance binary data deserialization library providing a type-safe, flexible and composable abstraction over manipulations on pointers.++  The API consists of two complementary abstractions:++  * 'Fixed' decoders for compile-time known, fixed-size data structures++  * 'Variable' decoders for runtime-dependent, variable-size data structures++  In combination they allow to build decoders of any complexity.++  The library delivers superior performance compared to alternatives like "cereal" and "store", making it ideal for high-throughput applications, networking, and systems programming.++copyright: (c) 2021, Nikita Volkov+license: MIT+license-file: LICENSE++source-repository head+  type: git+  location: https://github.com/nikita-volkov/ptr-peeker++common base+  default-language: Haskell2010+  default-extensions:+    ApplicativeDo+    Arrows+    BangPatterns+    BlockArguments+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveDataTypeable+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveTraversable+    DerivingVia+    EmptyDataDecls+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    ImportQualifiedPost+    LambdaCase+    LiberalTypeSynonyms+    MagicHash+    MultiParamTypeClasses+    MultiWayIf+    NoImplicitPrelude+    NoMonomorphismRestriction+    OverloadedStrings+    ParallelListComp+    PatternGuards+    QuasiQuotes+    RankNTypes+    RecordWildCards+    RoleAnnotations+    ScopedTypeVariables+    StandaloneDeriving+    StrictData+    TemplateHaskell+    TupleSections+    TypeApplications+    TypeFamilies+    TypeOperators+    UnboxedTuples++common executable+  import: base+  ghc-options:+    -O2+    -threaded+    -with-rtsopts=-N+    -rtsopts+    -funbox-strict-fields++common test+  import: base+  ghc-options:+    -threaded+    -with-rtsopts=-N++library+  import: base+  hs-source-dirs: src/library+  exposed-modules: PtrPeeker+  other-modules:+    PtrPeeker.Fixed+    PtrPeeker.Prelude+    PtrPeeker.Variable++  build-depends:+    base >=4.14 && <5,+    bytestring >=0.11 && <0.14,+    ptr >=0.16.8.6 && <0.17,+    text >=2 && <3,+    vector >=0.13 && <0.14,++test-suite test+  import: test+  type: exitcode-stdio-1.0+  hs-source-dirs: src/test+  main-is: Main.hs+  build-depends:+    QuickCheck >=2.8.1 && <3,+    cereal >=0.5.8 && <0.6,+    ptr-peeker,+    quickcheck-instances >=0.3.11 && <0.4,+    rerebase <2,+    tasty >=1.4.1 && <2,+    tasty-hunit >=0.10.0.3 && <0.11,+    tasty-quickcheck >=0.10.1.2 && <0.11,++benchmark bench+  import: executable+  type: exitcode-stdio-1.0+  hs-source-dirs: src/bench+  main-is: Main.hs+  build-depends:+    cereal >=0.5.8.3 && <0.6,+    criterion >=1.6 && <1.7,+    ptr-peeker,+    rerebase >=1.16.1 && <2,+    store >=0.7.18 && <0.8,+    tasty-hunit >=0.10.0.3 && <0.11,
+ src/bench/Main.hs view
@@ -0,0 +1,105 @@+import Criterion.Main+import Data.Serialize qualified as Cereal+import Data.Store qualified as Store+import Data.Vector qualified as V+import Data.Vector.Unboxed qualified as Vu+import PtrPeeker qualified as Pb+import Test.Tasty.HUnit qualified as Tasty+import Prelude++main :: IO ()+main = do+  putStrLn "Testing"+  groups <-+    sequence+      [ let input = Cereal.runPut $ do+              Cereal.putInt32le 1+              Cereal.putInt32le 2+              Cereal.putInt32le 3+            correctDecoding = (1, 2, 3)+            subjects =+              [ ( "ptr-peeker/fixed",+                  hush . Pb.runVariableOnByteString (Pb.fixed $ (,,) <$> Pb.leSignedInt4 <*> Pb.leSignedInt4 <*> Pb.leSignedInt4)+                ),+                ( "ptr-peeker/variable",+                  hush . Pb.runVariableOnByteString ((,,) <$> Pb.fixed Pb.leSignedInt4 <*> Pb.fixed Pb.leSignedInt4 <*> Pb.fixed Pb.leSignedInt4)+                ),+                ( "store",+                  hush . Store.decode @(Int32, Int32, Int32)+                ),+                ( "cereal",+                  hush . Cereal.runGet ((,,) <$> Cereal.getInt32le <*> Cereal.getInt32le <*> Cereal.getInt32le)+                )+              ]+         in initGroup "int32-le-triplet" input correctDecoding subjects,+        let input =+              Cereal.runPut+                $ Cereal.putInt32le 100+                <> replicateM_ 100 (Cereal.putInt32le (-1))+            correctDecoding =+              Vu.replicate 100 (-1)+            subjects =+              [ ( "ptr-peeker",+                  let decoder = do+                        size <- Pb.fixed Pb.leSignedInt4+                        Pb.fixed $ Pb.fixedArray @Vu.Vector Pb.leSignedInt4 $ fromIntegral size+                   in hush . Pb.runVariableOnByteString decoder+                ),+                ( "store",+                  let decoder = do+                        size <- Store.peek @Int32+                        Vu.replicateM (fromIntegral size) $ Store.peek @Int32+                   in hush . Store.decodeWith decoder+                ),+                ( "cereal",+                  let decoder = do+                        size <- Cereal.getInt32le+                        Vu.replicateM (fromIntegral size) $ Cereal.getInt32le+                   in hush . Cereal.runGet decoder+                )+              ]+         in initGroup "array-of-int4" input correctDecoding subjects,+        let input = Cereal.runPut $ do+              Cereal.putInt64le 100+              replicateM_ 100 $ do+                Cereal.putInt64le 3+                Cereal.putByteString "abc"+            correctDecoding = V.replicate 100 "abc"+            subjects =+              [ ( "ptr-peeker",+                  let decoder = do+                        size <- Pb.fixed Pb.leSignedInt8+                        Pb.variableArray @V.Vector byteStringDecoder $ fromIntegral size+                      byteStringDecoder = do+                        size <- Pb.fixed Pb.leSignedInt8+                        Pb.fixed $ Pb.byteArrayAsByteString $ fromIntegral size+                   in hush . Pb.runVariableOnByteString decoder+                ),+                ( "store",+                  hush . Store.decode+                ),+                ( "cereal",+                  let decoder = do+                        size <- Cereal.getInt64le+                        V.replicateM (fromIntegral size) $ do+                          size <- Cereal.getInt64le+                          Cereal.getByteString $ fromIntegral size+                   in hush . Cereal.runGet decoder+                )+              ]+         in initGroup "array-of-byte-arrays" input correctDecoding subjects+      ]++  putStrLn "Benchmarking"+  defaultMain groups++-- | Test functions and create a benchmark group out of them.+initGroup :: (Eq a, Show a, NFData a) => String -> ByteString -> a -> [(String, ByteString -> Maybe a)] -> IO Benchmark+initGroup name input correctDecoding subjects = do+  fmap (bgroup name) . forM subjects $ \(name, f) -> do+    Tasty.assertEqual name (Just correctDecoding) (f input)+    return $ bench name $ nf f input++-- | Suppress the 'Left' value of an 'Either'+hush :: Either a b -> Maybe b+hush = either (const Nothing) Just
+ src/library/PtrPeeker.hs view
@@ -0,0 +1,75 @@+-- |+-- High-performance composable binary data deserializers.+--+-- This module provides two types of decoders for parsing binary data:+--+-- * 'Fixed' decoders for compile-time known, fixed-size data structures+-- * 'Variable' decoders for runtime-dependent, variable-size data structures+--+-- == Quick Start+--+-- > import PtrPeeker+-- > import qualified Data.Vector+-- >+-- > data Point = Point Int32 Int32 Int32+-- >+-- > point :: Variable Point+-- > point =+-- >   fixed (Point <$> beSignedInt4 <*> beSignedInt4 <*> beSignedInt4)+-- >+-- > points :: Variable (Data.Vector.Vector Point)+-- > points = do+-- >   count <- fixed beUnsignedInt4+-- >   Data.Vector.replicateM (fromIntegral count) point+-- >+-- > decodePoint :: ByteString -> Either Int (Data.Vector.Vector Point)+-- > decodePoint = runVariableOnByteString points+module PtrPeeker+  ( -- * Execution+    runVariableOnByteString,+    runVariableOnByteStringWithRemainders,+    runVariableOnPtrWithRemainders,+    runFixedOnByteString,++    -- * Variable+    Variable,+    hasMore,+    forceSize,+    fixed,+    nullTerminatedStringAsByteString,+    nullTerminatedStringAsShortByteString,+    variableArray,+    remainderAsByteString,++    -- * Fixed+    Fixed,+    skip,+    storable,++    -- ** Unsigned Integers+    unsignedInt1,+    beUnsignedInt2,+    leUnsignedInt2,+    beUnsignedInt4,+    leUnsignedInt4,+    beUnsignedInt8,+    leUnsignedInt8,++    -- ** Signed Integers+    signedInt1,+    beSignedInt2,+    leSignedInt2,+    beSignedInt4,+    leSignedInt4,+    beSignedInt8,+    leSignedInt8,++    -- ** Arrays+    byteArrayAsByteString,+    byteArrayAsShortByteString,+    fixedArray,+  )+where++import PtrPeeker.Fixed+import PtrPeeker.Variable
+ src/library/PtrPeeker/Fixed.hs view
@@ -0,0 +1,211 @@+module PtrPeeker.Fixed where++import Data.ByteString.Internal qualified as Bsi+import Data.Vector.Generic qualified as Vg+import Data.Vector.Generic.Mutable qualified as Vgm+import Ptr.IO qualified+import PtrPeeker.Prelude++-- * Execution++-- |+-- Execute a fixed decoder on a ByteString.+--+-- Returns either:+--+-- * The number of additional bytes required if input is too short+--+-- * Successfully decoded value+{-# INLINE runFixedOnByteString #-}+runFixedOnByteString :: Fixed a -> ByteString -> Either Int a+runFixedOnByteString (Fixed size peek) (Bsi.PS bsFp bsOff bsSize) =+  if bsSize > size+    then Right . unsafeDupablePerformIO . withForeignPtr bsFp $ \p ->+      peek (plusPtr p bsOff)+    else Left $ size - bsSize++-- * Declarations++-- |+-- A highly optimized decoder for fixed-size data structures.+--+-- 'Fixed' decoders are the most efficient way to decode binary data when+-- the size of each element is known at compile time. They provide excellent+-- performance characteristics due to their predictable memory access patterns+-- and lack of runtime size calculations.+--+-- Use 'Fixed' when:+--+-- * Decoding primitive types (integers, floats)+-- * Working with fixed-size records or structures+-- * Performance is critical and data layout is predictable+-- * The binary format has a static, well-defined structure+--+-- 'Fixed' decoders can be lifted to 'Variable' using 'fixed', but the+-- reverse conversion is not possible due to the compile-time size requirement.+--+-- Example usage:+--+-- >-- Decode a fixed-size record+-- >data Point = Point Int32 Int32 Int32+-- >+-- >point :: Fixed Point+-- >point = Point <$> beSignedInt4 <*> beSignedInt4 <*> beSignedInt4+data Fixed output+  = -- |+    -- The 'Fixed' constructor takes two parameters:+    --+    -- * Size in bytes (must be exact)+    -- * IO action to perform the actual decoding from a pointer+    Fixed {-# UNPACK #-} !Int (Ptr Word8 -> IO output)++instance Functor Fixed where+  fmap fn (Fixed size io) = Fixed size (fmap fn . io)++instance Applicative Fixed where+  pure x = Fixed 0 (const (pure x))+  (<*>) (Fixed leftSize leftIO) (Fixed rightSize rightIO) =+    Fixed size io+    where+      size = leftSize + rightSize+      io ptr = leftIO ptr <*> rightIO (plusPtr ptr leftSize)++-- |+-- Skip the specified number of bytes without consuming them.+--+-- This is useful for advancing past padding or unused fields in binary formats.+-- The decoder succeeds immediately without reading any data.+{-# INLINE skip #-}+skip :: Int -> Fixed ()+skip amount = Fixed amount (const (pure ()))++-- |+-- 1-byte unsigned integer.+{-# INLINE unsignedInt1 #-}+unsignedInt1 :: Fixed Word8+unsignedInt1 = Fixed 1 Ptr.IO.peekWord8++-- |+-- 2-byte unsigned Big-Endian integer.+{-# INLINE beUnsignedInt2 #-}+beUnsignedInt2 :: Fixed Word16+beUnsignedInt2 = Fixed 2 Ptr.IO.peekBEWord16++-- |+-- 2-byte unsigned Little-Endian integer.+{-# INLINE leUnsignedInt2 #-}+leUnsignedInt2 :: Fixed Word16+leUnsignedInt2 = Fixed 2 Ptr.IO.peekLEWord16++-- |+-- 4-byte unsigned Big-Endian integer.+{-# INLINE beUnsignedInt4 #-}+beUnsignedInt4 :: Fixed Word32+beUnsignedInt4 = Fixed 4 Ptr.IO.peekBEWord32++-- |+-- 4-byte unsigned Little-Endian integer.+{-# INLINE leUnsignedInt4 #-}+leUnsignedInt4 :: Fixed Word32+leUnsignedInt4 = Fixed 4 Ptr.IO.peekLEWord32++-- |+-- 8-byte unsigned Big-Endian integer.+{-# INLINE beUnsignedInt8 #-}+beUnsignedInt8 :: Fixed Word64+beUnsignedInt8 = Fixed 8 Ptr.IO.peekBEWord64++-- |+-- 8-byte unsigned Little-Endian integer.+{-# INLINE leUnsignedInt8 #-}+leUnsignedInt8 :: Fixed Word64+leUnsignedInt8 = Fixed 8 Ptr.IO.peekLEWord64++-- |+-- 1-byte signed integer.+{-# INLINE signedInt1 #-}+signedInt1 :: Fixed Int8+signedInt1 = Fixed 1 Ptr.IO.peekInt8++-- |+-- 2-byte signed Big-Endian integer.+{-# INLINE beSignedInt2 #-}+beSignedInt2 :: Fixed Int16+beSignedInt2 = Fixed 2 Ptr.IO.peekBEInt16++-- |+-- 2-byte signed Little-Endian integer.+{-# INLINE leSignedInt2 #-}+leSignedInt2 :: Fixed Int16+leSignedInt2 = Fixed 2 Ptr.IO.peekLEInt16++-- |+-- 4-byte signed Big-Endian integer.+{-# INLINE beSignedInt4 #-}+beSignedInt4 :: Fixed Int32+beSignedInt4 = Fixed 4 Ptr.IO.peekBEInt32++-- |+-- 4-byte signed Little-Endian integer.+{-# INLINE leSignedInt4 #-}+leSignedInt4 :: Fixed Int32+leSignedInt4 = Fixed 4 Ptr.IO.peekLEInt32++-- |+-- 8-byte signed Big-Endian integer.+{-# INLINE beSignedInt8 #-}+beSignedInt8 :: Fixed Int64+beSignedInt8 = Fixed 8 Ptr.IO.peekBEInt64++-- |+-- 8-byte signed Little-Endian integer.+{-# INLINE leSignedInt8 #-}+leSignedInt8 :: Fixed Int64+leSignedInt8 = Fixed 8 Ptr.IO.peekLEInt64++-- |+-- Collect a strict bytestring knowing its size.+--+-- Typically, you\'ll be using it like this:+--+-- @+-- byteString :: 'Variable' ByteString+-- byteString = 'fixed' 'beSignedInt4' >>= 'fixed' . 'byteArrayAsByteString' . fromIntegral+-- @+{-# INLINE byteArrayAsByteString #-}+byteArrayAsByteString :: Int -> Fixed ByteString+byteArrayAsByteString size = Fixed size $ \p -> Ptr.IO.peekBytes p size++-- |+-- Collect a short bytestring knowing its size.+--+-- Typically, you\'ll be using it like this:+--+-- @+-- shortByteString :: 'Variable' ShortByteString+-- shortByteString = 'fixed' 'beSignedInt4' >>= 'fixed' . 'byteArrayAsShortByteString' . fromIntegral+-- @+{-# INLINE byteArrayAsShortByteString #-}+byteArrayAsShortByteString :: Int -> Fixed ShortByteString+byteArrayAsShortByteString size = Fixed size $ \p -> Ptr.IO.peekShortByteString p size++-- |+-- Construct an array of the specified amount of fixed sized elements.+{-# INLINE fixedArray #-}+fixedArray :: (Vg.Vector v a) => Fixed a -> Int -> Fixed (v a)+fixedArray (Fixed elementSize peekElement) amount =+  Fixed (elementSize * amount) $ \p -> do+    v <- Vgm.unsafeNew amount+    let populate i p =+          if i < amount+            then do+              a <- peekElement p+              Vgm.unsafeWrite v i a+              populate (succ i) (plusPtr p elementSize)+            else Vg.unsafeFreeze v+     in populate 0 p++-- | Fixed-size peeker for any Storable type.+{-# INLINE storable #-}+storable :: forall a. (Storable a) => Fixed a+storable = Fixed (sizeOf (undefined :: a)) Ptr.IO.peekStorable
+ src/library/PtrPeeker/Prelude.hs view
@@ -0,0 +1,72 @@+module PtrPeeker.Prelude+  ( module Exports,+  )+where++import Control.Applicative as Exports hiding (WrappedArrow (..))+import Control.Arrow as Exports hiding (first, second)+import Control.Category as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_)+import Control.Monad.Fail as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.IO.Class as Exports+import Control.Monad.ST as Exports+import Data.Bifunctor as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.ByteString as Exports (ByteString)+import Data.ByteString.Short as Exports (ShortByteString)+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+import Data.Fixed as Exports hiding (Fixed)+import Data.Foldable as Exports hiding (toList)+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports hiding (unzip)+import Data.Functor.Compose as Exports+import Data.Functor.Contravariant as Exports+import Data.IORef as Exports+import Data.Int as Exports+import Data.Ix as Exports+import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons)+import Data.List.NonEmpty as Exports (NonEmpty (..))+import Data.Maybe as Exports+import Data.Monoid as Exports hiding (Alt, (<>))+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.STRef as Exports+import Data.Semigroup as Exports hiding (First (..), Last (..))+import Data.String as Exports+import Data.Text as Exports (Text)+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Void as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign as Exports hiding (void)+import GHC.Conc as Exports hiding (orElse, threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar)+import GHC.Exts as Exports (IsList (..), groupWith, inline, lazy, sortWith)+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import GHC.OverloadedLabels as Exports+import Numeric as Exports+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.Printf as Exports (hPrintf, printf)+import Text.Read as Exports (Read (..), readEither, readMaybe)+import Unsafe.Coerce as Exports+import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))
+ src/library/PtrPeeker/Variable.hs view
@@ -0,0 +1,240 @@+module PtrPeeker.Variable where++import Data.ByteString.Char8 qualified as Bsc+import Data.ByteString.Internal qualified as Bsi+import Data.Vector.Generic qualified as Vg+import Data.Vector.Generic.Mutable qualified as Vgm+import Ptr.IO qualified+import PtrPeeker.Fixed+import PtrPeeker.Prelude++-- * Execution++-- |+-- Execute a variable decoder on a ByteString.+--+-- Returns either:+--+-- * The number of additional bytes required if input is too short+--+-- * Successfully decoded value+{-# INLINE runVariableOnByteString #-}+runVariableOnByteString :: Variable a -> ByteString -> Either Int a+runVariableOnByteString (Variable peek) (Bsi.PS bsFp bsOff bsSize) =+  unsafeDupablePerformIO+    $ withForeignPtr bsFp+    $ \p ->+      peek (return . Left) (\r _ _ -> return (Right r)) (plusPtr p bsOff) bsSize++-- |+-- Execute a variable decoder on a ByteString, returning both the decoded value and remaining bytes.+--+-- Returns either:+--+-- * The number of additional bytes required if input is too short+--+-- * Successfully decoded value and unconsumed bytes+runVariableOnByteStringWithRemainders :: Variable a -> ByteString -> Either Int (a, ByteString)+runVariableOnByteStringWithRemainders (Variable peek) (Bsi.PS bsFp bsOff bsSize) =+  unsafeDupablePerformIO+    $ withForeignPtr bsFp+    $ \ptr ->+      let initialPtr = plusPtr ptr bsOff+       in peek+            (return . Left)+            ( \output newPtr avail ->+                return+                  ( Right+                      ( output,+                        Bsi.PS bsFp (bsOff + minusPtr newPtr initialPtr) avail+                      )+                  )+            )+            initialPtr+            bsSize++-- |+-- Execute a variable decoder on a pointer and an amount of available bytes in it.+--+-- Fails with the amount of extra bytes required at least if it\'s too short.+--+-- Succeeds returning the output, the next pointer, and the remaining available bytes.+{-# INLINE runVariableOnPtrWithRemainders #-}+runVariableOnPtrWithRemainders :: Variable a -> Ptr Word8 -> Int -> IO (Either Int (a, Ptr Word8, Int))+runVariableOnPtrWithRemainders (Variable peek) ptr avail =+  peek+    (pure . Left)+    (\output ptr avail -> return (Right (output, ptr, avail)))+    ptr+    avail++-- * Declarations++-- |+-- A high-level decoder for variable-sized data structures where the size+-- is only known at runtime.+--+-- 'Variable' decoders are optimized for processing both multi-chunk and+-- single-chunk input efficiently. They provide full monadic composition,+-- allowing the output of one decoder to determine what the following+-- decoder should be. This makes them ideal for complex binary formats+-- where the structure depends on previously decoded values.+--+-- Use 'Variable' when:+--+-- * Decoding length-prefixed data (arrays, strings)+-- * The structure depends on previously decoded values+-- * You need conditional or data-dependent parsing+-- * Working with formats that have variable-length encoding+--+-- For better performance with fixed-size data, consider using 'Fixed' instead.+-- You can convert a 'Fixed' decoder to 'Variable' using 'fixed', but not+-- the other way around.+--+-- Example usage:+--+-- @+-- -- Decode a length-prefixed string+-- variableLengthString :: Variable ByteString+-- variableLengthString = do+--   len <- fixed beUnsignedInt4+--   fixed (byteArrayAsByteString (fromIntegral len))+-- @+newtype Variable output+  = Variable+      ( forall x.+        (Int -> IO x) ->+        (output -> Ptr Word8 -> Int -> IO x) ->+        (Ptr Word8 -> Int -> IO x)+      )++instance Functor Variable where+  {-# INLINE fmap #-}+  fmap f (Variable peek) = Variable $ \fail proceed -> peek fail (proceed . f)++instance Applicative Variable where+  pure a = Variable $ \_ proceed -> proceed a+  {-# INLINE (<*>) #-}+  Variable lPeek <*> Variable rPeek = Variable $ \fail proceed ->+    lPeek fail $ \lr -> rPeek fail $ \rr -> proceed (lr rr)+  {-# INLINE liftA2 #-}+  liftA2 f (Variable lPeek) (Variable rPeek) = Variable $ \fail proceed ->+    lPeek fail $ \lr -> rPeek fail $ \rr -> proceed (f lr rr)++instance Monad Variable where+  return = pure+  Variable lPeek >>= rk = Variable $ \fail proceed ->+    lPeek fail $ \lr -> case rk lr of Variable rPeek -> rPeek fail proceed++instance MonadIO Variable where+  liftIO io = Variable $ \_ proceed p avail -> io >>= \res -> proceed res p avail++-- |+-- Check whether more data is available.+hasMore :: Variable Bool+hasMore = Variable $ \_ proceed p avail -> proceed (avail > 0) p avail++-- |+-- Constrain a decoder to consume exactly the specified number of bytes.+--+-- Advances the position by the given amount regardless of how many bytes+-- the inner decoder actually consumes.+{-# INLINE forceSize #-}+forceSize :: Int -> Variable a -> Variable a+forceSize size (Variable dec) =+  Variable $ \fail proceed p avail ->+    if size > avail+      then fail (size - avail)+      else+        let nextPtr = plusPtr p size+            nextAvail = avail - size+            newProceed o _ _ = proceed o nextPtr nextAvail+         in dec fail newProceed p (min size avail)++-- |+-- Lift a fixed decoder into the variable decoder context.+--+-- This allows you to use fixed-size decoders within variable-size parsing+-- contexts. The reverse conversion (Variable to Fixed) is not possible.+--+-- When decoding several fixed-size fields in sequence, prefer combining them+-- inside a single Fixed decoder and lifting once, instead of lifting each field+-- separately. This reduces overhead (fewer checks, fewer continuations, fewer+-- pointer adjustments).+--+-- === Example (comparing styles):+--+-- Less optimal: 3 separate lifts (3 bounds checks, 3 continuations)+--+-- >triple1 :: Variable (Word32, Word32, Word16)+-- >triple1 =+-- >  (,,)+-- >    <$> fixed beUnsignedInt4+-- >    <*> fixed beUnsignedInt4+-- >    <*> fixed beUnsignedInt2+--+-- More optimal: compose in Fixed, lift once (1 bounds check, 1 continuation)+--+-- >triple2 :: Variable (Word32, Word32, Word16)+-- >triple2 =+-- >  fixed+-- >    ( (,,)+-- >        <$> beUnsignedInt4+-- >        <*> beUnsignedInt4+-- >        <*> beUnsignedInt2+-- >    )+--+-- The second form is typically faster in hot code paths.+{-# INLINE fixed #-}+fixed :: Fixed a -> Variable a+fixed (Fixed size io) = Variable $ \fail proceed p avail ->+  if avail >= size+    then io p >>= \x -> proceed x (plusPtr p size) (avail - size)+    else fail $ size - avail++-- |+-- C-style string, which is a collection of bytes terminated by the first 0-valued byte.+-- This last byte is not included in the decoded value.+{-# INLINE nullTerminatedStringAsByteString #-}+nullTerminatedStringAsByteString :: Variable ByteString+nullTerminatedStringAsByteString = Variable $ \fail proceed p avail -> do+  !bs <- Bsc.packCString (castPtr p)+  let sizeWithNull = succ (Bsc.length bs)+   in if avail < sizeWithNull+        then fail $ sizeWithNull - avail+        else proceed bs (plusPtr p sizeWithNull) (avail - sizeWithNull)++-- |+-- C-style string, which is a collection of bytes terminated by the first 0-valued byte.+-- This last byte is not included in the decoded value.+{-# INLINE nullTerminatedStringAsShortByteString #-}+nullTerminatedStringAsShortByteString :: Variable ShortByteString+nullTerminatedStringAsShortByteString = Variable $ \fail proceed p avail ->+  Ptr.IO.peekNullTerminatedShortByteString p $ \size build ->+    let sizeWithNull = succ size+     in if avail < sizeWithNull+          then fail $ sizeWithNull - avail+          else build >>= \x -> proceed x (plusPtr p sizeWithNull) (avail - sizeWithNull)++-- |+-- Array of variable sized elements of the specified amount.+{-# INLINE variableArray #-}+variableArray :: (Vg.Vector v a) => Variable a -> Int -> Variable (v a)+variableArray (Variable peekElement) amount = Variable $ \fail proceed p avail -> do+  v <- Vgm.unsafeNew amount+  let populate i p avail =+        if i < amount+          then peekElement fail (\a p avail -> Vgm.unsafeWrite v i a >> populate (succ i) p avail) p avail+          else Vg.unsafeFreeze v >>= \v -> proceed v p avail+   in populate 0 p avail++-- |+-- Consume all remaining bytes as a ByteString.+--+-- This decoder reads all available bytes from the current position to the end+-- of the input, returning them as a strict ByteString. After execution,+-- no bytes will remain available for subsequent decoders.+{-# INLINE remainderAsByteString #-}+remainderAsByteString :: Variable ByteString+remainderAsByteString = Variable $ \_ proceed p avail ->+  Ptr.IO.peekBytes p avail >>= \x -> proceed x (plusPtr p avail) 0
+ src/test/Main.hs view
@@ -0,0 +1,72 @@+module Main where++import Data.ByteString qualified as Bs+import Data.Serialize qualified as Cereal+import Data.Vector qualified as V+import Data.Vector.Unboxed qualified as Vu+import PtrPeeker qualified as Pb+import Test.QuickCheck qualified as Qc+import Test.QuickCheck.Instances ()+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import Prelude hiding (all, choose)++main :: IO ()+main =+  defaultMain+    $ testGroup "All"+    $ [ testCase "Unterminated C-string" $ do+          assertEqual "" Nothing+            $ either (const Nothing) Just+            $ Pb.runVariableOnByteString Pb.nullTerminatedStringAsByteString "\1\2\3\4",+        testCase "Terminated C-string" $ do+          assertEqual "" (Right "abc")+            $ Pb.runVariableOnByteString Pb.nullTerminatedStringAsByteString "abc\0d",+        testCase "Composition after C-string" $ do+          assertEqual "" (Right ("abc", "def"))+            $ flip Pb.runVariableOnByteString "abc\0def\0"+            $ (,)+            <$> Pb.nullTerminatedStringAsByteString+            <*> Pb.nullTerminatedStringAsByteString,+        testProperty "fixedArray" $ do+          vec <- Qc.arbitrary @(Vu.Vector Int32)+          let bs = Cereal.runPut $ do+                Cereal.putInt32be $ fromIntegral $ Vu.length vec+                Vu.forM_ vec $ Cereal.putInt32be+              res = flip Pb.runVariableOnByteString bs $ do+                size <- Pb.fixed Pb.beSignedInt4+                Pb.fixed $ Pb.fixedArray Pb.beSignedInt4 $ fromIntegral size+          return $ Right vec == res,+        testProperty "variableArray" $ do+          size <- Qc.choose (0, 99)+          vec <- V.replicateM (fromIntegral size) $ do+            size <- Qc.choose (0, 99)+            byteList <- replicateM size $ Qc.choose (1, 255)+            return $ Bs.pack byteList+          let bs = Cereal.runPut $ do+                Cereal.putInt32be size+                V.forM_ vec $ \x -> do+                  Cereal.putByteString x+                  Cereal.putWord8 0+              res = flip Pb.runVariableOnByteString bs $ do+                size <- Pb.fixed Pb.beSignedInt4+                Pb.variableArray Pb.nullTerminatedStringAsByteString $ fromIntegral size+          return $ Right vec == res,+        testCase "forceSize" $ do+          assertEqual "" (Left 1)+            $ Pb.runVariableOnByteString (Pb.forceSize 3 (Pb.fixed Pb.beSignedInt4)) "\1\2\3\4"+          let bs = Cereal.runPut $ do+                Cereal.putInt32be 5+                Cereal.putWord8 0+                Cereal.putWord8 0+                Cereal.putWord8 0+                Cereal.putInt32be 7+              dec = do+                a <- Pb.forceSize 7 $ Pb.fixed Pb.beSignedInt4+                b <- Pb.fixed Pb.beSignedInt4+                return (a, b)+           in assertEqual "" (Right (5, 7)) $ Pb.runVariableOnByteString dec bs+          assertEqual "" (Right 1)+            $ Pb.runVariableOnByteString (Pb.forceSize 4 (Pb.fixed Pb.beSignedInt4)) "\0\0\0\1"+      ]