TimeMapSpec.hs

{-# LANGUAGE
    GeneralizedNewtypeDeriving
  #-}

module Data.TimeMapSpec (spec) where

import           Data.TimeMap (TimeMap)
import qualified Data.TimeMap as TM

import Data.Maybe (isJust, isNothing)
import Test.Tasty
import Test.Tasty.QuickCheck as QC
import Test.QuickCheck
import Test.QuickCheck.Instances

import Control.Concurrent (threadDelay)


spec :: TestTree
spec = testGroup "Data.TimeMap"
  [ QC.testProperty "lookups should always succeed after insertion"
      lookupInsertExists
  , QC.testProperty "lookups should always fail after deletion"
      lookupDeleteNotExists
  , QC.testProperty "lookups should always fail after waiting past the time"
      lookupAgoNotExists
  , QC.testProperty "lookups should always succeed after waiting before the time"
      lookupAgoExists
  ]


type Key = Integer
type Content = Integer


newtype BuiltTimeMap = BuiltTimeMap
  { getBuiltTimeMap :: [(Key, Content)]
  } deriving (Show, Arbitrary)

buildTimeMap :: BuiltTimeMap -> IO (TimeMap Key Content)
buildTimeMap xs = do
  x <- TM.newTimeMap
  mapM_ (\(k,v) -> TM.insert k v x) $ getBuiltTimeMap xs
  return x


lookupInsertExists :: Key -> Content -> BuiltTimeMap -> Property
lookupInsertExists k v xs = ioProperty $ do
  x  <- buildTimeMap xs
  TM.insert k v x
  isJust <$> TM.lookup k x


lookupDeleteNotExists :: Key -> BuiltTimeMap -> Property
lookupDeleteNotExists k xs = ioProperty $ do
  x <- buildTimeMap xs
  TM.delete k x
  isNothing <$> TM.lookup k x

lookupAgoNotExists :: Key -> Content -> BuiltTimeMap -> Property
lookupAgoNotExists k v xs = ioProperty $ do
  x <- buildTimeMap xs
  TM.insert k v x
  threadDelay 1000000
  TM.filterFromNow 1 x
  isNothing <$> TM.lookup k x

lookupAgoExists :: Key -> Content -> BuiltTimeMap -> Property
lookupAgoExists k v xs = ioProperty $ do
  x <- buildTimeMap xs
  TM.insert k v x
  threadDelay 500000
  TM.filterFromNow 1 x
  isJust <$> TM.lookup k x