diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,23 @@ [`xcodec`](http://hackage.haskell.org/package/xcodec) change log: ================================================================= +Major release 2.0 +----------------- + +## Version 2.0.0.0 (07-21-2026) + +XCodec is now on version 2.0! This version is a clean up of the naming, and +removes the `StreamTranscoder` module, since it provided no functionality to +the project. + +The module naming scheme has been changed. Now, instead of +`Data.XCodec.BinaryTranscoder` to access the transcoder class, you use +`XCodec.Transcoder`. Additionally, the type-class name for `BinaryTranscoder` +has been changed to `Transcoder`. The function `unpackSerial` was renamed to +`unpackBuilder` and `execBuilder` was added to put builders into XCodec. +Finally, exports of function type-aliases have been removed, as they have +been inlined into the class function signatures. + Major release 1.0 ----------------- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,18 +5,16 @@ https://builds.sr.ht/~z0/xcodec/commits/main/ipfshs-ci.yml?) ------------------------------------------------------------ -The `xcodec` Haskell library provides a type-class for generic programming on -bit data for writing encoders and decoders for codecs. The `BinaryTranscoder` +The xcodec Haskell library provides a type-class for generic programming on +bit data for writing encoders and decoders for codecs. The `Transcoder` class provides a common interface of methods for processing binary data, and default instances for the `bytestring` types: `ByteString`, `ShortByteString`, -and `LazyByteString`. The `StreamTranscoder` class then provides the abstract -methods for a generic function encoding from and a generic function decoding to -the types implementing `BinaryTranscoder`. +and `LazyByteString`. Why? ---- -`xcodec` exists to abstract common patterns that arise when writing code with +xcodec exists to abstract common patterns that arise when writing code with the `bytestring` library in Haskell: - Reusing code for `ShortByteString`, `ByteString` and `LazyByteString`. - Having common interface for transferring into the bytestring `Builder` type. @@ -24,14 +22,14 @@ from constant values. Making bytestring code generic, can also make code more memory efficient; for -example, we can write functions for `BinaryTranscoder` and apply them to +example, we can write functions for `Transcoder` and apply them to `LazyByteString` when reading large files and to `ShortByteString` when working on smaller internal structures. Examples -------- -Using `xcodec` we can easily read numeric bit data to binary formats, +Using xcodec we can easily read numeric bit data to binary formats, programmatically: ```haskell @@ -39,7 +37,7 @@ import Data.ByteString.Short (ShortByteString) import Data.ByteString.Lazy (LazyByteString) import Data.Word (Word16) -import Data.XCodec.BinaryTranscoder (packValue) +import XCodec.Transcoder (packValue) -- Infers: packValue :: Int -> ByteString exStrict :: ByteString @@ -60,30 +58,30 @@ ```haskell import Data.ByteString.Builder qualified as Builder import Data.ByteString.Lazy (LazyByteString) -import Data.XCodec.BinaryTranscoder (serializeValue) +import XCodec.Transcoder (unpackBuilder) -- We can join several BXCs and Builders into a single unit of data. exBuilder :: LazyByteString exBuilder = Builder.toLazyByteString . mconcat $ - [ serializeValue exLazy, -- serializeValue :: LazyByteString -> Builder - serializeValue exStrict, -- serializeValue :: ByteString -> Builder - serializeValue exShort, -- serializeValue :: ShortByteString -> Builder + [ unpackBuilder exLazy, -- unpackBuilder :: LazyByteString -> Builder + unpackBuilder exStrict, -- unpackBuilder :: ByteString -> Builder + unpackBuilder exShort, -- unpackBuilder :: ShortByteString -> Builder Builder.string8 "Hello, World!" -- string8 :: String -> Builder ] ``` It also enables extracting binary data into `Integer` format so that bitwise transformations can be performed on large sets of binary data in *O(n)* time -with a specified [byte-order](https://en.wikipedia.org/wiki/Endianness): +with a specified [byte order](https://en.wikipedia.org/wiki/Endianness): ```haskell import Data.Bits ((.>>.), (.&.)) import Data.Word (Word32) -import Data.XCodec.BinaryTranscoder (BinaryTranscoder, unpackValue) +import XCodec.Transcoder (unpackValueBE, unpackValueLE) -- We can easily read an entire bit-set representation of transcoder data, --- directly from LazyByteString because it derives BinaryTranscoder. This +-- directly from LazyByteString because it derives Transcoder. This -- function produces its big-endian representation largeBitSet :: Integer largeBitSet = unpackValueBE exBuilder @@ -97,15 +95,27 @@ Development ----------- -Unit tests are provided on the main [ipfshs repo](https://git.sr.ht/~z0/ipfshs), -and bugs can be reported on [ipfshs ticket tracker]( -https://todo.sr.ht/~z0/ipfshs). +This project is part of [ipfshs](https://sr.ht/~z0/ipfshs); unit tests are +provided on the main page and bugs can be reported on its [ticket tracker]( +https://todo.sr.ht/~z0/ipfshs). Patches and pull requests can be submitted with +[`git send-email`](https://git-send-email.io/). To build and test this project +against all of ipfshs read [this](https://sr.ht/~z0/ipfshs/#development) +section on setting up an ipfshs development environment. +This project can also be built as a standalone library with [`cabal`]( +https://github.com/haskell/cabal#ways-to-get-the-cabal-install-binary). + +```shell +$ git clone https://git.sr.ht/~z0/xcodec +$ cd ipldm +$ cabal build +``` + Licensing --------- -The `xcodec` project and its modules are free software and licensed under the -BSD 3-clause license. See [LICENSE.txt](LICENSE.txt). +The xcodec project and its modules are free software and licensed under the BSD +3-clause license. See [`LICENSE.txt`](LICENSE.txt). Copyright © 2026 Zoey McBride | [zoeymcbride@mailbox.org]( mailto:zoeymcbride@mailbox.org) diff --git a/xcodec.cabal b/xcodec.cabal --- a/xcodec.cabal +++ b/xcodec.cabal @@ -1,5 +1,5 @@ cabal-version: 3.0 -version: 1.1.0.0 +version: 2.0.0.0 name: xcodec build-type: Simple author: Zoey McBride @@ -61,10 +61,5 @@ else { import: BuildUser } exposed-modules: -- * Type-class for transcoding binary data. - Data.XCodec.BinaryTranscoder - -- * Type-class for transcoding streams derivided from BinaryTranscoder - Data.XCodec.StreamTranscoder - other-modules: - -- * Helper functions - Data.XCodec.Internal + XCodec.Transcoder } diff --git a/xcodec/Data/XCodec/BinaryTranscoder.hs b/xcodec/Data/XCodec/BinaryTranscoder.hs deleted file mode 100644 --- a/xcodec/Data/XCodec/BinaryTranscoder.hs +++ /dev/null @@ -1,295 +0,0 @@ --- | Module : Data.XCodec.BinaryTranscoder --- Description : Type-class for building generic codecs on binary data. --- Copyright : Zoey McBride (c) 2026 --- License : BSD-3-Clause --- Maintainer : zoeymcbride@mailbox.org --- Stability : experimental -module Data.XCodec.BinaryTranscoder - ( -- * Interface for generic transcoding of binary data. - BinaryTranscoder (..), - - -- * BinaryTranscoder data as numeric values - BitSet, - Octet, - - -- * Converts BinaryTranscoders into editable streams. - UnpackValue, - UnpackOctets, - UnpackSerial, - - -- * Conversion of Integral values to transcoder data. - packValueBE, - packValueLE, - - -- * BinaryTranscoder utilities - fromOctet, - null, - uncons, - unsnoc, - takeOctetsTop, - dropOctetsTop, - takeOctetsEnd, - dropOctetsEnd, - takeWhileEndOctets, - takeWhileTopOctets, - dropWhileEndOctets, - dropWhileTopOctets, - ) -where - -import Data.Bits (Bits, (.&.), (.<<.), (.>>.), (.|.)) -import Data.ByteString (ByteString) -import Data.ByteString qualified as Bytes -import Data.ByteString.Builder (Builder) -import Data.ByteString.Builder qualified as Builder -import Data.ByteString.Lazy (LazyByteString) -import Data.ByteString.Lazy qualified as LBS -import Data.ByteString.Short (ShortByteString) -import Data.ByteString.Short qualified as SBS -import Data.Word (Word8) -import Data.XCodec.Internal (iterateInit, replaceNull) -import Prelude hiding (null) - --- | Stores 8-bit values. -type Octet = Word8 - --- | Stores BinaryTranscoder as numeric values. -type BitSet = Integer - --- | Functions used for unpacking transcoder data into BitSets. -type UnpackValue bxc = bxc -> BitSet - --- | Functions used for unpacking transcoder data into octets/8-bit values. -type UnpackOctets bxc = bxc -> [Octet] - --- | Functions used for unpacking transcoder data into bytestring Builders. -type UnpackSerial bxc = bxc -> Builder - --- | Class of functions for working on binary transcoder streams, that is --- streams of bytes that we can easily turn into a bitset, and can partition --- into smaller streams for extracting and parsing data. -class (Monoid bxc) => BinaryTranscoder bxc where - {-# MINIMAL - totalOctets, - swapOrder, - unpackSerial, - unpackValueCPU, - unpackValueBE, - unpackValueLE, - packOctets, - unpackOctets, - pushOctetTop, - pushOctetEnd, - spanOctetsTop, - spanOctetsEnd, - splitOffset, - replicateOctet - #-} - - -- | Gives back the length in octets of the Transcoder data. - totalOctets :: bxc -> Int - - -- | Packs Octet values into transcoder data `bxc`. - packOctets :: [Octet] -> bxc - - -- | Places the contents of the transcoder into a ByteString Builder. - unpackSerial :: UnpackSerial bxc - - -- | Unpacks transcoder data into a list of bytes. - unpackOctets :: UnpackOctets bxc - - -- | Unpacks transcoder data as BitSet in the host CPU's endianness. - unpackValueCPU :: UnpackValue bxc - - -- | Unpacks transcoder data as BitSet in Big-Endian (BE) order. - unpackValueBE :: UnpackValue bxc - - -- | Unpacks transcoder data as BitSet in Little-Endian (LE) order. - unpackValueLE :: UnpackValue bxc - - -- | Reverses the byte order of the transcoder data. - swapOrder :: bxc -> bxc - - -- | Prepends an octet value to the top of the transcoder data. - pushOctetTop :: bxc -> Octet -> bxc - - -- | Appends the octet value to the end of the transcoder data. - pushOctetEnd :: bxc -> Octet -> bxc - - -- | Parititions the binary data at - splitOffset :: Int -> bxc -> (bxc, bxc) - - -- | Repeats an octet value in binary data. - replicateOctet :: Int -> Octet -> bxc - - -- | Splits octet values based on the first false result from the predicate. - spanOctetsTop :: (Octet -> Bool) -> bxc -> (bxc, bxc) - - -- | Splits the list while the element predicate holds staring from the left - -- side. - spanOctetsEnd :: (Octet -> Bool) -> bxc -> (bxc, bxc) - --- | Implements binary decoder for Bytestrings, best for constant values that --- exist for the lifetime of the program. --- https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/Data-ByteString.html#g:2 -instance BinaryTranscoder ByteString where - totalOctets = Bytes.length - swapOrder = Bytes.reverse - packOctets = Bytes.pack - unpackSerial = Builder.byteString - unpackValueCPU = unpackValueCPU . LBS.fromStrict - unpackValueLE = unpackValueLE . LBS.fromStrict - unpackValueBE = unpackValueBE . LBS.fromStrict - unpackOctets = Bytes.unpack - pushOctetTop = flip Bytes.cons - pushOctetEnd = Bytes.snoc - spanOctetsTop = Bytes.span - spanOctetsEnd = Bytes.spanEnd - splitOffset = Bytes.splitAt - replicateOctet k = Bytes.replicate $ fromIntegral k - --- TODO: we can improve the proformance of unpackBits by examining the current --- bytestring, and loading a range of 1-8 bytes to OR simulaneously - --- | Implements binary decoder for LazyByteString, best for very large data sets --- that can be loaded in and out of memory on demand. --- https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/Data-ByteString-Lazy.html -instance BinaryTranscoder LazyByteString where - totalOctets = fromIntegral . LBS.length - swapOrder = LBS.reverse - packOctets = LBS.pack - unpackOctets = LBS.unpack - unpackValueLE = - -- From MSB to LSB, OR the current byte and shift the total bits. - LBS.foldr (\byte bits -> (bits .<<. 8) .|. fromIntegral byte) 0 - . LBS.dropWhileEnd (== 0) - unpackValueBE = - -- From LSB to MSB, OR the current byte and shift the total bits. - LBS.foldl' (\bits byte -> (bits .<<. 8) .|. fromIntegral byte) 0 - . LBS.dropWhile (== 0) - unpackSerial = Builder.lazyByteString - pushOctetTop = flip LBS.cons - pushOctetEnd = LBS.snoc - spanOctetsTop = LBS.span - spanOctetsEnd = LBS.spanEnd - splitOffset k = LBS.splitAt $ fromIntegral k - replicateOctet k = LBS.replicate $ fromIntegral k - unpackValueCPU = unpackValueLE - --- | Implements binary decoder for ShortByteString, best for compact data that --- doesn't exist long in memory. Notably, it packs better in memory than normal --- ByteString (prone to Heap Fragmentation). --- https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/Data-ByteString-Short.html#g:1 -instance BinaryTranscoder ShortByteString where - totalOctets = SBS.length - swapOrder = SBS.reverse - packOctets = SBS.pack - unpackOctets = SBS.unpack - unpackValueLE = - -- From MSB to LSB , OR the current byte and shift the total bits. - SBS.foldr (\byte bits -> (bits .<<. 8) .|. fromIntegral byte) 0 - . SBS.dropWhileEnd (== 0) - unpackValueBE = - -- From LSB to MSB, OR the current byte and shift the total bits. - SBS.foldl' (\bits byte -> (bits .<<. 8) .|. fromIntegral byte) 0 - . SBS.dropWhile (== 0) - unpackSerial = Builder.shortByteString - pushOctetTop = flip SBS.cons - pushOctetEnd = SBS.snoc - spanOctetsTop = SBS.span - spanOctetsEnd = SBS.spanEnd - splitOffset = SBS.splitAt - replicateOctet k = SBS.replicate $ fromIntegral k - unpackValueCPU = unpackValueLE - --- | Takes a subsection of octets from the beginning of the transcoder data. -takeOctetsTop :: (BinaryTranscoder bxc) => Int -> bxc -> bxc -takeOctetsTop idx = fst . splitOffset idx - --- | Removes octets from the beginning of transcoder data. -dropOctetsTop :: (BinaryTranscoder bxc) => Int -> bxc -> bxc -dropOctetsTop idx = snd . splitOffset idx - --- | Removes octets from the end of transcoder data. -takeOctetsEnd :: (BinaryTranscoder bxc) => Int -> bxc -> bxc -takeOctetsEnd idx bxc = snd $ splitOffset (totalOctets bxc - idx) bxc - --- | Removes octets from the end of transcoder data. -dropOctetsEnd :: (BinaryTranscoder bxc) => Int -> bxc -> bxc -dropOctetsEnd idx bxc = fst $ splitOffset (totalOctets bxc - idx) bxc - --- | Implements `takeWhile` for byte data in binary transcoder. -takeWhileTopOctets :: (BinaryTranscoder bxc) => (Octet -> Bool) -> bxc -> bxc -takeWhileTopOctets f = fst . spanOctetsEnd f - --- | Implements `dropWhile` for byte data in binary transcoder. -dropWhileTopOctets :: (BinaryTranscoder bxc) => (Octet -> Bool) -> bxc -> bxc -dropWhileTopOctets f = snd . spanOctetsEnd f - --- | Implements `takeWhileEnd` for byte data in binary transcoder. -takeWhileEndOctets :: (BinaryTranscoder bxc) => (Octet -> Bool) -> bxc -> bxc -takeWhileEndOctets f = snd . spanOctetsEnd f - --- | Implements `dropWhileEnd` for byte data in binary transcoder. -dropWhileEndOctets :: (BinaryTranscoder bxc) => (Octet -> Bool) -> bxc -> bxc -dropWhileEndOctets f = fst . spanOctetsEnd f - --- | Creates a binary transcoder from a single byte. -{-# INLINE fromOctet #-} -fromOctet :: (BinaryTranscoder bxc) => Octet -> bxc -fromOctet w8 = packOctets [w8] - --- | Returns True if the binary transcoder data is empty. -{-# INLINE null #-} -null :: (BinaryTranscoder bxc) => bxc -> Bool -null bxc = totalOctets bxc == 0 - --- | Returns the first byte removed from the transcoder data, if available. -{-# INLINE uncons #-} -uncons :: (BinaryTranscoder bxc) => bxc -> Maybe (Octet, bxc) -uncons bxc = - let (start, rest) = splitOffset 1 bxc - in case unpackOctets start of - [top] -> Just (top, rest) - _ -> Nothing - --- | Returns the last byte removed from the transcoder data, if available. -{-# INLINE unsnoc #-} -unsnoc :: (BinaryTranscoder bxc) => bxc -> Maybe (bxc, Octet) -unsnoc bxc = - let offset = totalOctets bxc - 1 - (rest, taken) = splitOffset offset bxc - in case unpackOctets taken of - [final] -> Just (rest, final) - _ -> Nothing - --- | Packs a bit string value into some bytes data `bxc`. -{-# INLINE packValueOrder #-} -packValueOrder :: - (Integral val, Bits val, BinaryTranscoder bxc) => - ([Octet] -> [Octet]) -> - val -> - bxc -packValueOrder setorder intdata = - -- This code can be optimized; if we precalculate the length of the BitSet - -- in bits we can mask from the other direction using left shifts, and - -- remove the call to setorder, maybe we can even use a list comprehension to - -- build in place for packOctets - packOctets - . replaceNull [0] - . setorder - . map (\(_, byte) -> fromIntegral byte) - . takeWhile (\(rest, byte) -> rest > 0 || byte > 0) - $ iterateInit (\(input, _) -> extractByte input) (,0) intdata - where - -- Gets the byte from LSB in input and shifts the value 8 bits. - extractByte input = (input .>>. 8, input .&. 0xFF) - --- | Packs a bit string value into some bytes data `bxc` in Big-Endian format. -packValueBE :: (Integral val, Bits val, BinaryTranscoder bxc) => val -> bxc -packValueBE = packValueOrder reverse - --- | Packs a bit string value into some bytes data `bxc` in Little-Endian --- format. -packValueLE :: (Integral val, Bits val, BinaryTranscoder bxc) => val -> bxc -packValueLE = packValueOrder id diff --git a/xcodec/Data/XCodec/Internal.hs b/xcodec/Data/XCodec/Internal.hs deleted file mode 100644 --- a/xcodec/Data/XCodec/Internal.hs +++ /dev/null @@ -1,23 +0,0 @@ --- | Module : Data.XCodec.Internal --- Description : Utility functions for lists. --- Copyright : Zoey McBride (c) 2026 --- License : BSD-3-Clause --- Maintainer : zoeymcbride@mailbox.org --- Stability : experimental -module Data.XCodec.Internal - ( -- * List utilities - replaceNull, - iterateInit, - ) -where - --- | Return the the first param if the second param is empty. -{-# INLINE replaceNull #-} -replaceNull :: [a] -> [a] -> [a] -replaceNull replace xs - | null xs = replace - | otherwise = xs - --- | Wraps iterate to compose with an intermediary type constructor. -iterateInit :: (b -> b) -> (a -> b) -> a -> [b] -iterateInit f iterinit = drop 1 . iterate f . iterinit diff --git a/xcodec/Data/XCodec/StreamTranscoder.hs b/xcodec/Data/XCodec/StreamTranscoder.hs deleted file mode 100644 --- a/xcodec/Data/XCodec/StreamTranscoder.hs +++ /dev/null @@ -1,34 +0,0 @@ --- | Module : Data.XCodec.StreamTranscoder --- Description : Type-class for encoding and decoding binary streams. --- Copyright : Zoey McBride (c) 2026 --- License : BSD-3-Clause --- Maintainer : zoeymcbride@mailbox.org --- Stability : experimental -module Data.XCodec.StreamTranscoder - ( -- * Interface for implementing generic digit symbol encoder/decoders. - StreamTranscoder (..), - - -- * Type-functions for generating generic StreamTranscoder instances. - Encoder, - Decoder, - ) -where - -import Data.XCodec.BinaryTranscoder (BinaryTranscoder) - --- | Type of function for transforming some `xtype` to some `ytype`. -type Encoder xtype ytype = xtype -> ytype - --- | Type of function for transforming some `ytype` into an `xtype` if the --- `ytype` is well formed. -type Decoder xtype ytype = ytype -> Maybe xtype - --- | Type-class of `codec`s for which `streamEncoder` produces a representation --- of an `xtype` through some `ytype` and which `streamDecoder` attempts to form --- a `xtype` only from well-formed values in `ytype`. -class (BinaryTranscoder xtype) => StreamTranscoder codec xtype ytype where - -- | Implements a `Encoder` function for the `codec`. - streamEncoder :: codec -> Encoder xtype ytype - - -- | Implements a `Decoder` function for the `codec`. - streamDecoder :: codec -> Decoder xtype ytype diff --git a/xcodec/XCodec/Transcoder.hs b/xcodec/XCodec/Transcoder.hs new file mode 100644 --- /dev/null +++ b/xcodec/XCodec/Transcoder.hs @@ -0,0 +1,300 @@ +-- | Module : XCodec.Transcoder +-- Description : Type-class for building generic codecs on binary data. +-- Copyright : Zoey McBride (c) 2026 +-- License : BSD-3-Clause +-- Maintainer : zoeymcbride@mailbox.org +-- Stability : experimental +module XCodec.Transcoder + ( -- * Interface for generic transcoding of binary data. + Transcoder (..), + + -- * Transcoder data as numeric values + BitSet, + Octet, + + -- * Conversion of Integral values to transcoder data. + packValueBE, + packValueLE, + + -- * Transcoder utilities + fromOctet, + null, + uncons, + unsnoc, + takeOctetsTop, + dropOctetsTop, + takeOctetsEnd, + dropOctetsEnd, + takeWhileEndOctets, + takeWhileTopOctets, + dropWhileEndOctets, + dropWhileTopOctets, + ) +where + +import Data.Bits (Bits, (.&.), (.<<.), (.>>.), (.|.)) +import Data.ByteString (ByteString) +import Data.ByteString qualified as Bytes +import Data.ByteString.Builder (Builder) +import Data.ByteString.Builder qualified as BSB +import Data.ByteString.Builder qualified as Builder +import Data.ByteString.Lazy (LazyByteString) +import Data.ByteString.Lazy qualified as LBS +import Data.ByteString.Short (ShortByteString) +import Data.ByteString.Short qualified as SBS +import Data.List qualified as List +import Data.Word (Word8) +import Prelude hiding (null) + +-- | Stores 8-bit values. +type Octet = Word8 + +-- | Stores Transcoder as numeric values. +type BitSet = Integer + +-- | Class of functions for working on binary transcoder streams, that is +-- streams of bytes that we can easily turn into a bitset, and can partition +-- into smaller streams for extracting and parsing data. +class (Monoid tc) => Transcoder tc where + {-# MINIMAL + totalOctets, + swapOrder, + packOctets, + execBuilder, + unpackValueCPU, + unpackValueBE, + unpackValueLE, + unpackBuilder, + unpackOctets, + pushOctetTop, + pushOctetEnd, + spanOctetsTop, + spanOctetsEnd, + splitOffset, + replicateOctet + #-} + + -- | Gives back the length in octets of the Transcoder data. + totalOctets :: tc -> Int + + -- | Reverses the byte order of the transcoder data. + swapOrder :: tc -> tc + + -- | Packs Octet values into transcoder data `tc`. + packOctets :: [Octet] -> tc + + -- | Executes the `Builder` into transcoder data. + execBuilder :: Builder -> tc + + -- | Unpacks transcoder data into a list of bytes. + unpackOctets :: tc -> [Octet] + + -- | Unpacks transcoder data as BitSet in the host CPU's endianness. + unpackValueCPU :: tc -> BitSet + + -- | Unpacks transcoder data as BitSet in Big-Endian (BE) order. + unpackValueBE :: tc -> BitSet + + -- | Unpacks transcoder data as BitSet in Little-Endian (LE) order. + unpackValueLE :: tc -> BitSet + + -- | Places the contents of the transcoder into a ByteString `Builder`. + unpackBuilder :: tc -> Builder + + -- | Prepends an octet value to the top of the transcoder data. + pushOctetTop :: tc -> Octet -> tc + + -- | Appends the octet value to the end of the transcoder data. + pushOctetEnd :: tc -> Octet -> tc + + -- | Parititions the binary data at + splitOffset :: Int -> tc -> (tc, tc) + + -- | Repeats an octet value in binary data. + replicateOctet :: Int -> Octet -> tc + + -- | Splits octet values based on the first false result from the predicate. + spanOctetsTop :: (Octet -> Bool) -> tc -> (tc, tc) + + -- | Splits the list while the element predicate holds staring from the left + -- side. + spanOctetsEnd :: (Octet -> Bool) -> tc -> (tc, tc) + +-- | Implements binary decoder for Bytestrings, best for constant values that +-- exist for the lifetime of the program. +-- https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/Data-ByteString.html#g:2 +instance Transcoder ByteString where + totalOctets = Bytes.length + swapOrder = Bytes.reverse + execBuilder = LBS.toStrict . execBuilder + packOctets = Bytes.pack + unpackBuilder = Builder.byteString + unpackValueCPU = unpackValueCPU . LBS.fromStrict + unpackValueLE = unpackValueLE . LBS.fromStrict + unpackValueBE = unpackValueBE . LBS.fromStrict + unpackOctets = Bytes.unpack + pushOctetTop = flip Bytes.cons + pushOctetEnd = Bytes.snoc + spanOctetsTop = Bytes.span + spanOctetsEnd = Bytes.spanEnd + splitOffset = Bytes.splitAt + replicateOctet k = Bytes.replicate $ fromIntegral k + +-- TODO: we can improve the proformance of unpackBits by examining the current +-- bytestring, and loading a range of 1-8 bytes to OR simulaneously + +-- | Implements binary decoder for LazyByteString, best for very large data sets +-- that can be loaded in and out of memory on demand. +-- https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/Data-ByteString-Lazy.html +instance Transcoder LazyByteString where + totalOctets = fromIntegral . LBS.length + swapOrder = LBS.reverse + execBuilder = BSB.toLazyByteString + packOctets = LBS.pack + unpackOctets = LBS.unpack + unpackValueLE = + -- From MSB to LSB, OR the current byte and shift the total bits. + LBS.foldr (\byte bits -> (bits .<<. 8) .|. fromIntegral byte) 0 + . LBS.dropWhileEnd (== 0) + unpackValueBE = + -- From LSB to MSB, OR the current byte and shift the total bits. + LBS.foldl' (\bits byte -> (bits .<<. 8) .|. fromIntegral byte) 0 + . LBS.dropWhile (== 0) + unpackBuilder = Builder.lazyByteString + pushOctetTop = flip LBS.cons + pushOctetEnd = LBS.snoc + spanOctetsTop = LBS.span + spanOctetsEnd = LBS.spanEnd + splitOffset k = LBS.splitAt $ fromIntegral k + replicateOctet k = LBS.replicate $ fromIntegral k + unpackValueCPU = unpackValueLE + +-- | Implements binary decoder for ShortByteString, best for compact data that +-- doesn't exist long in memory. Notably, it packs better in memory than normal +-- ByteString (prone to Heap Fragmentation). +-- https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/Data-ByteString-Short.html#g:1 +instance Transcoder ShortByteString where + totalOctets = SBS.length + swapOrder = SBS.reverse + execBuilder = SBS.toShort . execBuilder + packOctets = SBS.pack + unpackOctets = SBS.unpack + unpackValueLE = + -- From MSB to LSB , OR the current byte and shift the total bits. + SBS.foldr (\byte bits -> (bits .<<. 8) .|. fromIntegral byte) 0 + . SBS.dropWhileEnd (== 0) + unpackValueBE = + -- From LSB to MSB, OR the current byte and shift the total bits. + SBS.foldl' (\bits byte -> (bits .<<. 8) .|. fromIntegral byte) 0 + . SBS.dropWhile (== 0) + unpackBuilder = Builder.shortByteString + pushOctetTop = flip SBS.cons + pushOctetEnd = SBS.snoc + spanOctetsTop = SBS.span + spanOctetsEnd = SBS.spanEnd + splitOffset = SBS.splitAt + replicateOctet k = SBS.replicate $ fromIntegral k + unpackValueCPU = unpackValueLE + +-- | Takes a subsection of octets from the beginning of the transcoder data. +takeOctetsTop :: (Transcoder tc) => Int -> tc -> tc +takeOctetsTop idx = fst . splitOffset idx + +-- | Removes octets from the beginning of transcoder data. +dropOctetsTop :: (Transcoder tc) => Int -> tc -> tc +dropOctetsTop idx = snd . splitOffset idx + +-- | Removes octets from the end of transcoder data. +takeOctetsEnd :: (Transcoder tc) => Int -> tc -> tc +takeOctetsEnd idx tc = snd $ splitOffset (totalOctets tc - idx) tc + +-- | Removes octets from the end of transcoder data. +dropOctetsEnd :: (Transcoder tc) => Int -> tc -> tc +dropOctetsEnd idx tc = fst $ splitOffset (totalOctets tc - idx) tc + +-- | Implements `takeWhile` for byte data in binary transcoder. +takeWhileTopOctets :: (Transcoder tc) => (Octet -> Bool) -> tc -> tc +takeWhileTopOctets f = fst . spanOctetsEnd f + +-- | Implements `dropWhile` for byte data in binary transcoder. +dropWhileTopOctets :: (Transcoder tc) => (Octet -> Bool) -> tc -> tc +dropWhileTopOctets f = snd . spanOctetsEnd f + +-- | Implements `takeWhileEnd` for byte data in binary transcoder. +takeWhileEndOctets :: (Transcoder tc) => (Octet -> Bool) -> tc -> tc +takeWhileEndOctets f = snd . spanOctetsEnd f + +-- | Implements `dropWhileEnd` for byte data in binary transcoder. +dropWhileEndOctets :: (Transcoder tc) => (Octet -> Bool) -> tc -> tc +dropWhileEndOctets f = fst . spanOctetsEnd f + +-- | Creates a binary transcoder from a single byte. +{-# INLINE fromOctet #-} +fromOctet :: (Transcoder tc) => Octet -> tc +fromOctet w8 = packOctets [w8] + +-- | Returns True if the binary transcoder data is empty. +{-# INLINE null #-} +null :: (Transcoder tc) => tc -> Bool +null tc = totalOctets tc == 0 + +-- | Returns the first byte removed from the transcoder data, if available. +{-# INLINE uncons #-} +uncons :: (Transcoder tc) => tc -> Maybe (Octet, tc) +uncons tc = + let (start, rest) = splitOffset 1 tc + in case unpackOctets start of + [top] -> Just (top, rest) + _ -> Nothing + +-- | Returns the last byte removed from the transcoder data, if available. +{-# INLINE unsnoc #-} +unsnoc :: (Transcoder tc) => tc -> Maybe (tc, Octet) +unsnoc tc = + let offset = totalOctets tc - 1 + (rest, taken) = splitOffset offset tc + in case unpackOctets taken of + [final] -> Just (rest, final) + _ -> Nothing + +-- | Packs a bit string value into some bytes data `tc`. +{-# INLINE packValueOrder #-} +packValueOrder :: + (Integral val, Bits val, Transcoder tc) => + ([Octet] -> [Octet]) -> + val -> + tc +packValueOrder setorder intdata = + -- This code can be optimized; if we precalculate the length of the BitSet + -- in bits we can mask from the other direction using left shifts, and + -- remove the call to setorder, maybe we can even use a list comprehension to + -- build in place for packOctets + packOctets + . replaceNull [0] + . setorder + . map (\(_, byte) -> fromIntegral byte) + . takeWhile (\(rest, byte) -> rest > 0 || byte > 0) + $ iterateInit (\(input, _) -> extractByte input) (,0) intdata + where + -- Gets the byte from LSB in input and shifts the value 8 bits. + extractByte input = (input .>>. 8, input .&. 0xFF) + +-- | Packs a bit string value into some bytes data `tc` in Big-Endian format. +packValueBE :: (Integral val, Bits val, Transcoder tc) => val -> tc +packValueBE = packValueOrder reverse + +-- | Packs a bit string value into some bytes data `tc` in Little-Endian +-- format. +packValueLE :: (Integral val, Bits val, Transcoder tc) => val -> tc +packValueLE = packValueOrder id + +-- | Return the the first param if the second param is empty. +{-# INLINE replaceNull #-} +replaceNull :: [a] -> [a] -> [a] +replaceNull replace xs + | List.null xs = replace + | otherwise = xs + +-- | Wraps iterate to compose with an intermediary type constructor. +iterateInit :: (b -> b) -> (a -> b) -> a -> [b] +iterateInit f iterinit = drop 1 . iterate f . iterinit