{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
module Codec.CBOR.Decoding
(
Decoder
, DecodeAction(..)
, liftST
, getDecodeAction
, decodeWord
, decodeWord8
, decodeWord16
, decodeWord32
, decodeWord64
, decodeNegWord
, decodeNegWord64
, decodeInt
, decodeInt8
, decodeInt16
, decodeInt32
, decodeInt64
, decodeInteger
, decodeFloat
, decodeDouble
, decodeBytes
, decodeBytesIndef
, decodeByteArray
, decodeString
, decodeStringIndef
, decodeUtf8ByteArray
, decodeListLen
, decodeListLenIndef
, decodeMapLen
, decodeMapLenIndef
, decodeTag
, decodeTag64
, decodeBool
, decodeNull
, decodeSimple
, decodeWordOf
, decodeListLenOf
, decodeListLenOrIndef
, decodeMapLenOrIndef
, decodeBreakOr
, peekTokenType
, TokenType(..)
, peekAvailable
, ByteOffset
, peekByteOffset
, decodeWithByteSpan
, decodeWordCanonical
, decodeWord8Canonical
, decodeWord16Canonical
, decodeWord32Canonical
, decodeWord64Canonical
, decodeNegWordCanonical
, decodeNegWord64Canonical
, decodeIntCanonical
, decodeInt8Canonical
, decodeInt16Canonical
, decodeInt32Canonical
, decodeInt64Canonical
, decodeBytesCanonical
, decodeByteArrayCanonical
, decodeStringCanonical
, decodeUtf8ByteArrayCanonical
, decodeListLenCanonical
, decodeMapLenCanonical
, decodeTagCanonical
, decodeTag64Canonical
, decodeIntegerCanonical
, decodeFloat16Canonical
, decodeFloatCanonical
, decodeDoubleCanonical
, decodeSimpleCanonical
, decodeWordCanonicalOf
, decodeListLenCanonicalOf
, decodeSequenceLenIndef
, decodeSequenceLenN
) where
#include "cbor.h"
import GHC.Exts
import GHC.Word
import GHC.Int
import Data.Text (Text)
import Data.ByteString (ByteString)
import Control.Applicative
import Control.Monad.ST
import qualified Control.Monad.Fail as Fail
import Codec.CBOR.ByteArray (ByteArray)
import Prelude hiding (decodeFloat)
data Decoder s a = Decoder {
runDecoder :: forall r. (a -> ST s (DecodeAction s r)) -> ST s (DecodeAction s r)
}
data DecodeAction s a
= ConsumeWord (Word# -> ST s (DecodeAction s a))
| ConsumeWord8 (Word# -> ST s (DecodeAction s a))
| ConsumeWord16 (Word# -> ST s (DecodeAction s a))
| ConsumeWord32 (Word# -> ST s (DecodeAction s a))
| ConsumeNegWord (Word# -> ST s (DecodeAction s a))
| ConsumeInt (Int# -> ST s (DecodeAction s a))
| ConsumeInt8 (Int# -> ST s (DecodeAction s a))
| ConsumeInt16 (Int# -> ST s (DecodeAction s a))
| ConsumeInt32 (Int# -> ST s (DecodeAction s a))
| ConsumeListLen (Int# -> ST s (DecodeAction s a))
| ConsumeMapLen (Int# -> ST s (DecodeAction s a))
| ConsumeTag (Word# -> ST s (DecodeAction s a))
#if defined(ARCH_32bit)
| ConsumeWord64 (Word64# -> ST s (DecodeAction s a))
| ConsumeNegWord64 (Word64# -> ST s (DecodeAction s a))
| ConsumeInt64 (Int64# -> ST s (DecodeAction s a))
| ConsumeListLen64 (Int64# -> ST s (DecodeAction s a))
| ConsumeMapLen64 (Int64# -> ST s (DecodeAction s a))
| ConsumeTag64 (Word64# -> ST s (DecodeAction s a))
#endif
| ConsumeInteger (Integer -> ST s (DecodeAction s a))
| ConsumeFloat (Float# -> ST s (DecodeAction s a))
| ConsumeDouble (Double# -> ST s (DecodeAction s a))
| ConsumeBytes (ByteString-> ST s (DecodeAction s a))
| ConsumeByteArray (ByteArray -> ST s (DecodeAction s a))
| ConsumeString (Text -> ST s (DecodeAction s a))
| ConsumeUtf8ByteArray (ByteArray -> ST s (DecodeAction s a))
| ConsumeBool (Bool -> ST s (DecodeAction s a))
| ConsumeSimple (Word# -> ST s (DecodeAction s a))
| ConsumeBytesIndef (ST s (DecodeAction s a))
| ConsumeStringIndef (ST s (DecodeAction s a))
| ConsumeListLenIndef (ST s (DecodeAction s a))
| ConsumeMapLenIndef (ST s (DecodeAction s a))
| ConsumeNull (ST s (DecodeAction s a))
| ConsumeListLenOrIndef (Int# -> ST s (DecodeAction s a))
| ConsumeMapLenOrIndef (Int# -> ST s (DecodeAction s a))
| ConsumeBreakOr (Bool -> ST s (DecodeAction s a))
| PeekTokenType (TokenType -> ST s (DecodeAction s a))
| PeekAvailable (Int# -> ST s (DecodeAction s a))
#if defined(ARCH_32bit)
| PeekByteOffset (Int64# -> ST s (DecodeAction s a))
#else
| PeekByteOffset (Int# -> ST s (DecodeAction s a))
#endif
| ConsumeWordCanonical (Word# -> ST s (DecodeAction s a))
| ConsumeWord8Canonical (Word# -> ST s (DecodeAction s a))
| ConsumeWord16Canonical (Word# -> ST s (DecodeAction s a))
| ConsumeWord32Canonical (Word# -> ST s (DecodeAction s a))
| ConsumeNegWordCanonical (Word# -> ST s (DecodeAction s a))
| ConsumeIntCanonical (Int# -> ST s (DecodeAction s a))
| ConsumeInt8Canonical (Int# -> ST s (DecodeAction s a))
| ConsumeInt16Canonical (Int# -> ST s (DecodeAction s a))
| ConsumeInt32Canonical (Int# -> ST s (DecodeAction s a))
| ConsumeListLenCanonical (Int# -> ST s (DecodeAction s a))
| ConsumeMapLenCanonical (Int# -> ST s (DecodeAction s a))
| ConsumeTagCanonical (Word# -> ST s (DecodeAction s a))
#if defined(ARCH_32bit)
| ConsumeWord64Canonical (Word64# -> ST s (DecodeAction s a))
| ConsumeNegWord64Canonical (Word64# -> ST s (DecodeAction s a))
| ConsumeInt64Canonical (Int64# -> ST s (DecodeAction s a))
| ConsumeListLen64Canonical (Int64# -> ST s (DecodeAction s a))
| ConsumeMapLen64Canonical (Int64# -> ST s (DecodeAction s a))
| ConsumeTag64Canonical (Word64# -> ST s (DecodeAction s a))
#endif
| ConsumeIntegerCanonical (Integer -> ST s (DecodeAction s a))
| ConsumeFloat16Canonical (Float# -> ST s (DecodeAction s a))
| ConsumeFloatCanonical (Float# -> ST s (DecodeAction s a))
| ConsumeDoubleCanonical (Double# -> ST s (DecodeAction s a))
| ConsumeBytesCanonical (ByteString-> ST s (DecodeAction s a))
| ConsumeByteArrayCanonical (ByteArray -> ST s (DecodeAction s a))
| ConsumeStringCanonical (Text -> ST s (DecodeAction s a))
| ConsumeUtf8ByteArrayCanonical (ByteArray -> ST s (DecodeAction s a))
| ConsumeSimpleCanonical (Word# -> ST s (DecodeAction s a))
| Fail String
| Done a
data TokenType
= TypeUInt
| TypeUInt64
| TypeNInt
| TypeNInt64
| TypeInteger
| TypeFloat16
| TypeFloat32
| TypeFloat64
| TypeBytes
| TypeBytesIndef
| TypeString
| TypeStringIndef
| TypeListLen
| TypeListLen64
| TypeListLenIndef
| TypeMapLen
| TypeMapLen64
| TypeMapLenIndef
| TypeTag
| TypeTag64
| TypeBool
| TypeNull
| TypeSimple
| TypeBreak
| TypeInvalid
deriving (Eq, Ord, Enum, Bounded, Show)
instance Functor (Decoder s) where
{-# INLINE fmap #-}
fmap f = \d -> Decoder $ \k -> runDecoder d (k . f)
instance Applicative (Decoder s) where
{-# INLINE pure #-}
pure = \x -> Decoder $ \k -> k x
{-# INLINE (<*>) #-}
(<*>) = \df dx -> Decoder $ \k ->
runDecoder df (\f -> runDecoder dx (\x -> k (f x)))
{-# INLINE (*>) #-}
(*>) = \dm dn -> Decoder $ \k -> runDecoder dm (\_ -> runDecoder dn k)
instance Monad (Decoder s) where
return = pure
{-# INLINE (>>=) #-}
(>>=) = \dm f -> Decoder $ \k -> runDecoder dm (\m -> runDecoder (f m) k)
{-# INLINE (>>) #-}
(>>) = (*>)
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
instance Fail.MonadFail (Decoder s) where
fail msg = Decoder $ \_ -> return (Fail msg)
liftST :: ST s a -> Decoder s a
liftST m = Decoder $ \k -> m >>= k
getDecodeAction :: Decoder s a -> ST s (DecodeAction s a)
getDecodeAction (Decoder k) = k (\x -> return (Done x))
decodeWord :: Decoder s Word
decodeWord = Decoder (\k -> return (ConsumeWord (\w# -> k (W# w#))))
{-# INLINE decodeWord #-}
decodeWord8 :: Decoder s Word8
decodeWord8 = Decoder (\k -> return (ConsumeWord8 (\w# -> k (W8# w#))))
{-# INLINE decodeWord8 #-}
decodeWord16 :: Decoder s Word16
decodeWord16 = Decoder (\k -> return (ConsumeWord16 (\w# -> k (W16# w#))))
{-# INLINE decodeWord16 #-}
decodeWord32 :: Decoder s Word32
decodeWord32 = Decoder (\k -> return (ConsumeWord32 (\w# -> k (W32# w#))))
{-# INLINE decodeWord32 #-}
decodeWord64 :: Decoder s Word64
{-# INLINE decodeWord64 #-}
decodeWord64 =
#if defined(ARCH_64bit)
Decoder (\k -> return (ConsumeWord (\w# -> k (W64# w#))))
#else
Decoder (\k -> return (ConsumeWord64 (\w64# -> k (W64# w64#))))
#endif
decodeNegWord :: Decoder s Word
decodeNegWord = Decoder (\k -> return (ConsumeNegWord (\w# -> k (W# w#))))
{-# INLINE decodeNegWord #-}
decodeNegWord64 :: Decoder s Word64
{-# INLINE decodeNegWord64 #-}
decodeNegWord64 =
#if defined(ARCH_64bit)
Decoder (\k -> return (ConsumeNegWord (\w# -> k (W64# w#))))
#else
Decoder (\k -> return (ConsumeNegWord64 (\w64# -> k (W64# w64#))))
#endif
decodeInt :: Decoder s Int
decodeInt = Decoder (\k -> return (ConsumeInt (\n# -> k (I# n#))))
{-# INLINE decodeInt #-}
decodeInt8 :: Decoder s Int8
decodeInt8 = Decoder (\k -> return (ConsumeInt8 (\w# -> k (I8# w#))))
{-# INLINE decodeInt8 #-}
decodeInt16 :: Decoder s Int16
decodeInt16 = Decoder (\k -> return (ConsumeInt16 (\w# -> k (I16# w#))))
{-# INLINE decodeInt16 #-}
decodeInt32 :: Decoder s Int32
decodeInt32 = Decoder (\k -> return (ConsumeInt32 (\w# -> k (I32# w#))))
{-# INLINE decodeInt32 #-}
decodeInt64 :: Decoder s Int64
{-# INLINE decodeInt64 #-}
decodeInt64 =
#if defined(ARCH_64bit)
Decoder (\k -> return (ConsumeInt (\n# -> k (I64# n#))))
#else
Decoder (\k -> return (ConsumeInt64 (\n64# -> k (I64# n64#))))
#endif
decodeWordCanonical :: Decoder s Word
decodeWordCanonical = Decoder (\k -> return (ConsumeWordCanonical (\w# -> k (W# w#))))
{-# INLINE decodeWordCanonical #-}
decodeWord8Canonical :: Decoder s Word8
decodeWord8Canonical = Decoder (\k -> return (ConsumeWord8Canonical (\w# -> k (W8# w#))))
{-# INLINE decodeWord8Canonical #-}
decodeWord16Canonical :: Decoder s Word16
decodeWord16Canonical = Decoder (\k -> return (ConsumeWord16Canonical (\w# -> k (W16# w#))))
{-# INLINE decodeWord16Canonical #-}
decodeWord32Canonical :: Decoder s Word32
decodeWord32Canonical = Decoder (\k -> return (ConsumeWord32Canonical (\w# -> k (W32# w#))))
{-# INLINE decodeWord32Canonical #-}
decodeWord64Canonical :: Decoder s Word64
{-# INLINE decodeWord64Canonical #-}
decodeWord64Canonical =
#if defined(ARCH_64bit)
Decoder (\k -> return (ConsumeWordCanonical (\w# -> k (W64# w#))))
#else
Decoder (\k -> return (ConsumeWord64Canonical (\w64# -> k (W64# w64#))))
#endif
decodeNegWordCanonical :: Decoder s Word
decodeNegWordCanonical = Decoder (\k -> return (ConsumeNegWordCanonical (\w# -> k (W# w#))))
{-# INLINE decodeNegWordCanonical #-}
decodeNegWord64Canonical :: Decoder s Word64
{-# INLINE decodeNegWord64Canonical #-}
decodeNegWord64Canonical =
#if defined(ARCH_64bit)
Decoder (\k -> return (ConsumeNegWordCanonical (\w# -> k (W64# w#))))
#else
Decoder (\k -> return (ConsumeNegWord64Canonical (\w64# -> k (W64# w64#))))
#endif
decodeIntCanonical :: Decoder s Int
decodeIntCanonical = Decoder (\k -> return (ConsumeIntCanonical (\n# -> k (I# n#))))
{-# INLINE decodeIntCanonical #-}
decodeInt8Canonical :: Decoder s Int8
decodeInt8Canonical = Decoder (\k -> return (ConsumeInt8Canonical (\w# -> k (I8# w#))))
{-# INLINE decodeInt8Canonical #-}
decodeInt16Canonical :: Decoder s Int16
decodeInt16Canonical = Decoder (\k -> return (ConsumeInt16Canonical (\w# -> k (I16# w#))))
{-# INLINE decodeInt16Canonical #-}
decodeInt32Canonical :: Decoder s Int32
decodeInt32Canonical = Decoder (\k -> return (ConsumeInt32Canonical (\w# -> k (I32# w#))))
{-# INLINE decodeInt32Canonical #-}
decodeInt64Canonical :: Decoder s Int64
{-# INLINE decodeInt64Canonical #-}
decodeInt64Canonical =
#if defined(ARCH_64bit)
Decoder (\k -> return (ConsumeIntCanonical (\n# -> k (I64# n#))))
#else
Decoder (\k -> return (ConsumeInt64Canonical (\n64# -> k (I64# n64#))))
#endif
decodeInteger :: Decoder s Integer
decodeInteger = Decoder (\k -> return (ConsumeInteger (\n -> k n)))
{-# INLINE decodeInteger #-}
decodeFloat :: Decoder s Float
decodeFloat = Decoder (\k -> return (ConsumeFloat (\f# -> k (F# f#))))
{-# INLINE decodeFloat #-}
decodeDouble :: Decoder s Double
decodeDouble = Decoder (\k -> return (ConsumeDouble (\f# -> k (D# f#))))
{-# INLINE decodeDouble #-}
decodeBytes :: Decoder s ByteString
decodeBytes = Decoder (\k -> return (ConsumeBytes (\bs -> k bs)))
{-# INLINE decodeBytes #-}
decodeBytesCanonical :: Decoder s ByteString
decodeBytesCanonical = Decoder (\k -> return (ConsumeBytesCanonical (\bs -> k bs)))
{-# INLINE decodeBytesCanonical #-}
decodeBytesIndef :: Decoder s ()
decodeBytesIndef = Decoder (\k -> return (ConsumeBytesIndef (k ())))
{-# INLINE decodeBytesIndef #-}
decodeByteArray :: Decoder s ByteArray
decodeByteArray = Decoder (\k -> return (ConsumeByteArray k))
{-# INLINE decodeByteArray #-}
decodeByteArrayCanonical :: Decoder s ByteArray
decodeByteArrayCanonical = Decoder (\k -> return (ConsumeByteArrayCanonical k))
{-# INLINE decodeByteArrayCanonical #-}
decodeString :: Decoder s Text
decodeString = Decoder (\k -> return (ConsumeString (\str -> k str)))
{-# INLINE decodeString #-}
decodeStringCanonical :: Decoder s Text
decodeStringCanonical = Decoder (\k -> return (ConsumeStringCanonical (\str -> k str)))
{-# INLINE decodeStringCanonical #-}
decodeStringIndef :: Decoder s ()
decodeStringIndef = Decoder (\k -> return (ConsumeStringIndef (k ())))
{-# INLINE decodeStringIndef #-}
decodeUtf8ByteArray :: Decoder s ByteArray
decodeUtf8ByteArray = Decoder (\k -> return (ConsumeUtf8ByteArray k))
{-# INLINE decodeUtf8ByteArray #-}
decodeUtf8ByteArrayCanonical :: Decoder s ByteArray
decodeUtf8ByteArrayCanonical = Decoder (\k -> return (ConsumeUtf8ByteArrayCanonical k))
{-# INLINE decodeUtf8ByteArrayCanonical #-}
decodeListLen :: Decoder s Int
decodeListLen = Decoder (\k -> return (ConsumeListLen (\n# -> k (I# n#))))
{-# INLINE decodeListLen #-}
decodeListLenCanonical :: Decoder s Int
decodeListLenCanonical = Decoder (\k -> return (ConsumeListLenCanonical (\n# -> k (I# n#))))
{-# INLINE decodeListLenCanonical #-}
decodeListLenIndef :: Decoder s ()
decodeListLenIndef = Decoder (\k -> return (ConsumeListLenIndef (k ())))
{-# INLINE decodeListLenIndef #-}
decodeMapLen :: Decoder s Int
decodeMapLen = Decoder (\k -> return (ConsumeMapLen (\n# -> k (I# n#))))
{-# INLINE decodeMapLen #-}
decodeMapLenCanonical :: Decoder s Int
decodeMapLenCanonical = Decoder (\k -> return (ConsumeMapLenCanonical (\n# -> k (I# n#))))
{-# INLINE decodeMapLenCanonical #-}
decodeMapLenIndef :: Decoder s ()
decodeMapLenIndef = Decoder (\k -> return (ConsumeMapLenIndef (k ())))
{-# INLINE decodeMapLenIndef #-}
decodeTag :: Decoder s Word
decodeTag = Decoder (\k -> return (ConsumeTag (\w# -> k (W# w#))))
{-# INLINE decodeTag #-}
decodeTag64 :: Decoder s Word64
{-# INLINE decodeTag64 #-}
decodeTag64 =
#if defined(ARCH_64bit)
Decoder (\k -> return (ConsumeTag (\w# -> k (W64# w#))))
#else
Decoder (\k -> return (ConsumeTag64 (\w64# -> k (W64# w64#))))
#endif
decodeTagCanonical :: Decoder s Word
decodeTagCanonical = Decoder (\k -> return (ConsumeTagCanonical (\w# -> k (W# w#))))
{-# INLINE decodeTagCanonical #-}
decodeTag64Canonical :: Decoder s Word64
{-# INLINE decodeTag64Canonical #-}
decodeTag64Canonical =
#if defined(ARCH_64bit)
Decoder (\k -> return (ConsumeTagCanonical (\w# -> k (W64# w#))))
#else
Decoder (\k -> return (ConsumeTag64Canonical (\w64# -> k (W64# w64#))))
#endif
decodeBool :: Decoder s Bool
decodeBool = Decoder (\k -> return (ConsumeBool (\b -> k b)))
{-# INLINE decodeBool #-}
decodeNull :: Decoder s ()
decodeNull = Decoder (\k -> return (ConsumeNull (k ())))
{-# INLINE decodeNull #-}
decodeSimple :: Decoder s Word8
decodeSimple = Decoder (\k -> return (ConsumeSimple (\w# -> k (W8# w#))))
{-# INLINE decodeSimple #-}
decodeIntegerCanonical :: Decoder s Integer
decodeIntegerCanonical = Decoder (\k -> return (ConsumeIntegerCanonical (\n -> k n)))
{-# INLINE decodeIntegerCanonical #-}
decodeFloat16Canonical :: Decoder s Float
decodeFloat16Canonical = Decoder (\k -> return (ConsumeFloat16Canonical (\f# -> k (F# f#))))
{-# INLINE decodeFloat16Canonical #-}
decodeFloatCanonical :: Decoder s Float
decodeFloatCanonical = Decoder (\k -> return (ConsumeFloatCanonical (\f# -> k (F# f#))))
{-# INLINE decodeFloatCanonical #-}
decodeDoubleCanonical :: Decoder s Double
decodeDoubleCanonical = Decoder (\k -> return (ConsumeDoubleCanonical (\f# -> k (D# f#))))
{-# INLINE decodeDoubleCanonical #-}
decodeSimpleCanonical :: Decoder s Word8
decodeSimpleCanonical = Decoder (\k -> return (ConsumeSimpleCanonical (\w# -> k (W8# w#))))
{-# INLINE decodeSimpleCanonical #-}
decodeWordOf :: Word
-> Decoder s ()
decodeWordOf = decodeWordOfHelper decodeWord
{-# INLINE decodeWordOf #-}
decodeListLenOf :: Int -> Decoder s ()
decodeListLenOf = decodeListLenOfHelper decodeListLen
{-# INLINE decodeListLenOf #-}
decodeWordCanonicalOf :: Word
-> Decoder s ()
decodeWordCanonicalOf = decodeWordOfHelper decodeWordCanonical
{-# INLINE decodeWordCanonicalOf #-}
decodeListLenCanonicalOf :: Int -> Decoder s ()
decodeListLenCanonicalOf = decodeListLenOfHelper decodeListLenCanonical
{-# INLINE decodeListLenCanonicalOf #-}
decodeListLenOfHelper :: (Show a, Eq a, Fail.MonadFail m) => m a -> a -> m ()
decodeListLenOfHelper decodeFun = \len -> do
len' <- decodeFun
if len == len' then return ()
else fail $ "expected list of length " ++ show len
{-# INLINE decodeListLenOfHelper #-}
decodeWordOfHelper :: (Show a, Eq a, Fail.MonadFail m) => m a -> a -> m ()
decodeWordOfHelper decodeFun = \n -> do
n' <- decodeFun
if n == n' then return ()
else fail $ "expected word " ++ show n
{-# INLINE decodeWordOfHelper #-}
decodeListLenOrIndef :: Decoder s (Maybe Int)
decodeListLenOrIndef =
Decoder (\k -> return (ConsumeListLenOrIndef (\n# ->
if I# n# >= 0
then k (Just (I# n#))
else k Nothing)))
{-# INLINE decodeListLenOrIndef #-}
decodeMapLenOrIndef :: Decoder s (Maybe Int)
decodeMapLenOrIndef =
Decoder (\k -> return (ConsumeMapLenOrIndef (\n# ->
if I# n# >= 0
then k (Just (I# n#))
else k Nothing)))
{-# INLINE decodeMapLenOrIndef #-}
decodeBreakOr :: Decoder s Bool
decodeBreakOr = Decoder (\k -> return (ConsumeBreakOr (\b -> k b)))
{-# INLINE decodeBreakOr #-}
peekTokenType :: Decoder s TokenType
peekTokenType = Decoder (\k -> return (PeekTokenType (\tk -> k tk)))
{-# INLINE peekTokenType #-}
peekAvailable :: Decoder s Int
peekAvailable = Decoder (\k -> return (PeekAvailable (\len# -> k (I# len#))))
{-# INLINE peekAvailable #-}
type ByteOffset = Int64
peekByteOffset :: Decoder s ByteOffset
peekByteOffset = Decoder (\k -> return (PeekByteOffset (\off# -> k (I64# off#))))
{-# INLINE peekByteOffset #-}
decodeWithByteSpan :: Decoder s a -> Decoder s (a, ByteOffset, ByteOffset)
decodeWithByteSpan da = do
!before <- peekByteOffset
x <- da
!after <- peekByteOffset
return (x, before, after)
decodeSequenceLenIndef :: (r -> a -> r)
-> r
-> (r -> r')
-> Decoder s a
-> Decoder s r'
decodeSequenceLenIndef f z g get =
go z
where
go !acc = do
stop <- decodeBreakOr
if stop then return $! g acc
else do !x <- get; go (f acc x)
{-# INLINE decodeSequenceLenIndef #-}
decodeSequenceLenN :: (r -> a -> r)
-> r
-> (r -> r')
-> Int
-> Decoder s a
-> Decoder s r'
decodeSequenceLenN f z g c get =
go z c
where
go !acc 0 = return $! g acc
go !acc n = do !x <- get; go (f acc x) (n-1)
{-# INLINE decodeSequenceLenN #-}