{-# 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.Binary@
--
--------------------------------------------------------------------

module Data.MessagePack.Get
  ( getObject
  , getNil
  , getBool
  , getInt
  , getWord
  , getFloat
  , getDouble
  , getStr
  , getBin
  , getArray
  , getMap
  , getExt
  ) where

import           Control.Applicative    (empty, (<$), (<$>), (<*>), (<|>))
import           Control.Monad          (guard, replicateM)
import           Data.Binary            (Get)
import           Data.Binary.Get        (getByteString, getWord16be,
                                         getWord32be, getWord64be, getWord8)
import           Data.Binary.IEEE754    (getFloat32be, getFloat64be)
import           Data.Bits              ((.&.))
import qualified Data.ByteString        as S
import           Data.Int               (Int16, Int32, Int64, Int8)
import qualified Data.Text              as T
import qualified Data.Text.Encoding     as T
import qualified Data.Vector            as V
import           Data.Word              (Word64, Word8)

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

getObject :: Get Object
getObject :: Get Object
getObject =
      Object
ObjectNil    Object -> Get () -> Get Object
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  Get ()
getNil
  Get Object -> Get Object -> Get Object
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Object
ObjectBool   (Bool -> Object) -> Get Bool -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
getBool
  Get Object -> Get Object -> Get Object
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int64 -> Object
ObjectInt    (Int64 -> Object) -> Get Int64 -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt
  Get Object -> Get Object -> Get Object
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word64 -> Object
ObjectWord   (Word64 -> Object) -> Get Word64 -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord
  Get Object -> Get Object -> Get Object
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Float -> Object
ObjectFloat  (Float -> Object) -> Get Float -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
getFloat
  Get Object -> Get Object -> Get Object
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Double -> Object
ObjectDouble (Double -> Object) -> Get Double -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getDouble
  Get Object -> Get Object -> Get Object
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Object
ObjectStr    (Text -> Object) -> Get Text -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
getStr
  Get Object -> Get Object -> Get Object
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Object
ObjectBin    (ByteString -> Object) -> Get ByteString -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getBin
  Get Object -> Get Object -> Get Object
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Object -> Object
ObjectArray  (Vector Object -> Object) -> Get (Vector Object) -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Object -> Get (Vector Object)
forall a. Get a -> Get (Vector a)
getArray Get Object
getObject
  Get Object -> Get Object -> Get Object
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector (Object, Object) -> Object
ObjectMap    (Vector (Object, Object) -> Object)
-> Get (Vector (Object, Object)) -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Object -> Get Object -> Get (Vector (Object, Object))
forall a b. Get a -> Get b -> Get (Vector (a, b))
getMap Get Object
getObject Get Object
getObject
  Get Object -> Get Object -> Get Object
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> ByteString -> Object) -> (Word8, ByteString) -> Object
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word8 -> ByteString -> Object
ObjectExt ((Word8, ByteString) -> Object)
-> Get (Word8, ByteString) -> Get Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Word8, ByteString)
getExt

getNil :: Get ()
getNil :: Get ()
getNil = Word8 -> Get ()
tag Word8
0xC0

getBool :: Get Bool
getBool :: Get Bool
getBool =
  Bool
False Bool -> Get () -> Get Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Get ()
tag Word8
0xC2 Get Bool -> Get Bool -> Get Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Bool
True  Bool -> Get () -> Get Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Get ()
tag Word8
0xC3

getInt :: Get Int64
getInt :: Get Int64
getInt =
  Get Word8
getWord8 Get Word8 -> (Word8 -> Get Int64) -> Get Int64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    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 ->
        Int64 -> Get Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Get Int64) -> Int64 -> Get Int64
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 -> Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Int64) -> Get Int8 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
    Word8
0xD1 -> Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int64) -> Get Int16 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be
    Word8
0xD2 -> Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int64) -> Get Int32 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be
    Word8
0xD3 -> Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64) -> Get Int64 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64be
    Word8
_    -> Get Int64
forall (f :: * -> *) a. Alternative f => f a
empty

getWord :: Get Word64
getWord :: Get Word64
getWord =
  Get Word8
getWord8 Get Word8 -> (Word8 -> Get Word64) -> Get Word64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    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 ->
        Word64 -> Get Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Get Word64) -> Word64 -> Get Word64
forall a b. (a -> b) -> a -> b
$ Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c
    Word8
