{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module      :  Pinch.Protocol.Compact
-- Copyright   :  (c) Ben Gamari 2015
-- License     :  BSD3
--
-- Maintainer  :  Abhinav Gupta <mail@abhinavg.net>
-- Stability   :  experimental
--
-- Implements the Thrift Compact Protocol as a 'Protocol'.
module Pinch.Protocol.Compact (compactProtocol) where

import Control.Monad
import Data.Bits           hiding (shift)
import Data.ByteString     (ByteString)
import Data.HashMap.Strict (HashMap)
import Data.Int            (Int16, Int32, Int64)
import Data.List           (sortBy)
import Data.Ord            (comparing)
import Data.Typeable       (Typeable)
import Data.Word           (Word64, Word8)

import qualified Data.ByteString        as B
import qualified Data.HashMap.Strict    as M
import qualified Data.Serialize.IEEE754 as G
import qualified Data.Serialize.Get     as G
import qualified Data.Text.Encoding     as TE

import Pinch.Internal.Builder (Builder)
import Pinch.Internal.Message
import Pinch.Internal.TType
import Pinch.Internal.Value
import Pinch.Protocol         (Protocol (..))

import qualified Pinch.Internal.Builder  as BB
import qualified Pinch.Internal.FoldList as FL


-- | Provides an implementation of the Thrift Compact Protocol.
compactProtocol :: Protocol
compactProtocol :: Protocol
compactProtocol = Protocol :: (forall a. IsTType a => Value a -> Builder)
-> (Message -> Builder)
-> (forall a. IsTType a => Get (Value a))
-> Get Message
-> Protocol
Protocol
    { serializeValue :: forall a. IsTType a => Value a -> Builder
serializeValue     = forall a. IsTType a => Value a -> Builder
compactSerialize
    , deserializeValue' :: forall a. IsTType a => Get (Value a)
deserializeValue'  = TType a -> Get (Value a)
forall a. TType a -> Get (Value a)
compactDeserialize TType a
forall a. IsTType a => TType a
ttype
    , serializeMessage :: Message -> Builder
serializeMessage   = Message -> Builder
compactSerializeMessage
    , deserializeMessage' :: Get Message
deserializeMessage' = Get Message
compactDeserializeMessage
    }

------------------------------------------------------------------------------

protocolId, version :: Word8
protocolId :: Word8
protocolId = Word8
0x82
version :: Word8
version = Word8
0x01

compactSerializeMessage :: Message -> Builder
compactSerializeMessage :: Message -> Builder
compactSerializeMessage Message
msg =
    Word8 -> Builder
BB.word8 Word8
protocolId Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Word8 -> Builder
BB.word8 ((Word8
version Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1f) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (MessageType -> Word8
messageCode (Message -> MessageType
messageType Message
msg) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
5)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Int64 -> Builder
serializeVarint (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int64) -> Int32 -> Int64
forall a b. (a -> b) -> a -> b
$ Message -> Int32
messageId Message
msg) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    ByteString -> Builder
string (Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Message -> Text
messageName Message
msg) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Value TStruct -> Builder
forall a. IsTType a => Value a -> Builder
compactSerialize (Message -> Value TStruct
messagePayload Message
msg)

compactDeserializeMessage :: G.Get Message
compactDeserializeMessage :: Get Message
compactDeserializeMessage = do
    Word8
pid <- Get Word8
G.getWord8
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
pid Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
protocolId) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid protocol ID"
    Word8
w <- Get Word8
G.getWord8
    let ver :: Word8
ver = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1f
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
ver Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
version) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"Unsupported version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
ver
    let code :: Word8
code = Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
5
    Int64
msgId <- Get Int64
parseVarint
    Text
msgName <- ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> Get ByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int64
parseVarint Get Int64 -> (Int64 -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
G.getBytes (Int -> Get ByteString)
-> (Int64 -> Int) -> Int64 -> Get ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
    Value TStruct
payload <- TType TStruct -> Get (Value TStruct)
forall a. TType a -> Get (Value a)
compactDeserialize TType TStruct
forall a. IsTType a => TType a
ttype
    MessageType
mtype <- case Word8 -> Maybe MessageType
fromMessageCode Word8
code of
        Maybe MessageType
Nothing -> String -> Get MessageType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get MessageType) -> String -> Get MessageType
forall a b. (a -> b) -> a -> b
$ String
"unknown message type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
code
        Just MessageType
t -> MessageType -> Get MessageType
forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
t
    Message -> Get Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message :: Text -> MessageType -> Int32 -> Value TStruct -> Message
Message { messageType :: MessageType
messageType = MessageType
mtype
                   , messageId :: Int32
messageId = Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
msgId
                   , messageName :: Text
messageName = Text
msgName
                   , messagePayload :: Value TStruct
messagePayload = Value TStruct
payload
                   }


------------------------------------------------------------------------------

compactDeserialize :: TType a -> G.Get (Value a)
compactDeserialize :: TType a -> Get (Value a)
compactDeserialize TType a
typ = case TType a
typ of
  TType a
TBool      -> do
      Int8
n <- Get Int8
G.getInt8
      Value TBool -> Get (Value TBool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Value TBool -> Get (Value TBool))
