Made Arbitrary Page instance.

3 files changed, 41 insertions, 2 deletions

diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index 7aa6a25..8741cd6 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -11,10 +11,11 @@ import qualified Data.Map as M
 import Data.List (isPrefixOf)
 import Data.Char (isSpace)
 import Data.Maybe (fromMaybe)
-import Control.Monad (liftM)
+import Control.Monad (liftM, replicateM)
 import Control.Monad.Reader (liftIO)
 import System.FilePath (takeExtension, (</>))
 
+import Test.QuickCheck
 import Text.Pandoc
 import Data.Binary
 
@@ -29,7 +30,7 @@ import Text.Hakyll.Regex (substituteRegex, matchesRegex)
 -- | A Page is basically key-value mapping. Certain keys have special
 --   meanings, like for example url, body and title.
 data Page = Page Context
-          deriving (Show, Read)
+          deriving (Show, Read, Eq)
 
 -- | Create a Page from a key-value mapping.
 fromContext :: Context -> Page
@@ -156,3 +157,17 @@ instance Renderable Page where
 instance Binary Page where
     put (Page context) = put $ M.toAscList context
     get = liftM (Page . M.fromAscList) get
+
+-- | Generate an arbitrary page.
+arbitraryPage :: Gen Page
+arbitraryPage = do keys <- listOf key'
+                   values <- arbitrary
+                   return $ Page $ M.fromList $ zip keys values
+  where
+    key' = do l <- choose (5, 10)
+              replicateM l $ choose ('a', 'z')
+
+-- Make pages testable
+instance Arbitrary Page where
+    arbitrary = arbitraryPage
+    shrink (Page context) = map (Page . flip M.delete context) $ M.keys context
diff --git a/tests/Main.hs b/tests/Main.hs
index cdd46dc..9022dda 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -7,6 +7,7 @@ import Test.Framework.Providers.QuickCheck2
 import CompressCSS
 import Context
 import File
+import Page
 import Regex
 import Template
 import Util
@@ -14,6 +15,7 @@ import Util
 main = defaultMain [ compressCSSGroup
                    , contextGroup
                    , fileGroup
+                   , pageGroup
                    , regexGroup
                    , templateGroup
                    , utilGroup
diff --git a/tests/Page.hs b/tests/Page.hs
new file mode 100644
index 0000000..705b6ba
--- /dev/null
+++ b/tests/Page.hs
@@ -0,0 +1,22 @@
+module Page 
+    ( pageGroup
+    ) where
+
+import qualified Data.Map as M
+
+import Data.Binary
+import Test.Framework (testGroup)
+import Test.Framework.Providers.HUnit
+import Test.Framework.Providers.QuickCheck2
+import Test.HUnit
+
+import Text.Hakyll.Page
+
+-- Page test group.
+pageGroup = testGroup "Page"
+    [ testProperty "prop_page_encode_id" prop_page_encode_id
+    ]
+
+-- Test encoding/decoding of pages.
+prop_page_encode_id :: Page -> Bool
+prop_page_encode_id page = decode (encode page) == page