0xCC -> Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> Get Word8 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    Word8
0xCD -> Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word64) -> Get Word16 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
    Word8
0xCE -> Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
    Word8
0xCF -> Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> Get Word64 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be
    Word8
_    -> Get Word64
forall (f :: * -> *) a. Alternative f => f a
empty

getFloat :: Get Float
getFloat :: Get Float
getFloat = Word8 -> Get ()
tag Word8
0xCA Get () -> Get Float -> Get Float
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get Float
getFloat32be

getDouble :: Get Double
getDouble :: Get Double
getDouble = Word8 -> Get ()
tag Word8
0xCB Get () -> Get Double -> Get Double
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get Double
getFloat64be

getStr :: Get T.Text
getStr :: Get Text
getStr = do
  Int
len <- Get Word8
getWord8 Get Word8 -> (Word8 -> Get Int) -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    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 ->
      Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Get Int) -> Int -> Get Int
forall a b. (a -> b) -> a -> b
$ 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
    Word8
0xD9 -> 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
    Word8
0xDA -> 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
    Word8
0xDB -> 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
    Word8
_    -> Get Int
forall (f :: * -> *) a. Alternative f => f a
empty
  ByteString
bs <- Int -> Get ByteString
getByteString Int
len
  case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
bs of
    Left  UnicodeException
_ -> Get Text
forall (f :: * -> *) a. Alternative f => f a
empty
    Right Text
v -> Text -> Get Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
v

getBin :: Get S.ByteString
getBin :: Get ByteString
getBin = do
  Int
len <- Get Word8
getWord8 Get Word8 -> (Word8 -> Get Int) -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
0xC4 -> 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
    Word8
0xC5 -> 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
    Word8
0xC6 -> 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
    Word8
_    -> Get Int
forall (f :: * -> *) a. Alternative f => f a
empty
  Int -> Get ByteString
getByteString Int
len

getArray :: Get a -> Get (V.Vector a)
getArray :: Get a -> Get (Vector a)
getArray Get a
g = do
  Int
len <- Get Word8
getWord8 Get Word8 -> (Word8 -> Get Int) -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    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 ->
      Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Get Int) -> Int -> Get Int
forall a b. (a -> b) -> a -> b
$ 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
    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
    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
    Word8
_    -> Get Int
forall (f :: * -> *) a. Alternative f => f a
empty
  Int -> Get a -> Get (Vector a)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
len Get a
g

getMap :: Get a -> Get b -> Get (V.Vector (a, b))
getMap :: Get a -> Get b -> Get (Vector (a, b))
getMap Get a
k Get b
v = do
  Int
len <- Get Word8
getWord8 Get Word8 -> (Word8 -> Get Int) -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    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 ->
      Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Get Int) -> Int -> Get Int
forall a b. (a -> b) -> a -> b
$ 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
    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
    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
    Word8
_    -> Get Int
forall (f :: * -> *) a. Alternative f => f a
empty
  Int -> Get (a, b) -> Get (Vector (a, b))
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
len (Get (a, b) -> Get (Vector (a, b)))
-> Get (a, b) -> Get (Vector (a, b))
forall a b. (a -> b) -> a -> b
$ (,) (a -> b -> (a, b)) -> Get a -> Get (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
k Get (b -> (a, b)) -> Get b -> Get (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get b
v

getExt :: Get (Word8, S.ByteString)
getExt :: Get (Word8, ByteString)
getExt = do
  Int
len <- Get Word8
getWord8 Get Word8 -> (Word8 -> Get Int) -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
0xD4 -> Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
    Word8
0xD5 -> Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
    Word8
0xD6 -> Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
4
    Word8
0xD7 -> Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
8
    Word8
0xD8 -> Int -> Get Int
forall (m :: * -> *) a. Monad m => a -> m a
return 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
    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
    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
    Word8
_    -> Get Int
forall (f :: * -> *) a. Alternative f => f a
empty
  (,) (Word8 -> ByteString -> (Word8, ByteString))
-> Get Word8 -> Get (ByteString -> (Word8, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get (ByteString -> (Word8, ByteString))
-> Get ByteString -> Get (Word8, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getByteString Int
len

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

tag :: Word8 -> Get ()
tag :: Word8 -> Get ()
tag Word8
t = do
  Word8
b <- Get Word8
getWord8
  Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> Bool -> Get ()
forall a b. (a -> b) -> a -> b
$ Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
b