Add newtype for Context

12 files changed, 57 insertions, 42 deletions

diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs
index f7cb04e..a2ade71 100644
--- a/src/Text/Hakyll.hs
+++ b/src/Text/Hakyll.hs
@@ -15,7 +15,7 @@ module Text.Hakyll
 
 import Control.Monad.Reader (runReaderT, liftIO, ask)
 import Control.Monad (when)
-import qualified Data.Map as M
+import Data.Monoid (mempty)
 import System.Environment (getArgs, getProgName)
 import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
 
@@ -48,7 +48,7 @@ defaultHakyllConfiguration :: String               -- ^ Absolute site URL.
                            -> HakyllConfiguration  -- ^ Default config.
 defaultHakyllConfiguration absoluteUrl' = HakyllConfiguration
     { absoluteUrl         = absoluteUrl'
-    , additionalContext   = M.empty
+    , additionalContext   = mempty
     , siteDirectory       = "_site"
     , cacheDirectory      = "_cache"
     , enableIndexUrl      = False
diff --git a/src/Text/Hakyll/Context.hs b/src/Text/Hakyll/Context.hs
index c5c77d4..9045a65 100644
--- a/src/Text/Hakyll/Context.hs
+++ b/src/Text/Hakyll/Context.hs
@@ -1,11 +1,16 @@
 -- | This (quite small) module exports the datatype used for contexts. A
 --   @Context@ is a simple key-value mapping. You can render these @Context@s
 --   with templates, and manipulate them in various ways.
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Text.Hakyll.Context
-    ( Context
+    ( Context (..)
     ) where
 
+import Data.Monoid (Monoid)
 import Data.Map (Map)
+import Data.Binary (Binary)
 
 -- | Datatype used for key-value mappings.
-type Context = Map String String
+newtype Context = Context { -- | Extract the context.
+                            unContext :: Map String String
+                          } deriving (Show, Monoid, Binary)
diff --git a/src/Text/Hakyll/ContextManipulations.hs b/src/Text/Hakyll/ContextManipulations.hs
index ff4d661..b2706be 100644
--- a/src/Text/Hakyll/ContextManipulations.hs
+++ b/src/Text/Hakyll/ContextManipulations.hs
@@ -21,7 +21,7 @@ import qualified Data.Map as M
 
 import Text.Hakyll.Regex (substituteRegex)
 import Text.Hakyll.HakyllAction (HakyllAction (..))
-import Text.Hakyll.Context (Context)
+import Text.Hakyll.Context (Context (..))
 
 -- | Do something with a value in a @Context@, but keep the old value as well.
 --   If the key given is not present in the @Context@, nothing will happen.
@@ -29,7 +29,7 @@ renderValue :: String             -- ^ Key of which the value should be copied.
             -> String             -- ^ Key the value should be copied to.
             -> (String -> String) -- ^ Function to apply on the value.
             -> HakyllAction Context Context
-renderValue source destination f = arr $ \context ->
+renderValue source destination f = arr $ \(Context context) -> Context $
     case M.lookup source context of
         Nothing      -> context
         (Just value) -> M.insert destination (f value) context
diff --git a/src/Text/Hakyll/CreateContext.hs b/src/Text/Hakyll/CreateContext.hs
index 1bfd00c..a38d055 100644
--- a/src/Text/Hakyll/CreateContext.hs
+++ b/src/Text/Hakyll/CreateContext.hs
@@ -42,7 +42,7 @@ createCustomPage :: FilePath
 createCustomPage url association = HakyllAction
     { actionDependencies = dataDependencies
     , actionUrl          = Left $ return url
-    , actionFunction     = \_ -> M.fromList <$> assoc'
+    , actionFunction     = \_ -> Context . M.fromList <$> assoc'
     }
   where
     mtuple (a, b) = b >>= \b' -> return (a, b')
@@ -80,7 +80,8 @@ combine x y = HakyllAction
     { actionDependencies = actionDependencies x ++ actionDependencies y
     , actionUrl          = actionUrl x
     , actionFunction     = \_ ->
-        liftM2 M.union (runHakyllAction x) (runHakyllAction y)
+        Context <$> liftM2 (M.union) (unContext <$> runHakyllAction x)
+                                     (unContext <$> runHakyllAction y)
     }
 
 -- | Combine two @Context@s and set a custom URL. This behaves like @combine@,
@@ -91,7 +92,8 @@ combineWithUrl :: FilePath
                -> HakyllAction () Context
 combineWithUrl url x y = combine'
     { actionUrl          = Left $ return url
-    , actionFunction     = \_ -> M.insert "url" url <$> runHakyllAction combine'
+    , actionFunction     = \_ ->
+        Context . M.insert "url" url . unContext <$> runHakyllAction combine'
     }
   where
     combine' = combine x y
diff --git a/src/Text/Hakyll/Feed.hs b/src/Text/Hakyll/Feed.hs
index 40e4257..992b8da 100644
--- a/src/Text/Hakyll/Feed.hs
+++ b/src/Text/Hakyll/Feed.hs
@@ -28,7 +28,7 @@ import Control.Monad.Reader (liftIO)
 import Data.Maybe (fromMaybe)
 import qualified Data.Map as M
 
-import Text.Hakyll.Context (Context)
+import Text.Hakyll.Context (Context (..))
 import Text.Hakyll.CreateContext (createListing)
 import Text.Hakyll.ContextManipulations (renderDate)
 import Text.Hakyll.HakyllMonad (Hakyll)
@@ -69,8 +69,8 @@ createFeed configuration renderables template itemTemplate =
         ] ++ updated
 
     -- Take the first timestamp, which should be the most recent.
