diff options
author | Anthony F. Molinaro <molinaro@apache.org> | 2010-09-27 19:27:40 +0000 |
---|---|---|
committer | Anthony F. Molinaro <molinaro@apache.org> | 2010-09-27 19:27:40 +0000 |
commit | 71a58a87648c03309d00d959af74ca45c7700cfd (patch) | |
tree | 57c7c1cccf26fbb367a1027342c36650697b2770 | |
parent | 515c2381b71cf997c17a70c144bfc622a388c6a0 (diff) | |
download | thrift-71a58a87648c03309d00d959af74ca45c7700cfd.tar.gz |
THRIFT-918 : better haskell tests
git-svn-id: https://svn.apache.org/repos/asf/incubator/thrift/trunk@1001883 13f79535-47bb-0310-9956-ffa450edef68
-rw-r--r-- | compiler/cpp/src/generate/t_hs_generator.cc | 23 | ||||
-rw-r--r-- | test/ConstantsDemo.thrift | 10 | ||||
-rw-r--r-- | test/hs/Client.hs | 58 | ||||
-rw-r--r-- | test/hs/ConstantsDemo_TestClient.hs | 44 | ||||
-rw-r--r-- | test/hs/ConstantsDemo_TestServer.hs | 47 | ||||
-rw-r--r-- | test/hs/DebugProtoTest_TestClient.hs | 49 | ||||
-rw-r--r-- | test/hs/DebugProtoTest_TestServer.hs | 125 | ||||
-rw-r--r-- | test/hs/Server.hs | 57 | ||||
-rw-r--r-- | test/hs/ThriftTest_TestClient.hs | 61 | ||||
-rw-r--r-- | test/hs/ThriftTest_TestServer.hs | 152 | ||||
-rw-r--r-- | test/hs/runclient.sh | 44 | ||||
-rw-r--r-- | test/hs/runserver.sh | 45 |
12 files changed, 581 insertions, 134 deletions
diff --git a/compiler/cpp/src/generate/t_hs_generator.cc b/compiler/cpp/src/generate/t_hs_generator.cc index 0743251b0..6117f08d5 100644 --- a/compiler/cpp/src/generate/t_hs_generator.cc +++ b/compiler/cpp/src/generate/t_hs_generator.cc @@ -201,6 +201,7 @@ void t_hs_generator::init_generator() { string t_hs_generator::hs_language_pragma() { return std::string("{-# LANGUAGE DeriveDataTypeable #-}\n" + "{-# OPTIONS_GHC -fno-warn-missing-fields #-}\n" "{-# OPTIONS_GHC -fno-warn-missing-signatures #-}\n" "{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n" "{-# OPTIONS_GHC -fno-warn-unused-imports #-}\n" @@ -232,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, fromInteger, toInteger, 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 Data.Word\nimport Prelude ((==), String, Eq, Show, Ord, Maybe(..), (&&), (||), return, IO, Enum, fromIntegral, fromEnum, toEnum, Bool(..), (++), ($), Double, (-), length)"; return result; } @@ -786,9 +787,9 @@ void t_hs_generator::generate_service_client(t_service* tservice) { else exports+=","; string funname = (*f_iter)->get_name(); - exports+=funname; + exports += decapitalize(funname); } - indent(f_client_) << "module " << capitalize(service_name_) << "_Client("<<exports<<") where" << endl; + indent(f_client_) << "module " << capitalize(service_name_) << "_Client(" << exports << ") where" << endl; if (tservice->get_extends() != NULL) { extends = type_name(tservice->get_extends()); @@ -816,7 +817,7 @@ void t_hs_generator::generate_service_client(t_service* tservice) { } // Open function - indent(f_client_) << funname << " (ip,op)" << fargs << " = do" << endl; + indent(f_client_) << decapitalize(funname) << " (ip,op)" << fargs << " = do" << endl; indent_up(); indent(f_client_) << "send_" << funname << " op" << fargs; @@ -993,7 +994,7 @@ void t_hs_generator::generate_process_function(t_service* tservice, t_function* tfunction) { // Open function indent(f_service_) << - "process_" << tfunction->get_name() << " (seqid, iprot, oprot, handler) = do" << endl; + "process_" << decapitalize(tfunction->get_name()) << " (seqid, iprot, oprot, handler) = do" << endl; indent_up(); string argsname = capitalize(tfunction->get_name()) + "_args"; @@ -1042,7 +1043,7 @@ void t_hs_generator::generate_process_function(t_service* tservice, if (!tfunction->is_oneway() && !tfunction->get_returntype()->is_void()){ f_service_ << "res <- "; } - f_service_ << "Iface." << tfunction->get_name() << " handler"; + f_service_ << "Iface." << decapitalize(tfunction->get_name()) << " handler"; for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) { f_service_ << " (f_" << argsname << "_" << (*f_iter)->get_name() << " args)"; } @@ -1155,7 +1156,7 @@ void t_hs_generator::generate_deserialize_type(ofstream &out, out << " iprot"; } else if (type->is_enum()) { string ename = capitalize(type->get_name()); - out << "(do {i <- readI32 iprot; return (toEnum i :: " << ename << ")})"; + out << "(do {i <- readI32 iprot; return $ toEnum $ fromIntegral i})"; } else { printf("DO NOT KNOW HOW TO DESERIALIZE TYPE '%s'\n", type->get_name().c_str()); @@ -1273,7 +1274,7 @@ void t_hs_generator::generate_serialize_field(ofstream &out, } else if (type->is_enum()) { string ename = capitalize(type->get_name()); - out << "writeI32 oprot (fromEnum "<< name << ")"; + out << "writeI32 oprot (fromIntegral $ fromEnum "<< name << ")"; } } else { @@ -1303,17 +1304,17 @@ void t_hs_generator::generate_serialize_container(ofstream &out, string v = tmp("_viter"); out << "(let {f [] = return (); f (("<<k<<","<<v<<"):t) = do {"; generate_serialize_map_element(out, (t_map*)ttype, k, v); - out << ";f t}} in do {writeMapBegin oprot ("<< type_to_enum(((t_map*)ttype)->get_key_type())<<","<< type_to_enum(((t_map*)ttype)->get_val_type())<<",Map.size " << prefix << "); f (Map.toList " << prefix << ");writeMapEnd oprot})"; + out << ";f t}} in do {writeMapBegin oprot ("<< type_to_enum(((t_map*)ttype)->get_key_type())<<","<< type_to_enum(((t_map*)ttype)->get_val_type())<<",fromIntegral $ Map.size " << prefix << "); f (Map.toList " << prefix << ");writeMapEnd oprot})"; } else if (ttype->is_set()) { string v = tmp("_viter"); out << "(let {f [] = return (); f ("<<v<<":t) = do {"; generate_serialize_set_element(out, (t_set*)ttype, v); - out << ";f t}} in do {writeSetBegin oprot ("<< type_to_enum(((t_set*)ttype)->get_elem_type())<<",Set.size " << prefix << "); f (Set.toList " << prefix << ");writeSetEnd oprot})"; + out << ";f t}} in do {writeSetBegin oprot ("<< type_to_enum(((t_set*)ttype)->get_elem_type())<<",fromIntegral $ Set.size " << prefix << "); f (Set.toList " << prefix << ");writeSetEnd oprot})"; } else if (ttype->is_list()) { string v = tmp("_viter"); out << "(let {f [] = return (); f ("<<v<<":t) = do {"; generate_serialize_list_element(out, (t_list*)ttype, v); - out << ";f t}} in do {writeListBegin oprot ("<< type_to_enum(((t_list*)ttype)->get_elem_type())<<",fromInteger $ toInteger $ Prelude.length " << prefix << "); f " << prefix << ";writeListEnd oprot})"; + out << ";f t}} in do {writeListBegin oprot ("<< type_to_enum(((t_list*)ttype)->get_elem_type())<<",fromIntegral $ Prelude.length " << prefix << "); f " << prefix << ";writeListEnd oprot})"; } } diff --git a/test/ConstantsDemo.thrift b/test/ConstantsDemo.thrift index bf414ec02..7d971e60f 100644 --- a/test/ConstantsDemo.thrift +++ b/test/ConstantsDemo.thrift @@ -29,15 +29,15 @@ enum enumconstants { TWO = 2 } -struct thing2 { - /** standard docstring */ - 1: enumconstants val = TWO -} +// struct thing2 { +// /** standard docstring */ +// 1: enumconstants val = TWO +// } typedef i32 myIntType const myIntType myInt = 3 -const map<enumconstants,string> GEN_ENUM_NAMES = {ONE : "HOWDY", TWO: PARTNER} +//const map<enumconstants,string> GEN_ENUM_NAMES = {ONE : "HOWDY", TWO: "PARTNER"} const i32 hex_const = 0x0001F diff --git a/test/hs/Client.hs b/test/hs/Client.hs index c5e4d9074..e69de29bb 100644 --- a/test/hs/Client.hs +++ b/test/hs/Client.hs @@ -1,58 +0,0 @@ --- --- 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 Client where - -import ThriftTest_Client -import ThriftTest_Types -import qualified Data.Map as Map -import qualified Data.Set as Set -import Control.Monad -import Control.Exception as CE - -import Network - -import Thrift -import Thrift.Transport.Handle -import Thrift.Protocol.Binary - - -serverAddress = ("127.0.0.1", PortNumber 9090) - -main = do to <- hOpen serverAddress - let p = BinaryProtocol to - let ps = (p,p) - print =<< testString ps "bya" - print =<< testByte ps 8 - print =<< testByte ps (-8) - print =<< testI32 ps 32 - print =<< testI32 ps (-32) - print =<< testI64 ps 64 - print =<< testI64 ps (-64) - print =<< testDouble ps 3.14 - print =<< testDouble ps (-3.14) - print =<< testMap ps (Map.fromList [(1,1),(2,2),(3,3)]) - print =<< testList ps [1,2,3,4,5] - print =<< testSet ps (Set.fromList [1,2,3,4,5]) - print =<< testStruct ps (Xtruct (Just "hi") (Just 4) (Just 5) Nothing) - CE.catch (testException ps "e" >> print "bad") (\e -> print (e :: Xception)) - CE.catch (testMultiException ps "e" "e2" >> print "ok") (\e -> print (e :: Xception)) - CE.catch (CE.catch (testMultiException ps "e" "e2">> print "bad") (\e -> print (e :: Xception2))) (\(e :: SomeException) -> print "ok") - tClose to - diff --git a/test/hs/ConstantsDemo_TestClient.hs b/test/hs/ConstantsDemo_TestClient.hs new file mode 100644 index 000000000..1cc350dee --- /dev/null +++ b/test/hs/ConstantsDemo_TestClient.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE ScopedTypeVariables #-} +-- +-- 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 ConstantsDemo_TestClient where + + +import Network + +import Thrift +import Thrift.Protocol.Binary +import Thrift.Transport.Handle + +import Yowza_Client + + +serverAddress :: (String, PortID) +serverAddress = ("127.0.0.1", PortNumber 9090) + +main :: IO () +main = do + to <- hOpen serverAddress + let p = BinaryProtocol to + let ps = (p,p) + blingity ps + print =<< blangity ps + tClose to + diff --git a/test/hs/ConstantsDemo_TestServer.hs b/test/hs/ConstantsDemo_TestServer.hs new file mode 100644 index 000000000..10b2177e9 --- /dev/null +++ b/test/hs/ConstantsDemo_TestServer.hs @@ -0,0 +1,47 @@ +-- +-- 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 ConstantsDemo_TestServer where + + +import Control.Exception + +import Thrift +import Thrift.Server + +import Yowza +import Yowza_Iface + + +data YowzaHandler = YowzaHandler +instance Yowza_Iface YowzaHandler where + blingity _ = do + print $ "Got blingity" + return () + + blangity _ = do + print $ "Got blangity" + return $ 31 + + +main :: IO () +main = do putStrLn "Server ready..." + (runBasicServer YowzaHandler process 9090) + `Control.Exception.catch` + (\(TransportExn s _) -> print s) diff --git a/test/hs/DebugProtoTest_TestClient.hs b/test/hs/DebugProtoTest_TestClient.hs new file mode 100644 index 000000000..fc1582b7a --- /dev/null +++ b/test/hs/DebugProtoTest_TestClient.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE ScopedTypeVariables #-} +-- +-- 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 DebugProtoTest_TestClient where + + +import Network + +import Thrift.Transport.Handle +import Thrift.Protocol.Binary + +import Inherited_Client +import Srv_Client + + +serverAddress :: (String, PortID) +serverAddress = ("127.0.0.1", PortNumber 9090) + +main :: IO () +main = do to <- hOpen serverAddress + let p = BinaryProtocol to + let ps = (p,p) + print =<< janky ps 42 + voidMethod ps + _ <- primitiveMethod ps + _ <- structMethod ps + methodWithDefaultArgs ps 42 + onewayMethod ps + _ <- identity ps 42 + return () + + diff --git a/test/hs/DebugProtoTest_TestServer.hs b/test/hs/DebugProtoTest_TestServer.hs new file mode 100644 index 000000000..af3e5a9b0 --- /dev/null +++ b/test/hs/DebugProtoTest_TestServer.hs @@ -0,0 +1,125 @@ +-- +-- 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 DebugProtoTest_TestServer where + + +import Control.Exception +import qualified Data.ByteString.Lazy as DBL +import Maybe + +import Thrift +import Thrift.Server + +import DebugProtoTest_Types +import Inherited +import Inherited_Iface +import Srv_Iface + + +data InheritedHandler = InheritedHandler +instance Srv_Iface InheritedHandler where + janky _ arg = do + print $ "Got janky method call: " ++ show arg + return $ 31 + + voidMethod _ = do + print "Got voidMethod method call" + return () + + primitiveMethod _ = do + print "Got primitiveMethod call" + return $ 42 + + structMethod _ = do + print "Got structMethod call" + return $ CompactProtoTestStruct { + f_CompactProtoTestStruct_a_byte = Just 0x01, + f_CompactProtoTestStruct_a_i16 = Just 0x02, + f_CompactProtoTestStruct_a_i32 = Just 0x03, + f_CompactProtoTestStruct_a_i64 = Just 0x04, + f_CompactProtoTestStruct_a_double = Just 0.1, + f_CompactProtoTestStruct_a_string = Just "abcdef", + f_CompactProtoTestStruct_a_binary = Just DBL.empty, + f_CompactProtoTestStruct_true_field = Just True, + f_CompactProtoTestStruct_false_field = Just False, + f_CompactProtoTestStruct_empty_struct_field = Just Empty, + + f_CompactProtoTestStruct_byte_list = Nothing, + f_CompactProtoTestStruct_i16_list = Nothing, + f_CompactProtoTestStruct_i32_list = Nothing, + f_CompactProtoTestStruct_i64_list = Nothing, + f_CompactProtoTestStruct_double_list = Nothing, + f_CompactProtoTestStruct_string_list = Nothing, + f_CompactProtoTestStruct_binary_list = Nothing, + f_CompactProtoTestStruct_boolean_list = Nothing, + f_CompactProtoTestStruct_struct_list = Just [Empty], + + f_CompactProtoTestStruct_byte_set = Nothing, + f_CompactProtoTestStruct_i16_set = Nothing, + f_CompactProtoTestStruct_i32_set = Nothing, + f_CompactProtoTestStruct_i64_set = Nothing, + f_CompactProtoTestStruct_double_set = Nothing, + f_CompactProtoTestStruct_string_set = Nothing, + f_CompactProtoTestStruct_binary_set = Nothing, + f_CompactProtoTestStruct_boolean_set = Nothing, + f_CompactProtoTestStruct_struct_set = Nothing, + + f_CompactProtoTestStruct_byte_byte_map = Nothing, + f_CompactProtoTestStruct_i16_byte_map = Nothing, + f_CompactProtoTestStruct_i32_byte_map = Nothing, + f_CompactProtoTestStruct_i64_byte_map = Nothing, + f_CompactProtoTestStruct_double_byte_map = Nothing, + f_CompactProtoTestStruct_string_byte_map = Nothing, + f_CompactProtoTestStruct_binary_byte_map = Nothing, + f_CompactProtoTestStruct_boolean_byte_map = Nothing, + + f_CompactProtoTestStruct_byte_i16_map = Nothing, + f_CompactProtoTestStruct_byte_i32_map = Nothing, + f_CompactProtoTestStruct_byte_i64_map = Nothing, + f_CompactProtoTestStruct_byte_double_map = Nothing, + f_CompactProtoTestStruct_byte_string_map = Nothing, + f_CompactProtoTestStruct_byte_binary_map = Nothing, + f_CompactProtoTestStruct_byte_boolean_map = Nothing, + + f_CompactProtoTestStruct_list_byte_map = Nothing, + f_CompactProtoTestStruct_set_byte_map = Nothing, + f_CompactProtoTestStruct_map_byte_map = Nothing, + + f_CompactProtoTestStruct_byte_map_map = Nothing, + f_CompactProtoTestStruct_byte_set_map = Nothing, + f_CompactProtoTestStruct_byte_list_map = Nothing } + + methodWithDefaultArgs _ arg = do + print $ "Got methodWithDefaultArgs: " ++ show arg + return () + + onewayMethod _ = do + print "Got onewayMethod" + +instance Inherited_Iface InheritedHandler where + identity _ arg = do + print $ "Got identity method: " ++ show arg + return $ fromJust arg + +main :: IO () +main = do putStrLn "Server ready..." + (runBasicServer InheritedHandler process 9090) + `Control.Exception.catch` + (\(TransportExn s _) -> print s) diff --git a/test/hs/Server.hs b/test/hs/Server.hs index 0ca9d9fea..e69de29bb 100644 --- a/test/hs/Server.hs +++ b/test/hs/Server.hs @@ -1,57 +0,0 @@ --- --- 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 Server where - -import ThriftTest -import ThriftTest_Iface -import Data.Map as Map -import Control.Exception -import ThriftTest_Types - -import Thrift -import Thrift.Server - - -data TestHandler = TestHandler -instance ThriftTest_Iface TestHandler where - testVoid a = return () - testString a (Just s) = do print s; return s - testByte a (Just x) = do print x; return x - testI32 a (Just x) = do print x; return x - testI64 a (Just x) = do print x; return x - testDouble a (Just x) = do print x; return x - testStruct a (Just x) = do print x; return x - testNest a (Just x) = do print x; return x - testMap a (Just x) = do print x; return x - testSet a (Just x) = do print x; return x - testList a (Just x) = do print x; return x - testEnum a (Just x) = do print x; return x - testTypedef a (Just x) = do print x; return x - testMapMap a (Just x) = return (Map.fromList [(1,Map.fromList [(2,2)])]) - testInsanity a (Just x) = return (Map.fromList [(1,Map.fromList [(ONE,x)])]) - testMulti a a1 a2 a3 a4 a5 a6 = return (Xtruct Nothing Nothing Nothing Nothing) - testException a c = throw (Xception (Just 1) (Just "bya")) - testMultiException a c1 c2 = throw (Xception (Just 1) (Just "xyz")) - testOneway a (Just i) = do print i - - -main = do (runBasicServer TestHandler process 9090) - `Control.Exception.catch` - (\(TransportExn s t) -> print s) diff --git a/test/hs/ThriftTest_TestClient.hs b/test/hs/ThriftTest_TestClient.hs new file mode 100644 index 000000000..4aca27561 --- /dev/null +++ b/test/hs/ThriftTest_TestClient.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE ScopedTypeVariables #-} +-- +-- 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 ThriftTest_TestClient where + + +import Control.Exception as CE +import qualified Data.Map as Map +import qualified Data.Set as Set +import Network + +import Thrift +import Thrift.Transport.Handle +import Thrift.Protocol.Binary + +import ThriftTest_Client +import ThriftTest_Types + + +serverAddress :: (String, PortID) +serverAddress = ("127.0.0.1", PortNumber 9090) + +main :: IO () +main = do to <- hOpen serverAddress + let p = BinaryProtocol to + let ps = (p,p) + print =<< testString ps "bya" + print =<< testByte ps 8 + print =<< testByte ps (-8) + print =<< testI32 ps 32 + print =<< testI32 ps (-32) + print =<< testI64 ps 64 + print =<< testI64 ps (-64) + print =<< testDouble ps 3.14 + print =<< testDouble ps (-3.14) + print =<< testMap ps (Map.fromList [(1,1),(2,2),(3,3)]) + print =<< testList ps [1,2,3,4,5] + print =<< testSet ps (Set.fromList [1,2,3,4,5]) + print =<< testStruct ps (Xtruct (Just "hi") (Just 4) (Just 5) Nothing) + CE.catch (testException ps "e" >> print "bad") (\e -> print (e :: Xception)) + CE.catch (testMultiException ps "e" "e2" >> print "ok") (\e -> print (e :: Xception)) + CE.catch (CE.catch (testMultiException ps "e" "e2">> print "bad") (\e -> print (e :: Xception2))) (\(_ :: SomeException) -> print "ok") + tClose to + diff --git a/test/hs/ThriftTest_TestServer.hs b/test/hs/ThriftTest_TestServer.hs new file mode 100644 index 000000000..fbfcd5349 --- /dev/null +++ b/test/hs/ThriftTest_TestServer.hs @@ -0,0 +1,152 @@ +-- +-- 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 _ 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 ThriftTest_TestServer where + +import ThriftTest +import ThriftTest_Iface +import Data.Map as Map +import Control.Exception +import ThriftTest_Types + +import Thrift +import Thrift.Server + + +data TestHandler = TestHandler +instance ThriftTest_Iface TestHandler where + testVoid _ = return () + + testString _ (Just s) = do + print s + return s + + testString _ Nothing = do + error $ "Unsupported testString form" + + testByte _ (Just x) = do + print x + return x + + testByte _ Nothing = do + error $ "Unsupported testByte form" + + testI32 _ (Just x) = do + print x + return x + + testI32 _ Nothing = do + error $ "Unsupported testI32 form" + + testI64 _ (Just x) = do + print x + return x + + testI64 _ Nothing = do + error $ "Unsupported testI64 form" + + testDouble _ (Just x) = do + print x + return x + + testDouble _ Nothing = do + error $ "Unsupported testDouble form" + + testStruct _ (Just x) = do + print x + return x + + testStruct _ Nothing = do + error $ "Unsupported testStruct form" + + testNest _ (Just x) = do + print x + return x + + testNest _ Nothing = do + error $ "Unsupported testNest form" + + testMap _ (Just x) = do + print x + return x + + testMap _ Nothing = do + error $ "Unsupported testMap form" + + testSet _ (Just x) = do + print x + return x + + testSet _ Nothing = do + error $ "Unsupported testSet form" + + testList _ (Just x) = do + print x + return x + + testList _ Nothing = do + error $ "Unsupported testList form" + + testEnum _ (Just x) = do + print x + return x + + testEnum _ Nothing = do + error $ "Unsupported testEnum form" + + testTypedef _ (Just x) = do + print x + return x + + testTypedef _ Nothing = do + error $ "Unsupported testTypedef form" + + testMapMap _ (Just _) = do + return (Map.fromList [(1, Map.fromList [(2, 2)])]) + + testMapMap _ Nothing = do + error $ "Unsupported testMapMap form" + + testInsanity _ (Just x) = do + return (Map.fromList [(1, Map.fromList [(ONE, x)])]) + + testInsanity _ Nothing = do + error $ "Unsupported testInsanity form" + + testMulti _ _ _ _ _ _ _ = do + return (Xtruct Nothing Nothing Nothing Nothing) + + testException _ _ = do + throw (Xception (Just 1) (Just "bya")) + + testMultiException _ _ _ = do + throw (Xception (Just 1) (Just "xyz")) + + testOneway _ (Just i) = do + print i + + testOneway _ Nothing = do + error $ "Unsupported testOneway form" + + +main :: IO () +main = do putStrLn "Server ready..." + (runBasicServer TestHandler process 9090) + `Control.Exception.catch` + (\(TransportExn s _) -> print s) diff --git a/test/hs/runclient.sh b/test/hs/runclient.sh index b93bbb147..aab9f174c 100644 --- a/test/hs/runclient.sh +++ b/test/hs/runclient.sh @@ -19,8 +19,50 @@ # under the License. # +# Check some basic if [ -z $BASE ]; then BASE=../.. fi -ghci -fglasgow-exts -i$BASE/lib/hs/src -i$BASE/test/hs/gen-hs Client.hs +if [ -z $OUTDIR ]; then + OUTDIR=client-bindings +fi + +if [ -z $THRIFT_BIN ]; then + THRIFT_BIN=$(which thrift) +fi + +if [ ! -x "$THRIFT_BIN" ]; then + printf "Could not find thrift binary; pass it as environment variable THRIFT_BIN\n" + exit 1 +fi + +# Figure out what file to generate bindings from +if [ -z $THRIFT_FILE ]; then + THRIFT_FILE=$BASE/test/$1.thrift +fi + +if [ ! -e $THRIFT_FILE ]; then + printf "Missing thrift file $THRIFT_FILE \n" + exit 2 +fi + +# Figure out what file to run has a client +if [ -z $CLIENT_FILE ]; then + CLIENT_FILE=$BASE/test/hs/$1_TestClient.hs +fi + +if [ ! -e $CLIENT_FILE ]; then + printf "Missing client code file $CLIENT_FILE \n" + exit 3 +fi + +# Actually run the client bits +printf "Creating directory $OUTDIR to hold generated bindings... \n" +[ -d $OUTDIR ] || mkdir $OUTDIR + +printf "Generating bindings... \n" +$THRIFT_BIN -o $OUTDIR --gen hs $THRIFT_FILE + +printf "Starting client... \n" +runhaskell -Wall -Werror -i$BASE/lib/hs/src -i$OUTDIR/gen-hs $CLIENT_FILE diff --git a/test/hs/runserver.sh b/test/hs/runserver.sh index b23301b48..9189d3004 100644 --- a/test/hs/runserver.sh +++ b/test/hs/runserver.sh @@ -19,9 +19,50 @@ # under the License. # +# Check some basic if [ -z $BASE ]; then BASE=../.. fi -printf "Starting server... " -ghc -fglasgow-exts -i$BASE/lib/hs/src -i$BASE/test/hs/gen-hs Server.hs -e "putStrLn \"ready.\" >> Server.main" +if [ -z $OUTDIR ]; then + OUTDIR=server-bindings +fi + +if [ -z $THRIFT_BIN ]; then + THRIFT_BIN=$(which thrift) +fi + +if [ ! -x "$THRIFT_BIN" ]; then + printf "Could not find thrift binary; pass it as environment variable THRIFT_BIN\n" + exit 1 +fi + +# Figure out what file to generate bindings from +if [ -z $THRIFT_FILE ]; then + THRIFT_FILE=$BASE/test/$1.thrift +fi + +if [ ! -e $THRIFT_FILE ]; then + printf "Missing thrift file $THRIFT_FILE \n" + exit 2 +fi + +# Figure out what file to run has a server +if [ -z $SERVER_FILE ]; then + SERVER_FILE=$BASE/test/hs/$1_TestServer.hs +fi + +if [ ! -e $SERVER_FILE ]; then + printf "Missing server code file $SERVER_FILE \n" + exit 3 +fi + +# Actually run the server bits +printf "Creating directory $OUTDIR to hold generated bindings... \n" +[ -d $OUTDIR ] || mkdir $OUTDIR + +printf "Generating bindings... \n" +$THRIFT_BIN -o $OUTDIR --gen hs $THRIFT_FILE + +printf "Starting server... \n" +runhaskell -Wall -Werror -i$BASE/lib/hs/src -i$OUTDIR/gen-hs $SERVER_FILE |