From 2d1225104cb5a050a84bc70916e1aadfff25fb00 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Sun, 2 Jan 2011 10:22:49 +0100
Subject: Add toUrl, move & optimize replaceAll a bit

---
 src/Hakyll/Web/Util/String.hs | 34 +++++++++++++++++++++++++++++++++-
 1 file changed, 33 insertions(+), 1 deletion(-)

(limited to 'src/Hakyll/Web/Util')

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