defaultRelativizeUrls → relativizeUrlsCompiler

1 files changed, 18 insertions, 1 deletions

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