From 01d989894cbd5724240b07a577de2c7654c22300 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Tue, 24 May 2011 23:17:32 +0200
Subject: Add some store tests

---
 tests/Hakyll/Core/Rules/Tests.hs |  3 +-
 tests/Hakyll/Core/Store/Tests.hs | 66 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 68 insertions(+), 1 deletion(-)
 create mode 100644 tests/Hakyll/Core/Store/Tests.hs

(limited to 'tests/Hakyll/Core')

diff --git a/tests/Hakyll/Core/Rules/Tests.hs b/tests/Hakyll/Core/Rules/Tests.hs
index 1b388e8..ac2126c 100644
--- a/tests/Hakyll/Core/Rules/Tests.hs
+++ b/tests/Hakyll/Core/Rules/Tests.hs
@@ -1,7 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
 module Hakyll.Core.Rules.Tests
-    where
+    ( tests
+    ) where
 
 import qualified Data.Map as M
 import qualified Data.Set as S
diff --git a/tests/Hakyll/Core/Store/Tests.hs b/tests/Hakyll/Core/Store/Tests.hs
new file mode 100644
index 0000000..4f35abd
--- /dev/null
+++ b/tests/Hakyll/Core/Store/Tests.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Hakyll.Core.Store.Tests
+    ( tests
+    ) where
+
+import Control.Applicative ((<$>))
+import Control.Monad (replicateM)
+
+import Test.Framework
+import Test.Framework.Providers.QuickCheck2
+import Test.Framework.Providers.HUnit
+import Test.QuickCheck
+import Test.QuickCheck.Monadic
+import qualified Test.HUnit as H
+
+import Hakyll.Core.Identifier
+import Hakyll.Core.Store
+
+tests :: [Test]
+tests =
+    [ testProperty "simple storeGet . storeSet" simpleSetGet
+    , testProperty "persistent storeGet . storeSet" persistentSetGet
+    , testCase     "WrongType storeGet . storeSet" wrongType
+    ]
+
+simpleSetGet :: Property
+simpleSetGet = monadicIO $ do
+    identifier <- parseIdentifier . unFileName <$> pick arbitrary
+    FileName name <- pick arbitrary
+    value <- pick arbitrary
+    store <- run $ makeStore "_store"
+    run $ storeSet store name identifier (value :: String)
+    value' <- run $ storeGet store name identifier
+    assert $ Found value == value'
+
+persistentSetGet :: Property
+persistentSetGet = monadicIO $ do
+    identifier <- parseIdentifier . unFileName <$> pick arbitrary
+    FileName name <- pick arbitrary
+    value <- pick arbitrary
+    store1 <- run $ makeStore "_store"
+    run $ storeSet store1 name identifier (value :: String)
+    -- Now Create another store from the same dir to test persistence
+    store2 <- run $ makeStore "_store"
+    value' <- run $ storeGet store2 name identifier
+    assert $ Found value == value'
+
+wrongType :: H.Assertion
+wrongType = do
+    store <- makeStore "_store"
+    -- Store a string and try to fetch an int
+    storeSet store "foo" "bar" ("qux" :: String)
+    value <- storeGet store "foo" "bar" :: IO (StoreGet Int)
+    H.assert $ case value of WrongType _ _ -> True
+                             _             -> False
+
+newtype FileName = FileName {unFileName :: String}
+                 deriving (Show)
+
+instance Arbitrary FileName where
+    arbitrary = do
+        length' <- choose (5, 100)
+        str <- replicateM length' $ elements cs
+        return $ FileName str
+      where
+        cs = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ ".- "
-- 
cgit v1.2.3