{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnboxedSums #-}

-- | Little-endian fixed-width numbers.
module Data.Bytes.Parser.LittleEndian
  ( -- * One

    -- ** Unsigned
    word8
  , word16
  , word32
  , word64
  , word128
  , word256

    -- ** Signed
  , int8
  , int16
  , int32
  , int64

    -- * Many

    -- ** Unsigned
  , word16Array
  , word32Array
  , word64Array
  , word128Array
  , word256Array

    -- ** Unsigned
  , int64Array
  ) where

import Prelude hiding (any, fail, length, takeWhile)

#if MIN_VERSION_base(4,18,0)
#else
import Control.Applicative (liftA2)
#endif
import Data.Bits (unsafeShiftL, (.|.))
import Data.Bytes.Parser.Internal (Parser, Result (..), swapArray128, swapArray16, swapArray256, swapArray32, swapArray64, uneffectful)
import Data.Bytes.Types (Bytes (..))
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Primitive (ByteArray (..), PrimArray (..))
import Data.WideWord (Word128 (Word128), Word256 (Word256))
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.ByteOrder (ByteOrder (BigEndian, LittleEndian), targetByteOrder)

import qualified Data.Bytes as Bytes
import qualified Data.Bytes.Parser as P
import qualified Data.Primitive as PM

-- | Unsigned 8-bit word.
word8 :: e -> Parser e s Word8
word8 :: forall e s. e -> Parser e s Word8
word8 = e -> Parser e s Word8
forall e s. e -> Parser e s Word8
P.any

{- | Array of little-endian unsigned 16-bit words. If the host is
little-endian, the implementation is optimized to simply @memcpy@
bytes into the result array. The result array always has elements
in native-endian byte order.
-}
word16Array ::
  -- | Error message if not enough bytes are present
  e ->
  -- | Number of little-endian 16-bit words to expect
  Int ->
  -- | Native-endian elements
  Parser e s (PrimArray Word16)
word16Array :: forall e s. e -> Int -> Parser e s (PrimArray Word16)
word16Array e
e !Int
n = case ByteOrder
targetByteOrder of
  ByteOrder
LittleEndian -> (Bytes -> PrimArray Word16)
-> Parser e s Bytes -> Parser e s (PrimArray Word16)
forall a b. (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteArray -> PrimArray Word16
asWord16s (ByteArray -> PrimArray Word16)
-> (Bytes -> ByteArray) -> Bytes -> PrimArray Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteArray
Bytes.toByteArrayClone) (e -> Int -> Parser e s Bytes
forall e s. e -> Int -> Parser e s Bytes
P.take e
e (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2))
  ByteOrder
BigEndian -> do
    Bytes
bs <- e -> Int -> Parser e s Bytes
forall e s. e -> Int -> Parser e s Bytes
P.take e
e (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
    let r :: ByteArray
r = Bytes -> ByteArray
swapArray16 Bytes
bs
    PrimArray Word16 -> Parser e s (PrimArray Word16)
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray -> PrimArray Word16
asWord16s ByteArray
r)

-- | Parse an array of little-endian unsigned 32-bit words.
word32Array ::
  -- | Error message if not enough bytes are present
  e ->
  -- | Number of little-endian 32-bit words to consume
  Int ->
  -- | Native-endian elements
  Parser e s (PrimArray Word32)
word32Array :: forall e s. e -> Int -> Parser e s (PrimArray Word32)
word32Array e
e !Int
n = case ByteOrder
targetByteOrder of
  ByteOrder
LittleEndian -> (Bytes -> PrimArray Word32)
-> Parser e s Bytes -> Parser e s (PrimArray Word32)
forall a b. (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteArray -> PrimArray Word32
asWord32s (ByteArray -> PrimArray Word32)
-> (Bytes -> ByteArray) -> Bytes -> PrimArray Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteArray
Bytes.toByteArrayClone) (e -> Int -> Parser e s Bytes
forall e s. e -> Int -> Parser e s Bytes
P.take e
e (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4))
  ByteOrder
BigEndian -> do
    Bytes
bs <- e -> Int -> Parser e s Bytes
forall e s. e -> Int -> Parser e s Bytes
P.take e
e (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
    let r :: ByteArray
r = Bytes -> ByteArray
swapArray32 Bytes
bs
    PrimArray Word32 -> Parser e s (PrimArray Word32)
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray -> PrimArray Word32
asWord32s ByteArray
r)

-- | Parse an array of little-endian unsigned 64-bit words.
word64Array ::
  -- | Error message if not enough bytes are present
  e ->
  -- | Number of little-endian 64-bit words to consume
  Int ->
  -- | Native-endian elements
  Parser e s (PrimArray Word64)
word64Array :: forall e s. e -> Int -> Parser e s (PrimArray Word64)
word64Array e
e !Int
n = case ByteOrder
targetByteOrder of
  ByteOrder
LittleEndian -> (Bytes -> PrimArray Word64)
-> Parser e s Bytes -> Parser e s (PrimArray Word64)
forall a b. (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteArray -> PrimArray Word64
asWord64s (ByteArray -> PrimArray Word64)
-> (Bytes -> ByteArray) -> Bytes -> PrimArray Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteArray
Bytes.toByteArrayClone) (e -> Int -> Parser e s Bytes
forall e s. e -> Int -> Parser e s Bytes
P.take e
e (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8))
  ByteOrder
BigEndian -> do
    Bytes
bs <- e -> Int -> Parser e s Bytes
forall e s. e -> Int -> Parser e s Bytes
P.take e
e (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
    let r :: ByteArray
r = Bytes -> ByteArray
swapArray64 Bytes
bs
    PrimArray Word64 -> Parser e s (PrimArray Word64)
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray -> PrimArray Word64
asWord64s ByteArray
r)

-- | Parse an array of little-endian unsigned 128-bit words.
word128Array ::
  -- | Error message if not enough bytes are present
  e ->
  -- | Number of little-endian 128-bit words to consume
  Int ->
  -- | Native-endian elements
  Parser e s (PrimArray Word128)
word128Array :: forall e s. e -> Int -> Parser e s (PrimArray Word128)
word128Array e
e !Int
n = case ByteOrder
targetByteOrder of
  ByteOrder
LittleEndian -> (Bytes -> PrimArray Word128)
-> Parser e s Bytes -> Parser e s (PrimArray Word128)
forall a b. (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteArray -> PrimArray Word128
asWord128s (ByteArray -> PrimArray Word128)
-> (Bytes -> ByteArray) -> Bytes -> PrimArray Word128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteArray
Bytes.toByteArrayClone) (e -> Int -> Parser e s Bytes
forall e s. e -> Int -> Parser e s Bytes
P.take e
e (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16))
  ByteOrder
BigEndian -> do
    Bytes
bs <- e -> Int -> Parser e s Bytes
forall e s. e -> Int -> Parser e s Bytes
P.take e
e (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16)
    let r :: ByteArray
r = Bytes -> ByteArray
swapArray128 Bytes
bs
    PrimArray Word128 -> Parser e s (PrimArray Word128)
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray -> PrimArray Word128
asWord128s ByteArray
r)

