{-# LANGUAGE LambdaCase  #-}
{-# LANGUAGE Trustworthy #-}

--------------------------------------------------------------------
-- |
-- Module    : Data.MessagePack.Get
-- Copyright : (c) Hideyuki Tanaka, 2009-2015
-- License   : BSD3
--
-- Maintainer:  tanaka.hideyuki@gmail.com
-- Stability :  experimental
-- Portability: portable
--
-- MessagePack Deserializer using @Data.Persist@
--
--------------------------------------------------------------------

module Data.MessagePack.Get
  ( getObject
  ) where

import           Control.Applicative    ((<$), (<$>), (<*>), (<|>))
import           Control.Monad          (guard, replicateM)
import           Data.Bits              ((.&.))
import qualified Data.ByteString        as S
import           Data.Int               (Int16, Int32, Int64, Int8)
import           Data.Persist           (Get, get, unBE)
import qualified Data.Persist           as P
import qualified Data.Text              as T
import qualified Data.Text.Encoding     as T
import           Data.Word              (Word64, Word32, Word16, Word8)

import           Data.MessagePack.Types (Object (..))

getObject :: Get Object
getObject :: Get Object
getObject = Get Word8
getWord8 Get Word8 -> (Word8 -> Get Object) -> Get Object
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Word8
0xC0 -> Object -> Get Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
ObjectNil
  Word8
0xC2 -> Object -> Get Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Get Object) -> Object -> Get Object
forall a b. (a -> b) -> a -> b
$ Bool -> Object
ObjectBool Bool
False
  Word8
0xC3 -> Object -> Get Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Get Object) -> Object -> Get Object
forall a b. (a -> b) -> a -> b
$ Bool -> Object
ObjectBool Bool
True
  Word8
c | Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xE0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xE0 -> Object -> Get Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Get Object) -> Object -> Get Object
forall a b. (a -> b) -> a -> b
$ Int64 -> Object
ObjectInt (Int64 -> Object) -> Int64 -> Object
forall a b. (a -> b) -> a -> b
$ Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c :: Int8)
  Word8
0xD0 -> Int64 -> Object
ObjectInt (Int64 -> Object) -> (Int8 -> Int64) -> Int8 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Object) -> Get Int8 -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
  Word8
0xD1 -> Int64 -> Object
ObjectInt (Int64 -> Object) -> (Int16 -> Int64) -> Int16 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Object) -> Get Int16 -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be
  Word8
0xD2 -> Int64 -> Object
ObjectInt (Int64 -> Object) -> (Int32 -> Int64) -> Int32 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Object) -> Get Int32 -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be
  Word8
0xD3 -> Int64 -> Object
ObjectInt (Int64 -> Object) -> (Int64 -> Int64) -> Int64 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Object) -> Get Int64 -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64be
  Word8
c | Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00 -> Object -> Get Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Get Object) -> Object -> Get Object
forall a b. (a -> b) -> a -> b
$ Word64 -> Object
ObjectWord (Word64 -> Object) -> Word64 -> Object
forall a b. (a -> b) -> a -> b
$ Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c
  Word8
0xCC -> Word64 -> Object
ObjectWord (Word64 -> Object) -> (Word8 -> Word64) -> Word8 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Object) -> Get Word8 -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
  Word8
0xCD -> Word64 -> Object
ObjectWord (Word64 -> Object) -> (Word16 -> Word64) -> Word16 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Object) -> Get Word16 -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
  Word8
0xCE -> Word64 -> Object
ObjectWord (Word64 -> Object) -> (Word32 -> Word64) -> Word32 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Object) -> Get Word32 -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
  Word8
0xCF -> Word64 -> Object
ObjectWord (Word64 -> Object) -> (Word64 -> Word64) -> Word64 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Object) -> Get Word64 -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be
  Word8
0xCA -> Float -> Object
ObjectFloat (Float -> Object) -> Get Float -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
getFloat32be
  Word8
0xCB -> Double -> Object
ObjectDouble (Double -> Object) -> Get Double -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getFloat64be
  Word8
t | Word8
t Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xE0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xA0 -> let len :: Int
len = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
t Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1F in Text -> Object
ObjectStr (Text -> Object) -> Get Text -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Get ByteString
getByteString Int
len Get ByteString -> (ByteString -> Get Text) -> Get Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Get Text
forall (m :: * -> *). MonadFail m => ByteString -> m Text
decodeStr)
  Word8
