THRIFT-1598 Update Haskell generated code to use Text, Hash{Map,Set}, Vector
Patch: Itai Zukerman
git-svn-id: https://svn.apache.org/repos/asf/thrift/trunk@1340014 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/lib/hs/README b/lib/hs/README
index bbfe699..fe525bd 100644
--- a/lib/hs/README
+++ b/lib/hs/README
@@ -43,7 +43,7 @@
* i16 -> Data.Int.Int16
* i32 -> Data.Int.Int32
* i64 -> Data.Int.Int64
- * string -> String
+ * string -> Text
* binary -> Data.ByteString.Lazy
* bool -> Boolean
@@ -52,6 +52,17 @@
Become Haskell 'data' types. Use fromEnum to get out the int value.
+Lists
+=====
+
+Become Data.Vector.Vector from the vector package.
+
+Maps and Sets
+=============
+
+Become Data.HashMap.Strict.Map and Data.HashSet.Set from the
+unordered-containers package.
+
Structs
=======
@@ -61,7 +72,7 @@
Exceptions
==========
-Identical to structs. Throw them with throwDyn. Catch them with catchDyn.
+Identical to structs. Use them with throw and catch from Control.Exception.
Client
======
@@ -86,4 +97,3 @@
Just a function that takes a handler label, protocols. It calls the
superclasses process if there is a superclass.
-
diff --git a/lib/hs/Thrift.cabal b/lib/hs/Thrift.cabal
index 393e064..cf02e12 100644
--- a/lib/hs/Thrift.cabal
+++ b/lib/hs/Thrift.cabal
@@ -36,13 +36,23 @@
Hs-Source-Dirs:
src
Build-Depends:
- base >= 4, base < 5, network, ghc-prim, binary, bytestring, HTTP
+ base >= 4, base < 5, network, ghc-prim, binary, bytestring, hashable, HTTP, text, unordered-containers, vector
Exposed-Modules:
- Thrift, Thrift.Protocol, Thrift.Protocol.Binary, Thrift.Transport,
- Thrift.Transport.Framed, Thrift.Transport.Handle,
- Thrift.Transport.HttpClient, Thrift.Server
+ Thrift,
+ Thrift.Protocol,
+ Thrift.Protocol.Binary,
+ Thrift.Server,
+ Thrift.Transport,
+ Thrift.Transport.Framed,
+ Thrift.Transport.Handle,
+ Thrift.Transport.HttpClient,
+ Thrift.Types
Extensions:
- DeriveDataTypeable, ExistentialQuantification, FlexibleInstances,
- KindSignatures, MagicHash, RankNTypes,
- ScopedTypeVariables, TypeSynonymInstances
-
+ DeriveDataTypeable,
+ ExistentialQuantification,
+ FlexibleInstances,
+ KindSignatures,
+ MagicHash,
+ RankNTypes,
+ ScopedTypeVariables,
+ TypeSynonymInstances
diff --git a/lib/hs/src/Thrift.hs b/lib/hs/src/Thrift.hs
index e57cff5..42f5d32 100644
--- a/lib/hs/src/Thrift.hs
+++ b/lib/hs/src/Thrift.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
--
-- Licensed to the Apache Software Foundation (ASF) under one
@@ -33,6 +34,7 @@
import Control.Monad ( when )
import Control.Exception
+import Data.Text.Lazy ( pack, unpack )
import Data.Typeable ( Typeable )
import Thrift.Transport
@@ -84,7 +86,7 @@
when (ae_message ae /= "") $ do
writeFieldBegin pt ("message", T_STRING , 1)
- writeString pt (ae_message ae)
+ writeString pt (pack $ ae_message ae)
writeFieldEnd pt
writeFieldBegin pt ("type", T_I32, 2);
@@ -108,7 +110,7 @@
else case tag of
1 -> if ft == T_STRING then
do s <- readString pt
- readAppExnFields pt record{ae_message = s}
+ readAppExnFields pt record{ae_message = unpack s}
else do skip pt ft
readAppExnFields pt record
2 -> if ft == T_I32 then
diff --git a/lib/hs/src/Thrift/Protocol.hs b/lib/hs/src/Thrift/Protocol.hs
index 1a31932..f3b342a 100644
--- a/lib/hs/src/Thrift/Protocol.hs
+++ b/lib/hs/src/Thrift/Protocol.hs
@@ -29,9 +29,10 @@
import Control.Monad ( replicateM_, unless )
import Control.Exception
-import Data.Int
-import Data.Typeable ( Typeable )
import Data.ByteString.Lazy
+import Data.Int
+import Data.Text.Lazy ( Text )
+import Data.Typeable ( Typeable )
import Thrift.Transport
@@ -102,12 +103,12 @@
class Protocol a where
getTransport :: Transport t => a t -> t
- writeMessageBegin :: Transport t => a t -> (String, MessageType, Int32) -> IO ()
+ writeMessageBegin :: Transport t => a t -> (Text, MessageType, Int32) -> IO ()
writeMessageEnd :: Transport t => a t -> IO ()
- writeStructBegin :: Transport t => a t -> String -> IO ()
+ writeStructBegin :: Transport t => a t -> Text -> IO ()
writeStructEnd :: Transport t => a t -> IO ()
- writeFieldBegin :: Transport t => a t -> (String, ThriftType, Int16) -> IO ()
+ writeFieldBegin :: Transport t => a t -> (Text, ThriftType, Int16) -> IO ()
writeFieldEnd :: Transport t => a t -> IO ()
writeFieldStop :: Transport t => a t -> IO ()
writeMapBegin :: Transport t => a t -> (ThriftType, ThriftType, Int32) -> IO ()
@@ -123,16 +124,16 @@
writeI32 :: Transport t => a t -> Int32 -> IO ()
writeI64 :: Transport t => a t -> Int64 -> IO ()
writeDouble :: Transport t => a t -> Double -> IO ()
- writeString :: Transport t => a t -> String -> IO ()
+ writeString :: Transport t => a t -> Text -> IO ()
writeBinary :: Transport t => a t -> ByteString -> IO ()
- readMessageBegin :: Transport t => a t -> IO (String, MessageType, Int32)
+ readMessageBegin :: Transport t => a t -> IO (Text, MessageType, Int32)
readMessageEnd :: Transport t => a t -> IO ()
- readStructBegin :: Transport t => a t -> IO String
+ readStructBegin :: Transport t => a t -> IO Text
readStructEnd :: Transport t => a t -> IO ()
- readFieldBegin :: Transport t => a t -> IO (String, ThriftType, Int16)
+ readFieldBegin :: Transport t => a t -> IO (Text, ThriftType, Int16)
readFieldEnd :: Transport t => a t -> IO ()
readMapBegin :: Transport t => a t -> IO (ThriftType, ThriftType, Int32)
readMapEnd :: Transport t => a t -> IO ()
@@ -147,7 +148,7 @@
readI32 :: Transport t => a t -> IO Int32
readI64 :: Transport t => a t -> IO Int64
readDouble :: Transport t => a t -> IO Double
- readString :: Transport t => a t -> IO String
+ readString :: Transport t => a t -> IO Text
readBinary :: Transport t => a t -> IO ByteString
diff --git a/lib/hs/src/Thrift/Protocol/Binary.hs b/lib/hs/src/Thrift/Protocol/Binary.hs
index c55ea5a..1bc9add 100644
--- a/lib/hs/src/Thrift/Protocol/Binary.hs
+++ b/lib/hs/src/Thrift/Protocol/Binary.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE OverloadedStrings #-}
--
-- Licensed to the Apache Software Foundation (ASF) under one
-- or more contributor license agreements. See the NOTICE file
@@ -30,6 +31,7 @@
import qualified Data.Binary
import Data.Bits
import Data.Int
+import Data.Text.Lazy.Encoding ( decodeUtf8, encodeUtf8 )
import GHC.Exts
import GHC.Word
@@ -38,7 +40,6 @@
import Thrift.Transport
import qualified Data.ByteString.Lazy as LBS
-import qualified Data.ByteString.Lazy.Char8 as LBSChar8
version_mask :: Int32
version_mask = 0xffff0000
@@ -76,7 +77,9 @@
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)
+ writeString p s = writeI32 p (fromIntegral $ LBS.length s') >> tWrite (getTransport p) s'
+ where
+ s' = encodeUtf8 s
writeBinary p s = writeI32 p (fromIntegral $ LBS.length s) >> tWrite (getTransport p) s
readMessageBegin p = do
@@ -136,7 +139,7 @@
readString p = do
i <- readI32 p
- LBSChar8.unpack `liftM` tReadAll (getTransport p) (fromIntegral i)
+ decodeUtf8 `liftM` tReadAll (getTransport p) (fromIntegral i)
readBinary p = do
i <- readI32 p
diff --git a/lib/hs/src/Thrift/Transport/Handle.hs b/lib/hs/src/Thrift/Transport/Handle.hs
index 70d39e7..cf4822b 100644
--- a/lib/hs/src/Thrift/Transport/Handle.hs
+++ b/lib/hs/src/Thrift/Transport/Handle.hs
@@ -27,7 +27,9 @@
, HandleSource(..)
) where
-import Control.Exception ( throw )
+import Prelude hiding ( catch )
+
+import Control.Exception ( catch, throw )
import Control.Monad ()
import Network
diff --git a/lib/hs/src/Thrift/Types.hs b/lib/hs/src/Thrift/Types.hs
new file mode 100644
index 0000000..e917e39
--- /dev/null
+++ b/lib/hs/src/Thrift/Types.hs
@@ -0,0 +1,34 @@
+-- Licensed to the Apache Software Foundation (ASF) under one
+-- or more contributor license agreements. See the NOTICE file
+-- distributed with this work for additional information
+-- regarding copyright ownership. The ASF licenses this file
+-- to you under the Apache License, Version 2.0 (the
+-- "License"); you may not use this file except in compliance
+-- with the License. You may obtain a copy of the License at
+--
+-- http://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing,
+-- software distributed under the License is distributed on an
+-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+-- KIND, either express or implied. See the License for the
+-- specific language governing permissions and limitations
+-- under the License.
+--
+
+module Thrift.Types where
+
+import Data.Foldable (foldl')
+import Data.Hashable ( Hashable, hashWithSalt )
+import qualified Data.HashMap.Strict as Map
+import qualified Data.HashSet as Set
+import qualified Data.Vector as Vector
+
+instance (Hashable k, Hashable v) => Hashable (Map.HashMap k v) where
+ hashWithSalt salt = foldl' hashWithSalt salt . Map.toList
+
+instance (Hashable a) => Hashable (Set.HashSet a) where
+ hashWithSalt salt = foldl' hashWithSalt salt
+
+instance (Hashable a) => Hashable (Vector.Vector a) where
+ hashWithSalt salt = Vector.foldl' hashWithSalt salt