-- | Parse an array of little-endian unsigned 256-bit words.
word256Array ::
  -- | Error message if not enough bytes are present
  e ->
  -- | Number of little-endian 256-bit words to consume
  Int ->
  -- | Native-endian elements
  Parser e s (PrimArray Word256)
word256Array :: forall e s. e -> Int -> Parser e s (PrimArray Word256)
word256Array e
e !Int
n = case ByteOrder
targetByteOrder of
  ByteOrder
LittleEndian -> (Bytes -> PrimArray Word256)
-> Parser e s Bytes -> Parser e s (PrimArray Word256)
forall a b. (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteArray -> PrimArray Word256
asWord256s (ByteArray -> PrimArray Word256)
-> (Bytes -> ByteArray) -> Bytes -> PrimArray Word256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteArray
Bytes.toByteArrayClone) (e -> Int -> Parser e s Bytes
forall e s. e -> Int -> Parser e s Bytes
P.take e
e (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
32))
  ByteOrder
BigEndian -> do
    Bytes
bs <- e -> Int -> Parser e s Bytes
forall e s. e -> Int -> Parser e s Bytes
P.take e
e (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
32)
    let r :: ByteArray
r = Bytes -> ByteArray
swapArray256 Bytes
bs
    PrimArray Word256 -> Parser e s (PrimArray Word256)
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray -> PrimArray Word256
asWord256s ByteArray
r)

-- | Parse an array of little-endian signed 64-bit words.
int64Array ::
  -- | Error message if not enough bytes are present
  e ->
  -- | Number of little-endian 64-bit words to expect
  Int ->
  -- | Native-endian elements
  Parser e s (PrimArray Int64)
int64Array :: forall e s. e -> Int -> Parser e s (PrimArray Int64)
int64Array e
e !Int
n = do
  PrimArray ByteArray#
