hakyll 4.16.7.1 → 4.16.8.0

raw patch · 19 files changed

+263/−90 lines, 19 filesdep +contravariantdep ~QuickCheckdep ~tastyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: contravariant

Dependency ranges changed: QuickCheck, tasty

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• data/templates/atom.xml +1/−0
• data/templates/feed.json +1/−0
• hakyll.cabal +12/−8
• lib/Hakyll/Core/Compiler.hs +1/−1
• lib/Hakyll/Core/Compiler/Internal.hs +11/−6
• lib/Hakyll/Core/Compiler/Require.hs +1/−1
• lib/Hakyll/Core/Dependencies.hs +86/−22
• lib/Hakyll/Core/Metadata.hs +3/−3
• lib/Hakyll/Core/Provider.hs +26/−10
• lib/Hakyll/Core/Provider/MetadataCache.hs +15/−3
• lib/Hakyll/Core/Runtime.hs +13/−9
• lib/Hakyll/Web/Paginate.hs +2/−1
• lib/Hakyll/Web/Pandoc.hs +6/−0
• lib/Hakyll/Web/Pandoc/FileType.hs +14/−0
• lib/Hakyll/Web/Tags.hs +2/−1
• lib/Hakyll/Web/Template/Context.hs +27/−15
• tests/Hakyll/Core/Dependencies/Tests.hs +30/−8
• tests/TestSuite/Util.hs +4/−2

@@ -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).

@@ -1,6 +1,7 @@ <?xml version="1.0" encoding="utf-8"?> <feed xmlns="http://www.w3.org/2005/Atom">     <title>$title$</title>+    <subtitle><![CDATA[$description$]]></subtitle>     <link href="$root$$url$" rel="self" />     <link href="$root$" />     <id>$root$$url$</id>

@@ -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)$

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

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

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

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

@@ -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 " ++

@@ -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'))   --------------------------------------------------------------------------------

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

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

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

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

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

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

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

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

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

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