-    updated = let action = createHakyllAction $
-                                return . fromMaybe "foo" . M.lookup "timestamp"
+    updated = let action = createHakyllAction $ return . fromMaybe "foo" 
+                                              . M.lookup "timestamp" . unContext
                   toTuple r = ("timestamp", Right $ r >>> action)
               in map toTuple $ take 1 renderables
             
diff --git a/src/Text/Hakyll/HakyllMonad.hs b/src/Text/Hakyll/HakyllMonad.hs
index 372fad1..9535a66 100644
--- a/src/Text/Hakyll/HakyllMonad.hs
+++ b/src/Text/Hakyll/HakyllMonad.hs
@@ -12,7 +12,7 @@ import qualified Data.Map as M
 
 import Text.Pandoc (ParserState, WriterOptions)
 
-import Text.Hakyll.Context (Context)
+import Text.Hakyll.Context (Context (..))
 
 -- | Our custom monad stack.
 type Hakyll = ReaderT HakyllConfiguration IO
@@ -50,5 +50,5 @@ askHakyll = flip liftM ask
 
 getAdditionalContext :: HakyllConfiguration -> Context
 getAdditionalContext configuration =
-    M.insert "absolute" (absoluteUrl configuration)
-             (additionalContext configuration)
+    let (Context c) = additionalContext configuration
+    in Context $ M.insert "absolute" (absoluteUrl configuration) c
diff --git a/src/Text/Hakyll/Internal/Page.hs b/src/Text/Hakyll/Internal/Page.hs
index e2998a5..59bae65 100644
--- a/src/Text/Hakyll/Internal/Page.hs
+++ b/src/Text/Hakyll/Internal/Page.hs
@@ -12,7 +12,7 @@ import Control.Monad.State (State, evalState, get, put)
 
 import Text.Pandoc
 
-import Text.Hakyll.Context (Context)
+import Text.Hakyll.Context (Context (..))
 import Text.Hakyll.File
 import Text.Hakyll.HakyllMonad
 import Text.Hakyll.Regex (substituteRegex, matchesRegex)
@@ -103,7 +103,7 @@ readPageFromFile path = do
         context = M.fromList $
             ("url", url) : ("path", path) : category ++ sectionsData
 
-    return context
+    return $ Context context
   where
     category = let dirs = splitDirectories $ takeDirectory path
                in [("category", last dirs) | not (null dirs)]
diff --git a/src/Text/Hakyll/Internal/Template.hs b/src/Text/Hakyll/Internal/Template.hs
index b7d1db0..bd8db2c 100644
--- a/src/Text/Hakyll/Internal/Template.hs
+++ b/src/Text/Hakyll/Internal/Template.hs
@@ -7,6 +7,7 @@ module Text.Hakyll.Internal.Template
     , finalSubstitute
     ) where
 
+import Control.Applicative ((<$>))
 import Data.List (isPrefixOf)
 import Data.Char (isAlphaNum)
 import Data.Binary
@@ -15,7 +16,7 @@ import Data.Maybe (fromMaybe)
 import System.FilePath ((</>))
 import qualified Data.Map as M
 
-import Text.Hakyll.Context (Context)
+import Text.Hakyll.Context (Context (..))
 import Text.Hakyll.HakyllMonad (Hakyll)
 import Text.Hakyll.Internal.Cache
 import Text.Hakyll.Internal.Page
@@ -47,7 +48,7 @@ readTemplate path = do
     if isCacheMoreRecent'
         then getFromCache fileName
         else do
-            page <- readPage path
+            page <- unContext <$> readPage path
             let body = fromMaybe (error $ "No body in template " ++ fileName)
                                  (M.lookup "body" page)
                 template = fromString body
