From: iproctor Date: Mon, 11 Feb 2008 22:59:01 +0000 (+0000) Subject: Thrift haskell getTransport working X-Git-Tag: 0.2.0~999 X-Git-Url: https://source.supwisdom.com/gerrit/gitweb?a=commitdiff_plain;h=55aebc404b52971909e8edd41c03c49b398698c1;p=common%2Fthrift.git 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/compiler/cpp/src/generate/t_hs_generator.cc b/compiler/cpp/src/generate/t_hs_generator.cc index 3be56b15..26f5b92e 100644 --- a/compiler/cpp/src/generate/t_hs_generator.cc +++ b/compiler/cpp/src/generate/t_hs_generator.cc @@ -706,7 +706,7 @@ void t_hs_generator::generate_service_client(t_service* tservice) { // Write to the stream f_client_ << indent() << "writeMessageEnd op" << endl << - indent() << "pflush op" << endl; + indent() << "tflush (getTransport op)" << endl; indent_down(); @@ -818,7 +818,7 @@ void t_hs_generator::generate_service_server(t_service* tservice) { indent(f_service_) << "writeMessageBegin oprot (name,M_EXCEPTION,seqid)" << endl; indent(f_service_) << "writeAppExn oprot (AppExn AE_UNKNOWN_METHOD (\"Unknown function \" ++ name))" << endl; indent(f_service_) << "writeMessageEnd oprot" << endl; - indent(f_service_) << "pflush oprot" << endl; + indent(f_service_) << "tflush (getTransport oprot)" << endl; indent_down(); } indent_down(); @@ -940,7 +940,7 @@ void t_hs_generator::generate_process_function(t_service* tservice, indent() << "writeMessageBegin oprot (\"" << tfunction->get_name() << "\", M_REPLY, seqid);" << endl << indent() << "write_"< TBinaryProtocol a + data TBinaryProtocol a = TTransport a => TBinaryProtocol a version_mask = 0xffff0000 version_1 = 0x80010000; @@ -33,78 +33,78 @@ module TBinaryProtocol (TBinaryProtocol(..)) where 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 diff --git a/lib/hs/src/Thrift.hs b/lib/hs/src/Thrift.hs index 6b946266..bb9f0bcd 100644 --- a/lib/hs/src/Thrift.hs +++ b/lib/hs/src/Thrift.hs @@ -119,52 +119,52 @@ module Thrift (TransportExn(..),TransportExn_Type(..),TTransport(..), T_type(..) class Protocol a where - pflush :: a -> IO () - writeMessageBegin :: a -> ([Char],Message_type,Int) -> IO () - writeMessageEnd :: a -> IO () - writeStructBegin :: a -> [Char] -> IO () - writeStructEnd :: a -> IO () - writeFieldBegin :: a -> ([Char], T_type,Int) -> IO () - writeFieldEnd :: a -> IO () - writeFieldStop :: a -> IO () - writeMapBegin :: a -> (T_type,T_type,Int) -> IO () - writeMapEnd :: a -> IO () - writeListBegin :: a -> (T_type,Int) -> IO () - writeListEnd :: a -> IO () - writeSetBegin :: a -> (T_type,Int) -> IO () - writeSetEnd :: a -> IO () - writeBool :: a -> Bool -> IO () - writeByte :: a -> Int -> IO () - writeI16 :: a -> Int -> IO () - writeI32 :: a -> Int -> IO () - writeI64 :: a -> Int -> IO () - writeDouble :: a -> Double -> IO () - writeString :: a -> [Char] -> IO () - writeBinary :: a -> [Char] -> IO () - readMessageBegin :: a -> IO ([Char],Message_type,Int) - readMessageEnd :: a -> IO () - readStructBegin :: a -> IO [Char] - readStructEnd :: a -> IO () - readFieldBegin :: a -> IO ([Char],T_type,Int) - readFieldEnd :: a -> IO () - readMapBegin :: a -> IO (T_type,T_type,Int) - readMapEnd :: a -> IO () - readListBegin :: a -> IO (T_type,Int) - readListEnd :: a -> IO () - readSetBegin :: a -> IO (T_type,Int) - readSetEnd :: a -> IO () - readBool :: a -> IO Bool - readByte :: a -> IO Int - readI16 :: a -> IO Int - readI32 :: a -> IO Int - readI64 :: a -> IO Int - readDouble :: a -> IO Double - readString :: a -> IO [Char] - readBinary :: a -> IO [Char] - skipFields :: a -> IO () - skipMapEntries :: a -> Int -> T_type -> T_type -> IO () - skipSetEntries :: a -> Int -> T_type -> IO () - skip :: a -> T_type -> IO () + getTransport :: TTransport t => a t -> t + writeMessageBegin :: TTransport t => a t -> ([Char],Message_type,Int) -> IO () + writeMessageEnd :: TTransport t => a t -> IO () + writeStructBegin :: TTransport t => a t -> [Char] -> IO () + writeStructEnd :: TTransport t => a t -> IO () + writeFieldBegin :: TTransport t => a t -> ([Char], T_type,Int) -> IO () + writeFieldEnd :: TTransport t => a t -> IO () + writeFieldStop :: TTransport t => a t -> IO () + writeMapBegin :: TTransport t => a t -> (T_type,T_type,Int) -> IO () + writeMapEnd :: TTransport t => a t -> IO () + writeListBegin :: TTransport t => a t -> (T_type,Int) -> IO () + writeListEnd :: TTransport t => a t -> IO () + writeSetBegin :: TTransport t => a t -> (T_type,Int) -> IO () + writeSetEnd :: TTransport t => a t -> IO () + writeBool :: TTransport t => a t -> Bool -> IO () + writeByte :: TTransport t => a t -> Int -> IO () + writeI16 :: TTransport t => a t -> Int -> IO () + writeI32 :: TTransport t => a t -> Int -> IO () + writeI64 :: TTransport t => a t -> Int -> IO () + writeDouble :: TTransport t => a t -> Double -> IO () + writeString :: TTransport t => a t -> [Char] -> IO () + writeBinary :: TTransport t => a t -> [Char] -> IO () + readMessageBegin :: TTransport t => a t -> IO ([Char],Message_type,Int) + readMessageEnd :: TTransport t => a t -> IO () + readStructBegin :: TTransport t => a t -> IO [Char] + readStructEnd :: TTransport t => a t -> IO () + readFieldBegin :: TTransport t => a t -> IO ([Char],T_type,Int) + readFieldEnd :: TTransport t => a t -> IO () + readMapBegin :: TTransport t => a t -> IO (T_type,T_type,Int) + readMapEnd :: TTransport t => a t -> IO () + readListBegin :: TTransport t => a t -> IO (T_type,Int) + readListEnd :: TTransport t => a t -> IO () + readSetBegin :: TTransport t => a t -> IO (T_type,Int) + readSetEnd :: TTransport t => a t -> IO () + readBool :: TTransport t => a t -> IO Bool + readByte :: TTransport t => a t -> IO Int + readI16 :: TTransport t => a t -> IO Int + readI32 :: TTransport t => a t -> IO Int + readI64 :: TTransport t => a t -> IO Int + readDouble :: TTransport t => a t -> IO Double + readString :: TTransport t => a t -> IO [Char] + readBinary :: TTransport t => a t -> IO [Char] + skipFields :: TTransport t => a t -> IO () + skipMapEntries :: TTransport t => a t -> Int -> T_type -> T_type -> IO () + skipSetEntries :: TTransport t => a t -> Int -> T_type -> IO () + skip :: TTransport t => a t -> T_type -> IO () skipFields a = do (_,ty,_) <- readFieldBegin a if ty == T_STOP then return ()