Miscellaneous Windows-specific fixes and CI

4 files changed, 24 insertions, 14 deletions

diff --git a/lib/Hakyll/Core/Identifier/Pattern.hs b/lib/Hakyll/Core/Identifier/Pattern.hs
index 5e2597b..d07402d 100644
--- a/lib/Hakyll/Core/Identifier/Pattern.hs
+++ b/lib/Hakyll/Core/Identifier/Pattern.hs
@@ -75,6 +75,7 @@ import           Text.Regex.TDFA                         ((=~))
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Identifier.Pattern.Internal
+import           Hakyll.Core.Util.String                 (removeWinPathSeparator)
 
 
 --------------------------------------------------------------------------------
@@ -183,7 +184,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 = (normaliseRegex $ toFilePath i) =~ r
+matches (Regex r)      i = (removeWinPathSeparator $ toFilePath i) =~ r
 matches (Version v)    i = identifierVersion i == v
 
 
@@ -205,7 +206,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) = ((normaliseRegex $ toFilePath i) =~ pat) :: (String, String, String, [String])
+  where (_, _, _, groups) = ((removeWinPathSeparator $ toFilePath i) =~ pat) :: (String, String, String, [String])
 capture _        _ = Nothing
 
 
@@ -263,9 +264,3 @@ 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/lib/Hakyll/Core/Routes.hs b/lib/Hakyll/Core/Routes.hs
index 06bf633..2411db9 100644
--- a/lib/Hakyll/Core/Routes.hs
+++ b/lib/Hakyll/Core/Routes.hs
@@ -46,7 +46,7 @@ module Hakyll.Core.Routes
 #if MIN_VERSION_base(4,9,0)
 import           Data.Semigroup                 (Semigroup (..))
 #endif
-import           System.FilePath                (replaceExtension)
+import           System.FilePath                (replaceExtension, normalise)
 
 
 --------------------------------------------------------------------------------
@@ -174,7 +174,11 @@ gsubRoute :: String              -- ^ Pattern
           -> (String -> String)  -- ^ Replacement
           -> Routes              -- ^ Resulting route
 gsubRoute pattern replacement = customRoute $
-    replaceAll pattern replacement . toFilePath
+    normalise . replaceAll pattern (replacement . removeWinPathSeparator) . removeWinPathSeparator . toFilePath
+    where
+        -- Filepaths on Windows containing `\\' will trip Regex matching, which
+        -- is used in replaceAll. We normalise filepaths to have '/' as a path separator
+        -- using removeWinPathSeparator
 
 
 --------------------------------------------------------------------------------
diff --git a/lib/Hakyll/Core/Util/String.hs b/lib/Hakyll/Core/Util/String.hs
index f848369..67c436f 100644
--- a/lib/Hakyll/Core/Util/String.hs
+++ b/lib/Hakyll/Core/Util/String.hs
@@ -6,6 +6,7 @@ module Hakyll.Core.Util.String
     , replaceAll
     , splitAll
     , needlePrefix
+    , removeWinPathSeparator
     ) where
 
 
@@ -76,3 +77,9 @@ needlePrefix needle haystack = go [] haystack
     go acc xss@(x:xs)
         | needle `isPrefixOf` xss = Just $ reverse acc
         | otherwise               = go (x : acc) xs
+
+
+--------------------------------------------------------------------------------
+-- | Translate native Windows path separators '\\' to '/' if present.
+removeWinPathSeparator :: String -> String
+removeWinPathSeparator = concatMap (\c -> if c == '\\' then ['/'] else [c])
\ No newline at end of file
diff --git a/lib/Hakyll/Web/Html.hs b/lib/Hakyll/Web/Html.hs
index 23ad78b..8cbfaa3 100644
--- a/lib/Hakyll/Web/Html.hs
+++ b/lib/Hakyll/Web/Html.hs
@@ -26,7 +26,7 @@ import           Data.Char                       (digitToInt, intToDigit,
                                                   isDigit, toLower)
 import           Data.List                       (isPrefixOf)
 import qualified Data.Set                        as S
-import           System.FilePath.Posix           (joinPath, splitPath,
+import           System.FilePath                 (joinPath, splitPath,
                                                   takeDirectory)
 import           Text.Blaze.Html                 (toHtml)
 import           Text.Blaze.Html.Renderer.String (renderHtml)
@@ -35,6 +35,10 @@ import           Network.URI                     (isUnreserved, escapeURIString)
 
 
 --------------------------------------------------------------------------------
+import           Hakyll.Core.Util.String         (removeWinPathSeparator)
+
+
+--------------------------------------------------------------------------------
 -- | Map over all tags in the document
 withTags :: (TS.Tag String -> TS.Tag String) -> String -> String
 withTags = withTagList . map
@@ -116,7 +120,7 @@ parseTags' = TS.parseTagsOptions (TS.parseOptions :: TS.ParseOptions String)
 --
 -- This also sanitizes the URL, e.g. converting spaces into '%20'
 toUrl :: FilePath -> String
-toUrl url = case url of
+toUrl url = case (removeWinPathSeparator url) of
     ('/' : xs) -> '/' : sanitize xs
     xs         -> '/' : sanitize xs
   where
@@ -130,8 +134,8 @@ toUrl url = case url of
 --------------------------------------------------------------------------------
 -- | Get the relative url to the site root, for a given (absolute) url
 toSiteRoot :: String -> String
-toSiteRoot = emptyException . joinPath . map parent
-           . filter relevant . splitPath . takeDirectory
+toSiteRoot = removeWinPathSeparator . emptyException . joinPath 
+           . map parent . filter relevant . splitPath . takeDirectory
   where
     parent            = const ".."
     emptyException [] = "."