@@ -65,7 +66,7 @@ substitute escaper (Chunk chunk template) context =
 substitute escaper (Identifier key template) context =
     replacement ++ substitute escaper template context
   where
-    replacement = fromMaybe ('$' : key) $ M.lookup key context
+    replacement = fromMaybe ('$' : key) $ M.lookup key $ unContext context
 substitute escaper (EscapeCharacter template) context =
     escaper ++ substitute escaper template context
 substitute _ End _ = []
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index a3476b6..d054f63 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -16,7 +16,7 @@ import System.Directory (copyFile)
 import Data.Maybe (fromMaybe)
 import qualified Data.Map as M
 
-import Text.Hakyll.Context (Context)
+import Text.Hakyll.Context (Context (..))
 import Text.Hakyll.HakyllMonad (Hakyll, askHakyll, getAdditionalContext)
 import Text.Hakyll.File
 import Text.Hakyll.HakyllAction
@@ -27,12 +27,12 @@ import Text.Hakyll.Internal.Template
 pureRender :: Template -- ^ Template to use for rendering.
            -> Context  -- ^ Renderable object to render with given template.
            -> Context  -- ^ The body of the result will contain the render.
-pureRender template context =
+pureRender template (Context c) =
     -- Ignore $root when substituting here. We will only replace that in the
     -- final render (just before writing).
-    let contextIgnoringRoot = M.insert "root" "$root" context
-        body = regularSubstitute template contextIgnoringRoot
-    in M.insert "body" body context
+    let contextIgnoringRoot = Context $ M.insert "root" "$root" c
+        body = regularSubstitute template $ contextIgnoringRoot
+    in Context $ M.insert "body" body c
 
 -- | This is the most simple render action. You render a @Context@ with a
 --   template, and get back the result.
@@ -68,7 +68,7 @@ renderAndConcat templatePaths renderables = HakyllAction
 
     actionFunction' _ = do
         contexts <- mapM runHakyllAction renders
-        return $ concatMap (fromMaybe "" . M.lookup "body") contexts
+        return $ concatMap (fromMaybe "" . M.lookup "body" . unContext) contexts
 
 -- | Chain a render action for a page with a number of templates. This will
 --   also write the result to the site destination. This is the preferred way
@@ -112,8 +112,8 @@ css source = runHakyllActionIfNeeded css'
 -- | Write a page to the site destination. Final action after render
 --   chains and such.
 writePage :: HakyllAction Context ()
-writePage = createHakyllAction $ \initialContext -> do
-    additionalContext' <- askHakyll getAdditionalContext
+writePage = createHakyllAction $ \(Context initialContext) -> do
+    additionalContext' <- unContext <$> askHakyll getAdditionalContext
     let url = fromMaybe (error "No url defined at write time.")
                         (M.lookup "url" initialContext)
         body = fromMaybe "" (M.lookup "body" initialContext)
@@ -121,4 +121,5 @@ writePage = createHakyllAction $ \initialContext -> do
     destination <- toDestination url
     makeDirectories destination
     -- Substitute $root here, just before writing.
-    liftIO $ writeFile destination $ finalSubstitute (fromString body) context
+    liftIO $ writeFile destination $ finalSubstitute (fromString body)
+                                                     (Context context)
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
index 8b7d96b..1ca74a5 100644
--- a/src/Text/Hakyll/Tags.hs
+++ b/src/Text/Hakyll/Tags.hs
@@ -43,7 +43,7 @@ import Control.Arrow (second, (>>>))
 import Control.Applicative ((<$>))
 import System.FilePath
 
-import Text.Hakyll.Context (Context)
+import Text.Hakyll.Context (Context (..))
 import Text.Hakyll.ContextManipulations (changeValue)
 import Text.Hakyll.CreateContext (createPage)
 import Text.Hakyll.HakyllMonad (Hakyll)
@@ -105,13 +105,13 @@ readTagMap :: String     -- ^ Unique identifier for the map.
 readTagMap = readMap getTagsFunction
   where
     getTagsFunction = map trim . splitRegex ","
-                    . fromMaybe [] . M.lookup "tags"
+                    . fromMaybe [] . M.lookup "tags" . unContext
 
 -- | Read a @TagMap@, using the subdirectories the pages are placed in.
 readCategoryMap :: String     -- ^ Unique identifier for the map.
                 -> [FilePath] -- ^ Paths to get tags from.
                 -> HakyllAction () TagMap
-readCategoryMap = readMap $ maybeToList . M.lookup "category"
+readCategoryMap = readMap $ maybeToList . M.lookup "category" . unContext
 
 withTagMap :: HakyllAction () TagMap
            -> (String -> [HakyllAction () Context] -> Hakyll ())
