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 3be56b1..26f5b92 100644
--- a/compiler/cpp/src/generate/t_hs_generator.cc
+++ b/compiler/cpp/src/generate/t_hs_generator.cc
@@ -706,7 +706,7 @@
// 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 @@
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 @@
indent() << "writeMessageBegin oprot (\"" << tfunction->get_name() << "\", M_REPLY, seqid);" << endl <<
indent() << "write_"<<resultname<<" oprot res" << endl <<
indent() << "writeMessageEnd oprot" << endl <<
- indent() << "pflush oprot" << endl;
+ indent() << "tflush (getTransport oprot)" << endl;
// Close function
indent_down();
diff --git a/lib/hs/README b/lib/hs/README
index d7b2232..7cc2f00 100644
--- a/lib/hs/README
+++ b/lib/hs/README
@@ -17,6 +17,3 @@
Processor: Just a function that takes a handler label, protocols. It calls the superclasses process if there is a superclass.
-
-Note: Protocols implement flush as well as transports and do not have a getTransport method. This is because I couldn't get getTransport to typecheck. Shrug.
-
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
diff --git a/lib/hs/src/Thrift.hs b/lib/hs/src/Thrift.hs
index 6b94626..bb9f0bc 100644
--- a/lib/hs/src/Thrift.hs
+++ b/lib/hs/src/Thrift.hs
@@ -119,52 +119,52 @@
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 ()