2 files changed, 29 insertions, 1 deletions
diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs
index 531c951..883da74 100644
--- a/src/Hakyll/Web/Page.hs
+++ b/src/Hakyll/Web/Page.hs
@@ -57,7 +57,6 @@ addDefaultFields =   (getRoute &&& id >>^ uncurry addRoute)
     -- Add root and url, based on route
     addRoute Nothing  = id
     addRoute (Just r) = addField "url" (toUrl r)
-                      . addField "root" (toSiteRoot $ toUrl r)
 
     -- Add title and category, based on identifier
     addIdentifier i = addField "title" (takeBaseName p)
diff --git a/src/Hakyll/Web/RelativizeUrls.hs b/src/Hakyll/Web/RelativizeUrls.hs
new file mode 100644
index 0000000..2a3b98f
--- /dev/null
+++ b/src/Hakyll/Web/RelativizeUrls.hs
@@ -0,0 +1,29 @@
+module Hakyll.Web.RelativizeUrls
+    ( relativizeUrls
+    ) where
+
+import Data.List (isPrefixOf)
+import qualified Data.Set as S
+
+import Text.HTML.TagSoup
+
+-- | Relativize URL's in HTML
+--
+relativizeUrls :: String  -- ^ Path to the site root
+               -> String  -- ^ HTML to relativize
+               -> String  -- ^ Resulting HTML
+relativizeUrls root = renderTags . map relativizeUrls' . parseTags
+  where
+    relativizeUrls' (TagOpen s a) = TagOpen s $ map (relativizeUrlsAttrs root) a
+    relativizeUrls' x = x
+
+-- | Relativize URL's in attributes
+--
+relativizeUrlsAttrs :: String            -- ^ Path to the site root
+                    -> Attribute String  -- ^ Attribute to relativize
+                    -> Attribute String  -- ^ Resulting attribute
+relativizeUrlsAttrs root (key, value)
+    | key `S.member` urls && "/" `isPrefixOf` value = (key, root ++ value)
+    | otherwise = (key, value)
+  where
+    urls = S.fromList ["src", "href"]