Cache.hs

{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
module YesodCoreTest.Cache (cacheTest, Widget) where

import Test.Hspec

import Network.Wai.Test

import Yesod.Core
import Data.IORef.Lifted
import Data.Typeable (Typeable)
import qualified Data.ByteString.Lazy.Char8 as L8

data C = C

newtype V1 = V1 Int
    deriving Typeable

newtype V2 = V2 Int
    deriving Typeable

mkYesod "C" [parseRoutes|/ RootR GET|]

instance Yesod C

getRootR :: Handler RepPlain
getRootR = do
    ref <- newIORef 0
    V1 v1a <- cached $ atomicModifyIORef ref $ \i -> (i + 1, V1 $ i + 1)
    V1 v1b <- cached $ atomicModifyIORef ref $ \i -> (i + 1, V1 $ i + 1)

    V2 v2a <- cached $ atomicModifyIORef ref $ \i -> (i + 1, V2 $ i + 1)
    V2 v2b <- cached $ atomicModifyIORef ref $ \i -> (i + 1, V2 $ i + 1)

    return $ RepPlain $ toContent $ show [v1a, v1b, v2a, v2b]

cacheTest :: Spec
cacheTest =
  describe "Test.Cache" $ do
      it "works" works

runner :: Session () -> IO ()
runner f = toWaiApp C >>= runSession f

works :: IO ()
works = runner $ do
    res <- request defaultRequest
    assertStatus 200 res
    assertBody (L8.pack $ show [1, 1, 2, 2 :: Int]) res