-> Value TBool -> Get (Value TBool)
forall a b. (a -> b) -> a -> b
$ Bool -> Value TBool
VBool (Int8
n Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
1)
  TType a
TByte      -> Get (Value a)
Get (Value TByte)
parseByte
  TType a
TDouble    -> Get (Value a)
Get (Value TDouble)
parseDouble
  TType a
TInt16     -> Get (Value a)
Get (Value TInt16)
parseInt16
  TType a
TInt32     -> Get (Value a)
Get (Value TInt32)
parseInt32
  TType a
TInt64     -> Get (Value a)
Get (Value TInt64)
parseInt64
  TType a
TBinary    -> Get (Value a)
Get (Value TBinary)
parseBinary
  TType a
TStruct    -> Get (Value a)
Get (Value TStruct)
parseStruct
  TType a
TMap       -> Get (Value a)
Get (Value TMap)
parseMap
  TType a
TSet       -> Get (Value a)
Get (Value TSet)
parseSet
  TType a
TList      -> Get (Value a)
Get (Value TList)
parseList

intToZigZag :: Int64 -> Int64
intToZigZag :: Int64 -> Int64
intToZigZag Int64
n =
    (Int64
n Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
`xor` (Int64
n Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
63)

zigZagToInt :: Int64 -> Int64
zigZagToInt :: Int64 -> Int64
zigZagToInt Int64
n =
    Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
n' Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
`xor` (-(Int64
n Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
1))
  where
    n' :: Word64
n' = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n :: Word64
    -- ensure no sign extension

parseVarint :: G.Get Int64
parseVarint :: Get Int64
parseVarint = Int64 -> Int -> Get Int64
forall b. (Bits b, Num b) => b -> Int -> Get b
go Int64
0 Int
0
  where
    go :: b -> Int -> Get b
go !b
val !Int
shift = do
        Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
shift Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
64) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parseVarint: too wide"
        Word8
n <- Get Word8
G.getWord8
        let val' :: b
