BatcherExample.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}

module Glue.Example.BatcherExample(
    batcherExample
) where

import Glue
import Control.Concurrent.Async
import Control.Concurrent.Lifted
import Data.IORef.Lifted
import qualified Data.List as L
import Data.Text
import Data.Traversable
import System.Metrics
import qualified System.Metrics.Distribution as D
import qualified Data.HashSet as S
import qualified Data.HashMap.Strict as M
import Text.Printf

printStats :: Store -> Text -> IO ()
printStats store name = do
  samples <- sampleAll store
  let possibleValue = M.lookup name samples
  case possibleValue of
                        (Just (Distribution stats)) -> printf "%s - sum : %f - count : %d" (unpack name) (D.sum stats) (D.count stats) >> putStrLn ""
                        otherwise                   -> return ()

runTest :: Store -> Text -> Bool -> IO ()
runTest store name shouldBatch = do
  counter <- newIORef 0
  let listOfNums = [1..50]
  let requests = fmap (S.fromList . L.take 10) $ L.tails listOfNums :: [S.HashSet Int]
  let service request = do
                          atomicModifyIORef' counter (\c -> (c + (S.size request), ()))
                          threadDelay (500 * S.size request)
                          return $ M.fromList $ fmap (\r -> (r, r * 2)) $ S.toList request
  statsWrappedService <- recordDistribution store name service
  possiblyBatchedService <- if shouldBatch then return statsWrappedService else fmap (\(_, b) -> b) $ batchingService defaultBatchingOptions statsWrappedService
  (mapConcurrently possiblyBatchedService requests)
  printStats store name

-- Tests the batchingService by comparing the stats with and without it.
batcherExample :: IO ()
batcherExample = do
  store <- newStore
  runTest store "Unbatched Service" False
  runTest store "Batched Service" True