From bc4fef81b7143d3b2035f3bd28fe89bea8dbc30d Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Tue, 15 Feb 2011 22:20:39 +0100
Subject: defaultRelativizeUrls → relativizeUrlsCompiler
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Hakyll/Web/RelativizeUrls.hs | 19 ++++++++++++++++++-
 1 file changed, 18 insertions(+), 1 deletion(-)

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

diff --git a/src/Hakyll/Web/RelativizeUrls.hs b/src/Hakyll/Web/RelativizeUrls.hs
index 40a5847..1df4fea 100644
--- a/src/Hakyll/Web/RelativizeUrls.hs
+++ b/src/Hakyll/Web/RelativizeUrls.hs
@@ -15,14 +15,31 @@
 -- > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" />
 --
 module Hakyll.Web.RelativizeUrls
-    ( relativizeUrls
+    ( relativizeUrlsCompiler
+    , relativizeUrls
     ) where
 
+import Prelude hiding (id)
+import Control.Category (id)
+import Control.Arrow ((&&&), (>>^))
 import Data.List (isPrefixOf)
 import qualified Data.Set as S
 
 import Text.HTML.TagSoup
 
+import Hakyll.Core.Compiler
+import Hakyll.Web.Page
+import Hakyll.Web.Util.String
+
+-- | Compiler form of 'compressCss' which automatically picks the right root
+-- path
+--
+relativizeUrlsCompiler :: Compiler (Page String) (Page String)
+relativizeUrlsCompiler = getRoute &&& id >>^ uncurry relativize
+  where
+    relativize Nothing = id
+    relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r)
+
 -- | Relativize URL's in HTML
 --
 relativizeUrls :: String  -- ^ Path to the site root
-- 
cgit v1.2.3