val' = b
val b -> b -> b
forall a. Bits a => a -> a -> a
.|. ((Word8 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n b -> b -> b
forall a. Bits a => a -> a -> a
.&. b
0x7f) b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftL` Int
shift)
        if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
n Int
7
          then b -> Int -> Get b
go b
val' (Int
shift Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)
          else b -> Get b
forall (m :: * -> *) a. Monad m => a -> m a
return b
val'

getCType :: Word8 -> G.Get SomeCType
getCType :: Word8 -> Get SomeCType
getCType Word8
code =
    Get SomeCType
-> (SomeCType -> Get SomeCType) -> Maybe SomeCType -> Get SomeCType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get SomeCType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get SomeCType) -> String -> Get SomeCType
forall a b. (a -> b) -> a -> b
$ String
"Unknown CType: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
code) SomeCType -> Get SomeCType
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SomeCType -> Get SomeCType)
-> Maybe SomeCType -> Get SomeCType
forall a b. (a -> b) -> a -> b
$ Word8 -> Maybe SomeCType
fromCompactCode Word8
code

parseByte :: G.Get (Value TByte)
parseByte :: Get (Value TByte)
parseByte = Int8 -> Value TByte
VByte (Int8 -> Value TByte) -> Get Int8 -> Get (Value TByte)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
G.getInt8

parseDouble :: G.Get (Value TDouble)
parseDouble :: Get (Value TDouble)
parseDouble = Double -> Value TDouble
VDouble (Double -> Value TDouble) -> Get Double -> Get (Value TDouble)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
G.getFloat64le

parseInt16 :: G.Get (Value TInt16)
parseInt16 :: Get (Value TInt16)
parseInt16 = Int16 -> Value TInt16
VInt16 (Int16 -> Value TInt16)
-> (Int64 -> Int16) -> Int64 -> Value TInt16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int16) -> (Int64 -> Int64) -> Int64 -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
zigZagToInt (Int64 -> Value TInt16) -> Get Int64 -> Get (Value TInt16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
parseVarint

parseInt32 :: G.Get (Value TInt32)
parseInt32 :: Get (Value TInt32)
parseInt32 = Int32 -> Value TInt32
VInt32 (Int32 -> Value TInt32)
-> (Int64 -> Int32) -> Int64 -> Value TInt32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int32) -> (Int64 -> Int64) -> Int64 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
zigZagToInt (Int64 -> Value TInt32) -> Get Int64 -> Get (Value TInt32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
parseVarint

parseInt64 :: G.Get (Value TInt64)
parseInt64 :: Get (Value TInt64)
parseInt64 = Int64 -> Value TInt64
VInt64 (Int64 -> Value TInt64)
-> (Int64 -> Int64) -> Int64 -> Value TInt64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64) -> (Int64 -> Int64) -> Int64 -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
zigZagToInt (Int64 -> Value TInt64) -> Get Int64 -> Get (Value TInt64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
parseVarint

parseBinary :: G.Get (Value TBinary)
parseBinary :: Get (Value TBinary)
parseBinary = do
    Int64
n <- Get Int64
parseVarint
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
        String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"parseBinary: invalid length " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show Int64
n
    ByteString -> Value TBinary
VBinary (ByteString -> Value TBinary)
-> Get ByteString -> Get (Value TBinary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
G.getBytes (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n)


parseMap :: G.Get (Value TMap)
parseMap :: Get (Value TMap)
parseMap = do
    Int64
count <- Get Int64
parseVarint
    case Int64
count of
      Int64
0 -> Value TMap -> Get (Value TMap)
forall (m :: * -> *) a. Monad m => a -> m a
return Value TMap
VNullMap
      Int64
_ -> do
          Word8
tys <- Get Word8
G.getWord8
          SomeCType CType a
kctype <- Word8 -> Get SomeCType
getCType (Word8
tys Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
          SomeCType CType a
vctype <- Word8 -> Get SomeCType
getCType (Word8
tys Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0f)

          let ktype :: TType a
ktype = CType a -> TType a
forall a. CType a -> TType a
cTypeToTType CType a
kctype
              vtype :: TType a
vtype = CType a -> TType a
forall a. CType a -> TType a
cTypeToTType CType a
vctype

          FoldList (MapItem a a)
items <- Int -> Get (MapItem a a) -> Get (FoldList (MapItem a a))
forall (m :: * -> *) a. Monad m => Int -> m a -> m (FoldList a)
FL.replicateM (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
count) (Get (MapItem a a) -> Get (FoldList (MapItem a a)))
-> Get (MapItem a a) -> Get (FoldList (MapItem a a))
forall a b. (a -> b) -> a -> b
$
              Value a -> Value a -> MapItem a a
forall k v. Value k -> Value v -> MapItem k v
MapItem (Value a -> Value a -> MapItem a a)
-> Get (Value a) -> Get (Value a -> MapItem a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TType a -> Get (Value a)
forall a. TType a -> Get (Value a)
compactDeserialize TType a
ktype
                      Get (Value a -> MapItem a a) -> Get (Value a) -> Get (MapItem a a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TType a -> Get (Value a)
forall a. TType a -> Get (Value a)
compactDeserialize TType a
vtype
          Value TMap -> Get (Value TMap)
forall (m :: * -> *) a. Monad m => a -> m a
return (Value TMap -> Get (Value TMap)) -> Value TMap -> Get (Value TMap)
forall a b. (a -> b) -> a -> b
$ FoldList (MapItem a a) -> Value TMap
forall k v.
(IsTType k, IsTType v) =>
FoldList (MapItem k v) -> Value TMap
VMap FoldList (MapItem a a)
items


parseCollection
    :: (forall a. IsTType a => FL.FoldList (Value a) -> Value b)
    -> G.Get (Value b)
parseCollection :: (forall a. IsTType a => FoldList (Value a) -> Value b)
-> Get (Value b)
parseCollection forall a. IsTType a => FoldList (Value a) -> Value b
buildValue = do
    Word8
sizeAndType <- Get Word8
G.getWord8
    SomeCType CType a
ctype <- Word8 -> Get SomeCType
getCType (Word8
sizeAndType Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0f)
    Int64
count <- case Word8
sizeAndType Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4 of
                 Word8
0xf -> Get Int64
parseVarint
                 Word8
n   -> 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
$ Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n
    let vtype :: TType a
vtype  = CType a -> TType a
forall a. CType a -> TType a
cTypeToTType CType a
ctype
    FoldList (Value a) -> Value b
forall a. IsTType a => FoldList (Value a) -> Value b
buildValue (FoldList (Value a) -> Value b)
-> Get (FoldList (Value a)) -> Get (Value b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get (Value a) -> Get (FoldList (Value a))
forall (m :: * -> *) a. Monad m => Int -> m a -> m (FoldList a)
FL.replicateM (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
count) (TType a -> Get (Value a)
forall a. TType a -> Get (Value a)
compactDeserialize TType a
vtype)

parseSet :: G.Get (Value TSet)
parseSet :: Get (Value TSet)
parseSet = (forall a. IsTType a => FoldList (Value a) -> Value TSet)
-> Get (Value TSet)
forall b.
(forall a. IsTType a => FoldList (Value a) -> Value b)
-> Get (Value b)
parseCollection forall a. IsTType a => FoldList (Value a) -> Value TSet
VSet

parseList :: G.Get (Value TList)
parseList :: Get (Value TList)
parseList = (forall a. IsTType a => FoldList (Value a) -> Value TList)
-> Get (Value TList)
forall b.
(forall a. IsTType a => FoldList (Value a) -> Value b)
-> Get (Value b)
parseCollection forall a. IsTType a => FoldList (Value a) -> Value TList
VList

parseStruct :: G.Get (Value TStruct)
parseStruct :: Get (Value TStruct)
parseStruct = HashMap Int16 SomeValue -> Int16 -> Get (Value TStruct)
loop HashMap Int16 SomeValue
forall k v. HashMap k v
M.empty Int16
0
  where
    loop :: HashMap Int16 SomeValue -> Int16 -> G.Get (Value TStruct)
    loop :: HashMap Int16 SomeValue -> Int16 -> Get (Value TStruct)
loop HashMap Int16 SomeValue
fields Int16
lastFieldId = do
        Word8
sizeAndType <- Get Word8
G.getWord8
        SomeCType CType a
ctype <- Word8 -> Get SomeCType
getCType (Word8
sizeAndType Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0f)
        case CType a
ctype of
            CType a
CStop -> Value TStruct -> Get (Value TStruct)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap Int16 SomeValue -> Value TStruct
VStruct HashMap Int16 SomeValue
fields)
            CType a
_     -> do
                Int16
fieldId <- case Word8
sizeAndType Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4 of
                               Word8
0x0 -> Int64 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int16) -> (Int64 -> Int64) -> Int64 -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
zigZagToInt (Int64 -> Int16) -> Get Int64 -> Get Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
parseVarint
                               Word8
n   -> Int16 -> Get Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16
lastFieldId Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Word8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n)
                SomeValue
value <- case CType a
ctype of
                  CType a
CBoolTrue  -> SomeValue -> Get SomeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Value TBool -> SomeValue
forall a. IsTType a => Value a -> SomeValue
SomeValue (Value TBool -> SomeValue) -> Value TBool -> SomeValue
forall a b. (a -> b) -> a -> b
$ Bool -> Value TBool
VBool Bool
True)
                  CType a
CBoolFalse -> SomeValue -> Get SomeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Value TBool -> SomeValue
forall a. IsTType a => Value a -> SomeValue
SomeValue (Value TBool -> SomeValue) -> Value TBool -> SomeValue
forall a b. (a -> b) -> a -> b
$ Bool -> Value TBool
VBool Bool
False)
                  CType a
_          ->
                    let vtype :: TType a
vtype = CType a -> TType a
forall a. CType a -> TType a
cTypeToTType CType a
ctype
                     in Value a -> SomeValue
forall a. IsTType a => Value a -> SomeValue
SomeValue (Value a -> SomeValue) -> Get (Value a) -> Get SomeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TType a -> Get (Value a)
forall a. TType a -> Get (Value a)
compactDeserialize TType a
vtype
                HashMap Int16 SomeValue -> Int16 -> Get (Value TStruct)
loop (Int16
-> SomeValue -> HashMap Int16 SomeValue -> HashMap Int16 SomeValue
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Int16
fieldId SomeValue
value HashMap Int16 SomeValue
fields) Int16
fieldId


------------------------------------------------------------------------------

compactSerialize :: forall a. IsTType a => Value a -> Builder
compactSerialize :: Value a -> Builder
compactSerialize = case (TType a
forall a. IsTType a => TType a
ttype :: TType a) of
  TType a
TBinary  -> Value a -> Builder
Value TBinary -> Builder
serializeBinary
  TType a
TBool    -> Value a -> Builder
Value TBool -> Builder
serializeBool
  TType a
TByte    -> Value a -> Builder
Value TByte -> Builder
serializeByte
  TType a
TDouble  -> Value a -> Builder
Value TDouble -> Builder
serializeDouble
  TType a
TInt16   -> Value a -> Builder
Value TInt16 -> Builder
serializeInt16
  TType a
TInt32   -> Value a -> Builder
Value TInt32 -> Builder
serializeInt32
  TType a
TInt64   -> Value a -> Builder
Value TInt64 -> Builder
serializeInt64
  TType a
TStruct  -> Value a -> Builder
Value TStruct -> Builder
serializeStruct
  TType a
TList    -> Value a -> Builder
Value TList -> Builder
serializeList
  TType a
TMap     -> Value a -> Builder
Value TMap -> Builder
serializeMap
  TType a
TSet     -> Value a -> Builder
Value TSet -> Builder
serializeSet
{-# INLINE compactSerialize #-}

serializeBinary :: Value TBinary -> Builder
serializeBinary :: Value TBinary -> Builder
serializeBinary (VBinary ByteString
x) = ByteString -> Builder
string ByteString
x
{-# INLINE serializeBinary #-}

serializeBool :: Value TBool -> Builder
serializeBool :: Value TBool -> Builder
serializeBool (VBool Bool
x) = CType TBool -> Builder
forall a. CType a -> Builder
compactCode (CType TBool -> Builder) -> CType TBool -> Builder
forall a b. (a -> b) -> a -> b
$ if Bool
x then CType TBool
CBoolTrue else CType TBool
CBoolFalse
{-# INLINE serializeBool #-}

serializeByte :: Value TByte -> Builder
serializeByte :: Value TByte -> Builder
serializeByte (VByte Int8
x) = Int8 -> Builder
BB.int8 Int8
x
{-# INLINE serializeByte #-}

serializeDouble :: Value TDouble -> Builder
serializeDouble :: Value TDouble -> Builder
serializeDouble (VDouble Double
x) = Double -> Builder
BB.doubleLE Double
x
{-# INLINE serializeDouble #-}

serializeVarint :: Int64 -> Builder
serializeVarint :: Int64 -> Builder
serializeVarint = Word64 -> Builder
go (Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  where
    -- Ensure we don't sign extend
    go :: Word64 -> Builder
    go :: Word64 -> Builder
go Word64
n
      | Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
0x7f Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 =
        Word8 -> Builder
BB.word8 (Word8 -> Builder) -> Word8 -> Builder
forall a b. (a -> b) -> a -> b
$ Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n
      | Bool
otherwise =
        Word8 -> Builder
BB.word8 (Word8
0x80 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7f)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Word64 -> Builder
go (Word64
n Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
7)

serializeInt16 :: Value TInt16 -> Builder
serializeInt16 :: Value TInt16 -> Builder
serializeInt16 (VInt16 Int16
x) = Int64 -> Builder
serializeVarint (Int64 -> Builder) -> Int64 -> Builder
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
intToZigZag (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
x
{-# INLINE serializeInt16 #-}

serializeInt32 :: Value TInt32 -> Builder
serializeInt32 :: Value TInt32 -> Builder
serializeInt32 (VInt32 Int32
x) = Int64 -> Builder
serializeVarint (Int64 -> Builder) -> Int64 -> Builder
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
intToZigZag (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x
{-# INLINE serializeInt32 #-}

serializeInt64 :: Value TInt64 -> Builder
serializeInt64 :: Value TInt64 -> Builder
serializeInt64 (VInt64 Int64
x) = Int64 -> Builder
serializeVarint (Int64 -> Builder) -> Int64 -> Builder
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
intToZigZag Int64
x
{-# INLINE serializeInt64 #-}

serializeList :: Value TList -> Builder
serializeList :: Value TList -> Builder
serializeList (VList FoldList (Value a)
xs) = TType a -> FoldList (Value a) -> Builder
forall a. IsTType a => TType a -> FoldList (Value a) -> Builder
serializeCollection TType a
forall a. IsTType a => TType a
ttype FoldList (Value a)
xs
{-# INLINE serializeList #-}

serializeSet :: Value TSet -> Builder
serializeSet :: Value TSet -> Builder
serializeSet (VSet FoldList (Value a)
xs) = TType a -> FoldList (Value a) -> Builder
forall a. IsTType a => TType a -> FoldList (Value a) -> Builder
serializeCollection TType a
forall a. IsTType a => TType a
ttype FoldList (Value a)
xs
{-# INLINE serializeSet #-}

serializeStruct :: Value TStruct -> Builder
serializeStruct :: Value TStruct -> Builder
serializeStruct (VStruct HashMap Int16 SomeValue
fields) =
    Int16 -> [(Int16, SomeValue)] -> Builder
forall t. Integral t => t -> [(t, SomeValue)] -> Builder
loop Int16
0 (((Int16, SomeValue) -> (Int16, SomeValue) -> Ordering)
-> [(Int16, SomeValue)] -> [(Int16, SomeValue)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int16, SomeValue) -> Int16)
-> (Int16, SomeValue) -> (Int16, SomeValue) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int16, SomeValue) -> Int16
forall a b. (a, b) -> a
fst) ([(Int16, SomeValue)] -> [(Int16, SomeValue)])
-> [(Int16, SomeValue)] -> [(Int16, SomeValue)]
forall a b. (a -> b) -> a -> b
$ HashMap Int16 SomeValue -> [(Int16, SomeValue)]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap Int16 SomeValue
fields)
  where
    loop :: t -> [(t, SomeValue)] -> Builder
loop t
_ [] = CType TStop -> Builder
forall a. CType a -> Builder
compactCode CType TStop
CStop
    loop t
lastFieldId ((t
fieldId, SomeValue
val) : [(t, SomeValue)]
rest) =
        let x :: Builder
x = case SomeValue
val of
                  SomeValue (VBool Bool
True)  -> CType TBool -> Builder
forall a. CType a -> Builder
writeFieldHeader CType TBool
CBoolTrue
                  SomeValue (VBool Bool
False) -> CType TBool -> Builder
forall a. CType a -> Builder
writeFieldHeader CType TBool
CBoolFalse
                  SomeValue (Value a
v :: Value a) ->
                      CType a -> Builder
forall a. CType a -> Builder
writeFieldHeader (TType a -> CType a
forall a. TType a -> CType a
tTypeToCType (TType a
forall a. IsTType a => TType a
ttype :: TType a)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Value a -> Builder
forall a. IsTType a => Value a -> Builder
compactSerialize Value a
v
        in Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> t -> [(t, SomeValue)] -> Builder
loop t
fieldId [(t, SomeValue)]
rest
      where
        writeFieldHeader :: CType a -> Builder
        writeFieldHeader :: CType a -> Builder
writeFieldHeader CType a
ccode
          | t
fieldId t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
lastFieldId Bool -> Bool -> Bool
&& t
fieldId t -> t -> t
forall a. Num a => a -> a -> a
- t
lastFieldId t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
16
          = CType a -> Word8 -> Builder
forall a. CType a -> Word8 -> Builder
compactCode' CType a
ccode (t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (t -> Word8) -> t -> Word8
forall a b. (a -> b) -> a -> b
$ t
fieldId t -> t -> t
forall a. Num a => a -> a -> a
- t
lastFieldId)
          | Bool
otherwise
          = CType a -> Builder
forall a. CType a -> Builder
compactCode CType a
ccode Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
serializeVarint (Int64 -> Int64
intToZigZag (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ t -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
fieldId)
{-# INLINE serializeStruct #-}

serializeMap :: Value TMap -> Builder
serializeMap :: Value TMap -> Builder
serializeMap Value TMap
VNullMap = Int8 -> Builder
BB.int8 Int8
0
serializeMap (VMap FoldList (MapItem k v)
items) = TType k -> TType v -> FoldList (MapItem k v) -> Builder
forall k v.
(IsTType k, IsTType v) =>
TType k -> TType v -> FoldList (MapItem k v) -> Builder
serialize TType k
forall a. IsTType a => TType a
ttype TType v
forall a. IsTType a => TType a
ttype FoldList (MapItem k v)
items
  where
    serialize
        :: (IsTType k, IsTType v)
        => TType k -> TType v -> FL.FoldList (MapItem k v) -> Builder
    serialize :: TType k -> TType v -> FoldList (MapItem k v) -> Builder
serialize TType k
kt TType v
vt FoldList (MapItem k v)
xs
        | Int32
size Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0 = Int8 -> Builder
BB.int8 Int8
0
        | Bool
otherwise =
            Int64 -> Builder
serializeVarint (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
size) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BB.word8 Word8
typeByte Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
body
      where
        code :: TType a -> Word8
code = CType a -> Word8
forall a. CType a -> Word8
toCompactCode (CType a -> Word8) -> (TType a -> CType a) -> TType a -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TType a -> CType a
forall a. TType a -> CType a
tTypeToCType
        typeByte :: Word8
typeByte = (TType k -> Word8
forall a. TType a -> Word8
code TType k
kt Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. TType v -> Word8
forall a. TType a -> Word8
code TType v
vt
        (Builder
body, Int32
size) = ((Builder, Int32) -> MapItem k v -> (Builder, Int32))
-> (Builder, Int32) -> FoldList (MapItem k v) -> (Builder, Int32)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
FL.foldl' (Builder, Int32) -> MapItem k v -> (Builder, Int32)
forall a a b.
(IsTType a, IsTType a, Num b) =>
(Builder, b) -> MapItem a a -> (Builder, b)
go (Builder
forall a. Monoid a => a
mempty, Int32
0 :: Int32) FoldList (MapItem k v)
xs
        go :: (Builder, b) -> MapItem a a -> (Builder, b)
go (Builder
prev, !b
c) (MapItem Value a
k Value a
v) =
            ( Builder
prev Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Value a -> Builder
forall a. IsTType a => Value a -> Builder
compactSerialize Value a
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Value a -> Builder
forall a. IsTType a => Value a -> Builder
compactSerialize Value a
v
            , b
c b -> b -> b
forall a. Num a => a -> a -> a
+ b
1
            )
{-# INLINE serializeMap #-}

serializeCollection
    :: IsTType a
    => TType a -> FL.FoldList (Value a) -> Builder
serializeCollection :: TType a -> FoldList (Value a) -> Builder
serializeCollection TType a
vtype FoldList (Value a)
xs =
    let go :: (Builder, b) -> Value a -> (Builder, b)
go (Builder
prev, !b
c) Value a
item = (Builder
prev Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Value a -> Builder
forall a. IsTType a => Value a -> Builder
compactSerialize Value a
item, b
c b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)
        (Builder
body, Int32
size) = ((Builder, Int32) -> Value a -> (Builder, Int32))
-> (Builder, Int32) -> FoldList (Value a) -> (Builder, Int32)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
FL.foldl' (Builder, Int32) -> Value a -> (Builder, Int32)
forall a b.
(IsTType a, Num b) =>
(Builder, b) -> Value a -> (Builder, b)
go (Builder
forall a. Monoid a => a
mempty, Int32
0 :: Int32) FoldList (Value a)
xs
        type_and_size :: Builder
type_and_size
          | Int32
size Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
15 = TType a -> Word8 -> Builder
forall a. TType a -> Word8 -> Builder
typeCode' TType a
vtype (Int32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
size)
          | Bool
otherwise = TType a -> Word8 -> Builder
forall a. TType a -> Word8 -> Builder
typeCode' TType a
vtype Word8
0xf Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
serializeVarint (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
size)
    in Builder
type_and_size Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
body
{-# INLINE serializeCollection #-}

------------------------------------------------------------------------------


messageCode :: MessageType -> Word8
messageCode :: MessageType -> Word8
messageCode MessageType
Call      = Word8
1
messageCode MessageType
Reply     = Word8
2
messageCode MessageType
Exception = Word8
3
messageCode MessageType
Oneway    = Word8
4
{-# INLINE messageCode #-}


fromMessageCode :: Word8 -> Maybe MessageType
fromMessageCode :: Word8 -> Maybe MessageType
fromMessageCode Word8
1 = MessageType -> Maybe MessageType
forall a. a -> Maybe a
Just MessageType
Call
fromMessageCode Word8
2 = MessageType -> Maybe MessageType
forall a. a -> Maybe a
Just MessageType
Reply
fromMessageCode Word8
3 = MessageType -> Maybe MessageType
forall a. a -> Maybe a
Just MessageType
Exception
fromMessageCode Word8
4 = MessageType -> Maybe MessageType
forall a. a -> Maybe a
Just MessageType
Oneway
fromMessageCode Word8
_ = Maybe MessageType
forall a. Maybe a
Nothing
{-# INLINE fromMessageCode #-}


data TStop deriving (Typeable)

instance IsTType TStop where
    ttype :: TType TStop
ttype = String -> TType TStop
forall a. HasCallStack => String -> a
error String
"ttype TStop"

-- | A compact message type.
data CType a where
    CStop      :: CType TStop
    CBoolTrue  :: CType TBool
    CBoolFalse :: CType TBool
    CByte      :: CType TByte
    CInt16     :: CType TInt16
    CInt32     :: CType TInt32
    CInt64     :: CType TInt64
    CDouble    :: CType TDouble
    CBinary    :: CType TBinary
    CList      :: CType TList
    CSet       :: CType TSet
    CMap       :: CType TMap
    CStruct    :: CType TStruct


data SomeCType where
    SomeCType :: forall a. IsTType a => CType a -> SomeCType


-- | Map a TType to its type code.
toCompactCode :: CType a -> Word8
toCompactCode :: CType a -> Word8
toCompactCode CType a
CStop      = Word8
0
toCompactCode CType a
CBoolTrue  = Word8
1
toCompactCode CType a
CBoolFalse = Word8
2
toCompactCode CType a
CByte      = Word8
3
toCompactCode CType a
CInt16     = Word8
4
toCompactCode CType a
CInt32     = Word8
5
toCompactCode CType a
CInt64     = Word8
6
toCompactCode CType a
CDouble    = Word8
7
toCompactCode CType a
CBinary    = Word8
8
toCompactCode CType a
CList      = Word8
9
toCompactCode CType a
CSet       = Word8
10
toCompactCode CType a
CMap       = Word8
11
toCompactCode CType a
CStruct    = Word8
12
{-# INLINE toCompactCode #-}


-- | Map a type code to the corresponding TType.
fromCompactCode :: Word8 -> Maybe SomeCType
fromCompactCode :: Word8 -> Maybe SomeCType
fromCompactCode Word8
0  = SomeCType -> Maybe SomeCType
forall a. a -> Maybe a
Just (SomeCType -> Maybe SomeCType) -> SomeCType -> Maybe SomeCType
forall a b. (a -> b) -> a -> b
$ CType TStop -> SomeCType
forall a. IsTType a => CType a -> SomeCType
SomeCType CType TStop
CStop
fromCompactCode Word8
1  = SomeCType -> Maybe SomeCType
forall a. a -> Maybe a
Just (SomeCType -> Maybe SomeCType) -> SomeCType -> Maybe SomeCType
forall a b. (a -> b) -> a -> b
$ CType TBool -> SomeCType
forall a. IsTType a => CType a -> SomeCType
SomeCType CType TBool
CBoolTrue
fromCompactCode Word8
2  = SomeCType -> Maybe SomeCType
forall a. a -> Maybe a
Just (SomeCType -> Maybe SomeCType) -> SomeCType -> Maybe SomeCType
forall a b. (a -> b) -> a -> b
$ CType TBool -> SomeCType
forall a. IsTType a => CType a -> SomeCType
SomeCType CType TBool
CBoolFalse
fromCompactCode Word8
3  = SomeCType -> Maybe SomeCType
forall a. a -> Maybe a
Just (SomeCType -> Maybe SomeCType) -> SomeCType -> Maybe SomeCType
forall a b. (a -> b) -> a -> b
$ CType TByte -> SomeCType
forall a. IsTType a => CType a -> SomeCType
SomeCType CType TByte
CByte
fromCompactCode Word8
4  = SomeCType -> Maybe SomeCType
forall a. a -> Maybe a
Just (SomeCType -> Maybe SomeCType) -> SomeCType -> Maybe SomeCType
forall a b. (a -> b) -> a -> b
$ CType TInt16 -> SomeCType
forall a. IsTType a => CType a -> SomeCType
SomeCType CType TInt16
CInt16
fromCompactCode Word8
5  = SomeCType -> Maybe SomeCType
forall a. a -> Maybe a
Just (SomeCType -> Maybe SomeCType) -> SomeCType -> Maybe SomeCType
forall a b. (a -> b) -> a -> b
$ CType TInt32 -> SomeCType
forall a. IsTType a => CType a -> SomeCType
SomeCType CType TInt32
CInt32
fromCompactCode Word8
6  = SomeCType -> Maybe SomeCType
forall a. a -> Maybe a
Just (SomeCType -> Maybe SomeCType) -> SomeCType -> Maybe SomeCType
forall a b. (a -> b) -> a -> b
$ CType TInt64 -> SomeCType
forall a. IsTType a => CType a -> SomeCType
SomeCType CType TInt64
CInt64
fromCompactCode Word8
7  = SomeCType -> Maybe SomeCType
forall a. a -> Maybe a
Just (SomeCType -> Maybe SomeCType) -> SomeCType -> Maybe SomeCType
forall a b. (a -> b) -> a -> b
$ CType TDouble -> SomeCType
forall a. IsTType a => CType a -> SomeCType
SomeCType CType TDouble
CDouble
fromCompactCode Word8
8  = SomeCType -> Maybe SomeCType
forall a. a -> Maybe a
Just (SomeCType -> Maybe SomeCType) -> SomeCType -> Maybe SomeCType
forall a b. (a -> b) -> a -> b
$ CType TBinary -> SomeCType
forall a. IsTType a => CType a -> SomeCType
SomeCType CType TBinary
CBinary
fromCompactCode Word8
9  = SomeCType -> Maybe SomeCType
forall a. a -> Maybe a
Just (SomeCType -> Maybe SomeCType) -> SomeCType -> Maybe SomeCType
forall a b. (a -> b) -> a -> b
$ CType TList -> SomeCType
forall a. IsTType a => CType a -> SomeCType
SomeCType CType TList
CList
fromCompactCode Word8
10 = SomeCType -> Maybe SomeCType
forall a. a -> Maybe a
Just (SomeCType -> Maybe SomeCType) -> SomeCType -> Maybe SomeCType
forall a b. (a -> b) -> a -> b
$ CType TSet -> SomeCType
forall a. IsTType a => CType a -> SomeCType
SomeCType CType TSet
CSet
fromCompactCode Word8
11 = SomeCType -> Maybe SomeCType
forall a. a -> Maybe a
Just (SomeCType -> Maybe SomeCType) -> SomeCType -> Maybe SomeCType
forall a b. (a -> b) -> a -> b
$ CType TMap -> SomeCType
forall a. IsTType a => CType a -> SomeCType
SomeCType CType TMap
CMap
fromCompactCode Word8
12 = SomeCType -> Maybe SomeCType
forall a. a -> Maybe a
Just (SomeCType -> Maybe SomeCType) -> SomeCType -> Maybe SomeCType
forall a b. (a -> b) -> a -> b
$ CType TStruct -> SomeCType
forall a. IsTType a => CType a -> SomeCType
SomeCType CType TStruct
CStruct
fromCompactCode Word8
_  = Maybe SomeCType
forall a. Maybe a
Nothing
{-# INLINE fromCompactCode #-}

tTypeToCType :: TType a -> CType a
tTypeToCType :: TType a -> CType a
tTypeToCType TType a
TBool      = CType a
CType TBool
CBoolTrue
tTypeToCType TType a
TByte      = CType a
CType TByte
CByte
tTypeToCType TType a
TInt16     = CType a
CType TInt16
CInt16
tTypeToCType TType a
TInt32     = CType a
CType TInt32
CInt32
tTypeToCType TType a
TInt64     = CType a
CType TInt64
CInt64
tTypeToCType TType a
TDouble    = CType a
CType TDouble
CDouble
tTypeToCType TType a
TBinary    = CType a
CType TBinary
CBinary
tTypeToCType TType a
TList      = CType a
CType TList
CList
tTypeToCType TType a
TSet       = CType a
CType TSet
CSet
tTypeToCType TType a
TMap       = CType a
CType TMap
CMap
tTypeToCType TType a
TStruct    = CType a
CType TStruct
CStruct

cTypeToTType :: CType a -> TType a
cTypeToTType :: CType a -> TType a
cTypeToTType CType a
CStop      = String -> TType a
forall a. HasCallStack => String -> a
error String
"cTypeToTType: CStop"
cTypeToTType CType a
CBoolTrue  = TType a
TType TBool
TBool
cTypeToTType CType a
CBoolFalse = TType a
TType TBool
TBool
cTypeToTType CType a
CByte      = TType a
TType TByte
TByte
cTypeToTType CType a
CInt16     = TType a
TType TInt16
TInt16
cTypeToTType CType a
CInt32     = TType a
TType TInt32
TInt32
cTypeToTType CType a
CInt64     = TType a
TType TInt64
TInt64
cTypeToTType CType a
CDouble    = TType a
TType TDouble
TDouble
cTypeToTType CType a
CBinary    = TType a
TType TBinary
TBinary
cTypeToTType CType a
CList      = TType a
TType TList
TList
cTypeToTType CType a
CSet       = TType a
TType TSet
TSet
cTypeToTType CType a
CMap       = TType a
TType TMap
TMap
cTypeToTType CType a
CStruct    = TType a
TType TStruct
TStruct

------------------------------------------------------------------------------


string :: ByteString -> Builder
string :: ByteString -> Builder
string ByteString
b = Int64 -> Builder
serializeVarint (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
b) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
b
{-# INLINE string #-}

compactCode :: CType a -> Builder
compactCode :: CType a -> Builder
compactCode = Word8 -> Builder
BB.word8 (Word8 -> Builder) -> (CType a -> Word8) -> CType a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CType a -> Word8
forall a. CType a -> Word8
toCompactCode
{-# INLINE compactCode #-}

compactCode' :: CType a  -- ^ The compact type code
             -> Word8    -- ^ a four-bit (unshifted) payload
             -> Builder
compactCode' :: CType a -> Word8 -> Builder
compactCode' CType a
ty Word8
payload =
    Word8 -> Builder
BB.word8 (CType a -> Word8
forall a. CType a -> Word8
toCompactCode CType a
ty Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
payload Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4))
{-# INLINE compactCode' #-}

typeCode' :: TType a -> Word8 -> Builder
typeCode' :: TType a -> Word8 -> Builder
typeCode' TType a
ty = CType a -> Word8 -> Builder
forall a. CType a -> Word8 -> Builder
compactCode' (TType a -> CType a
forall a. TType a -> CType a
tTypeToCType TType a
ty)
{-# INLINE typeCode' #-}