@@ -131,7 +131,7 @@ renderTagCloud urlFunction minSize maxSize = createHakyllAction renderTagCloud'
         return $ intercalate " " $ map (renderTag tagMap) (tagCount tagMap)
 
     renderTag tagMap (tag, count) = 
-        finalSubstitute linkTemplate $ M.fromList
+        finalSubstitute linkTemplate $ Context $ M.fromList
             [ ("size", sizeTag tagMap count)
             , ("url", urlFunction tag)
             , ("tag", tag)
diff --git a/tests/Page.hs b/tests/Page.hs
index 1b80578..d12638e 100644
--- a/tests/Page.hs
+++ b/tests/Page.hs
@@ -35,7 +35,8 @@ test_readPage fileName content assertion = do
     temporaryDir <- getTemporaryDirectory
     let temporaryFile = temporaryDir </> fileName
     writeFile temporaryFile content
-    page <- runReaderT (readPage temporaryFile) defaultHakyllConfiguration
+    page <- runReaderT (readPage temporaryFile)
+                       (defaultHakyllConfiguration "http://examples.com")
     removeFile temporaryFile
     return $ assertion page
 
@@ -48,7 +49,7 @@ test_readPage_1 = test_readPage fileName content assertion @? "test_readPage_1"
                         , "---"
                         , "This is a simple test."
                         ]
-    assertion page = M.lookup "author" page == Just "Eric Cartman"
+    assertion page = M.lookup "author" (unContext page) == Just "Eric Cartman"
 
 -- | readPage test case 2.
 test_readPage_2 = test_readPage fileName content assertion @? "test_readPage_2"
@@ -59,8 +60,10 @@ test_readPage_2 = test_readPage fileName content assertion @? "test_readPage_2"
                         , "---"
                         , "This is the body."
                         ]
-    assertion page =  M.lookup "someSection" page == Just "This is a section.\n"
-                   && M.lookup "body" page == Just "This is the body.\n"
+    assertion page =
+        let m = unContext page
+        in M.lookup "someSection" m == Just "This is a section.\n"
+           && M.lookup "body" m == Just "This is the body.\n"
 
 -- | readPage test case 3.
 test_readPage_3 = test_readPage fileName content assertion @? "test_readPage_3"
@@ -68,7 +71,8 @@ test_readPage_3 = test_readPage fileName content assertion @? "test_readPage_3"
     fileName  = "test_readPage_3.txt"
     content   = unlines [ "No metadata here, sorry."
                         ]
-    assertion page =  M.lookup "body" page == Just "No metadata here, sorry.\n"
+    assertion page =
+        M.lookup "body" (unContext page) == Just "No metadata here, sorry.\n"
 
 -- | readPage test case 4.
 test_readPage_4 = test_readPage fileName content assertion @? "test_readPage_4"
@@ -81,7 +85,7 @@ test_readPage_4 = test_readPage fileName content assertion @? "test_readPage_4"
                         , "------"
                         , "The header is not a separate section."
                         ]
-    assertion page = M.lookup "body" page == Just body
+    assertion page = M.lookup "body" (unContext page) == Just body
     body = unlines [ "Header"
                    , "------"
                    , "The header is not a separate section."
diff --git a/tests/Template.hs b/tests/Template.hs
index 9924efb..4024b6a 100644
--- a/tests/Template.hs
+++ b/tests/Template.hs
@@ -5,6 +5,7 @@ module Template
 import qualified Data.Map as M
 import Control.Applicative ((<$>))
 import Control.Monad (replicateM)
+import Data.Monoid (mempty)
 
 import Data.Binary
 import Test.Framework (testGroup)
@@ -13,6 +14,7 @@ import Test.Framework.Providers.QuickCheck2
 import Test.HUnit
 import Test.QuickCheck
 
+import Text.Hakyll.Context (Context (..))
 import Text.Hakyll.Internal.Template
 
 -- Template test group.
@@ -58,18 +60,18 @@ prop_template_encode_id template = decode (encode template) == template
 
 -- Check we get the same sting with empty substitutions.
 prop_substitute_id string =
-    regularSubstitute (fromString string) M.empty == string
+    regularSubstitute (fromString string) mempty == string
 
 -- substitute test case 1.
 test_substitute_1 =
     finalSubstitute template context @?= "Banana costs $4."
   where
     template = fromString "$product costs $$$price."
-    context = M.fromList [("product", "Banana"), ("price", "4")]
+    context = Context $ M.fromList [("product", "Banana"), ("price", "4")]
 
 -- substitute test case 2.
 test_substitute_2 =
     regularSubstitute template context @?= "$$root is a special key."
   where
     template = fromString "$$root is a special $thing."
-    context = M.fromList [("root", "foo"), ("thing", "key")]
+    context = Context $ M.fromList [("root", "foo"), ("thing", "key")]