Fix for filepath matching on Windows

3 files changed, 34 insertions, 32 deletions

diff --git a/lib/Hakyll/Core/Identifier.hs b/lib/Hakyll/Core/Identifier.hs
index d6306a8..e9dced2 100644
--- a/lib/Hakyll/Core/Identifier.hs
+++ b/lib/Hakyll/Core/Identifier.hs
@@ -22,7 +22,7 @@ module Hakyll.Core.Identifier
 import           Control.DeepSeq     (NFData (..))
 import           Data.List           (intercalate)
 import           System.FilePath     (dropTrailingPathSeparator, splitPath,
-                                      pathSeparator)
+                                      pathSeparator, normalise)
 
 
 --------------------------------------------------------------------------------
@@ -64,18 +64,13 @@ instance Show Identifier where
 --------------------------------------------------------------------------------
 -- | Parse an identifier from a string
 fromFilePath :: FilePath -> Identifier
-fromFilePath = Identifier Nothing .
-    intercalate "/" . filter (not . null) . split'
-  where
-    split' = map dropTrailingPathSeparator . splitPath
+fromFilePath = Identifier Nothing . normalise
 
 
 --------------------------------------------------------------------------------
 -- | Convert an identifier to a relative 'FilePath'
 toFilePath :: Identifier -> FilePath
-toFilePath = intercalate [pathSeparator] . split' . identifierPath
-  where
-    split' = map dropTrailingPathSeparator . splitPath
+toFilePath = normalise . identifierPath
 
 
 --------------------------------------------------------------------------------
diff --git a/lib/Hakyll/Core/Identifier/Pattern.hs b/lib/Hakyll/Core/Identifier/Pattern.hs
index 4125a8b..5e2597b 100644
--- a/lib/Hakyll/Core/Identifier/Pattern.hs
+++ b/lib/Hakyll/Core/Identifier/Pattern.hs
@@ -64,6 +64,7 @@ import           Data.List                               (inits, isPrefixOf,
                                                           tails)
 import           Data.Maybe                              (isJust)
 import qualified Data.Set                                as S
+import           System.FilePath                         (normalise, pathSeparator)
 
 
 --------------------------------------------------------------------------------
@@ -84,14 +85,14 @@ instance IsString Pattern where
 --------------------------------------------------------------------------------
 -- | Parse a pattern from a string
 fromGlob :: String -> Pattern
-fromGlob = Glob . parse'
+fromGlob = Glob . parse' . normalise
   where
-    parse' str =
-        let (chunk, rest) = break (`elem` "\\*") str
+    parse' str = 
+        let (chunk, rest) = break (== '*') str
         in case rest of
-            ('\\' : x   : xs) -> Literal (chunk ++ [x]) : parse' xs
             ('*'  : '*' : xs) -> Literal chunk : CaptureMany : parse' xs
             ('*'  : xs)       -> Literal chunk : Capture : parse' xs
+            ""                -> Literal chunk : []
             xs                -> Literal chunk : Literal xs : []
 
 
@@ -182,7 +183,7 @@ matches (Complement p) i = not $ matches p i
 matches (And x y)      i = matches x i && matches y i
 matches (Glob p)       i = isJust $ capture (Glob p) i
 matches (List l)       i = i `S.member` l
-matches (Regex r)      i = toFilePath i =~ r
+matches (Regex r)      i = (normaliseRegex $ toFilePath i) =~ r
 matches (Version v)    i = identifierVersion i == v
 
 
@@ -204,7 +205,7 @@ splits = inits &&& tails >>> uncurry zip >>> reverse
 capture :: Pattern -> Identifier -> Maybe [String]
 capture (Glob p) i = capture' p (toFilePath i)
 capture (Regex pat) i = Just groups
-  where (_, _, _, groups) = ((toFilePath i) =~ pat) :: (String, String, String, [String])
+  where (_, _, _, groups) = ((normaliseRegex $ toFilePath i) =~ pat) :: (String, String, String, [String])
 capture _        _ = Nothing
 
 
@@ -218,8 +219,8 @@ capture' (Literal l : ms) str
     | l `isPrefixOf` str = capture' ms $ drop (length l) str
     | otherwise          = Nothing
 capture' (Capture : ms) str =
