Skip to content

Commit

Permalink
THRIFT-560. haskell: Move to ByteString and compiler fixes
Browse files Browse the repository at this point in the history 
git-svn-id: https://svn.apache.org/repos/asf/incubator/thrift/trunk@898012 13f79535-47bb-0310-9956-ffa450edef68
  • Loading branch information
David Reiss committed Jan 11, 2010
1 parent 35565a4 commit 752529e
Show file tree
Hide file tree
Showing 5 changed files with 53 additions and 25 deletions.
29 changes: 24 additions & 5 deletions compiler/cpp/src/generate/t_hs_generator.cc
View file
Expand Up @@ -139,8 +139,9 @@ class t_hs_generator : public t_oop_generator {
*/

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);
Expand Down Expand Up @@ -180,20 +181,27 @@ void t_hs_generator::init_generator() {
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 <<
"import " << pname<<"_Types"<< endl;

}

string t_hs_generator::hs_language_pragma() {
return std::string("{-# LANGUAGE DeriveDataTypeable #-}");
}

/**
* Autogen'd comment
Expand All @@ -211,7 +219,17 @@ string t_hs_generator::hs_autogen_comment() {
* 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;
}

/**
Expand Down Expand Up @@ -618,6 +636,7 @@ void t_hs_generator::generate_service(t_service* tservice) {
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;
Expand Down Expand Up @@ -1249,7 +1268,7 @@ void t_hs_generator::generate_serialize_field(ofstream &out,
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,
Expand Down Expand Up @@ -1332,7 +1351,7 @@ string t_hs_generator::function_type(t_function* tfunc, bool options, bool io, b
}


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_) {
Expand All @@ -1347,7 +1366,7 @@ string t_hs_generator::type_name(t_type* ttype) {
} else {
name = capitalize(name);
}
return prefix + name;
return prefix + function_prefix + name;
}

/**
Expand Down
6 changes: 3 additions & 3 deletions lib/hs/Thrift.cabal
View file
@@ -1,5 +1,5 @@
Name: Thrift
Version: 0.1.0
Version: 0.1.1
Cabal-Version: >= 1.2
License: Apache2
Category: Foreign
Expand All @@ -10,11 +10,11 @@ Library
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
21 changes: 13 additions & 8 deletions lib/hs/src/Thrift/Protocol/Binary.hs
View file
Expand Up @@ -23,6 +23,7 @@ module Thrift.Protocol.Binary
) where

import Control.Exception ( throw )
import Control.Monad ( liftM )

import Data.Bits
import Data.Int
Expand All @@ -34,6 +35,7 @@ import GHC.Word
import Thrift.Protocol
import Thrift.Transport

import qualified Data.ByteString.Lazy.Char8 as LBS

version_mask = 0xffff0000
version_1 = 0x80010000
Expand Down Expand Up @@ -62,13 +64,13 @@ instance Protocol BinaryProtocol where
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
Expand Down Expand Up @@ -116,7 +118,10 @@ instance Protocol BinaryProtocol where
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


Expand All @@ -128,16 +133,16 @@ writeType p t = writeByte p (fromEnum t)
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#)
Expand Down
14 changes: 8 additions & 6 deletions lib/hs/src/Thrift/Transport.hs
View file
Expand Up @@ -28,23 +28,25 @@ import Control.Exception ( Exception, throw )

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 )
Expand Down
8 changes: 5 additions & 3 deletions lib/hs/src/Thrift/Transport/Handle.hs
View file
Expand Up @@ -32,12 +32,14 @@ import System.IO.Error ( isEOFError )

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


Expand All @@ -54,5 +56,5 @@ instance HandleSource (HostName, PortID) where


handleEOF e = if isEOFError e
then return []
then return mempty
else throw $ TransportExn "TChannelTransport: Could not read" TE_UNKNOWN

0 comments on commit 752529e

Please sign in to comment.