sdl2-compositor-1.2.0.5: tests/Cache.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cache where

import Distribution.TestSuite as TestSuite
import Test.Hspec as Hspec
import Test.Hspec.Core.Runner
import Test.QuickCheck
import Test.QuickCheck.Monadic as QC

import SDL.Data.Cache

tests :: IO [Test]
tests = return . map (uncurry hspecToTest) $
        [ (functionTest,"cache functional tests") ]

hspecToTest :: Spec -> String -> Test
hspecToTest s = Test . hspecToTestInstance s

hspecToTestInstance :: Spec -> String -> TestInstance
hspecToTestInstance tests name =
  progressToTestInstance name .
  fmap (Finished . summaryToResult) $
  hspecResult tests
  where
    summaryToResult summary
      | fails == 0 = Pass
      | otherwise = Fail $ show fails ++ "of " ++ show runs ++ " FAILED."
      where fails = summaryFailures summary
            runs = summaryExamples summary
    progressToTestInstance n progressAction =
      TestInstance { TestSuite.run = progressAction
                   , name = n
                   , tags = []
                   , options = []
                   , setOption = (const . const)
                                 (Right $ hspecToTestInstance tests name)
                   }

newtype CacheInteger = CacheInteger { fromCacheInteger :: Integer }
                     deriving (Eq,Ord,Num,Arbitrary,Show)

instance Cacheable CacheInteger where
  releaseResource _ = return ()

functionTest :: Spec
functionTest =
  describe "SDL.Data.Cache.Cache" $
  it "produces the same result as without the Cache" $
  property $ \ (n :: CacheInteger) ->
  monadicIO $ QC.run $ do
  let calc x = return (2*x)
  res <- calc n
  cache <- newCache 1
  resCached <- throughCache cache n (calc n)
  return (res == resCached)