From 0969fe41c7c94c34e5663ed231ecbb9e2c4bc051 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Tue, 4 Jan 2011 11:13:08 +0100
Subject: Add relativize URL's functionality

---
 src/Hakyll/Web/RelativizeUrls.hs | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)
 create mode 100644 src/Hakyll/Web/RelativizeUrls.hs

(limited to 'src/Hakyll/Web/RelativizeUrls.hs')

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"]
-- 
cgit v1.2.3