THRIFT-560. haskell: Add tutorial

git-svn-id: https://svn.apache.org/repos/asf/incubator/thrift/trunk@898015 13f79535-47bb-0310-9956-ffa450edef68

3 files changed, 206 insertions, 0 deletions

diff --git a/tutorial/hs/HaskellClient.hs b/tutorial/hs/HaskellClient.hs
new file mode 100644
index 000000000..a56187b6a
--- /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 000000000..4f9ab7c99
--- /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 000000000..381f32a75
--- /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