From c14d8871b8b2df51735948b50f53677a06924a5b Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Tue, 1 Mar 2011 22:22:11 +0100
Subject: Add trySetField, fix bug in renderField

---
 src/Hakyll/Web/Feed.hs          | 14 +++++++-------
 src/Hakyll/Web/Page.hs          |  8 ++++----
 src/Hakyll/Web/Page/Metadata.hs | 13 +++++++++++--
 3 files changed, 22 insertions(+), 13 deletions(-)

(limited to 'src/Hakyll')

diff --git a/src/Hakyll/Web/Feed.hs b/src/Hakyll/Web/Feed.hs
index 85674c6..63ef2c1 100644
--- a/src/Hakyll/Web/Feed.hs
+++ b/src/Hakyll/Web/Feed.hs
@@ -60,17 +60,17 @@ createFeed :: Template           -- ^ Feed template
            -> String             -- ^ Resulting feed
 createFeed feedTemplate itemTemplate url configuration items =
     pageBody $ applyTemplate feedTemplate
-             $ setField "timestamp"   timestamp
-             $ setField "title"       (feedTitle configuration)
-             $ setField "description" (feedDescription configuration)
-             $ setField "authorName"  (feedDescription configuration)
-             $ setField "root"        (feedRoot configuration)
-             $ setField "url"         url
+             $ trySetField "timestamp"   timestamp
+             $ trySetField "title"       (feedTitle configuration)
+             $ trySetField "description" (feedDescription configuration)
+             $ trySetField "authorName"  (feedDescription configuration)
+             $ trySetField "root"        (feedRoot configuration)
+             $ trySetField "url"         url
              $ fromBody body
   where
     -- Preprocess items
     items' = flip map items $ applyTemplate itemTemplate
-                            . setField "root" (feedRoot configuration)
+                            . trySetField "root" (feedRoot configuration)
 
     -- Body: concatenated items
     body = concat $ map pageBody items'
diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs
index 955e1a8..c41647b 100644
--- a/src/Hakyll/Web/Page.hs
+++ b/src/Hakyll/Web/Page.hs
@@ -107,12 +107,12 @@ addDefaultFields =   (getRoute &&& id >>^ uncurry addRoute)
   where
     -- Add root and url, based on route
     addRoute Nothing  = id
-    addRoute (Just r) = setField "url" (toUrl r)
+    addRoute (Just r) = trySetField "url" (toUrl r)
 
     -- Add title and category, based on identifier
-    addIdentifier i = setField "title" (takeBaseName p)
-                    . setField "category" (takeBaseName $ takeDirectory p)
-                    . setField "path" p
+    addIdentifier i = trySetField "title" (takeBaseName p)
+                    . trySetField "category" (takeBaseName $ takeDirectory p)
+                    . trySetField "path" p
       where
         p = toFilePath i
 
diff --git a/src/Hakyll/Web/Page/Metadata.hs b/src/Hakyll/Web/Page/Metadata.hs
index 72742e6..b0545f3 100644
--- a/src/Hakyll/Web/Page/Metadata.hs
+++ b/src/Hakyll/Web/Page/Metadata.hs
@@ -4,6 +4,7 @@ module Hakyll.Web.Page.Metadata
     ( getField
     , getFieldMaybe
     , setField
+    , trySetField
     , setFieldA
     , renderField
     , changeField
@@ -41,13 +42,21 @@ getFieldMaybe :: String        -- ^ Key
               -> Maybe String  -- ^ Value, if found
 getFieldMaybe key = M.lookup key . pageMetadata
 
--- | Add a metadata field. If the field already exists, it is not overwritten.
+-- | Version of 'trySetField' which overrides any previous value
 --
 setField :: String  -- ^ Key
          -> String  -- ^ Value
          -> Page a  -- ^ Page to add it to
          -> Page a  -- ^ Resulting page
-setField k v (Page m b) = Page (M.insertWith (flip const) k v m) b
+setField k v (Page m b) = Page (M.insert k v m) b
+
+-- | Add a metadata field. If the field already exists, it is not overwritten.
+--
+trySetField :: String  -- ^ Key
+            -> String  -- ^ Value
+            -> Page a  -- ^ Page to add it to
+            -> Page a  -- ^ Resulting page
+trySetField k v (Page m b) = Page (M.insertWith (flip const) k v m) b
 
 -- | Arrow-based variant of 'setField'. Because of it's type, this function is
 -- very usable together with the different 'require' functions.
-- 
cgit v1.2.3