From: David Reiss Date: Mon, 11 Jan 2010 19:13:18 +0000 (+0000) Subject: THRIFT-560. haskell: Add tutorial X-Git-Tag: 0.3.0~141 X-Git-Url: https://source.supwisdom.com/gerrit/gitweb?a=commitdiff_plain;h=68f8c389bd00ef179b6b0bd03a7aadcbe2cfd05a;p=common%2Fthrift.git THRIFT-560. haskell: Add tutorial git-svn-id: https://svn.apache.org/repos/asf/incubator/thrift/trunk@898015 13f79535-47bb-0310-9956-ffa450edef68 --- diff --git a/tutorial/hs/HaskellClient.hs b/tutorial/hs/HaskellClient.hs new file mode 100644 index 00000000..a56187b6 --- /dev/null +++ b/tutorial/hs/HaskellClient.hs @@ -0,0 +1,75 @@ +-- +-- 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. +-- + +import qualified Calculator +import qualified Calculator_Client as Client +import qualified SharedService_Client as SClient +import Tutorial_Types +import SharedService_Iface +import Shared_Types + +import Thrift +import Thrift.Protocol.Binary +import Thrift.Transport +import Thrift.Transport.Handle +import Thrift.Server + +import Data.Maybe +import Text.Printf +import Network + +main = do + transport <- hOpen ("localhost", PortNumber 9090) + let binProto = BinaryProtocol transport + let client = (binProto, binProto) + + Client.ping client + print "ping()" + + sum <- Client.add client 1 1 + printf "1+1=%d\n" sum + + + let work = Work { f_Work_op = Just DIVIDE, + f_Work_num1 = Just 1, + f_Work_num2 = Just 0, + f_Work_comment = Nothing + } + + -- TODO - get this one working + --catch (Client.calculate client 1 work) (\except -> + -- printf "InvalidOp %s" (show except)) + + + let work = Work { f_Work_op = Just SUBTRACT, + f_Work_num1 = Just 15, + f_Work_num2 = Just 10, + f_Work_comment = Nothing + } + + diff <- Client.calculate client 1 work + printf "15-10=%d\n" diff + + log <- SClient.getStruct client 1 + printf "Check log: %s\n" $ fromJust $ f_SharedStruct_value log + + -- Close! + tClose transport + + diff --git a/tutorial/hs/HaskellServer.hs b/tutorial/hs/HaskellServer.hs new file mode 100644 index 00000000..4f9ab7c9 --- /dev/null +++ b/tutorial/hs/HaskellServer.hs @@ -0,0 +1,102 @@ +-- +-- 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. +-- + +import qualified Calculator +import Calculator_Iface +import Tutorial_Types +import SharedService_Iface +import Shared_Types + +import Thrift +import Thrift.Protocol.Binary +import Thrift.Transport +import Thrift.Server + +import Data.Maybe +import Text.Printf +import Control.Exception (throw) +import Control.Concurrent.MVar +import qualified Data.Map as M +import Data.Map ((!)) +import Data.Monoid + +data CalculatorHandler = CalculatorHandler {mathLog :: MVar (M.Map Int SharedStruct)} + +newCalculatorHandler = do + log <- newMVar mempty + return $ CalculatorHandler log + +instance SharedService_Iface CalculatorHandler where + getStruct self k = do + myLog <- readMVar (mathLog self) + return $ (myLog ! (fromJust k)) + + +instance Calculator_Iface CalculatorHandler where + ping _ = + print "ping()" + + add _ n1 n2 = do + printf "add(%d,%d)\n" (fromJust n1) (fromJust n2) + return ((fromJust n1)+(fromJust n2)) + + calculate self mlogid mwork = do + printf "calculate(%d, %s)\n" logid (show work) + + let val = case op work of + ADD -> + num1 work + num2 work + SUBTRACT -> + num1 work - num2 work + MULTIPLY -> + num1 work * num2 work + DIVIDE -> + if num2 work == 0 then + throw $ + InvalidOperation { + f_InvalidOperation_what = Just $ fromEnum $ op work, + f_InvalidOperation_why = Just "Cannot divide by 0" + } + else + num1 work `div` num2 work + + let logEntry = SharedStruct (Just logid) (Just (show val)) + modifyMVar_ (mathLog self) $ return .(M.insert logid logEntry) + + return val + + where + -- stupid dynamic languages f'ing it up + num1 = fromJust . f_Work_num1 + num2 = fromJust . f_Work_num2 + op = fromJust . f_Work_op + logid = fromJust mlogid + work = fromJust mwork + + + --return val + + zip _ = + print "zip()" + +main = do + handler <- newCalculatorHandler + print "Starting the server..." + runBasicServer handler Calculator.process 9090 + print "done." diff --git a/tutorial/hs/ThriftTutorial.cabal b/tutorial/hs/ThriftTutorial.cabal new file mode 100644 index 00000000..381f32a7 --- /dev/null +++ b/tutorial/hs/ThriftTutorial.cabal @@ -0,0 +1,29 @@ +Name: ThriftTutorial +Version: 0.1.0 +Cabal-Version: >= 1.2 +License: Apache2 +Category: Foreign +Build-Type: Simple +Synopsis: Thrift Tutorial library package + +Executable HaskellServer + Main-is: HaskellServer.hs + Hs-Source-Dirs: + ., ../gen-hs/ + Build-Depends: + base >=4, network, ghc-prim, containers, Thrift + ghc-options: + -fglasgow-exts + Extensions: + DeriveDataTypeable + +Executable HaskellClient + Main-is: HaskellClient.hs + Hs-Source-Dirs: + ., ../gen-hs/ + Build-Depends: + base >=4, network, ghc-prim, containers, Thrift + ghc-options: + -fglasgow-exts + Extensions: + DeriveDataTypeable