LRU-0.1.1: LRU_test.hs

{-# OPTIONS_GHC -fno-monomorphism-restriction #-}

module Main where

import qualified Data.LRU as LRU
import Test.QuickCheck
import Data.List (nub, sort)
import Data.Maybe (fromJust)

import qualified Data.Set as Set

-- | Returns true if the given list contains no duplicates
isUnique :: (Ord a) => [a] -> Bool
isUnique list = length (nub $ sort list) == length list

simpleLRU :: (Ord a) => [a] -> [a]
simpleLRU = foldl update [] where
  update [] newelem = [newelem]
  update lru newelem = newelem : (filter (\x -> x /= newelem) lru)

lruInsert = foldl (flip LRU.hit) LRU.empty

popLRU 0 _ = []
popLRU n lru =
  (fromJust $ LRU.last lru) : (popLRU (n - 1) (LRU.pop lru))

prop_LRUOrder :: [Int] -> Property
prop_LRUOrder list =
  isUnique list ==>
  (LRU.toList $ lruInsert list) == reverse list

prop_LRUActions list =
  True ==>
  (LRU.toList $ lruInsert list) == simpleLRU list

prop_LRUDelete :: [Int] -> Int -> Property
prop_LRUDelete list x =
  isUnique list && elem x list ==>
  Set.difference (Set.fromList list) (Set.fromList $ LRU.toList $ LRU.delete x $ lruInsert list) == Set.fromList [x]

prop_LRUPopping list =
  isUnique list ==>
  (popLRU (length list) $ lruInsert list) == list

prop_LRUNull list =
  isUnique list ==>
  LRU.null (pop (length list) $ lruInsert list) where
  pop 0 lru = lru
  pop n lru = pop (n - 1) $ LRU.pop lru

prop_LRUSize list =
  isUnique list ==>
  LRU.size (lruInsert list) == length list

main = do
  mapM_ (check (defaultConfig { configMaxTest = 1000, configMaxFail = 10000 })) [prop_LRUOrder, prop_LRUActions, prop_LRUPopping, prop_LRUNull, prop_LRUSize]
  mapM_ (check (defaultConfig { configMaxTest = 1000, configMaxFail = 100000 })) [prop_LRUDelete]