diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,12 @@ # Releases +## Hakyll 4.13.4.0 (2020-06-20) + +- Miscellaneous Windows-specific fixes and CI (by Laurent P. René de Cotret) +- Bump upper bound for `cryptonite` to 0.28 +- Bump upper bound for `tasty` to 1.4 + ## Hakyll 4.13.3.0 (2020-04-12) - Fix compilation issue related to `MonadFail` on Windows (by Martín Emanuel) diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 4.13.3.0 +Version: 4.13.4.0 Synopsis: A static website compiler library Description: @@ -170,10 +170,10 @@ blaze-markup >= 0.5.1 && < 0.9, bytestring >= 0.9 && < 0.11, containers >= 0.3 && < 0.7, - cryptonite >= 0.25 && < 0.27, + cryptonite >= 0.25 && < 0.28, data-default >= 0.4 && < 0.8, deepseq >= 1.3 && < 1.5, - directory >= 1.0 && < 1.4, + directory >= 1.2.7.0 && < 1.4, file-embed >= 0.0.10.1 && < 0.0.12, filepath >= 1.0 && < 1.5, lrucache >= 1.1.1 && < 1.3, @@ -266,7 +266,7 @@ Build-Depends: hakyll, QuickCheck >= 2.8 && < 2.14, - tasty >= 0.11 && < 1.3, + tasty >= 0.11 && < 1.4, tasty-hunit >= 0.9 && < 0.11, tasty-quickcheck >= 0.8 && < 0.11, -- Copy pasted from hakyll dependencies: diff --git a/lib/Hakyll/Core/Identifier.hs b/lib/Hakyll/Core/Identifier.hs --- a/lib/Hakyll/Core/Identifier.hs +++ b/lib/Hakyll/Core/Identifier.hs @@ -22,7 +22,7 @@ import Control.DeepSeq (NFData (..)) import Data.List (intercalate) import System.FilePath (dropTrailingPathSeparator, splitPath, - pathSeparator) + pathSeparator, normalise) -------------------------------------------------------------------------------- @@ -64,18 +64,13 @@ -------------------------------------------------------------------------------- -- | 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 --- a/lib/Hakyll/Core/Identifier/Pattern.hs +++ b/lib/Hakyll/Core/Identifier/Pattern.hs @@ -64,6 +64,7 @@ tails) import Data.Maybe (isJust) import qualified Data.Set as S +import System.FilePath (normalise, pathSeparator) -------------------------------------------------------------------------------- @@ -74,6 +75,7 @@ -------------------------------------------------------------------------------- import Hakyll.Core.Identifier import Hakyll.Core.Identifier.Pattern.Internal +import Hakyll.Core.Util.String (removeWinPathSeparator) -------------------------------------------------------------------------------- @@ -84,14 +86,14 @@ -------------------------------------------------------------------------------- -- | 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 +184,7 @@ 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 = (removeWinPathSeparator $ toFilePath i) =~ r matches (Version v) i = identifierVersion i == v @@ -204,7 +206,7 @@ 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) = ((removeWinPathSeparator $ toFilePath i) =~ pat) :: (String, String, String, [String]) capture _ _ = Nothing @@ -218,8 +220,8 @@ | 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 diff --git a/lib/Hakyll/Core/Routes.hs b/lib/Hakyll/Core/Routes.hs --- a/lib/Hakyll/Core/Routes.hs +++ b/lib/Hakyll/Core/Routes.hs @@ -46,7 +46,7 @@ #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 @@ -> (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/File.hs b/lib/Hakyll/Core/Util/File.hs --- a/lib/Hakyll/Core/Util/File.hs +++ b/lib/Hakyll/Core/Util/File.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} -------------------------------------------------------------------------------- -- | A module containing various file utility functions module Hakyll.Core.Util.File @@ -8,10 +10,12 @@ -------------------------------------------------------------------------------- +import Control.Concurrent (threadDelay) +import Control.Exception (SomeException, catch) import Control.Monad (filterM, forM, when) import System.Directory (createDirectoryIfMissing, doesDirectoryExist, getDirectoryContents, - removeDirectoryRecursive) + removeDirectoryRecursive, removePathForcibly) import System.FilePath (takeDirectory, ()) @@ -51,6 +55,30 @@ -------------------------------------------------------------------------------- removeDirectory :: FilePath -> IO () +#ifndef mingw32_HOST_OS removeDirectory fp = do e <- doesDirectoryExist fp when e $ removeDirectoryRecursive fp +#else +-- Deleting files on Windows is unreliable. If a file/directory is open by a program (e.g. antivirus), +-- then removing related directories *quickly* may fail with strange messages. +-- See here for discussions: +-- https://github.com/haskell/directory/issues/96 +-- https://github.com/haskell/win32/pull/129 +-- +-- The hacky solution is to retry deleting directories a few times, +-- with a delay, on Windows only. +removeDirectory = retryWithDelay 10 . removePathForcibly +#endif + + +-------------------------------------------------------------------------------- +-- | Retry an operation at most /n/ times (/n/ must be positive). +-- If the operation fails the /n/th time it will throw that final exception. +-- A delay of 100ms is introduced between every retry. +retryWithDelay :: Int -> IO a -> IO a +retryWithDelay i x + | i <= 0 = error "Hakyll.Core.Util.File.retry: retry count must be 1 or more" + | i == 1 = x + | otherwise = catch x $ \(_::SomeException) -> threadDelay 100 >> retryWithDelay (i-1) x + diff --git a/lib/Hakyll/Core/Util/String.hs b/lib/Hakyll/Core/Util/String.hs --- a/lib/Hakyll/Core/Util/String.hs +++ b/lib/Hakyll/Core/Util/String.hs @@ -6,6 +6,7 @@ , replaceAll , splitAll , needlePrefix + , removeWinPathSeparator ) where @@ -76,3 +77,9 @@ 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]) diff --git a/lib/Hakyll/Web/Html.hs b/lib/Hakyll/Web/Html.hs --- a/lib/Hakyll/Web/Html.hs +++ b/lib/Hakyll/Web/Html.hs @@ -26,7 +26,7 @@ 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 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 @@ -- -- 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 @@ -------------------------------------------------------------------------------- -- | 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 [] = "." diff --git a/tests/Hakyll/Core/Identifier/Tests.hs b/tests/Hakyll/Core/Identifier/Tests.hs --- a/tests/Hakyll/Core/Identifier/Tests.hs +++ b/tests/Hakyll/Core/Identifier/Tests.hs @@ -13,6 +13,7 @@ -------------------------------------------------------------------------------- import Hakyll.Core.Identifier import Hakyll.Core.Identifier.Pattern +import System.FilePath (()) import TestSuite.Util @@ -27,22 +28,21 @@ -------------------------------------------------------------------------------- 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" ] diff --git a/tests/Hakyll/Core/Routes/Tests.hs b/tests/Hakyll/Core/Routes/Tests.hs --- a/tests/Hakyll/Core/Routes/Tests.hs +++ b/tests/Hakyll/Core/Routes/Tests.hs @@ -10,7 +10,7 @@ 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 @@ store <- newTestStore provider <- newTestProvider store (route, _) <- runRoutes r provider id' - Just expected @=? route + Just (normalise expected) @=? route cleanTestEnv diff --git a/tests/Hakyll/Core/Rules/Tests.hs b/tests/Hakyll/Core/Rules/Tests.hs --- a/tests/Hakyll/Core/Rules/Tests.hs +++ b/tests/Hakyll/Core/Rules/Tests.hs @@ -17,7 +17,7 @@ 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 @@ 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 diff --git a/tests/Hakyll/Core/UnixFilter/Tests.hs b/tests/Hakyll/Core/UnixFilter/Tests.hs --- a/tests/Hakyll/Core/UnixFilter/Tests.hs +++ b/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 @@ -------------------------------------------------------------------------------- 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" diff --git a/tests/Hakyll/Web/Html/Tests.hs b/tests/Hakyll/Web/Html/Tests.hs --- a/tests/Hakyll/Web/Html/Tests.hs +++ b/tests/Hakyll/Web/Html/Tests.hs @@ -44,6 +44,7 @@ , 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" diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs --- a/tests/Hakyll/Web/Template/Tests.hs +++ b/tests/Hakyll/Web/Template/Tests.hs @@ -12,6 +12,7 @@ (@=?), (@?=)) import Data.Either (isLeft) +import System.IO (nativeNewline, Newline(..)) -------------------------------------------------------------------------------- import Hakyll.Core.Compiler @@ -149,8 +150,11 @@ str <- testCompilerDone store provider "item3" $ applyTemplate embeddedTemplate defaultContext item - itemBody str @?= "

Hello, world

\n" + itemBody str @?= ("

Hello, world

" ++ (newline nativeNewline)) cleanTestEnv where item = Item "item1" "Hello, world" + + newline LF = "\n" + newline CRLF = "\r\n"