x <- e -> Int -> Parser e s (PrimArray Word64)
forall e s. e -> Int -> Parser e s (PrimArray Word64)
word64Array e
e Int
n
  PrimArray Int64 -> Parser e s (PrimArray Int64)
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray# -> PrimArray Int64
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x)

asWord16s :: ByteArray -> PrimArray Word16
asWord16s :: ByteArray -> PrimArray Word16
asWord16s (ByteArray ByteArray#
x) = ByteArray# -> PrimArray Word16
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x

asWord32s :: ByteArray -> PrimArray Word32
asWord32s :: ByteArray -> PrimArray Word32
asWord32s (ByteArray ByteArray#
x) = ByteArray# -> PrimArray Word32
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x

asWord64s :: ByteArray -> PrimArray Word64
asWord64s :: ByteArray -> PrimArray Word64
asWord64s (ByteArray ByteArray#
x) = ByteArray# -> PrimArray Word64
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x

asWord128s :: ByteArray -> PrimArray Word128
asWord128s :: ByteArray -> PrimArray Word128
asWord128s (ByteArray ByteArray#
x) = ByteArray# -> PrimArray Word128
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x

asWord256s :: ByteArray -> PrimArray Word256
asWord256s :: ByteArray -> PrimArray Word256
asWord256s (ByteArray ByteArray#
x) = ByteArray# -> PrimArray Word256
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x

-- | Unsigned 16-bit word.
word16 :: e -> Parser e s Word16
word16 :: forall e s. e -> Parser e s Word16
word16 e
e = (Bytes -> Result e Word16) -> Parser e s Word16
forall e a s. (Bytes -> Result e a) -> Parser e s a
uneffectful ((Bytes -> Result e Word16) -> Parser e s Word16)
-> (Bytes -> Result e Word16) -> Parser e s Word16
forall a b. (a -> b) -> a -> b
$ \Bytes
chunk ->
  if Bytes -> Int
length Bytes
chunk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
    then
      let wa :: Word8
wa = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk) :: Word8
          wb :: Word8
wb = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) :: Word8
       in Word16 -> Int -> Int -> Result e Word16
forall e a. a -> Int -> Int -> Result e a
Success
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Word16 (Word -> Int -> Word
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wb) Int
8 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wa))
            (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
            (Bytes -> Int
length Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
    else e -> Result e Word16
forall e a. e -> Result e a
Failure e
e

-- | Unsigned 32-bit word.
word32 :: e -> Parser e s Word32
word32 :: forall e s. e -> Parser e s Word32
word32 e
e = (Bytes -> Result e Word32) -> Parser e s Word32
forall e a s. (Bytes -> Result e a) -> Parser e s a
uneffectful ((Bytes -> Result e Word32) -> Parser e s Word32)
-> (Bytes -> Result e Word32) -> Parser e s Word32
forall a b. (a -> b) -> a -> b
$ \Bytes
chunk ->
  if Bytes -> Int
length Bytes
chunk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4
    then
      let wa :: Word8
wa = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk) :: Word8
          wb :: Word8
wb = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) :: Word8
          wc :: Word8
wc = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) :: Word8
          wd :: Word8
wd = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) :: Word8
       in Word32 -> Int -> Int -> Result e Word32
forall e a. a -> Int -> Int -> Result e a
Success
            ( forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Word32
                ( Word -> Int -> Word
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wd) Int
24
                    Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Int -> Word
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wc) Int
16
                    Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Int -> Word
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wb) Int
8
                    Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wa
                )
            )
            (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
            (Bytes -> Int
length Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
    else e -> Result e Word32
forall e a. e -> Result e a
Failure e
e

-- | Unsigned 64-bit word.
word64 :: e -> Parser e s Word64
word64 :: forall e s. e -> Parser e s Word64
word64 e
e = (Bytes -> Result e Word64) -> Parser e s Word64
forall e a s. (Bytes -> Result e a) -> Parser e s a
uneffectful ((Bytes -> Result e Word64) -> Parser e s Word64)
-> (Bytes -> Result e Word64) -> Parser e s Word64
forall a b. (a -> b) -> a -> b
$ \Bytes
chunk ->
  if Bytes -> Int
length Bytes
chunk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8
    then
      let wa :: Word8
wa = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk) :: Word8
          wb :: Word8
wb = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) :: Word8
          wc :: Word8
wc = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) :: Word8
          wd :: Word8
wd = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) :: Word8
          we :: Word8
we = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) :: Word8
          wf :: Word8
wf = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) :: Word8
          wg :: Word8
