module Data.Conduit.Parsers.Binary.Put
( PutM
, DefaultEncodingState
, Put
, runPut
, bytesWrote
, castPut
, putWord8
, putInt8
, putByteString
, putLazyByteString
, putShortByteString
, putWord16be
, putWord32be
, putWord64be
, putInt16be
, putInt32be
, putInt64be
, putFloatbe
, putDoublebe
, putWord16le
, putWord32le
, putWord64le
, putInt16le
, putInt32le
, putInt64le
, putFloatle
, putDoublele
, putWordhost
, putWord16host
, putWord32host
, putWord64host
, putInthost
, putInt16host
, putInt32host
, putInt64host
, putFloathost
, putDoublehost
) where
import qualified Data.Binary.Put as S
import Data.Binary.IEEE754 (floatToWord, doubleToWord)
import qualified Data.Binary.IEEE754 as S hiding (floatToWord, wordToFloat, doubleToWord, wordToDouble)
import Data.Bits
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.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as HB hiding (ShortByteString)
import Data.Conduit hiding (ConduitM)
import Data.Int
import Data.Word
import Data.Conduit.Parsers.Binary
import Data.Conduit.Parsers.Binary.ByteOffset
import Data.Conduit.Parsers.PutS
class (EncodingState s, EncodingToken s ~ Word64, EncodingBytesWrote s) => DefaultEncodingState s where
instance (EncodingState s, EncodingToken s ~ Word64, EncodingBytesWrote s) => DefaultEncodingState s where
type Put = forall s i m. (DefaultEncodingState s, Monad m) => PutM s i S.ByteString m ()
runPut :: PutM ByteOffset i o m () -> ConduitT i o m ()
runPut !p = runEncoding $ snd $ runPutS p $ startEncoding $ ByteOffset 0
{-# INLINE runPut #-}
bytesWrote :: EncodingBytesWrote s => PutM s i o m Word64
bytesWrote = putS $ \ !s -> (encodingBytesWrote s, s)
{-# INLINE bytesWrote #-}
castPut :: (EncodingState s, Monad m) => EncodingToken s -> S.Put -> PutM s i S.ByteString m ()
castPut !n !p = putS $ \ !t -> ((), encoded (mapM_ yield $ B.toChunks $ S.runPut p, n) t)
{-# INLINE castPut #-}
putWord8 :: (EncodingState s, Num (EncodingToken s), Monad m) => Word8 -> PutM s i S.ByteString m ()
putWord8 = castPut 1 . S.putWord8
{-# INLINE putWord8 #-}
putInt8 :: (EncodingState s, Num (EncodingToken s), Monad m) => Int8 -> PutM s i S.ByteString m ()
putInt8 = castPut 1 . S.putInt8
{-# INLINE putInt8 #-}
putByteString :: (EncodingState s, Num (EncodingToken s), Monad m) => S.ByteString -> PutM s i S.ByteString m ()
putByteString b = castPut (fromIntegral $ SB.length b) $ S.putByteString b
{-# INLINE putByteString #-}
putLazyByteString :: (EncodingState s, Num (EncodingToken s), Monad m) => ByteString -> PutM s i S.ByteString m ()
putLazyByteString b = castPut (fromIntegral $ B.length b) $ S.putLazyByteString b
{-# INLINE putLazyByteString #-}
putShortByteString :: (EncodingState s, Num (EncodingToken s), Monad m) => ShortByteString -> PutM s i S.ByteString m ()
putShortByteString b = castPut (fromIntegral $ HB.length b) $ S.putShortByteString b
{-# INLINE putShortByteString #-}
putWord16be :: (EncodingState s, Num (EncodingToken s), Monad m) => Word16 -> PutM s i S.ByteString m ()
putWord16be = castPut 2 . S.putWord16be
{-# INLINE putWord16be #-}
putWord32be :: (EncodingState s, Num (EncodingToken s), Monad m) => Word32 -> PutM s i S.ByteString m ()
putWord32be = castPut 4 . S.putWord32be
{-# INLINE putWord32be #-}
putWord64be :: (EncodingState s, Num (EncodingToken s), Monad m) => Word64 -> PutM s i S.ByteString m ()
putWord64be = castPut 8 . S.putWord64be
{-# INLINE putWord64be #-}
putInt16be :: (EncodingState s, Num (EncodingToken s), Monad m) => Int16 -> PutM s i S.ByteString m ()
putInt16be = castPut 2 . S.putInt16be
{-# INLINE putInt16be #-}
putInt32be :: (EncodingState s, Num (EncodingToken s), Monad m) => Int32 -> PutM s i S.ByteString m ()
putInt32be = castPut 4 . S.putInt32be
{-# INLINE putInt32be #-}
putInt64be :: (EncodingState s, Num (EncodingToken s), Monad m) => Int64 -> PutM s i S.ByteString m ()
putInt64be = castPut 8 . S.putInt64be
{-# INLINE putInt64be #-}
putFloatbe :: (EncodingState s, Num (EncodingToken s), Monad m) => Float -> PutM s i S.ByteString m ()
putFloatbe = castPut 4 . S.putFloat32be
{-# INLINE putFloatbe #-}
putDoublebe :: (EncodingState s, Num (EncodingToken s), Monad m) => Double -> PutM s i S.ByteString m ()
putDoublebe = castPut 8 . S.putFloat64be
{-# INLINE putDoublebe #-}
putWord16le :: (EncodingState s, Num (EncodingToken s), Monad m) => Word16 -> PutM s i S.ByteString m ()
putWord16le = castPut 2 . S.putWord16le
{-# INLINE putWord16le #-}
putWord32le :: (EncodingState s, Num (EncodingToken s), Monad m) => Word32 -> PutM s i S.ByteString m ()
putWord32le = castPut 4 . S.putWord32le
{-# INLINE putWord32le #-}
putWord64le :: (EncodingState s, Num (EncodingToken s), Monad m) => Word64 -> PutM s i S.ByteString m ()
putWord64le = castPut 8 . S.putWord64le
{-# INLINE putWord64le #-}
putInt16le :: (EncodingState s, Num (EncodingToken s), Monad m) => Int16 -> PutM s i S.ByteString m ()
putInt16le = castPut 2 . S.putInt16le
{-# INLINE putInt16le #-}
putInt32le :: (EncodingState s, Num (EncodingToken s), Monad m) => Int32 -> PutM s i S.ByteString m ()
putInt32le = castPut 4 . S.putInt32le
{-# INLINE putInt32le #-}
putInt64le :: (EncodingState s, Num (EncodingToken s), Monad m) => Int64 -> PutM s i S.ByteString m ()
putInt64le = castPut 8 . S.putInt64le
{-# INLINE putInt64le #-}
putFloatle :: (EncodingState s, Num (EncodingToken s), Monad m) => Float -> PutM s i S.ByteString m ()
putFloatle = castPut 4 . S.putFloat32le
{-# INLINE putFloatle #-}
putDoublele :: (EncodingState s, Num (EncodingToken s), Monad m) => Double -> PutM s i S.ByteString m ()
putDoublele = castPut 8 . S.putFloat64le
{-# INLINE putDoublele #-}
putWordhost :: (EncodingState s, Num (EncodingToken s), Monad m) => Word -> PutM s i S.ByteString m ()
putWordhost = castPut (fromIntegral $ finiteBitSize (0 :: Word)) . S.putWordhost
{-# INLINE putWordhost #-}
putWord16host :: (EncodingState s, Num (EncodingToken s), Monad m) => Word16 -> PutM s i S.ByteString m ()
putWord16host = castPut 2 . S.putWord16host
{-# INLINE putWord16host #-}
putWord32host :: (EncodingState s, Num (EncodingToken s), Monad m) => Word32 -> PutM s i S.ByteString m ()
putWord32host = castPut 4 . S.putWord32host
{-# INLINE putWord32host #-}
putWord64host :: (EncodingState s, Num (EncodingToken s), Monad m) => Word64 -> PutM s i S.ByteString m ()
putWord64host = castPut 8 . S.putWord64host
{-# INLINE putWord64host #-}
putInthost :: (EncodingState s, Num (EncodingToken s), Monad m) => Int -> PutM s i S.ByteString m ()
putInthost = castPut (fromIntegral $ finiteBitSize (0 :: Int)) . S.putInthost
{-# INLINE putInthost #-}
putInt16host :: (EncodingState s, Num (EncodingToken s), Monad m) => Int16 -> PutM s i S.ByteString m ()
putInt16host = castPut 2 . S.putInt16host
{-# INLINE putInt16host #-}
putInt32host :: (EncodingState s, Num (EncodingToken s), Monad m) => Int32 -> PutM s i S.ByteString m ()
putInt32host = castPut 4 . S.putInt32host
{-# INLINE putInt32host #-}
putInt64host :: (EncodingState s, Num (EncodingToken s), Monad m) => Int64 -> PutM s i S.ByteString m ()
putInt64host = castPut 8 . S.putInt64host
{-# INLINE putInt64host #-}
putFloathost :: (EncodingState s, Num (EncodingToken s), Monad m) => Float -> PutM s i S.ByteString m ()
putFloathost = castPut 4 . S.putWord32host . floatToWord
{-# INLINE putFloathost #-}
putDoublehost :: (EncodingState s, Num (EncodingToken s), Monad m) => Double -> PutM s i S.ByteString m ()
putDoublehost = castPut 8 . S.putWord64host . doubleToWord
{-# INLINE putDoublehost #-}