Add toUrl, move & optimize replaceAll a bit

3 files changed, 36 insertions, 18 deletions

diff --git a/src/Hakyll/Web/CompressCss.hs b/src/Hakyll/Web/CompressCss.hs
index cd03237..6e3b6f2 100644
--- a/src/Hakyll/Web/CompressCss.hs
+++ b/src/Hakyll/Web/CompressCss.hs
@@ -6,23 +6,9 @@ module Text.Hakyll.Internal.CompressCss
     ) where
 
 import Data.Char (isSpace)
-import Data.Maybe (listToMaybe)
 import Data.List (isPrefixOf)
-import Text.Regex.Posix ((=~~))
 
--- | A simple (but inefficient) regex replace funcion
---
-replaceAll :: String              -- ^ Pattern
-           -> (String -> String)  -- ^ Replacement (called on capture)
-           -> String              -- ^ Source string
-           -> String              -- ^ Result
-replaceAll pattern f source =
-    case listToMaybe (source =~~ pattern) of
-        Nothing     -> source
-        Just (o, l) ->
-            let (before, tmp) = splitAt o source
-                (capture, after) = splitAt l tmp
-            in before ++ f capture ++ replaceAll pattern f after
+import Hakyll.Web.Util.String
 
 -- | Compress CSS to speed up your site.
 --
diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs
index 9294231..531c951 100644
--- a/src/Hakyll/Web/Page.hs
+++ b/src/Hakyll/Web/Page.hs
@@ -56,8 +56,8 @@ addDefaultFields =   (getRoute &&& id >>^ uncurry addRoute)
   where
     -- Add root and url, based on route
     addRoute Nothing  = id
-    addRoute (Just r) = addField "url" r
-                      . addField "root" (toSiteRoot r)
+    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/Util/String.hs b/src/Hakyll/Web/Util/String.hs
index e48580b..ed8b904 100644
--- a/src/Hakyll/Web/Util/String.hs
+++ b/src/Hakyll/Web/Util/String.hs
@@ -2,12 +2,16 @@
 --
 module Hakyll.Web.Util.String
     ( trim
+    , replaceAll
+    , toUrl
     , toSiteRoot
     ) where
 
 import Data.Char (isSpace)
+import Data.Maybe (listToMaybe)
 
 import System.FilePath (splitPath, takeDirectory, joinPath)
+import Text.Regex.PCRE ((=~~))
 
 -- | Trim a string (drop spaces, tabs and newlines at both sides).
 --
@@ -16,9 +20,37 @@ trim = reverse . trim' . reverse . trim'
   where
     trim' = dropWhile isSpace
 
+-- | A simple (but inefficient) regex replace funcion
+--
+replaceAll :: String              -- ^ Pattern
+           -> (String -> String)  -- ^ Replacement (called on capture)
+           -> String              -- ^ Source string
+           -> String              -- ^ Result
+replaceAll pattern f source = replaceAll' source
+  where
+    replaceAll' src = case listToMaybe (src =~~ pattern) of
+        Nothing     -> src
+        Just (o, l) ->
+            let (before, tmp) = splitAt o src
+                (capture, after) = splitAt l tmp
+            in before ++ f capture ++ replaceAll' after
+
+-- | Convert a filepath to an URL starting from the site root
+--
+-- Example:
+--
+-- > toUrl "foo/bar.html"
+--
+-- Result:
+--
+-- > "/foo/bar.html"
+--
+toUrl :: FilePath -> String
+toUrl = ('/' :)
+
 -- | Get the relative url to the site root, for a given (absolute) url
 --
-toSiteRoot :: FilePath -> FilePath
+toSiteRoot :: String -> String
 toSiteRoot = emptyException . joinPath . map parent . splitPath . takeDirectory
   where
     parent = const ".."