module Data.Conduit.Parsers.Binary.Get
( MonadMapError (..)
, (?=>>)
, (?>>)
, DefaultDecodingState
, GetT
, Get
, runGet
, bytesRead
, castGet
, skip
, isolate
, getByteString
, getLazyByteString
, getLazyByteStringNul
, getRemainingLazyByteString
, getWord8
, getInt8
, getWord16be
, getWord32be
, getWord64be
, getWord16le
, getWord32le
, getWord64le
, getWordhost
, getWord16host
, getWord32host
, getWord64host
, getInt16be
, getInt32be
, getInt64be
, getInt16le
, getInt32le
, getInt64le
, getInthost
, getInt16host
, getInt32host
, getInt64host
, getFloatbe
, getFloatle
, getFloathost
, getDoublebe
, getDoublele
, getDoublehost
, endOfInput
) where
import qualified Data.Binary.Get as S
import Data.Binary.IEEE754 (wordToFloat, wordToDouble)
import qualified Data.Binary.IEEE754 as S hiding (floatToWord, wordToFloat, doubleToWord, wordToDouble)
import qualified Data.ByteString as S (ByteString)
import qualified Data.ByteString as SB hiding (ByteString, head, last, init, tail)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B hiding (ByteString, head, last, init, tail)
import Data.Conduit hiding (ConduitM)
import Data.Int
import Data.Maybe
import Data.Word
import Control.Monad.Error.Map
import Data.Conduit.Parsers
import Data.Conduit.Parsers.Binary ()
import Data.Conduit.Parsers.Binary.ByteOffset
import Data.Conduit.Parsers.GetC
class (DecodingState s, DecodingToken s ~ S.ByteString, DecodingElemsRead s) => DefaultDecodingState s where
instance (DecodingState s, DecodingToken s ~ S.ByteString, DecodingElemsRead s) => DefaultDecodingState s where
type Get e a = forall s o m. (DefaultDecodingState s, Monad m) => GetT s S.ByteString o e m a
runGet :: Monad m => GetT ByteOffset i o e m a -> ConduitT i o m (Either e a)
runGet !g = fst <$> runGetC (startDecoding $ ByteOffset 0) g
{-# INLINE runGet #-}
bytesRead :: (DecodingState s, DecodingElemsRead s, Monad m) => GetT s i o e m Word64
bytesRead = elemsRead
{-# INLINE bytesRead #-}
castGet :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => S.Get a -> GetT s S.ByteString o String m a
castGet !g = getC $
go (S.runGetIncremental g) SB.empty
where
go (S.Done !rest _ !result) !chunk !decoding =
if SB.null rest
then return (Right result, decoded chunk decoding)
else leftover rest >> return (Right result, decoded (SB.take (SB.length chunk - SB.length rest) chunk) decoding)
go (S.Fail _ _ !err) !chunk !decoding = return (Left err, decoded chunk decoding)
go (S.Partial !continue) !chunk !decoding = do
next <- await
go (continue next) (fromMaybe SB.empty next) (decoded chunk decoding)
{-# INLINE castGet #-}
voidError :: Monad m => GetT s i o e m a -> GetT s i o () m a
voidError = mapError (const ())
{-# INLINE voidError #-}
getByteString :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => Int -> GetT s S.ByteString o () m S.ByteString
getByteString !n = getC $
go SB.empty 0
where
go consumed !consumed_length !decoding
| consumed_length >= n = return (Right consumed, decoding)
| otherwise = do
!mi <- await
case mi of
Nothing -> return (Left (), decoding)
Just !i -> do
let !gap = n - consumed_length
if gap >= SB.length i
then do
go (consumed <> i) (consumed_length + fromIntegral (SB.length i)) (decoded i decoding)
else do
let (!got, !rest) = SB.splitAt gap i
leftover rest
return (Right (consumed <> got), decoded got decoding)
{-# INLINE getByteString #-}
getLazyByteString :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => Int64 -> GetT s S.ByteString o () m ByteString
getLazyByteString n = getC $
go B.empty 0
where
go consumed !consumed_length !decoding
| consumed_length >= n = return (Right consumed, decoding)
| otherwise = do
!mi <- await
case mi of
Nothing -> return (Left (), decoding)
Just !i -> do
let !gap = n - consumed_length
if gap >= fromIntegral (SB.length i)
then do
go (consumed <> B.fromStrict i) (consumed_length + fromIntegral (SB.length i)) (decoded i decoding)
else do
let (!got, !rest) = SB.splitAt (fromIntegral gap) i
leftover rest
return (Right (consumed <> B.fromStrict got), decoded got decoding)
{-# INLINE getLazyByteString #-}
getLazyByteStringNul :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m ByteString
getLazyByteStringNul = getC $
go B.empty
where
go consumed !decoding = do
!mi <- await
case mi of
Nothing -> return (Left (), decoding)
Just !i -> do
let (!h, !t) = SB.span (/= 0) i
let r = consumed <> B.fromStrict h
let !d = decoded h decoding
if SB.length t == 0
then go r d
else do
let (!z, !zt) = SB.splitAt 1 t
leftover zt
return (Right r, decoded z $ decoded h decoding)
{-# INLINE getLazyByteStringNul #-}
getRemainingLazyByteString :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o e m ByteString
getRemainingLazyByteString = getC $
go B.empty
where
go consumed !decoding = do
!mi <- await
case mi of
Nothing -> return (Right consumed, decoding)
Just !i -> go (consumed <> B.fromStrict i) (decoded i decoding)
voidCastGet :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => S.Get a -> GetT s S.ByteString o () m a
voidCastGet = voidError . castGet
{-# INLINE voidCastGet #-}
getWord8 :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word8
getWord8 = voidCastGet S.getWord8
{-# INLINE getWord8 #-}
getInt8 :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int8
getInt8 = voidCastGet S.getInt8
{-# INLINE getInt8 #-}
getWord16be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word16
getWord16be = voidCastGet S.getWord16be
{-# INLINE getWord16be #-}
getWord32be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word32
getWord32be = voidCastGet S.getWord32be
{-# INLINE getWord32be #-}
getWord64be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word64
getWord64be = voidCastGet S.getWord64be
{-# INLINE getWord64be #-}
getWord16le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word16
getWord16le = voidCastGet S.getWord16le
{-# INLINE getWord16le #-}
getWord32le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word32
getWord32le = voidCastGet S.getWord32le
{-# INLINE getWord32le #-}
getWord64le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word64
getWord64le = voidCastGet S.getWord64le
{-# INLINE getWord64le #-}
getWordhost :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word
getWordhost = voidCastGet S.getWordhost
{-# INLINE getWordhost #-}
getWord16host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word16
getWord16host = voidCastGet S.getWord16host
{-# INLINE getWord16host #-}
getWord32host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word32
getWord32host = voidCastGet S.getWord32host
{-# INLINE getWord32host #-}
getWord64host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word64
getWord64host = voidCastGet S.getWord64host
{-# INLINE getWord64host #-}
getInt16be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int16
getInt16be = voidCastGet S.getInt16be
{-# INLINE getInt16be #-}
getInt32be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int32
getInt32be = voidCastGet S.getInt32be
{-# INLINE getInt32be #-}
getInt64be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int64
getInt64be = voidCastGet S.getInt64be
{-# INLINE getInt64be #-}
getInt16le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int16
getInt16le = voidCastGet S.getInt16le
{-# INLINE getInt16le #-}
getInt32le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int32
getInt32le = voidCastGet S.getInt32le
{-# INLINE getInt32le #-}
getInt64le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int64
getInt64le = voidCastGet S.getInt64le
{-# INLINE getInt64le #-}
getInthost :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int
getInthost = voidCastGet S.getInthost
{-# INLINE getInthost #-}
getInt16host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int16
getInt16host = voidCastGet S.getInt16host
{-# INLINE getInt16host #-}
getInt32host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int32
getInt32host = voidCastGet S.getInt32host
{-# INLINE getInt32host #-}
getInt64host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int64
getInt64host = voidCastGet S.getInt64host
{-# INLINE getInt64host #-}
getFloatbe :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Float
getFloatbe = voidCastGet S.getFloat32be
{-# INLINE getFloatbe #-}
getFloatle :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Float
getFloatle = voidCastGet S.getFloat32le
{-# INLINE getFloatle #-}
getFloathost :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Float
getFloathost = wordToFloat <$> voidCastGet S.getWord32host
{-# INLINE getFloathost #-}
getDoublebe :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Double
getDoublebe = voidCastGet S.getFloat64be
{-# INLINE getDoublebe #-}
getDoublele :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Double
getDoublele = voidCastGet S.getFloat64le
{-# INLINE getDoublele #-}
getDoublehost :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Double
getDoublehost = wordToDouble <$> voidCastGet S.getWord64host
{-# INLINE getDoublehost #-}