{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.ProtoLens.Encoding.Bytes(
Parser,
Builder,
runParser,
isolate,
runBuilder,
getBytes,
putBytes,
getVarInt,
putVarInt,
getFixed32,
getFixed64,
putFixed32,
putFixed64,
wordToFloat,
wordToDouble,
floatToWord,
doubleToWord,
signedInt32ToWord,
wordToSignedInt32,
signedInt64ToWord,
wordToSignedInt64,
atEnd,
runEither,
(<?>),
foldMapBuilder,
) where
import Data.Bits
import Data.ByteString (ByteString)
import Data.ByteString.Lazy.Builder as Builder
import qualified Data.ByteString.Builder.Internal as Internal
import qualified Data.ByteString.Lazy as L
import Data.Int (Int32, Int64)
import Data.Monoid ((<>))
import qualified Data.Vector.Generic as V
import Data.Word (Word32, Word64)
#if MIN_VERSION_base(4,11,0)
import qualified GHC.Float as Float
#else
import Foreign.Ptr (castPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Storable (Storable, peek, poke)
import System.IO.Unsafe (unsafePerformIO)
#endif
import Data.ProtoLens.Encoding.Parser
runBuilder :: Builder -> ByteString
runBuilder = L.toStrict . Builder.toLazyByteString
putBytes :: ByteString -> Builder
putBytes = Builder.byteString
getVarInt :: Parser Word64
getVarInt = loop 1 0
where
loop !s !n = do
b <- getWord8
let n' = n + s * fromIntegral (b .&. 127)
if (b .&. 128) == 0
then return $! n'
else loop (128*s) n'
putVarInt :: Word64 -> Builder
putVarInt n
| n < 128 = Builder.word8 (fromIntegral n)
| otherwise = Builder.word8 (fromIntegral $ n .&. 127 .|. 128)
<> putVarInt (n `shiftR` 7)
getFixed32 :: Parser Word32
getFixed32 = getWord32le
getFixed64 :: Parser Word64
getFixed64 = do
x <- getFixed32
y <- getFixed32
return $ fromIntegral y `shiftL` 32 + fromIntegral x
putFixed32 :: Word32 -> Builder
putFixed32 !x = word32LE x
putFixed64 :: Word64 -> Builder
putFixed64 !x = word64LE x
#if MIN_VERSION_base(4,11,0)
wordToDouble :: Word64 -> Double
wordToDouble = Float.castWord64ToDouble
wordToFloat :: Word32 -> Float
wordToFloat = Float.castWord32ToFloat
doubleToWord :: Double -> Word64
doubleToWord = Float.castDoubleToWord64
floatToWord :: Float -> Word32
floatToWord = Float.castFloatToWord32
#else
{-# INLINE cast #-}
cast :: (Storable a, Storable b) => a -> b
cast x = unsafePerformIO $ alloca $ \p -> do
poke p x
peek $ castPtr p
wordToDouble :: Word64 -> Double
wordToDouble = cast
wordToFloat :: Word32 -> Float
wordToFloat = cast
doubleToWord :: Double -> Word64
doubleToWord = cast
floatToWord :: Float -> Word32
floatToWord = cast
#endif
signedInt32ToWord :: Int32 -> Word32
signedInt32ToWord n = fromIntegral $ shiftL n 1 `xor` shiftR n 31
wordToSignedInt32 :: Word32 -> Int32
wordToSignedInt32 n
= fromIntegral (shiftR n 1) `xor` negate (fromIntegral $ n .&. 1)
signedInt64ToWord :: Int64 -> Word64
signedInt64ToWord n = fromIntegral $ shiftL n 1 `xor` shiftR n 63
wordToSignedInt64 :: Word64 -> Int64
wordToSignedInt64 n
= fromIntegral (shiftR n 1) `xor` negate (fromIntegral $ n .&. 1)
runEither :: Either String a -> Parser a
runEither = either fail return
foldMapBuilder :: V.Vector v a => (a -> Builder) -> v a -> Builder
foldMapBuilder f = \v0 -> Internal.builder (loop v0)
where
loop v cont bs
| V.null v = cont bs
| otherwise = let
!x = V.unsafeHead v
!xs = V.unsafeTail v
in Internal.runBuilderWith
(f x)
(loop xs cont) bs
{-# INLINE foldMapBuilder #-}