THRIFT-560. haskell: Move to ByteString and compiler fixes
git-svn-id: https://svn.apache.org/repos/asf/incubator/thrift/trunk@898012 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/lib/hs/src/Thrift/Protocol/Binary.hs b/lib/hs/src/Thrift/Protocol/Binary.hs
index 3f798ce..fa9a207 100644
--- a/lib/hs/src/Thrift/Protocol/Binary.hs
+++ b/lib/hs/src/Thrift/Protocol/Binary.hs
@@ -23,6 +23,7 @@
) where
import Control.Exception ( throw )
+import Control.Monad ( liftM )
import Data.Bits
import Data.Int
@@ -34,6 +35,7 @@
import Thrift.Protocol
import Thrift.Transport
+import qualified Data.ByteString.Lazy.Char8 as LBS
version_mask = 0xffff0000
version_1 = 0x80010000
@@ -62,13 +64,13 @@
writeSetBegin p (t, n) = writeType p t >> writeI32 p n
writeSetEnd _ = return ()
- writeBool p b = tWrite (getTransport p) [toEnum $ if b then 1 else 0]
+ writeBool p b = tWrite (getTransport p) $ LBS.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)
writeDouble p d = writeI64 p (fromIntegral $ floatBits d)
- writeString p s = writeI32 p (length s) >> tWrite (getTransport p) s
+ writeString p s = writeI32 p (length s) >> tWrite (getTransport p) (LBS.pack s)
writeBinary = writeString
readMessageBegin p = do
@@ -116,7 +118,10 @@
readDouble p = do
bs <- readI64 p
return $ floatOfBits $ fromIntegral bs
- readString p = readI32 p >>= tReadAll (getTransport p)
+ readString p = do
+ i <- readI32 p
+ LBS.unpack `liftM` tReadAll (getTransport p) i
+
readBinary = readString
@@ -128,16 +133,16 @@
readType :: (Protocol p, Transport t) => p t -> IO ThriftType
readType p = toEnum `fmap` readByte p
-composeBytes :: (Bits b, Enum t) => [t] -> b
-composeBytes = (foldl' fn 0) . (map $ fromIntegral . fromEnum)
+composeBytes :: (Bits b) => LBS.ByteString -> b
+composeBytes = (foldl' fn 0) . (map (fromIntegral . fromEnum)) . LBS.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 -> String
-getBytes i 0 = []
-getBytes i n = (toEnum $ fromIntegral $ getByte i (n-1)):(getBytes i (n-1))
+getBytes :: (Bits a, Integral a) => a -> Int -> LBS.ByteString
+getBytes i 0 = LBS.empty
+getBytes i n = (toEnum $ fromIntegral $ getByte i (n-1)) `LBS.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 29f50d0..80e4914 100644
--- a/lib/hs/src/Thrift/Transport.hs
+++ b/lib/hs/src/Thrift/Transport.hs
@@ -28,23 +28,25 @@
import Data.Typeable ( Typeable )
+import qualified Data.ByteString.Lazy.Char8 as LBS
+import Data.Monoid
class Transport a where
tIsOpen :: a -> IO Bool
tClose :: a -> IO ()
- tRead :: a -> Int -> IO String
- tWrite :: a -> String ->IO ()
+ tRead :: a -> Int -> IO LBS.ByteString
+ tWrite :: a -> LBS.ByteString -> IO ()
tFlush :: a -> IO ()
- tReadAll :: a -> Int -> IO String
+ tReadAll :: a -> Int -> IO LBS.ByteString
- tReadAll a 0 = return []
+ tReadAll a 0 = return mempty
tReadAll a len = do
result <- tRead a len
- let rlen = length result
+ let rlen = fromIntegral $ LBS.length result
when (rlen == 0) (throw $ TransportExn "Cannot read. Remote side has closed." TE_UNKNOWN)
if len <= rlen
then return result
- else (result ++) `fmap` (tReadAll a (len - rlen))
+ else (result `mappend`) `fmap` (tReadAll a (len - rlen))
data TransportExn = TransportExn String TransportExnType
deriving ( Show, Typeable )
diff --git a/lib/hs/src/Thrift/Transport/Handle.hs b/lib/hs/src/Thrift/Transport/Handle.hs
index e49456b..0b1cb75 100644
--- a/lib/hs/src/Thrift/Transport/Handle.hs
+++ b/lib/hs/src/Thrift/Transport/Handle.hs
@@ -32,12 +32,14 @@
import Thrift.Transport
+import qualified Data.ByteString.Lazy.Char8 as LBS
+import Data.Monoid
instance Transport Handle where
tIsOpen = hIsOpen
tClose h = hClose h
- tRead h n = replicateM n (hGetChar h) `catch` handleEOF
- tWrite h s = mapM_ (hPutChar h) s
+ tRead h n = LBS.hGet h n `catch` handleEOF
+ tWrite h s = LBS.hPut h s
tFlush = hFlush
@@ -54,5 +56,5 @@
handleEOF e = if isEOFError e
- then return []
+ then return mempty
else throw $ TransportExn "TChannelTransport: Could not read" TE_UNKNOWN