Worker.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

module Instrument.Tests.Worker
  ( tests,
  )
where

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

-------------------------------------------------------------------------------

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)