on master help sign in
Made Arbitrary Page instance.
8e78fe0Jasper Van der Jeugt
src/Text/Hakyll/Page.hs+17−2
@@ -11,10 +11,11 @@ import qualified Data.Map as M
11import Data.List (isPrefixOf)
11import Data.List (isPrefixOf)
12import Data.Char (isSpace)
12import Data.Char (isSpace)
13import Data.Maybe (fromMaybe)
13import Data.Maybe (fromMaybe)
14−import Control.Monad (liftM)
14+import Control.Monad (liftM, replicateM)
15import Control.Monad.Reader (liftIO)
15import Control.Monad.Reader (liftIO)
16import System.FilePath (takeExtension, (</>))
16import System.FilePath (takeExtension, (</>))
17
17
18+import Test.QuickCheck
18import Text.Pandoc
19import Text.Pandoc
19import Data.Binary
20import Data.Binary
20
21
@@ -29,7 +30,7 @@ import Text.Hakyll.Regex (substituteRegex, matchesRegex)
29-- | A Page is basically key-value mapping. Certain keys have special
30-- | A Page is basically key-value mapping. Certain keys have special
30-- meanings, like for example url, body and title.
31-- meanings, like for example url, body and title.
31data Page = Page Context
32data Page = Page Context
32− deriving (Show, Read)
33+ deriving (Show, Read, Eq)
33
34
34-- | Create a Page from a key-value mapping.
35-- | Create a Page from a key-value mapping.
35fromContext :: Context -> Page
36fromContext :: Context -> Page
@@ -156,3 +157,17 @@ instance Renderable Page where
156instance Binary Page where
157instance Binary Page where
157 put (Page context) = put $ M.toAscList context
158 put (Page context) = put $ M.toAscList context
158 get = liftM (Page . M.fromAscList) get
159 get = liftM (Page . M.fromAscList) get
160+
161+-- | Generate an arbitrary page.
162+arbitraryPage :: Gen Page
163+arbitraryPage = do keys <- listOf key'
164+ values <- arbitrary
165+ return $ Page $ M.fromList $ zip keys values
166+ where
167+ key' = do l <- choose (5, 10)
168+ replicateM l $ choose ('a', 'z')
169+
170+-- Make pages testable
171+instance Arbitrary Page where
172+ arbitrary = arbitraryPage
173+ shrink (Page context) = map (Page . flip M.delete context) $ M.keys context
tests/Main.hs+2
@@ -7,6 +7,7 @@ import Test.Framework.Providers.QuickCheck2
7import CompressCSS
7import CompressCSS
8import Context
8import Context
9import File
9import File
10+import Page
10import Regex
11import Regex
11import Template
12import Template
12import Util
13import Util
@@ -14,6 +15,7 @@ import Util
14main = defaultMain [ compressCSSGroup
15main = defaultMain [ compressCSSGroup
15 , contextGroup
16 , contextGroup
16 , fileGroup
17 , fileGroup
18+ , pageGroup
17 , regexGroup
19 , regexGroup
18 , templateGroup
20 , templateGroup
19 , utilGroup
21 , utilGroup
tests/Page.hsnew file+22
@@ -0,0 +1,22 @@
1+module Page
2+ ( pageGroup
3+ ) where
4+
5+import qualified Data.Map as M
6+
7+import Data.Binary
8+import Test.Framework (testGroup)
9+import Test.Framework.Providers.HUnit
10+import Test.Framework.Providers.QuickCheck2
11+import Test.HUnit
12+
13+import Text.Hakyll.Page
14+
15+-- Page test group.
16+pageGroup = testGroup "Page"
17+ [ testProperty "prop_page_encode_id" prop_page_encode_id
18+ ]
19+
20+-- Test encoding/decoding of pages.
21+prop_page_encode_id :: Page -> Bool
22+prop_page_encode_id page = decode (encode page) == page