-    -- Match until the next /
-    let (chunk, rest) = break (== '/') str
+    -- Match until the next path separator
+    let (chunk, rest) = break (== pathSeparator) str
     in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]
 capture' (CaptureMany : ms) str =
     -- Match everything
@@ -262,3 +263,9 @@ fromCaptures' (m : ms) [] = case m of
 fromCaptures' (m : ms) ids@(i : is) = case m of
     Literal l -> l `mappend` fromCaptures' ms ids
     _         -> i `mappend` fromCaptures' ms is
+
+
+--------------------------------------------------------------------------------
+-- | Normalise filepaths to have '/' as a path separator for Regex matching
+normaliseRegex :: FilePath -> FilePath
+normaliseRegex = concatMap (\c -> if c == '\\' then ['/'] else [c])
\ No newline at end of file
diff --git a/tests/Hakyll/Core/Identifier/Tests.hs b/tests/Hakyll/Core/Identifier/Tests.hs
index 2829927..8f534a2 100644
--- a/tests/Hakyll/Core/Identifier/Tests.hs
+++ b/tests/Hakyll/Core/Identifier/Tests.hs
@@ -13,6 +13,7 @@ import           Test.Tasty.HUnit               ((@=?))
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Identifier.Pattern
+import           System.FilePath                ((</>))
 import           TestSuite.Util
 
 
@@ -27,22 +28,21 @@ tests = testGroup "Hakyll.Core.Identifier.Tests" $ concat
 --------------------------------------------------------------------------------
 captureTests :: [TestTree]
 captureTests = fromAssertions "capture"
-    [ Just ["bar"]              @=? capture "foo/**" "foo/bar"
-    , Just ["foo/bar"]          @=? capture "**" "foo/bar"
-    , Nothing                   @=? capture "*" "foo/bar"
-    , Just []                   @=? capture "foo" "foo"
-    , Just ["foo"]              @=? capture "*/bar" "foo/bar"
-    , Just ["foo/bar"]          @=? capture "**/qux" "foo/bar/qux"
-    , Just ["foo/bar", "qux"]   @=? capture "**/*" "foo/bar/qux"
-    , Just ["foo", "bar/qux"]   @=? capture "*/**" "foo/bar/qux"
-    , Just ["foo"]              @=? capture "*.html" "foo.html"
-    , Nothing                   @=? capture "*.html" "foo/bar.html"
-    , Just ["foo/bar"]          @=? capture "**.html" "foo/bar.html"
-    , Just ["foo/bar", "wut"]   @=? capture "**/qux/*" "foo/bar/qux/wut"
-    , Just ["lol", "fun/large"] @=? capture "*cat/**.jpg" "lolcat/fun/large.jpg"
-    , Just []                   @=? capture "\\*.jpg" "*.jpg"
-    , Nothing                   @=? capture "\\*.jpg" "foo.jpg"
-    , Just ["xyz","42"]              @=? capture (fromRegex "cat-([a-z]+)/foo([0-9]+).jpg") "cat-xyz/foo42.jpg"
+    [ Just ["bar"]                    @=? capture "foo/**" "foo/bar"
+    , Just ["foo" </> "bar"]          @=? capture "**" "foo/bar"
+    , Nothing                         @=? capture "*" "foo/bar"
+    , Just []                         @=? capture "foo" "foo"
+    , Just ["foo"]                    @=? capture "*/bar" "foo/bar"
+    , Just ["foo" </> "bar"]          @=? capture "**/qux" "foo/bar/qux"
+    , Just ["foo" </> "bar", "qux"]   @=? capture "**/*" "foo/bar/qux"
+    , Just ["foo", "bar" </> "qux"]   @=? capture "*/**" "foo/bar/qux"
+    , Just ["foo"]                    @=? capture "*.html" "foo.html"
+    , Nothing                         @=? capture "*.html" "foo/bar.html"
+    , Just ["foo" </> "bar"]          @=? capture "**.html" "foo/bar.html"
+    , Just ["foo" </> "bar", "wut"]   @=? capture "**/qux/*" "foo/bar/qux/wut"
+    , Just ["lol", "fun" </> "large"] @=? capture "*cat/**.jpg" "lolcat/fun/large.jpg"
+    , Nothing                         @=? capture "\\*.jpg" "foo.jpg"
+    , Just ["xyz","42"]               @=? capture (fromRegex "cat-([a-z]+)/foo([0-9]+).jpg") "cat-xyz/foo42.jpg"
     ]