All Apache Thrift tutorials require that you have:
thrift -r --gen hs tutorial.thrift
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 Control.Exception
import Data.Maybe
import Data.Text.Lazy
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 { work_op = Operation_DIVIDE,
work_num1 = 1,
work_num2 = 0,
work_comment = Nothing
}
Control.Exception.catch (printf "1/0=%d\n" =<< Client.calculate client 1 work)
(\e -> printf "InvalidOperation %s\n" (show (e :: InvalidOperation)))
let work = Work { work_op = Operation_SUBTRACT,
work_num1 = 15,
work_num2 = 10,
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" $ unpack $ sharedStruct_value log
-- Close!
{-# LANGUAGE OverloadedStrings #-}
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.Int
import Data.String
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 Int32 SharedStruct)}
newCalculatorHandler = do
log <- newMVar mempty
return $ CalculatorHandler log
instance SharedService_Iface CalculatorHandler where
getStruct self k = do
myLog <- readMVar (mathLog self)
return $ (myLog ! k)
instance Calculator_Iface CalculatorHandler where
ping _ =
print "ping()"
add _ n1 n2 = do
printf "add(%d,%d)\n" n1 n2
return (n1 + n2)
calculate self mlogid mwork = do
printf "calculate(%d, %s)\n" logid (show work)
let val = case op work of
Operation_ADD ->
num1 work + num2 work
Operation_SUBTRACT ->
num1 work - num2 work
Operation_MULTIPLY ->
num1 work * num2 work
Operation_DIVIDE ->
if num2 work == 0 then
throw $
InvalidOperation {
invalidOperation_whatOp = fromIntegral $ fromEnum $ op work,
invalidOperation_why = "Cannot divide by 0"
}
else
num1 work `div` num2 work
let logEntry = SharedStruct logid (fromString $ show $ val)
modifyMVar_ (mathLog self) $ return .(M.insert logid logEntry)
return $! val
where
-- stupid dynamic languages f'ing it up
num1 = work_num1
num2 = work_num2
op = work_op
logid = mlogid
work = mwork
zip _ =
print "zip()"
main = do
handler <- newCalculatorHandler
print "Starting the server..."
runBasicServer handler Calculator.process 9090