Thrift haskell getTransport working
Summary: getTransport is now a method of Protocol. To flush the transport one does tflush (getTransport p) instead of pflush p. This is more like how it is done with other languages.
Reviewed By: dcorson
Test Plan: Ran thrifttest for haskell.
Revert: OK
DiffCamp Revision: 7515
git-svn-id: https://svn.apache.org/repos/asf/incubator/thrift/trunk@665473 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/lib/hs/src/TBinaryProtocol.hs b/lib/hs/src/TBinaryProtocol.hs
index e02a0ee..2903d01 100644
--- a/lib/hs/src/TBinaryProtocol.hs
+++ b/lib/hs/src/TBinaryProtocol.hs
@@ -7,7 +7,7 @@
import GHC.Word
import Control.Exception
- data TBinaryProtocol a = (TTransport a) => TBinaryProtocol a
+ data TBinaryProtocol a = TTransport a => TBinaryProtocol a
version_mask = 0xffff0000
version_1 = 0x80010000;
@@ -33,78 +33,78 @@
composeBytes64H (h:t) n = (shiftL (fromIntegral (fromEnum h) :: Word64) (8*n)) .|. (composeBytes64H t (n-1))
compBytes64 :: [Char] -> Word64
compBytes64 b = composeBytes64H b ((length b)-1)
- instance TTransport a => Protocol (TBinaryProtocol a) where
- writeBool (TBinaryProtocol tr) b = twrite tr (if b then [toEnum 1::Char] else [toEnum 0::Char])
- writeByte (TBinaryProtocol tr) b = twrite tr (getBytes b 1)
- writeI16 (TBinaryProtocol tr) b = twrite tr (getBytes b 2)
- writeI32 (TBinaryProtocol tr) b = twrite tr (getBytes b 4)
- writeI64 (TBinaryProtocol tr) b = twrite tr (getBytes b 8)
- writeDouble (TBinaryProtocol tr) b = writeI64 (TBinaryProtocol tr) (fromIntegral (floatBits b) :: Int)
- writeString (TBinaryProtocol tr) s = do twrite tr (getBytes (length s) 4)
- twrite tr s
- writeBinary = writeString
- writeMessageBegin (TBinaryProtocol tr) (n,t,s) = do writeI32 (TBinaryProtocol tr) (version_1 .|. (fromEnum t))
- writeString (TBinaryProtocol tr) n
- writeI32 (TBinaryProtocol tr) s
- writeMessageEnd (TBinaryProtocol tr) = return ()
- writeStructBegin (TBinaryProtocol tr) s = return ()
- writeStructEnd (TBinaryProtocol tr) = return ()
- writeFieldBegin a (n,t,i) = do writeByte a (fromEnum t)
- writeI16 a i
- writeFieldEnd a = return ()
- writeFieldStop a = writeByte a (fromEnum T_STOP)
- writeMapBegin a (k,v,s) = do writeByte a (fromEnum k)
- writeByte a (fromEnum v)
- writeI32 a s
- writeMapEnd a = return ()
- writeListBegin a (t,s) = do writeByte a (fromEnum t)
- writeI32 a s
- writeListEnd a = return ()
- writeSetBegin = writeListBegin
- writeSetEnd a = return ()
- readByte (TBinaryProtocol tr) = do b <- treadAll tr 1
- return $ (fromIntegral (fromIntegral (compBytes b) :: Int8) :: Int)
- readI16 (TBinaryProtocol tr) = do b <- treadAll tr 2
- return $ (fromIntegral (fromIntegral (compBytes b) :: Int16) :: Int)
- readI32 (TBinaryProtocol tr) = do b <- treadAll tr 4
- return $ (fromIntegral (fromIntegral (compBytes b) :: Int32) :: Int)
- readI64 (TBinaryProtocol tr) = do b <- treadAll tr 8
- return $ (fromIntegral (fromIntegral (compBytes64 b) :: Int64) :: Int)
- readDouble (TBinaryProtocol tr) = do b <- readI64 (TBinaryProtocol tr)
- return $ floatOfBits (fromIntegral b :: Word64)
- readBool (TBinaryProtocol tr) = do b <- readByte (TBinaryProtocol tr)
- return $ b == 1
- readString (TBinaryProtocol tr) = do l <- readI32 (TBinaryProtocol tr)
- treadAll tr l
- readBinary = readString
- readMessageBegin (TBinaryProtocol tr) = do ver <- readI32 (TBinaryProtocol tr)
- if (ver .&. version_mask /= version_1) then
- throwDyn (ProtocolExn PE_BAD_VERSION "Missing version identifier")
- else do
- s <- readString (TBinaryProtocol tr)
- sz <- readI32 (TBinaryProtocol tr)
- return (s,toEnum (ver .&. 0xFF) :: Message_type,fromIntegral sz :: Int)
- readMessageEnd (TBinaryProtocol tr) = return ()
- readStructBegin (TBinaryProtocol tr) = return ""
- readStructEnd (TBinaryProtocol tr) = return ()
- readFieldBegin (TBinaryProtocol tr) = do t <- readByte (TBinaryProtocol tr)
- if (toEnum t :: T_type) /= T_STOP then
- do s <- readI16 (TBinaryProtocol tr)
- return ("",toEnum t :: T_type,fromIntegral s :: Int)
- else return ("",toEnum t :: T_type,0)
- readFieldEnd (TBinaryProtocol tr) = return ()
- readMapBegin a = do kt <- readByte a
- vt <- readByte a
- s <- readI32 a
- return (toEnum kt :: T_type,toEnum vt :: T_type,fromIntegral s :: Int)
- readMapEnd a = return ()
- readListBegin a = do b <- readByte a
- s <- readI32 a
- return (toEnum b :: T_type,fromIntegral s :: Int)
- readListEnd a = return ()
- readSetBegin = readListBegin
- readSetEnd = readListEnd
- pflush (TBinaryProtocol tr) = tflush tr
+ instance Protocol TBinaryProtocol where
+ getTransport (TBinaryProtocol t) = t
+ writeBool (TBinaryProtocol tr) b = twrite tr (if b then [toEnum 1::Char] else [toEnum 0::Char])
+ writeByte (TBinaryProtocol tr) b = twrite tr (getBytes b 1)
+ writeI16 (TBinaryProtocol tr) b = twrite tr (getBytes b 2)
+ writeI32 (TBinaryProtocol tr) b = twrite tr (getBytes b 4)
+ writeI64 (TBinaryProtocol tr) b = twrite tr (getBytes b 8)
+ writeDouble (TBinaryProtocol tr) b = writeI64 (TBinaryProtocol tr) (fromIntegral (floatBits b) :: Int)
+ writeString (TBinaryProtocol tr) s = do twrite tr (getBytes (length s) 4)
+ twrite tr s
+ writeBinary = writeString
+ writeMessageBegin (TBinaryProtocol tr) (n,t,s) = do writeI32 (TBinaryProtocol tr) (version_1 .|. (fromEnum t))
+ writeString (TBinaryProtocol tr) n
+ writeI32 (TBinaryProtocol tr) s
+ writeMessageEnd (TBinaryProtocol tr) = return ()
+ writeStructBegin (TBinaryProtocol tr) s = return ()
+ writeStructEnd (TBinaryProtocol tr) = return ()
+ writeFieldBegin a (n,t,i) = do writeByte a (fromEnum t)
+ writeI16 a i
+ writeFieldEnd a = return ()
+ writeFieldStop a = writeByte a (fromEnum T_STOP)
+ writeMapBegin a (k,v,s) = do writeByte a (fromEnum k)
+ writeByte a (fromEnum v)
+ writeI32 a s
+ writeMapEnd a = return ()
+ writeListBegin a (t,s) = do writeByte a (fromEnum t)
+ writeI32 a s
+ writeListEnd a = return ()
+ writeSetBegin = writeListBegin
+ writeSetEnd a = return ()
+ readByte (TBinaryProtocol tr) = do b <- treadAll tr 1
+ return $ (fromIntegral (fromIntegral (compBytes b) :: Int8) :: Int)
+ readI16 (TBinaryProtocol tr) = do b <- treadAll tr 2
+ return $ (fromIntegral (fromIntegral (compBytes b) :: Int16) :: Int)
+ readI32 (TBinaryProtocol tr) = do b <- treadAll tr 4
+ return $ (fromIntegral (fromIntegral (compBytes b) :: Int32) :: Int)
+ readI64 (TBinaryProtocol tr) = do b <- treadAll tr 8
+ return $ (fromIntegral (fromIntegral (compBytes64 b) :: Int64) :: Int)
+ readDouble (TBinaryProtocol tr) = do b <- readI64 (TBinaryProtocol tr)
+ return $ floatOfBits (fromIntegral b :: Word64)
+ readBool (TBinaryProtocol tr) = do b <- readByte (TBinaryProtocol tr)
+ return $ b == 1
+ readString (TBinaryProtocol tr) = do l <- readI32 (TBinaryProtocol tr)
+ treadAll tr l
+ readBinary = readString
+ readMessageBegin (TBinaryProtocol tr) = do ver <- readI32 (TBinaryProtocol tr)
+ if (ver .&. version_mask /= version_1) then
+ throwDyn (ProtocolExn PE_BAD_VERSION "Missing version identifier")
+ else do
+ s <- readString (TBinaryProtocol tr)
+ sz <- readI32 (TBinaryProtocol tr)
+ return (s,toEnum (ver .&. 0xFF) :: Message_type,fromIntegral sz :: Int)
+ readMessageEnd (TBinaryProtocol tr) = return ()
+ readStructBegin (TBinaryProtocol tr) = return ""
+ readStructEnd (TBinaryProtocol tr) = return ()
+ readFieldBegin (TBinaryProtocol tr) = do t <- readByte (TBinaryProtocol tr)
+ if (toEnum t :: T_type) /= T_STOP then
+ do s <- readI16 (TBinaryProtocol tr)
+ return ("",toEnum t :: T_type,fromIntegral s :: Int)
+ else return ("",toEnum t :: T_type,0)
+ readFieldEnd (TBinaryProtocol tr) = return ()
+ readMapBegin a = do kt <- readByte a
+ vt <- readByte a
+ s <- readI32 a
+ return (toEnum kt :: T_type,toEnum vt :: T_type,fromIntegral s :: Int)
+ readMapEnd a = return ()
+ readListBegin a = do b <- readByte a
+ s <- readI32 a
+ return (toEnum b :: T_type,fromIntegral s :: Int)
+ readListEnd a = return ()
+ readSetBegin = readListBegin
+ readSetEnd = readListEnd