Miscellaneous Windows-specific fixes and CI

.github/workflows/main.yml

@@ -2,7 +2,13 @@ name: 'CI'
 on: ['push']
 jobs:
  build:
- runs-on: 'ubuntu-latest'
+ strategy:
+ matrix:
+ os: [ubuntu-latest, windows-latest]
+
+ name: ${{ matrix.os }}
+ runs-on: $${{ matrix.os }}
+
  steps:
  - uses: 'actions/checkout@v1'
  - uses: 'mstksg/setup-stack@v1'

README.markdown

@@ -1,6 +1,6 @@
 # hakyll
 
-[![Build Status](https://img.shields.io/circleci/project/github/jaspervdj/hakyll.svg)](https://circleci.com/gh/jaspervdj/hakyll)
+![CI](https://github.com/jaspervdj/hakyll/workflows/CI/badge.svg)
 
 Hakyll is a static site generator library in Haskell. More information
 (including a tutorial) can be found on

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])

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
 
 
 --------------------------------------------------------------------------------

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])

lib/Hakyll/Web/Html.hs

@@ -26,14 +26,18 @@ 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)
 import qualified Text.HTML.TagSoup as TS
 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
@@ -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 [] = "."

tests/Hakyll/Core/Routes/Tests.hs

@@ -10,7 +10,7 @@ import Data.Maybe (fromMaybe)
 import Hakyll.Core.Identifier
 import Hakyll.Core.Metadata
 import Hakyll.Core.Routes
-import System.FilePath ((</>))
+import System.FilePath ((</>), normalise)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (Assertion, (@=?))
 import TestSuite.Util
@@ -46,5 +46,5 @@ testRoutes expected r id' = do
  store <- newTestStore
  provider <- newTestProvider store
  (route, _) <- runRoutes r provider id'
- Just expected @=? route
+ Just (normalise expected) @=? route
  cleanTestEnv

tests/Hakyll/Core/Rules/Tests.hs

@@ -17,7 +17,7 @@ import Hakyll.Core.Metadata
 import Hakyll.Core.Routes
 import Hakyll.Core.Rules
 import Hakyll.Core.Rules.Internal
-import System.FilePath ((</>))
+import System.FilePath ((</>), normalise)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (Assertion, (@=?))
 import TestSuite.Util
@@ -39,7 +39,7 @@ case01 = do
  let identifiers = S.fromList $ map fst $ rulesCompilers ruleSet
  routes = rulesRoutes ruleSet
  checkRoute ex i =
- runRoutes routes provider i >>= \(r, _) -> Just ex @=? r
+ runRoutes routes provider i >>= \(r, _) -> Just (normalise ex) @=? r
 
  -- Test that we have some identifiers and that the routes work out
  S.fromList expected @=? identifiers

tests/Hakyll/Core/UnixFilter/Tests.hs

@@ -1,5 +1,6 @@
 --------------------------------------------------------------------------------
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
 module Hakyll.Core.UnixFilter.Tests
  ( tests
  ) where
@@ -22,10 +23,17 @@ import TestSuite.Util
 --------------------------------------------------------------------------------
 tests :: TestTree
 tests = testGroup "Hakyll.Core.UnixFilter.Tests"
+#ifdef mingw32_HOST_OS
+ -- The `rev` utility is not present by default on Windows
+ [ testCase "unixFilter false" unixFilterFalse
+ , testCase "unixFilter error" unixFilterError
+ ]
+#else
  [ testCase "unixFilter rev" unixFilterRev
  , testCase "unixFilter false" unixFilterFalse
  , testCase "unixFilter error" unixFilterError
  ]
+#endif
 
 testMarkdown :: Identifier
 testMarkdown = "russian.md"

tests/Hakyll/Web/Html/Tests.hs

@@ -44,6 +44,7 @@ tests = testGroup "Hakyll.Web.Html.Tests" $ concat
 
  , fromAssertions "toUrl"
  [ "/foo/bar.html" @=? toUrl "foo/bar.html"
+ , "/foo/bar.html" @=? toUrl "foo\\bar.html" -- Windows-specific
  , "/" @=? toUrl "/"
  , "/funny-pics.html" @=? toUrl "/funny-pics.html"
  , "/funny%20pics.html" @=? toUrl "funny pics.html"

tests/Hakyll/Web/Template/Tests.hs

@@ -12,6 +12,7 @@ import Test.Tasty.HUnit (Assertion, assertBool, testCase,
  (@=?), (@?=))
 
 import Data.Either (isLeft)
+import System.IO (nativeNewline, Newline(..))
 
 --------------------------------------------------------------------------------
 import Hakyll.Core.Compiler
@@ -149,8 +150,11 @@ testEmbeddedTemplate = do
  str <- testCompilerDone store provider "item3" $
  applyTemplate embeddedTemplate defaultContext item
 
- itemBody str @?= "<p>Hello, world</p>\n"
+ itemBody str @?= ("<p>Hello, world</p>" ++ (newline nativeNewline))
  cleanTestEnv
  where
  item = Item "item1" "Hello, world"
+
+ newline LF = "\n"
+ newline CRLF = "\r\n"