Add newtype for Context

9 files changed, 40 insertions, 31 deletions

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)