diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 4.6.3.0 +Version: 4.6.4.0 Synopsis: A static website compiler library Description: diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -19,6 +19,7 @@ module Hakyll.Core.Rules ( Rules , match + , matchMetadata , create , version , compile @@ -120,15 +121,25 @@ -------------------------------------------------------------------------------- -match :: Pattern -> Rules () -> Rules () -match pattern rules = do +matchInternal :: Pattern -> Rules [Identifier] -> Rules () -> Rules () +matchInternal pattern getIDs rules = do tellPattern pattern flush - ids <- getMatches pattern + ids <- getIDs tellResources ids Rules $ local (setMatches ids) $ unRules $ rules >> flush where setMatches ids env = env {rulesMatches = ids} + +-------------------------------------------------------------------------------- +match :: Pattern -> Rules () -> Rules () +match pattern = matchInternal pattern $ getMatches pattern + + +-------------------------------------------------------------------------------- +matchMetadata :: Pattern -> (Metadata -> Bool) -> Rules () -> Rules () +matchMetadata pattern metadataPred = matchInternal pattern $ + map fst . filter (metadataPred . snd) <$> getAllMetadata pattern -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs --- a/src/Hakyll/Core/Runtime.hs +++ b/src/Hakyll/Core/Runtime.hs @@ -208,13 +208,13 @@ -- Signal that a snapshot was saved -> CompilerSnapshot snapshot c -> do - -- Update info and just continue. + -- Update info. The next 'chase' will pick us again at some + -- point so we can continue then. modify $ \s -> s { runtimeSnapshots = S.insert (id', snapshot) (runtimeSnapshots s) , runtimeTodo = M.insert id' c (runtimeTodo s) } - chase trail id' -- Huge success CompilerDone (SomeItem item) cwrite -> do diff --git a/src/Hakyll/Init.hs b/src/Hakyll/Init.hs --- a/src/Hakyll/Init.hs +++ b/src/Hakyll/Init.hs @@ -8,12 +8,13 @@ import Control.Arrow (first) import Control.Monad (forM_) import Data.Char (isAlphaNum, isNumber) +import Data.List (foldl') import Data.List (intercalate) -import Data.Version (Version(..)) -import System.Directory (copyFile, canonicalizePath) +import Data.Version (Version (..)) +import System.Directory (canonicalizePath, copyFile) import System.Environment (getArgs, getProgName) import System.Exit (exitFailure) -import System.FilePath ((), splitDirectories) +import System.FilePath (splitDirectories, ()) -------------------------------------------------------------------------------- @@ -37,38 +38,25 @@ putStrLn $ "Creating " ++ dst makeDirectories dst copyFile src dst - -- canonicalizePath is safe because the destination - -- directory should exist at this point - canonicalizePath dstDir >>= createCabal + + name <- makeName dstDir + let cabalPath = dstDir name ++ ".cabal" + putStrLn $ "Creating " ++ cabalPath + createCabal cabalPath name _ -> do putStrLn $ "Usage: " ++ progName ++ " " exitFailure - -createCabal :: FilePath -> IO () -createCabal dstDir = do - putStrLn $ "Creating " ++ name ++ ".cabal" - writeFile (dstDir name ++ ".cabal") $ unlines [ - "name: " ++ name - , "version: 0.1.0.0" - , "build-type: Simple" - , "cabal-version: >= 1.10" - , "" - , "executable site" - , " main-is: site.hs" - , " build-depends: base == 4.*" - , " , hakyll == " ++ version' ++ ".*" - , " ghc-options: -threaded" - , " default-language: Haskell2010" - ] +-- | Figure out a good cabal package name from the given (existing) directory +-- name +makeName :: FilePath -> IO String +makeName dstDir = do + canonical <- canonicalizePath dstDir + return $ case safeLast (splitDirectories canonical) of + Nothing -> fallbackName + Just "/" -> fallbackName + Just x -> repair (fallbackName ++) id x where - -- Major hakyll version - version' = intercalate "." . take 2 . map show $ versionBranch version - -- last is safe here as the path is canonicalised and "/" is just - -- a very rare but possible corner case - name = case last (splitDirectories dstDir) of - "/" -> fallbackName - x -> repair (fallbackName ++) id x -- Package name repair code comes from -- cabal-install.Distribution.Client.Init.Heuristics repair invalid valid x = case dropWhile (not . isAlphaNum) x of @@ -79,3 +67,24 @@ | otherwise = valid c repairRest = repair id ('-' :) fallbackName = "site" + + safeLast = foldl' (\_ x -> Just x) Nothing + +createCabal :: FilePath -> String -> IO () +createCabal path name = do + writeFile (path ++ ".cabal") $ unlines [ + "name: " ++ name + , "version: 0.1.0.0" + , "build-type: Simple" + , "cabal-version: >= 1.10" + , "" + , "executable site" + , " main-is: site.hs" + , " build-depends: base == 4.*" + , " , hakyll == " ++ version' ++ ".*" + , " ghc-options: -threaded" + , " default-language: Haskell2010" + ] + where + -- Major hakyll version + version' = intercalate "." . take 2 . map show $ versionBranch version 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 @@ -8,7 +8,9 @@ -------------------------------------------------------------------------------- import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import qualified Data.Map as M import qualified Data.Set as S +import System.FilePath (()) import Test.Framework (Test, testGroup) import Test.HUnit (Assertion, assert, (@=?)) @@ -44,22 +46,29 @@ runRoutes routes provider i >>= \(r, _) -> Just ex @=? r -- Test that we have some identifiers and that the routes work out - assert $ all (`S.member` identifiers) expected - checkRoute "example.html" "example.md" - checkRoute "example.md" (sv "raw" "example.md") - checkRoute "example.md" (sv "nav" "example.md") - checkRoute "example.mv1" (sv "mv1" "example.md") - checkRoute "example.mv2" (sv "mv2" "example.md") + S.fromList expected @=? identifiers + checkRoute "example.html" "example.md" + checkRoute "example.md" (sv "raw" "example.md") + checkRoute "example.md" (sv "nav" "example.md") + checkRoute "example.mv1" (sv "mv1" "example.md") + checkRoute "example.mv2" (sv "mv2" "example.md") + checkRoute "food/example.md" (sv "metadataMatch" "example.md") readIORef ioref >>= assert cleanTestEnv where sv g = setVersion (Just g) expected = - [ "example.md" - , "russian.md" - , sv "raw" "example.md" + [ "example.md" + , sv "raw" "example.md" + , sv "metadataMatch" "example.md" + , sv "nav" "example.md" + , sv "mv1" "example.md" + , sv "mv2" "example.md" + + , "russian.md" , sv "raw" "russian.md" - , sv "nav" "example.md" + , sv "mv1" "russian.md" + , sv "mv2" "russian.md" ] @@ -78,6 +87,11 @@ match "*.md" $ version "raw" $ do route idRoute compile getResourceString + + version "metadataMatch" $ + matchMetadata "*.md" (\md -> M.lookup "subblog" md == Just "food") $ do + route $ customRoute $ \id' -> "food" toFilePath id' + compile getResourceString -- Regression test version "nav" $ match (fromList ["example.md"]) $ do