wg = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) :: Word8
          wh :: Word8
wh = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray (Bytes -> ByteArray
array Bytes
chunk) (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) :: Word8
       in Word64 -> Int -> Int -> Result e Word64
forall e a. a -> Int -> Int -> Result e a
Success
            ( Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wh) Int
56
                Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wg) Int
48
                Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wf) Int
40
                Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
we) Int
32
                Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wd) Int
24
                Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wc) Int
16
                Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wb) Int
8
                Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wa
            )
            (Bytes -> Int
offset Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8)
            (Bytes -> Int
length Bytes
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8)
    else e -> Result e Word64
forall e a. e -> Result e a
Failure e
e

-- | Unsigned 256-bit word.
word256 :: e -> Parser e s Word256
word256 :: forall e s. e -> Parser e s Word256
word256 e
e = (\Word64
d Word64
c Word64
b Word64
a -> Word64 -> Word64 -> Word64 -> Word64 -> Word256
Word256 Word64
a Word64
b Word64
c Word64
d) (Word64 -> Word64 -> Word64 -> Word64 -> Word256)
-> Parser e s Word64
-> Parser e s (Word64 -> Word64 -> Word64 -> Word256)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> Parser e s Word64
forall e s. e -> Parser e s Word64
word64 e
e Parser e s (Word64 -> Word64 -> Word64 -> Word256)
-> Parser e s Word64 -> Parser e s (Word64 -> Word64 -> Word256)
forall a b. Parser e s (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> Parser e s Word64
forall e s. e -> Parser e s Word64
word64 e
e Parser e s (Word64 -> Word64 -> Word256)
-> Parser e s Word64 -> Parser e s (Word64 -> Word256)
forall a b. Parser e s (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> Parser e s Word64
forall e s. e -> Parser e s Word64
word64 e
e Parser e s (Word64 -> Word256)
-> Parser e s Word64 -> Parser e s Word256
forall a b. Parser e s (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> Parser e s Word64
forall e s. e -> Parser e s Word64
word64 e
e

-- | Unsigned 128-bit word.
word128 :: e -> Parser e s Word128
word128 :: forall e s. e -> Parser e s Word128
word128 e
e = (Word64 -> Word64 -> Word128)
-> Parser e s Word64 -> Parser e s Word64 -> Parser e s Word128
forall a b c.
(a -> b -> c) -> Parser e s a -> Parser e s b -> Parser e s c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Word64 -> Word64 -> Word128) -> Word64 -> Word64 -> Word128
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Word64 -> Word128
Word128) (e -> Parser e s Word64
forall e s. e -> Parser e s Word64
word64 e
e) (e -> Parser e s Word64
forall e s. e -> Parser e s Word64
word64 e
e)

-- | Signed 8-bit integer.
int8 :: e -> Parser e s Int8
int8 :: forall e s. e -> Parser e s Int8
int8 = (Word8 -> Int8) -> Parser e s Word8 -> Parser e s Int8
forall a b. (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Parser e s Word8 -> Parser e s Int8)
-> (e -> Parser e s Word8) -> e -> Parser e s Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Parser e s Word8
forall e s. e -> Parser e s Word8
word8

-- | Signed 16-bit integer.
int16 :: e -> Parser e s Int16
int16 :: forall e s. e -> Parser e s Int16
int16 = (Word16 -> Int16) -> Parser e s Word16 -> Parser e s Int16
forall a b. (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Parser e s Word16 -> Parser e s Int16)
-> (e -> Parser e s Word16) -> e -> Parser e s Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Parser e s Word16
forall e s. e -> Parser e s Word16
word16

-- | Signed 32-bit integer.
int32 :: e -> Parser e s Int32
int32 :: forall e s. e -> Parser e s Int32
int32 = (Word32 -> Int32) -> Parser e s Word32 -> Parser e s Int32
forall a b. (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Parser e s Word32 -> Parser e s Int32)
-> (e -> Parser e s Word32) -> e -> Parser e s Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Parser e s Word32
forall e s. e -> Parser e s Word32
word32

-- | Signed 64-bit integer.
int64 :: e -> Parser e s Int64
int64 :: forall e s. e -> Parser e s Int64
int64 = (Word64 -> Int64) -> Parser e s Word64 -> Parser e s Int64
forall a b. (a -> b) -> Parser e s a -> Parser e s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Parser e s Word64 -> Parser e s Int64)
-> (e -> Parser e s Word64) -> e -> Parser e s Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Parser e s Word64
forall e s. e -> Parser e s Word64
word64