From 6885325146aa46adf255c55de0e0345a0f84961e Mon Sep 17 00:00:00 2001
From: Fraser Tweedale <frase@frase.id.au>
Date: Wed, 23 Jun 2021 03:26:20 +1000
Subject: add 'forceCompile' rules modifier (#857)

Compilers that use data from sources other than local files may need
to be recompiled, but Hakyll's file-based dependency checking does
not handle this situation.

Add a new kind of dependency called 'AlwaysOutOfDate'.  If an item
has this dependency, it will be unconditionally rebuilt.

Also add the 'forceCompile' rule modifier, which is a user-friendly
way to force recompilation of specific items.  Example usage:

    forceCompile $ create ["foo"] $ do
        route $ idRoute
        compile $ unsafeCompiler $ doSomeIO
---
 lib/Hakyll/Core/Dependencies.hs | 51 +++++++++++++++++++++++++++++++----------
 lib/Hakyll/Core/Rules.hs        |  9 ++++++++
 2 files changed, 48 insertions(+), 12 deletions(-)

diff --git a/lib/Hakyll/Core/Dependencies.hs b/lib/Hakyll/Core/Dependencies.hs
index 4a51b9c..f9b8048 100644
--- a/lib/Hakyll/Core/Dependencies.hs
+++ b/lib/Hakyll/Core/Dependencies.hs
@@ -33,6 +33,7 @@ import           Hakyll.Core.Identifier.Pattern
 data Dependency
     = PatternDependency Pattern (Set Identifier)
     | IdentifierDependency Identifier
+    | AlwaysOutOfDate
     deriving (Show, Typeable)
 
 
@@ -40,9 +41,11 @@ data Dependency
 instance Binary Dependency 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
+        2 -> pure AlwaysOutOfDate
         _ -> error "Data.Binary.get: Invalid Dependency"
 
 
@@ -84,13 +87,30 @@ markOod id' = State.modify $ \s ->
 
 
 --------------------------------------------------------------------------------
-dependenciesFor :: Identifier -> DependencyM [Identifier]
+-- | Collection of dependencies that should be checked to determine
+-- if an identifier needs rebuilding.
+data Dependencies
+  = DependsOn [Identifier]
+  | MustRebuild
+  deriving (Show)
+
+instance Semigroup Dependencies where
+  DependsOn ids <> DependsOn moreIds = DependsOn (ids <> moreIds)
+  MustRebuild <> _ = MustRebuild
+  _ <> MustRebuild = MustRebuild
+
+instance Monoid Dependencies where
+  mempty = DependsOn []
+
+--------------------------------------------------------------------------------
+dependenciesFor :: Identifier -> DependencyM Dependencies
 dependenciesFor id' = do
     facts <- dependencyFacts <$> State.get
-    return $ concatMap dependenciesFor' $ fromMaybe [] $ M.lookup id' facts
+    return $ foldMap dependenciesFor' $ fromMaybe [] $ M.lookup id' facts
   where
-    dependenciesFor' (IdentifierDependency i) = [i]
-    dependenciesFor' (PatternDependency _ is) = S.toList is
+    dependenciesFor' (IdentifierDependency i) = DependsOn [i]
+    dependenciesFor' (PatternDependency _ is) = DependsOn $ S.toList is
+    dependenciesFor' AlwaysOutOfDate          = MustRebuild
 
 
 --------------------------------------------------------------------------------
@@ -113,6 +133,7 @@ checkChangedPatterns = do
             {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
         universe <- ask
         let ls' = S.fromList $ filterMatches p universe
@@ -136,11 +157,17 @@ bruteForce = do
 
     check (todo, changed) id' = do
         deps <- dependenciesFor id'
-        ood  <- dependencyOod <$> State.get
-        case find (`S.member` ood) deps of
-            Nothing -> return (id' : todo, changed)
-            Just d  -> do
-                tell [show id' ++ " is out-of-date because " ++
-                    show d ++ " is out-of-date"]
-                markOod id'
-                return (todo, True)
+        case deps of
+          DependsOn depList -> do
+            ood  <- dependencyOod <$> State.get
+            case find (`S.member` ood) depList of
+                Nothing -> return (id' : todo, changed)
+                Just d  -> do
+                    tell [show id' ++ " is out-of-date because " ++
+                        show d ++ " is out-of-date"]
+                    markOod id'
+                    return (todo, True)
+          MustRebuild -> do
+            tell [show id' ++ " will be forcibly rebuilt"]
+            markOod id'
+            return (todo, True)
diff --git a/lib/Hakyll/Core/Rules.hs b/lib/Hakyll/Core/Rules.hs
index 41b9a73..695665a 100644
--- a/lib/Hakyll/Core/Rules.hs
+++ b/lib/Hakyll/Core/Rules.hs
@@ -29,6 +29,7 @@ module Hakyll.Core.Rules
     , preprocess
     , Dependency (..)
     , rulesExtraDependencies
+    , forceCompile
     ) where
 
 
@@ -221,3 +222,11 @@ rulesExtraDependencies deps rules =
             | (i, c) <- rulesCompilers ruleSet
             ]
         }
+
+
+--------------------------------------------------------------------------------
+-- | Force the item(s) to always be recompiled, whether or not the
+-- dependencies are out of date.  This can be useful if you are using
+-- I/O to generate part (or all) of an item.
+forceCompile :: Rules a -> Rules a
+forceCompile = rulesExtraDependencies [AlwaysOutOfDate]
-- 
cgit v1.2.3