Some changes to the regex interface, and version bump.

5 files changed, 76 insertions, 21 deletions

diff --git a/src/Text/Hakyll/CompressCSS.hs b/src/Text/Hakyll/CompressCSS.hs
index 8745368..85c061d 100644
--- a/src/Text/Hakyll/CompressCSS.hs
+++ b/src/Text/Hakyll/CompressCSS.hs
@@ -3,27 +3,23 @@ module Text.Hakyll.CompressCSS
     ) where
 
 import Data.List (isPrefixOf)
-import Text.Regex (subRegex, mkRegex)
-
--- | subRegex with arguments flipped for easy function composition.
-subRegex' :: String -> String -> String -> String
-subRegex' pattern replacement str = subRegex (mkRegex pattern) str replacement
+import Text.Hakyll.Regex (substitute)
 
 -- | Compress CSS to speed up your site.
 compressCSS :: String -> String
 compressCSS = compressSeparators
-            . compressWhitespace
             . stripComments
+            . compressWhitespace
 
 -- | Compresses certain forms of separators.
 compressSeparators :: String -> String
-compressSeparators = subRegex' ";\\s*}" "}" 
-                   . subRegex' "\\s*([{};:])\\s*" "\\1"
-                   . subRegex' ";;*" ";"
+compressSeparators = substitute "; *}" "}" 
+                   . substitute " *([{};:]) *" "\\1"
+                   . substitute ";;*" ";"
 
 -- | Compresses all whitespace.
 compressWhitespace :: String -> String
-compressWhitespace = subRegex' "\\s\\s*" " "
+compressWhitespace = substitute "[ \t\n][ \t\n]*" " "
 
 -- | Function that strips CSS comments away.
 stripComments :: String -> String
diff --git a/src/Text/Hakyll/Context.hs b/src/Text/Hakyll/Context.hs
index e3069b5..22409bf 100644
--- a/src/Text/Hakyll/Context.hs
+++ b/src/Text/Hakyll/Context.hs
@@ -10,11 +10,11 @@ import qualified Data.ByteString.Lazy.Char8 as B
 
 import System.Locale (defaultTimeLocale)
 import System.FilePath (takeFileName)
-import Text.Regex (subRegex, mkRegex)
 import Text.Template (Context)
 import Data.Time.Format (parseTime, formatTime)
 import Data.Time.Clock (UTCTime)
 import Data.Maybe (fromMaybe)
+import Text.Hakyll.Regex (substitute)
 
 -- | Type for context manipulating functions.
 type ContextManipulation = Context -> Context
@@ -38,9 +38,8 @@ renderDate key format defaultValue context =
     M.insert (B.pack key) (B.pack value) context
     where value = fromMaybe defaultValue pretty
           pretty = do filePath <- M.lookup (B.pack "path") context
-                      let dateString = subRegex (mkRegex "^([0-9]*-[0-9]*-[0-9]*).*")
-                                                (takeFileName $ B.unpack filePath)
-                                                "\\1"
+                      let dateString = substitute "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"
+                                                  (takeFileName $ B.unpack filePath)
                       time <- parseTime defaultTimeLocale
                                         "%Y-%m-%d"
                                         dateString :: Maybe UTCTime
diff --git a/src/Text/Hakyll/Regex.hs b/src/Text/Hakyll/Regex.hs
new file mode 100644
index 0000000..e2e21bc
--- /dev/null
+++ b/src/Text/Hakyll/Regex.hs
@@ -0,0 +1,66 @@
+-- | A module that exports a simple regex interface. This code is mostly copied
+--   from the regex-compat package at hackage.
+module Text.Hakyll.Regex
+    ( split
+    , substitute
+    ) where
+
+import Text.Regex.TDFA
+
+-- | Match a regular expression against a string, returning more information
+--   about the match.
+matchRegexAll :: Regex -> String -> Maybe (String, String, String, [String])
+matchRegexAll p str = matchM p str
+
+-- | Replaces every occurance of the given regexp with the replacement string.
+subRegex :: Regex                          -- ^ Search pattern
+      -> String                         -- ^ Input string
+      -> String                         -- ^ Replacement text
+      -> String                         -- ^ Output string
+subRegex _ "" _ = ""
+subRegex regexp inp replacement =
+  let -- bre matches a backslash then capture either a backslash or some digits
+      bre = makeRegex "\\\\(\\\\|[0-9]+)"
+      lookup' _ [] _ = []
+      lookup' [] _ _ = []
+      lookup' match' repl groups =
+        case matchRegexAll bre repl of
+          Nothing -> repl
+          Just (lead, _, trail, bgroups) ->
+            let newval =
+                 if (head bgroups) == "\\"
+                   then "\\"
+                   else let index :: Int
+                            index = (read (head bgroups)) - 1
+                        in if index == -1
+                             then match'
+                             else groups !! index
+            in lead ++ newval ++ lookup' match' trail groups
+  in case matchRegexAll regexp inp of
+       Nothing -> inp
+       Just (lead, match', trail, groups) ->
+         lead ++ lookup' match' replacement groups ++ (subRegex regexp trail replacement)
+
+-- | Splits a string based on a regular expression.  The regular expression
+--   should identify one delimiter.
+splitRegex :: Regex -> String -> [String]
+splitRegex _ [] = []
+splitRegex delim strIn = loop strIn where
+  loop str = case matchOnceText delim str of
+                Nothing -> [str]
+                Just (firstline, _, remainder) ->
+                  if null remainder
+                    then [firstline,""]
+                    else firstline : loop remainder
+
+-- | Split a list at a certain element.
+split :: String -> String -> [String]
+split pattern = filter (not . null)
+              . splitRegex (makeRegex pattern)
+
+-- | Substitute a regex. Simplified interface.
+substitute :: String -- ^ Pattern to replace (regex).
+           -> String -- ^ Replacement string.
+           -> String -- ^ Input string.
+           -> String -- ^ Result.
+substitute pattern replacement str = subRegex (makeRegex pattern) str replacement
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
index ea9ee87..69386be 100644
--- a/src/Text/Hakyll/Tags.hs
+++ b/src/Text/Hakyll/Tags.hs
@@ -12,6 +12,7 @@ import Data.List (intercalate)
 import Control.Monad (foldM)
 
 import Text.Hakyll.Context (ContextManipulation, renderValue)
+import Text.Hakyll.Regex
 import Text.Hakyll.Util
 import Text.Hakyll.Page
 import Control.Arrow (second)
diff --git a/src/Text/Hakyll/Util.hs b/src/Text/Hakyll/Util.hs
index 319bed4..018c404 100644
--- a/src/Text/Hakyll/Util.hs
+++ b/src/Text/Hakyll/Util.hs
@@ -1,12 +1,10 @@
 module Text.Hakyll.Util 
     ( trim
-    , split
     , stripHTML
     , link
     ) where
 
 import Data.Char (isSpace)
-import Text.Regex (splitRegex, mkRegex)
 
 -- | Trim a string (drop spaces and tabs at both sides).
 trim :: String -> String
@@ -23,11 +21,6 @@ stripHTML str = let (beforeTag, rest) = break (== '<') str
     where tail' [] = []
           tail' xs = tail xs
 
--- | Split a list at a certain element.
-split :: String -> String -> [String]
-split pattern = filter (not . null)
-              . splitRegex (mkRegex pattern)
-
 -- | Make a HTML link.
 --
 --   > link "foo" "bar.html" == "<a href='bar.html'>foo</a>"