You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@thrift.apache.org by dr...@apache.org on 2010/01/11 20:12:57 UTC
svn commit: r898012 - in /incubator/thrift/trunk:
compiler/cpp/src/generate/t_hs_generator.cc lib/hs/Thrift.cabal
lib/hs/src/Thrift/Protocol/Binary.hs lib/hs/src/Thrift/Transport.hs
lib/hs/src/Thrift/Transport/Handle.hs
Author: dreiss
Date: Mon Jan 11 19:12:56 2010
New Revision: 898012
URL: http://svn.apache.org/viewvc?rev=898012&view=rev
Log:
THRIFT-560. haskell: Move to ByteString and compiler fixes
Modified:
incubator/thrift/trunk/compiler/cpp/src/generate/t_hs_generator.cc
incubator/thrift/trunk/lib/hs/Thrift.cabal
incubator/thrift/trunk/lib/hs/src/Thrift/Protocol/Binary.hs
incubator/thrift/trunk/lib/hs/src/Thrift/Transport.hs
incubator/thrift/trunk/lib/hs/src/Thrift/Transport/Handle.hs
Modified: incubator/thrift/trunk/compiler/cpp/src/generate/t_hs_generator.cc
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/compiler/cpp/src/generate/t_hs_generator.cc?rev=898012&r1=898011&r2=898012&view=diff
==============================================================================
--- incubator/thrift/trunk/compiler/cpp/src/generate/t_hs_generator.cc (original)
+++ incubator/thrift/trunk/compiler/cpp/src/generate/t_hs_generator.cc Mon Jan 11 19:12:56 2010
@@ -139,8 +139,9 @@
*/
std::string hs_autogen_comment();
+ std::string hs_language_pragma();
std::string hs_imports();
- std::string type_name(t_type* ttype);
+ std::string type_name(t_type* ttype, string function_prefix = "");
std::string function_type(t_function* tfunc, bool options = false, bool io = false, bool method = false);
std::string type_to_enum(t_type* ttype);
std::string render_hs_type(t_type* type, bool needs_parens = true);
@@ -180,13 +181,17 @@
string f_consts_name = get_out_dir()+pname+"_Consts.hs";
f_consts_.open(f_consts_name.c_str());
+
+
// Print header
f_types_ <<
+ hs_language_pragma() << endl <<
hs_autogen_comment() << endl <<
"module " << pname <<"_Types where" << endl <<
hs_imports() << endl;
f_consts_ <<
+ hs_language_pragma() << endl <<
hs_autogen_comment() << endl <<
"module " << pname <<"_Consts where" << endl <<
hs_imports() << endl <<
@@ -194,6 +199,9 @@
}
+string t_hs_generator::hs_language_pragma() {
+ return std::string("{-# LANGUAGE DeriveDataTypeable #-}");
+}
/**
* Autogen'd comment
@@ -211,7 +219,17 @@
* Prints standard thrift imports
*/
string t_hs_generator::hs_imports() {
- return "import Thrift\nimport Data.Typeable ( Typeable )\nimport Control.Exception\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\nimport Data.Int";
+ const vector<t_program*>& includes = program_->get_includes();
+ string result = "";
+ for (size_t i = 0; i < includes.size(); ++i) {
+ result += "import qualified " + capitalize(includes[i]->get_name()) + "_Types\n";
+ }
+ if (includes.size() > 0) {
+ 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.Int;\nimport Prelude ((==), String, Eq, Show, Ord, Maybe(..), (&&), (||), return, IO, Enum, fromEnum, toEnum, Bool(..), (++))";
+ return result;
}
/**
@@ -618,6 +636,7 @@
f_service_.open(f_service_name.c_str());
f_service_ <<
+ hs_language_pragma() << endl <<
hs_autogen_comment() << endl <<
"module " << capitalize(service_name_) << " where" << endl <<
hs_imports() << endl;
@@ -1249,7 +1268,7 @@
void t_hs_generator::generate_serialize_struct(ofstream &out,
t_struct* tstruct,
string prefix) {
- out << "write_" << type_name(tstruct) << " oprot " << prefix;
+ out << type_name(tstruct, "write_") << " oprot " << prefix;
}
void t_hs_generator::generate_serialize_container(ofstream &out,
@@ -1332,7 +1351,7 @@
}
-string t_hs_generator::type_name(t_type* ttype) {
+string t_hs_generator::type_name(t_type* ttype, string function_prefix) {
string prefix = "";
t_program* program = ttype->get_program();
if (program != NULL && program != program_) {
@@ -1347,7 +1366,7 @@
} else {
name = capitalize(name);
}
- return prefix + name;
+ return prefix + function_prefix + name;
}
/**
Modified: incubator/thrift/trunk/lib/hs/Thrift.cabal
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/lib/hs/Thrift.cabal?rev=898012&r1=898011&r2=898012&view=diff
==============================================================================
--- incubator/thrift/trunk/lib/hs/Thrift.cabal (original)
+++ incubator/thrift/trunk/lib/hs/Thrift.cabal Mon Jan 11 19:12:56 2010
@@ -1,5 +1,5 @@
Name: Thrift
-Version: 0.1.0
+Version: 0.1.1
Cabal-Version: >= 1.2
License: Apache2
Category: Foreign
@@ -10,11 +10,11 @@
Hs-Source-Dirs:
src
Build-Depends:
- base >=4, network, ghc-prim
+ base >=4, network, ghc-prim, binary, bytestring, HTTP
ghc-options:
-fglasgow-exts
Extensions:
DeriveDataTypeable
Exposed-Modules:
Thrift, Thrift.Protocol, Thrift.Transport, Thrift.Protocol.Binary
- Thrift.Transport.Handle, Thrift.Server
+ Thrift.Transport.Handle, Thrift.Transport.HttpClient, Thrift.Server
Modified: incubator/thrift/trunk/lib/hs/src/Thrift/Protocol/Binary.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/lib/hs/src/Thrift/Protocol/Binary.hs?rev=898012&r1=898011&r2=898012&view=diff
==============================================================================
--- incubator/thrift/trunk/lib/hs/src/Thrift/Protocol/Binary.hs (original)
+++ incubator/thrift/trunk/lib/hs/src/Thrift/Protocol/Binary.hs Mon Jan 11 19:12:56 2010
@@ -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#)
Modified: incubator/thrift/trunk/lib/hs/src/Thrift/Transport.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/lib/hs/src/Thrift/Transport.hs?rev=898012&r1=898011&r2=898012&view=diff
==============================================================================
--- incubator/thrift/trunk/lib/hs/src/Thrift/Transport.hs (original)
+++ incubator/thrift/trunk/lib/hs/src/Thrift/Transport.hs Mon Jan 11 19:12:56 2010
@@ -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 )
Modified: incubator/thrift/trunk/lib/hs/src/Thrift/Transport/Handle.hs
URL: http://svn.apache.org/viewvc/incubator/thrift/trunk/lib/hs/src/Thrift/Transport/Handle.hs?rev=898012&r1=898011&r2=898012&view=diff
==============================================================================
--- incubator/thrift/trunk/lib/hs/src/Thrift/Transport/Handle.hs (original)
+++ incubator/thrift/trunk/lib/hs/src/Thrift/Transport/Handle.hs Mon Jan 11 19:12:56 2010
@@ -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