@@ -0,0 +1,66 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Hakyll.Core.Store.Tests
3+ ( tests
4+ ) where
5+
6+import Control.Applicative ((<$>))
7+import Control.Monad (replicateM)
8+
9+import Test.Framework
10+import Test.Framework.Providers.QuickCheck2
11+import Test.Framework.Providers.HUnit
12+import Test.QuickCheck
13+import Test.QuickCheck.Monadic
14+import qualified Test.HUnit as H
15+
16+import Hakyll.Core.Identifier
17+import Hakyll.Core.Store
18+
19+tests :: [Test]
20+tests =
21+ [ testProperty "simple storeGet . storeSet" simpleSetGet
22+ , testProperty "persistent storeGet . storeSet" persistentSetGet
23+ , testCase "WrongType storeGet . storeSet" wrongType
24+ ]
25+
26+simpleSetGet :: Property
27+simpleSetGet = monadicIO $ do
28+ identifier <- parseIdentifier . unFileName <$> pick arbitrary
29+ FileName name <- pick arbitrary
30+ value <- pick arbitrary
31+ store <- run $ makeStore "_store"
32+ run $ storeSet store name identifier (value :: String)
33+ value' <- run $ storeGet store name identifier
34+ assert $ Found value == value'
35+
36+persistentSetGet :: Property
37+persistentSetGet = monadicIO $ do
38+ identifier <- parseIdentifier . unFileName <$> pick arbitrary
39+ FileName name <- pick arbitrary
40+ value <- pick arbitrary
41+ store1 <- run $ makeStore "_store"
42+ run $ storeSet store1 name identifier (value :: String)
43+ -- Now Create another store from the same dir to test persistence
44+ store2 <- run $ makeStore "_store"
45+ value' <- run $ storeGet store2 name identifier
46+ assert $ Found value == value'
47+
48+wrongType :: H.Assertion
49+wrongType = do
50+ store <- makeStore "_store"
51+ -- Store a string and try to fetch an int
52+ storeSet store "foo" "bar" ("qux" :: String)
53+ value <- storeGet store "foo" "bar" :: IO (StoreGet Int)
54+ H.assert $ case value of WrongType _ _ -> True
55+ _ -> False
56+
57+newtype FileName = FileName {unFileName :: String}
58+ deriving (Show)
59+
60+instance Arbitrary FileName where
61+ arbitrary = do
62+ length' <- choose (5, 100)
63+ str <- replicateM length' $ elements cs
64+ return $ FileName str
65+ where
66+ cs = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ ".- "