Haskell Tutorial


Introduction

All Apache Thrift tutorials require that you have:

  1. Built and installed the Apache Thrift Compiler and Libraries, see Building from source for more details.
  2. Generated the tutorial.thrift and shared.thrift files as discussed here

    thrift -r --gen hs tutorial.thrift
    
  3. Followed all prerequesets listed

Prerequisites

Client

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

Server

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."

Additional Information