0xD9 -> Text -> Object
ObjectStr (Text -> Object) -> Get Text -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get Int -> (Int -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getByteString Get ByteString -> (ByteString -> Get Text) -> Get Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Get Text
forall (m :: * -> *). MonadFail m => ByteString -> m Text
decodeStr)
  Word8
0xDA -> Text -> Object
ObjectStr (Text -> Object) -> Get Text -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be Get Int -> (Int -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getByteString Get ByteString -> (ByteString -> Get Text) -> Get Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Get Text
forall (m :: * -> *). MonadFail m => ByteString -> m Text
decodeStr)
  Word8
0xDB -> Text -> Object
ObjectStr (Text -> Object) -> Get Text -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be Get Int -> (Int -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getByteString Get ByteString -> (ByteString -> Get Text) -> Get Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Get Text
forall (m :: * -> *). MonadFail m => ByteString -> m Text
decodeStr)
  Word8
0xC4 -> ByteString -> Object
ObjectBin (ByteString -> Object) -> Get ByteString -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get Int -> (Int -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getByteString)
  Word8
0xC5 -> ByteString -> Object
ObjectBin (ByteString -> Object) -> Get ByteString -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be Get Int -> (Int -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getByteString)
  Word8
0xC6 -> ByteString -> Object
ObjectBin (ByteString -> Object) -> Get ByteString -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be Get Int -> (Int -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getByteString)
  Word8
t | Word8
t Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xF0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x90 -> let len :: Int
len = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
t Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0F in [Object] -> Object
ObjectArray ([Object] -> Object) -> Get [Object] -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Object -> Get [Object]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len Get Object
getObject
  Word8
0xDC -> Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be Get Int -> (Int -> Get Object) -> Get Object
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
len -> [Object] -> Object
ObjectArray ([Object] -> Object) -> Get [Object] -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Object -> Get [Object]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len Get Object
getObject
  Word8
0xDD -> Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be Get Int -> (Int -> Get Object) -> Get Object
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
len -> [Object] -> Object
ObjectArray ([Object] -> Object) -> Get [Object] -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Object -> Get [Object]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len Get Object
getObject
  Word8
