From ae7f7fa57f9fa984711362ea88f42d21a965a642 Mon Sep 17 00:00:00 2001 From: Christian Lavoie Date: Tue, 2 Nov 2010 21:42:53 +0000 Subject: [PATCH] THRIFT-950: Haskell bindings treat 'byte' as unsigned 8-bit int (Data.Word.Word8), java/cpp as signed (byte/int8_t). Fix Haskell. git-svn-id: https://svn.apache.org/repos/asf/thrift/trunk@1030243 13f79535-47bb-0310-9956-ffa450edef68 --- compiler/cpp/src/generate/t_hs_generator.cc | 6 +-- lib/hs/src/Thrift/Protocol.hs | 5 +-- lib/hs/src/Thrift/Protocol/Binary.hs | 45 ++++++++++----------- lib/hs/src/Thrift/Transport.hs | 2 +- lib/hs/src/Thrift/Transport/Handle.hs | 2 +- lib/hs/src/Thrift/Transport/HttpClient.hs | 2 +- 6 files changed, 30 insertions(+), 32 deletions(-) diff --git a/compiler/cpp/src/generate/t_hs_generator.cc b/compiler/cpp/src/generate/t_hs_generator.cc index c41ff68f..9e08d374 100644 --- a/compiler/cpp/src/generate/t_hs_generator.cc +++ b/compiler/cpp/src/generate/t_hs_generator.cc @@ -233,7 +233,7 @@ string t_hs_generator::hs_imports() { result += "\n"; } - result += "import Thrift\nimport Data.Typeable ( Typeable )\nimport Control.Exception\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\nimport Data.ByteString.Lazy\nimport Data.Int\nimport Data.Word\nimport Prelude ((==), String, Eq, Show, Ord, Maybe(..), (&&), (||), return, IO, Enum, fromIntegral, fromEnum, toEnum, Bool(..), (++), ($), Double, (-), length)"; + result += "import Thrift\nimport Data.Typeable ( Typeable )\nimport Control.Exception\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\nimport Data.ByteString.Lazy\nimport Data.Int\nimport Prelude ((==), String, Eq, Show, Ord, Maybe(..), (&&), (||), return, IO, Enum, fromIntegral, fromEnum, toEnum, Bool(..), (++), ($), Double, (-), length)"; return result; } @@ -335,7 +335,7 @@ string t_hs_generator::render_const_value(t_type* type, t_const_value* value) { break; case t_base_type::TYPE_BYTE: - out << "(" << value->get_integer() << " :: Word8)"; + out << "(" << value->get_integer() << " :: Int8)"; break; case t_base_type::TYPE_I16: @@ -1434,7 +1434,7 @@ string t_hs_generator::render_hs_type(t_type* type, bool needs_parens) { case t_base_type::TYPE_BOOL: return "Bool"; case t_base_type::TYPE_BYTE: - return "Word8"; + return "Int8"; case t_base_type::TYPE_I16: return "Int16"; case t_base_type::TYPE_I32: diff --git a/lib/hs/src/Thrift/Protocol.hs b/lib/hs/src/Thrift/Protocol.hs index b34e8066..1a319327 100644 --- a/lib/hs/src/Thrift/Protocol.hs +++ b/lib/hs/src/Thrift/Protocol.hs @@ -31,7 +31,6 @@ import Control.Monad ( replicateM_, unless ) import Control.Exception import Data.Int import Data.Typeable ( Typeable ) -import Data.Word import Data.ByteString.Lazy import Thrift.Transport @@ -119,7 +118,7 @@ class Protocol a where writeSetEnd :: Transport t => a t -> IO () writeBool :: Transport t => a t -> Bool -> IO () - writeByte :: Transport t => a t -> Word8 -> IO () + writeByte :: Transport t => a t -> Int8 -> IO () writeI16 :: Transport t => a t -> Int16 -> IO () writeI32 :: Transport t => a t -> Int32 -> IO () writeI64 :: Transport t => a t -> Int64 -> IO () @@ -143,7 +142,7 @@ class Protocol a where readSetEnd :: Transport t => a t -> IO () readBool :: Transport t => a t -> IO Bool - readByte :: Transport t => a t -> IO Word8 + readByte :: Transport t => a t -> IO Int8 readI16 :: Transport t => a t -> IO Int16 readI32 :: Transport t => a t -> IO Int32 readI64 :: Transport t => a t -> IO Int64 diff --git a/lib/hs/src/Thrift/Protocol/Binary.hs b/lib/hs/src/Thrift/Protocol/Binary.hs index cd959654..c55ea5a2 100644 --- a/lib/hs/src/Thrift/Protocol/Binary.hs +++ b/lib/hs/src/Thrift/Protocol/Binary.hs @@ -27,10 +27,9 @@ module Thrift.Protocol.Binary import Control.Exception ( throw ) import Control.Monad ( liftM ) +import qualified Data.Binary import Data.Bits import Data.Int -import Data.List ( foldl' ) -import Data.Word import GHC.Exts import GHC.Word @@ -38,8 +37,8 @@ import GHC.Word import Thrift.Protocol import Thrift.Transport -import qualified Data.ByteString.Lazy.Char8 as LBSChar8 import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy.Char8 as LBSChar8 version_mask :: Int32 version_mask = 0xffff0000 @@ -71,11 +70,11 @@ instance Protocol BinaryProtocol where writeSetBegin p (t, n) = writeType p t >> writeI32 p n writeSetEnd _ = return () - writeBool p b = tWrite (getTransport p) $ LBSChar8.singleton $ toEnum $ if b then 1 else 0 - writeByte p b = tWrite (getTransport p) (getBytes b 1) - writeI16 p b = tWrite (getTransport p) (getBytes b 2) - writeI32 p b = tWrite (getTransport p) (getBytes b 4) - writeI64 p b = tWrite (getTransport p) (getBytes b 8) + writeBool p b = tWrite (getTransport p) $ LBS.singleton $ toEnum $ if b then 1 else 0 + writeByte p b = tWrite (getTransport p) $ Data.Binary.encode b + writeI16 p b = tWrite (getTransport p) $ Data.Binary.encode b + writeI32 p b = tWrite (getTransport p) $ Data.Binary.encode b + writeI64 p b = tWrite (getTransport p) $ Data.Binary.encode b writeDouble p d = writeI64 p (fromIntegral $ floatBits d) writeString p s = writeI32 p (fromIntegral $ length s) >> tWrite (getTransport p) (LBSChar8.pack s) writeBinary p s = writeI32 p (fromIntegral $ LBS.length s) >> tWrite (getTransport p) s @@ -114,20 +113,31 @@ instance Protocol BinaryProtocol where readSetEnd _ = return () readBool p = (== 1) `fmap` readByte p + readByte p = do bs <- tReadAll (getTransport p) 1 - return $ fromIntegral (composeBytes bs :: Int8) + return $ Data.Binary.decode bs + readI16 p = do bs <- tReadAll (getTransport p) 2 - return $ fromIntegral (composeBytes bs :: Int16) - readI32 p = composeBytes `fmap` tReadAll (getTransport p) 4 - readI64 p = composeBytes `fmap` tReadAll (getTransport p) 8 + return $ Data.Binary.decode bs + + readI32 p = do + bs <- tReadAll (getTransport p) 4 + return $ Data.Binary.decode bs + + readI64 p = do + bs <- tReadAll (getTransport p) 8 + return $ Data.Binary.decode bs + readDouble p = do bs <- readI64 p return $ floatOfBits $ fromIntegral bs + readString p = do i <- readI32 p LBSChar8.unpack `liftM` tReadAll (getTransport p) (fromIntegral i) + readBinary p = do i <- readI32 p tReadAll (getTransport p) (fromIntegral i) @@ -143,17 +153,6 @@ readType p = do b <- readByte p return $ toEnum $ fromIntegral b -composeBytes :: (Bits b) => LBSChar8.ByteString -> b -composeBytes = (foldl' fn 0) . (map (fromIntegral . fromEnum)) . LBSChar8.unpack - where fn acc b = (acc `shiftL` 8) .|. b - -getByte :: Bits a => a -> Int -> a -getByte i n = 255 .&. (i `shiftR` (8 * n)) - -getBytes :: (Bits a, Integral a) => a -> Int -> LBSChar8.ByteString -getBytes _ 0 = LBSChar8.empty -getBytes i n = (toEnum $ fromIntegral $ getByte i (n-1)) `LBSChar8.cons` (getBytes i (n-1)) - floatBits :: Double -> Word64 floatBits (D# d#) = W64# (unsafeCoerce# d#) diff --git a/lib/hs/src/Thrift/Transport.hs b/lib/hs/src/Thrift/Transport.hs index 99dbd6f1..3e5f18b7 100644 --- a/lib/hs/src/Thrift/Transport.hs +++ b/lib/hs/src/Thrift/Transport.hs @@ -29,7 +29,7 @@ import Control.Exception ( Exception, throw ) import Data.Typeable ( Typeable ) -import qualified Data.ByteString.Lazy.Char8 as LBS +import qualified Data.ByteString.Lazy as LBS import Data.Monoid class Transport a where diff --git a/lib/hs/src/Thrift/Transport/Handle.hs b/lib/hs/src/Thrift/Transport/Handle.hs index e9fe17eb..70d39e70 100644 --- a/lib/hs/src/Thrift/Transport/Handle.hs +++ b/lib/hs/src/Thrift/Transport/Handle.hs @@ -37,7 +37,7 @@ import System.IO.Error ( isEOFError ) import Thrift.Transport -import qualified Data.ByteString.Lazy.Char8 as LBS +import qualified Data.ByteString.Lazy as LBS import Data.Monoid instance Transport Handle where diff --git a/lib/hs/src/Thrift/Transport/HttpClient.hs b/lib/hs/src/Thrift/Transport/HttpClient.hs index 6729b12b..b1b0982c 100644 --- a/lib/hs/src/Thrift/Transport/HttpClient.hs +++ b/lib/hs/src/Thrift/Transport/HttpClient.hs @@ -34,7 +34,7 @@ import Data.Monoid (mappend, mempty) import Control.Exception (throw) import Control.Concurrent.MVar import qualified Data.Binary.Builder as B -import qualified Data.ByteString.Lazy.Char8 as LBS +import qualified Data.ByteString.Lazy as LBS -- | 'HttpClient', or THttpClient implements the Thrift Transport -- 2.17.1