From 9656e78869dd8248a8558671a48d2e52dbe7edb5 Mon Sep 17 00:00:00 2001
From: "Laurent P. René de Cotret" <LaurentRDC@users.noreply.github.com>
Date: Wed, 27 May 2020 06:16:47 -0400
Subject: Fix for filepath matching on Windows

---
 lib/Hakyll/Core/Identifier.hs         | 11 +++--------
 lib/Hakyll/Core/Identifier/Pattern.hs | 23 +++++++++++++++--------
 2 files changed, 18 insertions(+), 16 deletions(-)

(limited to 'lib')

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