t | Word8
t Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xF0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x80 -> let len :: Int
len =  Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
t Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0F in [(Object, Object)] -> Object
ObjectMap ([(Object, Object)] -> Object)
-> Get [(Object, Object)] -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get (Object, Object) -> Get [(Object, Object)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len ((,) (Object -> Object -> (Object, Object))
-> Get Object -> Get (Object -> (Object, Object))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Object
getObject Get (Object -> (Object, Object))
-> Get Object -> Get (Object, Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Object
getObject)
  Word8
0xDE -> Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be Get Int -> (Int -> Get Object) -> Get Object
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
len -> [(Object, Object)] -> Object
ObjectMap ([(Object, Object)] -> Object)
-> Get [(Object, Object)] -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get (Object, Object) -> Get [(Object, Object)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len ((,) (Object -> Object -> (Object, Object))
-> Get Object -> Get (Object -> (Object, Object))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Object
getObject Get (Object -> (Object, Object))
-> Get Object -> Get (Object, Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Object
getObject)
  Word8
0xDF -> Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be Get Int -> (Int -> Get Object) -> Get Object
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
len -> [(Object, Object)] -> Object
ObjectMap ([(Object, Object)] -> Object)
-> Get [(Object, Object)] -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get (Object, Object) -> Get [(Object, Object)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len ((,) (Object -> Object -> (Object, Object))
-> Get Object -> Get (Object -> (Object, Object))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Object
getObject Get (Object -> (Object, Object))
-> Get Object -> Get (Object, Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Object
getObject)
  Word8
0xD4 -> Word8 -> ByteString -> Object
ObjectExt (Word8 -> ByteString -> Object)
-> Get Word8 -> Get (ByteString -> Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get (ByteString -> Object) -> Get ByteString -> Get Object
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getByteString Int
1
  Word8
0xD5 -> Word8 -> ByteString -> Object
ObjectExt (Word8 -> ByteString -> Object)
-> Get Word8 -> Get (ByteString -> Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get (ByteString -> Object) -> Get ByteString -> Get Object
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getByteString Int
2
  Word8
0xD6 -> Word8 -> ByteString -> Object
ObjectExt (Word8 -> ByteString -> Object)
-> Get Word8 -> Get (ByteString -> Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get (ByteString -> Object) -> Get ByteString -> Get Object
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getByteString Int
4
  Word8
0xD7 -> Word8 -> ByteString -> Object
ObjectExt (Word8 -> ByteString -> Object)
-> Get Word8 -> Get (ByteString -> Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get (ByteString -> Object) -> Get ByteString -> Get Object
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getByteString Int
8
  Word8
0xD8 -> Word8 -> ByteString -> Object
ObjectExt (Word8 -> ByteString -> Object)
-> Get Word8 -> Get (ByteString -> Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get (ByteString -> Object) -> Get ByteString -> Get Object
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getByteString Int
16
  Word8
0xC7 -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get Int -> (Int -> Get Object) -> Get Object
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
len -> Word8 -> ByteString -> Object
ObjectExt (Word8 -> ByteString -> Object)
-> Get Word8 -> Get (ByteString -> Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get (ByteString -> Object) -> Get ByteString -> Get Object
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getByteString Int
len
  Word8
0xC8 -> Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be Get Int -> (Int -> Get Object) -> Get Object
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
len -> Word8 -> ByteString -> Object
ObjectExt (Word8 -> ByteString -> Object)
-> Get Word8 -> Get (ByteString -> Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get (ByteString -> Object) -> Get ByteString -> Get Object
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getByteString Int
len
  Word8
0xC9 -> Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be Get Int -> (Int -> Get Object) -> Get Object
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
len -> Word8 -> ByteString -> Object
ObjectExt (Word8 -> ByteString -> Object)
-> Get Word8 -> Get (ByteString -> Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get (ByteString -> Object) -> Get ByteString -> Get Object
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getByteString Int
len
  Word8
_ -> String -> Get Object
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Data.MessagePack.Get.getObject: Encountered invalid byte"

  where
    decodeStr :: ByteString -> m Text
decodeStr ByteString
bs = case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
bs of
      Left  UnicodeException
_ -> String -> m Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Data.MessagePack.Get.getObject: cannot decode bytestring to text"
      Right Text
v -> Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v

getWord8 :: Get Word8
getWord8 :: Get Word8
getWord8 = Get Word8
forall t. Persist t => Get t
get

getWord16be :: Get Word16
getWord16be :: Get Word16
getWord16be = BigEndian Word16 -> Word16
forall a. BigEndian a -> a
unBE (BigEndian Word16 -> Word16)
-> Get (BigEndian Word16) -> Get Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (BigEndian Word16)
forall t. Persist t => Get t
get

getWord32be :: Get Word32
getWord32be :: Get Word32
getWord32be = BigEndian Word32 -> Word32
forall a. BigEndian a -> a
unBE (BigEndian Word32 -> Word32)
-> Get (BigEndian Word32) -> Get Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (BigEndian Word32)
forall t. Persist t => Get t
get

getWord64be :: Get Word64
getWord64be :: Get Word64
getWord64be = BigEndian Word64 -> Word64
forall a. BigEndian a -> a
unBE (BigEndian Word64 -> Word64)
-> Get (BigEndian Word64) -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (BigEndian Word64)
forall t. Persist t => Get t
get

getFloat32be :: Get Float
getFloat32be :: Get Float
getFloat32be = BigEndian Float -> Float
forall a. BigEndian a -> a
unBE (BigEndian Float -> Float) -> Get (BigEndian Float) -> Get Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (BigEndian Float)
forall t. Persist t => Get t
get

getFloat64be :: Get Double
getFloat64be :: Get Double
getFloat64be = BigEndian Double -> Double
forall a. BigEndian a -> a
unBE (BigEndian Double -> Double)
-> Get (BigEndian Double) -> Get Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (BigEndian Double)
forall t. Persist t => Get t
get

getByteString :: Int -> Get S.ByteString
getByteString :: Int -> Get ByteString
getByteString = Int -> Get ByteString
P.getByteString

getInt8 :: Get Int8
getInt8 :: Get Int8
getInt8 = Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8) -> Get Word8 -> Get Int8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

getInt16be :: Get Int16
getInt16be :: Get Int16
getInt16be = Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int16) -> Get Word16 -> Get Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be

getInt32be :: Get Int32
getInt32be :: Get Int32
getInt32be = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> Get Word32 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be

getInt64be :: Get Int64
getInt64be :: Get Int64
getInt64be = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Get Word64 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be