Worker.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
module Instrument.Tests.Worker
    ( tests
    ) where


-------------------------------------------------------------------------------
import qualified Data.Map                   as M
import           Data.Monoid                as Monoid
import           Test.Tasty
import           Test.Tasty.HUnit
import           Test.Tasty.QuickCheck
-------------------------------------------------------------------------------
import           Instrument.Tests.Arbitrary ()
import           Instrument.Types
import           Instrument.Worker
-------------------------------------------------------------------------------


tests :: TestTree
tests = testGroup "Instrument.Worker"
  [ expandDimsTests
  ]


-------------------------------------------------------------------------------
expandDimsTests :: TestTree
expandDimsTests = testGroup "expandDims"
  [ testProperty "input is a submap of output" $ \(Dims dims) ->
      let res = expandDims dims
      in counterexample
           ("Expected " <> show dims <> " to be a submap of " <> show res)
           (dims `M.isSubmapOf` res)
  , testProperty "always includes an aggregate with no dimensions" $ \(Dims dims) ->
      let res = expandDims dims
      in M.member Monoid.mempty res
  --TODO: more and then a test of the worked example
  , testProperty "no one member exceeds the total number of packets" $ \(Dims dims) ->
      let totalPacketCount = sum (length <$> dims)
          res = expandDims dims
          lengths = length <$> res
      in all (<= totalPacketCount) lengths
  , testCase "worked example from the readme" $ do
      let m = M.fromList [
             (M.fromList [(d1, d1v1), (d2, d2v1)], [p1])
           , (M.fromList [(d1, d1v1), (d2, d2v2)], [p2])
           ]
      let expected = M.fromList [
             (M.fromList [(d1, d1v1), (d2, d2v1)], [p1])
           , (M.fromList [(d1, d1v1), (d2, d2v2)], [p2])
           -- additions
           , (M.fromList [(d1, d1v1)], [p1, p2])
           , (M.fromList [(d2, d2v1)], [p1])
           , (M.fromList [(d2, d2v2)], [p2])
           , ((M.fromList []), [p1, p2])
           ]
      expandDims m @?= expected
  ]
  where
    d1 = DimensionName "d1"
    d2 = DimensionName "d2"
    d1v1 = DimensionValue "d1v1"
    d2v1 = DimensionValue "d2v1"
    d2v2 = DimensionValue "d2v2"
    p1 :: String
    p1 = "p1"
    p2 :: String
    p2 = "p2"



-- | Fixes the packet type for type inference
newtype Dims = Dims (M.Map Dimensions [Char])
  deriving (Show, Eq, Arbitrary)