diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,14 @@ # Releases +## 4.15.8.0 + +- Added support for djot for pandoc 3.1.12+ (#1096) +- Added support for pandoc 3.9 (#1095) +- Added support for declaring metadata-only dependencies (#1084). +- Added support for AsciiDoc for pandoc 3.8.3+ (#1089). +- Added support for tasty-1.5.4+ by disabling threaded tests. + ## Hakyll 4.16.7.1 (2025-09-06) - Added support for pandoc 3.8 (#1080). diff --git a/data/templates/atom.xml b/data/templates/atom.xml --- a/data/templates/atom.xml +++ b/data/templates/atom.xml @@ -1,6 +1,7 @@ $title$ + $root$$url$ diff --git a/data/templates/feed.json b/data/templates/feed.json --- a/data/templates/feed.json +++ b/data/templates/feed.json @@ -1,6 +1,7 @@ { "version": "https://www.jsonfeed.org/version/1.1", "title": "$title$", + "description": "$description$", "home_page_url": "$root$", "feed_url": "$root$$url$", $if(authorName)$ diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 4.16.7.1 +Version: 4.16.8.0 Synopsis: A static website compiler library Description: @@ -192,6 +192,7 @@ blaze-html >= 0.5 && < 0.10, bytestring >= 0.9 && < 0.13, containers >= 0.3 && < 0.9, + contravariant >= 1.5 && < 1.6, data-default >= 0.4 && < 0.9, deepseq >= 1.3 && < 1.6, directory >= 1.2.7.0 && < 1.4, @@ -209,12 +210,12 @@ resourcet >= 1.1 && < 1.4, scientific >= 0.3.4 && < 0.4, tagsoup >= 0.13.1 && < 0.15, - template-haskell >= 2.14 && < 2.24, + template-haskell >= 2.14 && < 2.25, text >= 0.11 && < 1.3 || >= 2.0 && < 2.2, - time >= 1.8 && < 1.15, + time >= 1.8 && < 1.16, time-locale-compat >= 0.1 && < 0.2, vector >= 0.11 && < 0.14, - wai-app-static >= 3.1 && < 3.2, + wai-app-static >= 3.1 && < 3.3, yaml >= 0.8.11 && < 0.12, xml-conduit >= 1.0 && < 1.11 @@ -253,7 +254,7 @@ Other-Modules: Hakyll.Web.Pandoc.Binary Build-Depends: - pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.9, + pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.10, pandoc-types >= 1.22 && < 1.24 Cpp-options: -DUSE_PANDOC @@ -262,7 +263,10 @@ Type: exitcode-stdio-1.0 Hs-source-dirs: tests Main-is: TestSuite.hs - Ghc-options: -Wall -threaded + -- Note that tests are purposefully run without + -- -threaded because of their side-effects. Test + -- failures became apparent with tasty-1.5.4 + Ghc-options: -Wall Default-language: Haskell2010 Other-modules: @@ -320,7 +324,7 @@ Cpp-options: -DUSE_PANDOC Build-Depends: - pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.9, + pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.10, pandoc-types >= 1.22 && < 1.24 @@ -355,5 +359,5 @@ base >= 4.12 && < 5, directory >= 1.0 && < 1.4, filepath >= 1.0 && < 1.6, - pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.9, + pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.10, pandoc-types >= 1.22 && < 1.24 diff --git a/lib/Hakyll/Core/Compiler.hs b/lib/Hakyll/Core/Compiler.hs --- a/lib/Hakyll/Core/Compiler.hs +++ b/lib/Hakyll/Core/Compiler.hs @@ -82,7 +82,7 @@ -- Note that this makes us dependend on that identifier: when the metadata -- of that item changes, the route may change, hence we have to recompile (mfp, um) <- compilerUnsafeIO $ runRoutes routes provider identifier - when um $ compilerTellDependencies [IdentifierDependency identifier] + when um $ compilerTellDependencies [metadataDependency $ IdentifierDependency identifier] return mfp diff --git a/lib/Hakyll/Core/Compiler/Internal.hs b/lib/Hakyll/Core/Compiler/Internal.hs --- a/lib/Hakyll/Core/Compiler/Internal.hs +++ b/lib/Hakyll/Core/Compiler/Internal.hs @@ -39,7 +39,7 @@ -------------------------------------------------------------------------------- import Control.Applicative (Alternative (..)) import Control.Exception (SomeException, handle) -import Control.Monad (forM_) +import Control.Monad (forM, forM_) import qualified Control.Monad.Fail as Fail import Control.Monad.Except (MonadError (..)) import Data.List.NonEmpty (NonEmpty (..)) @@ -196,7 +196,12 @@ -- | Access provided metadata from anywhere instance MonadMetadata Compiler where getMetadata = compilerGetMetadata - getMatches = compilerGetMatches + getMatches = compilerGetMatches KindContent + getAllMetadata pattern = do + matches' <- compilerGetMatches KindMetadata pattern + forM matches' $ \id' -> do + metadata <- getMetadata id' + return (id', metadata) -------------------------------------------------------------------------------- @@ -346,14 +351,14 @@ compilerGetMetadata :: Identifier -> Compiler Metadata compilerGetMetadata identifier = do provider <- compilerProvider <$> compilerAsk - compilerTellDependencies [IdentifierDependency identifier] + compilerTellDependencies [metadataDependency $ IdentifierDependency identifier] compilerUnsafeIO $ resourceMetadata provider identifier -------------------------------------------------------------------------------- -compilerGetMatches :: Pattern -> Compiler [Identifier] -compilerGetMatches pattern = do +compilerGetMatches :: DependencyKind -> Pattern -> Compiler [Identifier] +compilerGetMatches kind pattern = do universe <- compilerUniverse <$> compilerAsk let matching = S.filter (matches pattern) universe - compilerTellDependencies [PatternDependency pattern matching] + compilerTellDependencies [Dependency kind $ PatternDependency pattern matching] pure $ S.toList matching diff --git a/lib/Hakyll/Core/Compiler/Require.hs b/lib/Hakyll/Core/Compiler/Require.hs --- a/lib/Hakyll/Core/Compiler/Require.hs +++ b/lib/Hakyll/Core/Compiler/Require.hs @@ -105,7 +105,7 @@ when (id' `S.notMember` universe) (fail $ notFound id' snap) traverse_ checkMember ids - compilerTellDependencies $ IdentifierDependency . fst <$> toList ids + compilerTellDependencies $ contentDependency . IdentifierDependency . fst <$> toList ids let go (id', snap) = do result <- compilerUnsafeIO $ Store.get store (key id' snap) case result of diff --git a/lib/Hakyll/Core/Dependencies.hs b/lib/Hakyll/Core/Dependencies.hs --- a/lib/Hakyll/Core/Dependencies.hs +++ b/lib/Hakyll/Core/Dependencies.hs @@ -1,9 +1,14 @@ -------------------------------------------------------------------------------- {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TupleSections #-} module Hakyll.Core.Dependencies ( Dependency (..) + , DependencySelector (..) + , DependencyKind (..) , DependencyFacts , outOfDate + , contentDependency + , metadataDependency ) where @@ -15,6 +20,7 @@ import Control.Monad.Writer (tell) import Data.Binary (Binary (..), getWord8, putWord8) +import Data.Functor ((<&>)) import Data.List (find) import Data.Map (Map) import qualified Data.Map as M @@ -30,23 +36,54 @@ -------------------------------------------------------------------------------- -data Dependency +data DependencySelector = PatternDependency Pattern (Set Identifier) | IdentifierDependency Identifier - | AlwaysOutOfDate deriving (Show, Typeable) - -------------------------------------------------------------------------------- -instance Binary Dependency where +instance Binary DependencySelector where put (PatternDependency p is) = putWord8 0 >> put p >> put is put (IdentifierDependency i) = putWord8 1 >> put i - put AlwaysOutOfDate = putWord8 2 get = getWord8 >>= \t -> case t of 0 -> PatternDependency <$> get <*> get 1 -> IdentifierDependency <$> get + _ -> fail "Data.Binary.get: Invalid DependencySelector" + + +-------------------------------------------------------------------------------- +-- | A data type representing a dependency on another 'Identifier'. We can +-- depend either on the 'Hakyll.Core.Metadata.Metadata' or the entire content of +-- the underlying file. This is signified by the supplied 'DependencyKind'. +data Dependency + = Dependency DependencyKind DependencySelector + | AlwaysOutOfDate + deriving (Show, Typeable) + + +-------------------------------------------------------------------------------- +-- | Utility function to create a new content dependency. +contentDependency :: DependencySelector -> Dependency +contentDependency = Dependency KindContent + +-- | Utility function to a create a new metadata dependency. +metadataDependency :: DependencySelector -> Dependency +metadataDependency = Dependency KindMetadata + + +-------------------------------------------------------------------------------- +instance Binary Dependency where + put AlwaysOutOfDate = putWord8 2 + put (Dependency k s) = putWord8 3 >> put k >> put s + + get = getWord8 >>= \t -> case t of + -- XXX: Backwards compatability with Hakyll <=4.16.7.1. + 0 -> (\p i -> contentDependency $ PatternDependency p i) <$> get <*> get + 1 -> contentDependency . IdentifierDependency <$> get + 2 -> pure AlwaysOutOfDate - _ -> error "Data.Binary.get: Invalid Dependency" + 3 -> Dependency <$> get <*> get + _ -> fail "Data.Binary.get: Invalid Dependency" -------------------------------------------------------------------------------- @@ -56,11 +93,12 @@ -------------------------------------------------------------------------------- outOfDate :: [Identifier] -- ^ All known identifiers - -> Set Identifier -- ^ Initially out-of-date resources + -> Set Identifier -- ^ Changed content + -> Set Identifier -- ^ Changed metadata -> DependencyFacts -- ^ Old dependency facts -> (Set Identifier, DependencyFacts, [String]) -outOfDate universe ood oldFacts = - let (_, state, logs) = runRWS rws universe (DependencyState oldFacts ood) +outOfDate universe ood oodMeta oldFacts = + let (_, state, logs) = runRWS rws universe (DependencyState oldFacts ood oodMeta) in (dependencyOod state, dependencyFacts state, logs) where rws = do @@ -71,8 +109,9 @@ -------------------------------------------------------------------------------- data DependencyState = DependencyState - { dependencyFacts :: DependencyFacts - , dependencyOod :: Set Identifier + { dependencyFacts :: DependencyFacts + , dependencyOod :: Set Identifier + , dependencyOodMeta :: Set Identifier } deriving (Show) @@ -87,10 +126,23 @@ -------------------------------------------------------------------------------- +data DependencyKind = KindContent | KindMetadata + deriving (Show) + +instance Binary DependencyKind where + put KindContent = putWord8 0 + put KindMetadata = putWord8 1 + + get = getWord8 >>= \t -> case t of + 0 -> pure KindContent + 1 -> pure KindMetadata + _ -> fail "Data.Binary.get: Invalid DependencyKind" + +-------------------------------------------------------------------------------- -- | Collection of dependencies that should be checked to determine -- if an identifier needs rebuilding. data Dependencies - = DependsOn [Identifier] + = DependsOn [(DependencyKind, Identifier)] | MustRebuild deriving (Show) @@ -108,11 +160,14 @@ facts <- dependencyFacts <$> State.get return $ foldMap dependenciesFor' $ fromMaybe [] $ M.lookup id' facts where - dependenciesFor' (IdentifierDependency i) = DependsOn [i] - dependenciesFor' (PatternDependency _ is) = DependsOn $ S.toList is - dependenciesFor' AlwaysOutOfDate = MustRebuild + dependenciesForSelector (IdentifierDependency i) = [i] + dependenciesForSelector (PatternDependency _ is) = S.toList is + dependenciesFor' AlwaysOutOfDate = MustRebuild + dependenciesFor' (Dependency kind selector) = DependsOn $ + map (kind,) $ dependenciesForSelector selector + -------------------------------------------------------------------------------- checkNew :: DependencyM () checkNew = do @@ -132,19 +187,21 @@ State.modify $ \s -> s {dependencyFacts = M.insert id' deps' $ dependencyFacts s} where - go _ ds (IdentifierDependency i) = return $ IdentifierDependency i : ds - go _ ds AlwaysOutOfDate = return $ AlwaysOutOfDate : ds - go id' ds (PatternDependency p ls) = do + go' _ (IdentifierDependency i) = return $ IdentifierDependency i + go' id' (PatternDependency p ls) = do universe <- ask let ls' = S.fromList $ filterMatches p universe if ls == ls' - then return $ PatternDependency p ls : ds + then return $ PatternDependency p ls else do tell [show id' ++ " is out-of-date because a pattern changed"] markOod id' - return $ PatternDependency p ls' : ds + return $ PatternDependency p ls' + go _ ds AlwaysOutOfDate = return $ AlwaysOutOfDate : ds + go id' ds (Dependency kind select) = (Dependency kind <$> go' id' select) <&> (: ds) + -------------------------------------------------------------------------------- bruteForce :: DependencyM () bruteForce = do @@ -155,12 +212,19 @@ (todo', changed) <- foldM check ([], False) todo when changed (go todo') + findOod oodContent oodMetadata (k, i) + = S.member i $ + case k of + KindContent -> oodContent + KindMetadata -> oodMetadata + check (todo, changed) id' = do deps <- dependenciesFor id' case deps of DependsOn depList -> do - ood <- dependencyOod <$> State.get - case find (`S.member` ood) depList of + ood <- dependencyOod <$> State.get + oodMeta <- dependencyOodMeta <$> State.get + case find (findOod ood oodMeta) depList of Nothing -> return (id' : todo, changed) Just d -> do tell [show id' ++ " is out-of-date because " ++ diff --git a/lib/Hakyll/Core/Metadata.hs b/lib/Hakyll/Core/Metadata.hs --- a/lib/Hakyll/Core/Metadata.hs +++ b/lib/Hakyll/Core/Metadata.hs @@ -84,10 +84,10 @@ -------------------------------------------------------------------------------- -makePatternDependency :: MonadMetadata m => Pattern -> m Dependency -makePatternDependency pattern = do +makePatternDependency :: MonadMetadata m => DependencyKind -> Pattern -> m Dependency +makePatternDependency kind pattern = do matches' <- getMatches pattern - return $ PatternDependency pattern (S.fromList matches') + return $ Dependency kind (PatternDependency pattern (S.fromList matches')) -------------------------------------------------------------------------------- diff --git a/lib/Hakyll/Core/Provider.hs b/lib/Hakyll/Core/Provider.hs --- a/lib/Hakyll/Core/Provider.hs +++ b/lib/Hakyll/Core/Provider.hs @@ -22,22 +22,38 @@ , Internal.resourceBody ) where - -------------------------------------------------------------------------------- +import Control.Monad (forM) import qualified Hakyll.Core.Provider.Internal as Internal import qualified Hakyll.Core.Provider.MetadataCache as Internal import Hakyll.Core.Store (Store) +import Hakyll.Core.Identifier (Identifier) -------------------------------------------------------------------------------- -- | Create a resource provider -newProvider :: Store -- ^ Store to use - -> (FilePath -> IO Bool) -- ^ Should we ignore this file? - -> FilePath -- ^ Search directory - -> IO Internal.Provider -- ^ Resulting provider +newProvider :: Store -- ^ Store to use + -> (FilePath -> IO Bool) -- ^ Should we ignore this file? + -> FilePath -- ^ Search directory + -> IO (Internal.Provider, [Identifier]) -- ^ Resulting provider and modified metadata newProvider store ignore directory = do - -- Delete metadata cache where necessary - p <- Internal.newProvider store ignore directory - mapM_ (Internal.resourceInvalidateMetadataCache p) $ - filter (Internal.resourceModified p) $ Internal.resourceList p - return p + p <- Internal.newProvider store ignore directory + + let modified = + filter + (Internal.resourceModified p) + (Internal.resourceList p) + + -- Delete metadata cache where necessary and extract identifiers for which the + -- metadata was actually modified. That is, exclude identifiers where the body + -- was modified but the metadata wasn't. + modifiedMetadata <- fmap concat $ forM modified $ \identifier -> do + mbCachedMetadata <- Internal.resourceLookupMetadataCache p identifier + case mbCachedMetadata of + Nothing -> pure [] + Just oldMeta -> do + Internal.resourceInvalidateMetadataCache p identifier + newMeta <- Internal.resourceMetadata p identifier + pure $ if oldMeta == newMeta then [] else [identifier] + + return (p, modifiedMetadata) diff --git a/lib/Hakyll/Core/Provider/MetadataCache.hs b/lib/Hakyll/Core/Provider/MetadataCache.hs --- a/lib/Hakyll/Core/Provider/MetadataCache.hs +++ b/lib/Hakyll/Core/Provider/MetadataCache.hs @@ -2,12 +2,14 @@ module Hakyll.Core.Provider.MetadataCache ( resourceMetadata , resourceBody + , resourceLookupMetadataCache , resourceInvalidateMetadataCache ) where -------------------------------------------------------------------------------- import Control.Monad (unless) +import Data.Maybe (fromMaybe) import Hakyll.Core.Identifier import Hakyll.Core.Metadata import Hakyll.Core.Provider.Internal @@ -22,9 +24,7 @@ | otherwise = do -- TODO keep time in md cache load p r - Store.Found (BinaryMetadata md) <- Store.get (providerStore p) - [name, toFilePath r, "metadata"] - return md + fromMaybe mempty <$> resourceLookupMetadataCache p r -------------------------------------------------------------------------------- @@ -34,6 +34,18 @@ Store.Found bd <- Store.get (providerStore p) [name, toFilePath r, "body"] maybe (resourceString p r) return bd + + +-------------------------------------------------------------------------------- +-- | Perform a lookup for metadata in the cache only. +-- Useful internally for invalidation. +resourceLookupMetadataCache :: Provider -> Identifier -> IO (Maybe Metadata) +resourceLookupMetadataCache p r = do + result <- Store.get (providerStore p) [name, toFilePath r, "metadata"] + pure $ case result of + Store.Found (BinaryMetadata m) -> Just m + Store.NotFound -> Nothing + Store.WrongType _ _ -> error "unexpected WrongType" -------------------------------------------------------------------------------- diff --git a/lib/Hakyll/Core/Runtime.hs b/lib/Hakyll/Core/Runtime.hs --- a/lib/Hakyll/Core/Runtime.hs +++ b/lib/Hakyll/Core/Runtime.hs @@ -71,7 +71,7 @@ Logger.message logger "Creating store..." store <- Store.new (inMemoryCache config) $ storeDirectory config Logger.message logger "Creating provider..." - provider <- newProvider store (shouldIgnoreFile config) $ + (provider, modifiedMeta) <- newProvider store (shouldIgnoreFile config) $ providerDirectory config Logger.message logger "Running rules..." ruleSet <- runRules rules provider @@ -88,6 +88,7 @@ { runtimeConfiguration = config , runtimeLogger = logger , runtimeProvider = provider + , runtimeModifiedMeta = Set.fromList modifiedMeta , runtimeStore = store , runtimeRoutes = rulesRoutes ruleSet , runtimeUniverse = Map.fromList compilers @@ -116,6 +117,7 @@ { runtimeConfiguration :: Configuration , runtimeLogger :: Logger , runtimeProvider :: Provider + , runtimeModifiedMeta :: Set Identifier , runtimeStore :: Store , runtimeRoutes :: Routes , runtimeUniverse :: Map Identifier (Compiler SomeItem) @@ -185,9 +187,10 @@ schedulerMarkOutOfDate :: Map Identifier (Compiler SomeItem) -> Set Identifier + -> Set Identifier -> Scheduler -> (Scheduler, [String]) -schedulerMarkOutOfDate universe modified scheduler@Scheduler {..} = +schedulerMarkOutOfDate universe modifiedC modifiedM scheduler@Scheduler {..} = ( scheduler { schedulerQueue = schedulerQueue <> Seq.fromList (Map.keys todo) , schedulerDone = schedulerDone <> @@ -198,7 +201,7 @@ , msgs ) where - (ood, facts', msgs) = outOfDate (Map.keys universe) modified schedulerFacts + (ood, facts', msgs) = outOfDate (Map.keys universe) modifiedC modifiedM schedulerFacts todo = Map.filterWithKey (\id' _ -> id' `Set.member` ood) universe @@ -396,13 +399,14 @@ -------------------------------------------------------------------------------- scheduleOutOfDate :: ReaderT RuntimeRead IO () scheduleOutOfDate = do - logger <- runtimeLogger <$> ask - provider <- runtimeProvider <$> ask - universe <- runtimeUniverse <$> ask - schedulerRef <- runtimeScheduler <$> ask - let modified = Set.filter (resourceModified provider) (Map.keysSet universe) + logger <- runtimeLogger <$> ask + provider <- runtimeProvider <$> ask + modifiedMeta <- runtimeModifiedMeta <$> ask + universe <- runtimeUniverse <$> ask + schedulerRef <- runtimeScheduler <$> ask + let modifiedContent = Set.filter (resourceModified provider) (Map.keysSet universe) msgs <- liftIO . IORef.atomicModifyIORef' schedulerRef $ - schedulerMarkOutOfDate universe modified + schedulerMarkOutOfDate universe modifiedContent modifiedMeta -- Print messages mapM_ (Logger.debug logger) msgs diff --git a/lib/Hakyll/Web/Paginate.hs b/lib/Hakyll/Web/Paginate.hs --- a/lib/Hakyll/Web/Paginate.hs +++ b/lib/Hakyll/Web/Paginate.hs @@ -19,6 +19,7 @@ -------------------------------------------------------------------------------- import Hakyll.Core.Compiler +import Hakyll.Core.Dependencies import Hakyll.Core.Identifier import Hakyll.Core.Identifier.Pattern import Hakyll.Core.Item @@ -68,7 +69,7 @@ return Paginate { paginateMap = M.fromList (zip [1 ..] idGroups) , paginateMakeId = makeId - , paginateDependency = PatternDependency pattern idsSet + , paginateDependency = contentDependency $ PatternDependency pattern idsSet } diff --git a/lib/Hakyll/Web/Pandoc.hs b/lib/Hakyll/Web/Pandoc.hs --- a/lib/Hakyll/Web/Pandoc.hs +++ b/lib/Hakyll/Web/Pandoc.hs @@ -68,6 +68,12 @@ MediaWiki -> readMediaWiki ro OrgMode -> readOrg ro Rst -> readRST ro +#if MIN_VERSION_pandoc(3,8,3) + AsciiDoc -> readAsciiDoc ro +#endif +#if MIN_VERSION_pandoc(3,1,12) + Djot -> readDjot ro +#endif -- This preprocessing instruction can be dropped -- once the minimum supported GHC version is 8.10 #if MIN_VERSION_pandoc(3,1,3) diff --git a/lib/Hakyll/Web/Pandoc/FileType.hs b/lib/Hakyll/Web/Pandoc/FileType.hs --- a/lib/Hakyll/Web/Pandoc/FileType.hs +++ b/lib/Hakyll/Web/Pandoc/FileType.hs @@ -34,6 +34,12 @@ | PlainText | Rst | Textile +#if MIN_VERSION_pandoc(3,8,3) + | AsciiDoc +#endif +#if MIN_VERSION_pandoc(3,1,12) + | Djot +#endif -- This preprocessing instruction can be dropped -- once the minimum supported GHC version is 8.10 #if MIN_VERSION_pandoc(3,1,3) @@ -72,6 +78,14 @@ fileType' _ ".text" = PlainText fileType' _ ".textile" = Textile fileType' _ ".txt" = PlainText +#if MIN_VERSION_pandoc(3,8,3) + fileType' _ ".asciidoc" = AsciiDoc + fileType' _ ".adoc" = AsciiDoc +#endif +#if MIN_VERSION_pandoc(3,1,12) + fileType' _ ".dj" = Djot + fileType' _ ".djot" = Djot +#endif -- This preprocessing instruction can be dropped -- once the minimum supported GHC version is 8.10 #if MIN_VERSION_pandoc(3,1,3) diff --git a/lib/Hakyll/Web/Tags.hs b/lib/Hakyll/Web/Tags.hs --- a/lib/Hakyll/Web/Tags.hs +++ b/lib/Hakyll/Web/Tags.hs @@ -136,7 +136,8 @@ ids <- getMatches pattern tagMap <- foldM addTags M.empty ids let set' = S.fromList ids - return $ Tags (M.toList tagMap) makeId (PatternDependency pattern set') + return $ Tags (M.toList tagMap) makeId + (metadataDependency $ PatternDependency pattern set') where -- Create a tag map for one page addTags tagMap id' = do diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs --- a/lib/Hakyll/Web/Template/Context.hs +++ b/lib/Hakyll/Web/Template/Context.hs @@ -54,27 +54,28 @@ -------------------------------------------------------------------------------- -import Control.Applicative (Alternative (..)) -import Control.Monad (msum) +import Control.Applicative (Alternative (..)) +import Control.Monad (msum) #if !MIN_VERSION_base(4,13,0) -import Control.Monad.Fail (MonadFail) +import Control.Monad.Fail (MonadFail) #endif -import Data.List (intercalate, tails) -import Data.Time.Clock (UTCTime (..)) -import Data.Time.Format (formatTime, parseTimeM) -import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale) +import Data.Functor.Contravariant (Contravariant (..)) +import Data.Functor.Contravariant.Divisible (Divisible (..), Decidable (..)) +import Data.List (intercalate, tails) +import Data.Time.Clock (UTCTime (..)) +import Data.Time.Format (formatTime, parseTimeM) +import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale) import Hakyll.Core.Compiler import Hakyll.Core.Compiler.Internal import Hakyll.Core.Identifier import Hakyll.Core.Item import Hakyll.Core.Metadata import Hakyll.Core.Provider -import Hakyll.Core.Util.String (needlePrefix, splitAll) +import Hakyll.Core.Util.String (needlePrefix, splitAll) import Hakyll.Web.Html -import Prelude hiding (id) -import System.FilePath (dropExtension, splitDirectories, - takeBaseName) - +import Prelude hiding (id) +import System.FilePath (dropExtension, splitDirectories, + takeBaseName) -------------------------------------------------------------------------------- -- | Mostly for internal usage @@ -114,7 +115,18 @@ mempty = missingField mappend = (<>) +instance Contravariant Context where + contramap f ctx = Context (\s ss -> unContext ctx s ss . fmap f) +instance Divisible Context where + divide f c1 c2 = contramap (fst . f) c1 <> contramap (snd . f) c2 + conquer = missingField + +instance Decidable Context where + choose f (Context c1) (Context c2) = Context (\s ss (Item i e) -> + either (c1 s ss . Item i) (c2 s ss . Item i) (f e)) + lose f = contramap f missingField + -------------------------------------------------------------------------------- field' :: String -> (Item a -> Compiler ContextField) -> Context a field' key value = Context $ \k _ i -> @@ -152,14 +164,14 @@ -------------------------------------------------------------------------------- --- | Creates a 'field' to use with the @$if()$@ template macro, in the --- 'Compiler' monad. Attempting to substitute the field into the template +-- | Creates a 'field' to use with the @$if()$@ template macro, in the +-- 'Compiler' monad. Attempting to substitute the field into the template -- will cause an error. -- -- @since 4.16.4.0 boolFieldM :: String -- ^ Key - -> (Item a -> Compiler Bool) -- ^ Extract value from an @'Item' a@ + -> (Item a -> Compiler Bool) -- ^ Extract value from an @'Item' a@ -- from within the 'Compiler' monad -> Context a boolFieldM name f = field' name (\i -> do diff --git a/tests/Hakyll/Core/Dependencies/Tests.hs b/tests/Hakyll/Core/Dependencies/Tests.hs --- a/tests/Hakyll/Core/Dependencies/Tests.hs +++ b/tests/Hakyll/Core/Dependencies/Tests.hs @@ -22,7 +22,7 @@ -------------------------------------------------------------------------------- tests :: TestTree tests = testGroup "Hakyll.Core.Dependencies.Tests" $ - fromAssertions "analyze" [case01, case02, case03] + fromAssertions "analyze" [case01, case02, case03, case04, case05] -------------------------------------------------------------------------------- @@ -38,11 +38,15 @@ , ("posts/02.md", []) , ("index.md", - [ PatternDependency "posts/*" + [ contentDependency $ PatternDependency "posts/*" (S.fromList ["posts/01.md", "posts/02.md"]) - , IdentifierDependency "posts/01.md" - , IdentifierDependency "posts/02.md" + , contentDependency $ IdentifierDependency "posts/01.md" + , contentDependency $ IdentifierDependency "posts/02.md" ]) + , ("sidebar", + [ metadataDependency $ PatternDependency "posts/*" + (S.fromList ["posts/01.md", "posts/02.md"]) + ]) ] @@ -51,7 +55,7 @@ case01 :: Assertion case01 = S.fromList ["posts/02.md", "index.md"] @=? ood where - (ood, _, _) = outOfDate oldUniverse (S.singleton "posts/02.md") oldFacts + (ood, _, _) = outOfDate oldUniverse (S.singleton "posts/02.md") S.empty oldFacts -------------------------------------------------------------------------------- @@ -59,13 +63,31 @@ case02 :: Assertion case02 = S.singleton "about.md" @=? ood where - (ood, _, _) = outOfDate ("about.md" : oldUniverse) S.empty oldFacts + (ood, _, _) = outOfDate ("about.md" : oldUniverse) S.empty S.empty oldFacts -------------------------------------------------------------------------------- -- | posts/01.md was removed case03 :: Assertion -case03 = S.singleton "index.md" @=? ood +case03 = S.fromList ["index.md", "sidebar"] @=? ood where (ood, _, _) = - outOfDate ("posts/01.md" `delete` oldUniverse) S.empty oldFacts + outOfDate ("posts/01.md" `delete` oldUniverse) S.empty S.empty oldFacts + + +-------------------------------------------------------------------------------- +-- | metadata of posts/01.md was changed +case04 :: Assertion +case04 = S.singleton "sidebar" @=? ood + where + (ood, _, _) = + outOfDate oldUniverse S.empty (S.singleton "posts/01.md") oldFacts + + +-------------------------------------------------------------------------------- +-- | content of posts/01.md was changed but metadata wasn't +case05 :: Assertion +case05 = S.fromList ["posts/01.md", "index.md"] @=? ood + where + (ood, _, _) = + outOfDate oldUniverse (S.singleton "posts/01.md") S.empty oldFacts diff --git a/tests/TestSuite/Util.hs b/tests/TestSuite/Util.hs --- a/tests/TestSuite/Util.hs +++ b/tests/TestSuite/Util.hs @@ -48,8 +48,10 @@ -------------------------------------------------------------------------------- newTestProvider :: Store -> IO Provider -newTestProvider store = newProvider store (const $ return False) $ - providerDirectory testConfiguration +newTestProvider store = do + let dir = providerDirectory testConfiguration + (p, _) <- newProvider store (const $ return False) dir + pure p --------------------------------------------------------------------------------