StatsSpec.hs

{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, ScopedTypeVariables #-}

module Glue.StatsSpec where

import Data.Int
import Data.Typeable
import Glue.Stats
import Glue.Types
import Test.QuickCheck.Instances()
import Test.Hspec
import Data.Text
import Test.QuickCheck
import Control.Exception.Base hiding (throw, throwIO)
import Control.Exception.Lifted
import System.Metrics
import qualified System.Metrics.Distribution as MD
import qualified Data.HashMap.Strict as M

data StatsTestException = StatsTestException deriving (Eq, Show, Typeable)
instance Exception StatsTestException

data MetricsResult = CounterResult Int64
                   | GaugeResult Int64
                   | LabelResult Text
                   | DistributionResult Int64
                    deriving (Eq, Show)

checkResult :: Store -> Text -> (MetricsResult -> Expectation) -> Expectation
checkResult store name check = do
  allMetrics <- sampleAll store
  let possibleValue = M.lookup name allMetrics
  result <- case possibleValue of
                (Just (Counter counterCount)) -> return $ CounterResult counterCount
                (Just (Gauge value))          -> return $ GaugeResult value
                (Just (Label text))           -> return $ LabelResult text
                (Just (Distribution stats))   -> return $ DistributionResult $ MD.count stats
                Nothing                       -> fail "No metric."
  check result

testStats :: String -> 
            (Store -> Text -> BasicService IO Int Int -> IO (BasicService IO Int Int)) ->
            (Int -> Int -> MetricsResult -> Expectation) ->
            (Int -> Int -> MetricsResult -> Expectation) ->
            Spec
testStats methodName method successCheck failureCheck = 
  describe methodName $ do
    it "Successful call" $ do
      property $ \(request :: Int, result :: Int, name :: Text) -> do
        let service _ = return result :: IO Int
        store <- newStore
        wrappedService <- method store name service :: IO (BasicService IO Int Int)
        (wrappedService request) `shouldReturn` result
        checkResult store name $ successCheck request result
    it "Failing call" $ do
      property $ \(request :: Int, result :: Int, name :: Text) -> do
        let service _ = throwIO StatsTestException :: IO Int
        store <- newStore
        wrappedService <- method store name service :: IO (BasicService IO Int Int)
        (wrappedService request) `shouldThrow` (== StatsTestException)
        checkResult store name $ failureCheck request result

spec :: Spec
spec = parallel $ do
  testStats "recordDistribution" recordDistribution (\_ -> \_ -> \m -> m `shouldBe` (DistributionResult 1)) (\_ -> \_ -> \m -> m `shouldBe` (DistributionResult 1))
  testStats "recordAttempts" recordAttempts (\_ -> \_ -> \m -> m `shouldBe` (CounterResult 1)) (\_ -> \_ -> \m -> m `shouldBe` (CounterResult 1))
  testStats "recordSuccesses" recordSuccesses (\_ -> \_ -> \m -> m `shouldBe` (CounterResult 1)) (\_ -> \_ -> \m -> m `shouldBe` (CounterResult 0))
  testStats "recordFailures" recordFailures (\_ -> \_ -> \m -> m `shouldBe` (CounterResult 0)) (\_ -> \_ -> \m -> m `shouldBe` (CounterResult 1))
  testStats "recordLastRequest" recordLastRequest (\r -> \_ -> \m -> m `shouldBe` (LabelResult $ pack $ show r)) (\r -> \_ -> \m -> m `shouldBe` (LabelResult $ pack $ show r))
  testStats "recordLastResult" recordLastResult (\_ -> \r -> \m -> m `shouldBe` (LabelResult $ pack $ show r)) (\_ -> \_ -> \m -> m `shouldBe` (LabelResult ""))