ceph/src/jaegertracing/thrift/tutorial/hs/HaskellServer.hs

   1 --
   2 -- Licensed to the Apache Software Foundation (ASF) under one
   3 -- or more contributor license agreements. See the NOTICE file
   4 -- distributed with this work for additional information
   5 -- regarding copyright ownership. The ASF licenses this file
   6 -- to you under the Apache License, Version 2.0 (the
   7 -- "License"); you may not use this file except in compliance
   8 -- with the License. You may obtain a copy of the License at
   9 --
  10 --   http://www.apache.org/licenses/LICENSE-2.0
  11 --
  12 -- Unless required by applicable law or agreed to in writing,
  13 -- software distributed under the License is distributed on an
  14 -- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
  15 -- KIND, either express or implied. See the License for the
  16 -- specific language governing permissions and limitations
  17 -- under the License.
  18 --
  19
  20 {-# LANGUAGE OverloadedStrings #-}
  21
  22 import qualified Calculator
  23 import Calculator_Iface
  24 import Tutorial_Types
  25 import SharedService_Iface
  26 import Shared_Types
  27
  28 import Thrift
  29 import Thrift.Protocol.Binary
  30 import Thrift.Transport
  31 import Thrift.Server
  32
  33 import Data.Int
  34 import Data.String
  35 import Data.Maybe
  36 import Text.Printf
  37 import Control.Exception (throw)
  38 import Control.Concurrent.MVar
  39 import qualified Data.Map as M
  40 import Data.Map ((!))
  41 import Data.Monoid
  42
  43 data CalculatorHandler = CalculatorHandler {mathLog :: MVar (M.Map Int32 SharedStruct)}
  44
  45 newCalculatorHandler = do
  46   log <- newMVar mempty
  47   return $ CalculatorHandler log
  48
  49 instance SharedService_Iface CalculatorHandler where
  50   getStruct self k = do
  51     myLog <- readMVar (mathLog self)
  52     return $ (myLog ! k)
  53
  54
  55 instance Calculator_Iface CalculatorHandler where
  56   ping _ =
  57     print "ping()"
  58
  59   add _ n1 n2 = do
  60     printf "add(%d,%d)\n" n1 n2
  61     return (n1 + n2)
  62
  63   calculate self mlogid mwork = do
  64     printf "calculate(%d, %s)\n" logid (show work)
  65
  66     let val = case op work of
  67                 ADD ->
  68                     num1 work + num2 work
  69                 SUBTRACT ->
  70                     num1 work - num2 work
  71                 MULTIPLY ->
  72                     num1 work * num2 work
  73                 DIVIDE ->
  74                     if num2 work == 0 then
  75                         throw $
  76                               InvalidOperation {
  77                                  invalidOperation_whatOp = fromIntegral $ fromEnum $ op work,
  78                                  invalidOperation_why = "Cannot divide by 0"
  79                                             }
  80                     else
  81                         num1 work `div` num2 work
  82
  83     let logEntry = SharedStruct logid (fromString $ show $ val)
  84     modifyMVar_ (mathLog self) $ return .(M.insert logid logEntry)
  85
  86     return $! val
  87
  88    where
  89      -- stupid dynamic languages f'ing it up
  90      num1 = work_num1
  91      num2 = work_num2
  92      op = work_op
  93      logid = mlogid
  94      work = mwork
  95
  96   zip _ =
  97     print "zip()"
  98
  99 main =  do
 100   handler <- newCalculatorHandler
 101   print "Starting the server..."
 102   runBasicServer handler Calculator.process 9090
 103   print "done."