build: add --dry-run option (jaspervdj#877)

Add a --dry-run option to the build command. In this mode, build prints the list of items that need to be (re)compiled. This mode is also useful for benchmarking the initialisation phase.
Zekt · Sep 12, 2021 · c1384bb · c1384bb
1 parent abd8c27
commit c1384bb
Show file tree

Hide file tree

Showing 5 changed files with 41 additions and 24 deletions.
diff --git a/lib/Hakyll/Commands.hs b/lib/Hakyll/Commands.hs
@@ -48,8 +48,8 @@ import           System.IO.Error            (catchIOError)
 
 --------------------------------------------------------------------------------
 -- | Build the site
-build :: Configuration -> Logger -> Rules a -> IO ExitCode
-build conf logger rules = fst <$> run conf logger rules
+build :: RunMode -> Configuration -> Logger -> Rules a -> IO ExitCode
+build mode conf logger rules = fst <$> run mode conf logger rules
 
 
 --------------------------------------------------------------------------------
@@ -105,7 +105,7 @@ watch conf logger host port runServer rules = do
     server'
   where
     update = do
-        (_, ruleSet) <- run conf logger rules
+        (_, ruleSet) <- run RunModeNormal conf logger rules
         return $ rulesPattern ruleSet
     loop = threadDelay 100000 >> loop
     server' = if runServer then server conf logger host port else loop
@@ -117,7 +117,7 @@ watch _ _ _ _ _ _ = watchServerDisabled
 -- | Rebuild the site
 rebuild :: Configuration -> Logger -> Rules a -> IO ExitCode
 rebuild conf logger rules =
-    clean conf logger >> build conf logger rules
+    clean conf logger *> build RunModeNormal conf logger rules
 
 --------------------------------------------------------------------------------
 -- | Start a server

diff --git a/lib/Hakyll/Core/Runtime.hs b/lib/Hakyll/Core/Runtime.hs
@@ -1,6 +1,7 @@
 --------------------------------------------------------------------------------
 module Hakyll.Core.Runtime
     ( run
+    , RunMode(..)
     ) where
 
 
@@ -12,6 +13,7 @@ import           Control.Monad.Except            (ExceptT, runExceptT, throwErro
 import           Control.Monad.Reader            (ReaderT, ask, runReaderT)
 import           Control.Monad.Trans             (liftIO)
 import qualified Data.Array                      as A
+import           Data.Foldable                   (traverse_)
 import           Data.Graph                      (Graph)
 import qualified Data.Graph                      as G
 import           Data.List                       (intercalate)
@@ -43,9 +45,19 @@ import           Hakyll.Core.Util.File
 import           Hakyll.Core.Writable
 
 
+factsKey :: [String]
+factsKey = ["Hakyll.Core.Runtime.run", "facts"]
+
+
+--------------------------------------------------------------------------------
+-- | Whether to execute a normal run (build the site) or a dry run.
+data RunMode = RunModeNormal | RunModePrintOutOfDate
+    deriving (Show)
+
+
 --------------------------------------------------------------------------------
-run :: Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
-run config logger rules = do
+run :: RunMode -> Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
+run mode config logger rules = do
     -- Initialization
     Logger.header logger "Initialising..."
     Logger.message logger "Creating store..."
@@ -82,24 +94,19 @@ run config logger rules = do
             }
 
     -- Run the program and fetch the resulting state
-    result <- runExceptT $ runReaderT build read'
+    result <- runExceptT $ runReaderT (build mode) read'
     case result of
         Left e          -> do
             Logger.error logger e
             Logger.flush logger
             return (ExitFailure 1, ruleSet)
 
         Right _ -> do
-            facts <- fmap runtimeFacts . liftIO . readMVar $ state
-            Store.set store factsKey facts
-
             Logger.debug logger "Removing tmp directory..."
             removeDirectory $ tmpDirectory config
 
             Logger.flush logger
             return (ExitSuccess, ruleSet)
-  where
-    factsKey = ["Hakyll.Core.Runtime.run", "facts"]
 
 
 --------------------------------------------------------------------------------
@@ -141,14 +148,23 @@ getRuntimeState = liftIO . readMVar . runtimeState =<< ask
 
 
 --------------------------------------------------------------------------------
-build :: Runtime ()
-build = do
+build :: RunMode -> Runtime ()
+build mode = do
     logger <- runtimeLogger <$> ask
     Logger.header logger "Checking for out-of-date items"
     scheduleOutOfDate
-    Logger.header logger "Compiling"
-    pickAndChase
-    Logger.header logger "Success"
+    case mode of
+        RunModeNormal -> do
+            Logger.header logger "Compiling"
+            pickAndChase
+            Logger.header logger "Success"
+            facts <- runtimeFacts <$> getRuntimeState
+            store <- runtimeStore <$> ask
+            liftIO $ Store.set store factsKey facts
+        RunModePrintOutOfDate -> do
+            Logger.header logger "Out of date items:"
+            todo <- runtimeTodo <$> getRuntimeState
+            traverse_ (Logger.message logger . show) (M.keys todo)
 
 
 --------------------------------------------------------------------------------

diff --git a/lib/Hakyll/Main.hs b/lib/Hakyll/Main.hs
@@ -39,6 +39,7 @@ import qualified Hakyll.Commands           as Commands
 import qualified Hakyll.Core.Configuration as Config
 import qualified Hakyll.Core.Logger        as Logger
 import           Hakyll.Core.Rules
+import           Hakyll.Core.Runtime
 
 
 --------------------------------------------------------------------------------
@@ -105,7 +106,7 @@ invokeCommands :: Command -> Config.Configuration ->
                   Check.Check -> Logger.Logger -> Rules a -> IO ExitCode
 invokeCommands args conf check logger rules =
     case args of
-        Build          -> Commands.build conf logger rules
+        Build   mode   -> Commands.build mode conf logger rules
         Check   _      -> Commands.check conf logger check
         Clean          -> Commands.clean conf logger >> ok
         Deploy         -> Commands.deploy conf
@@ -125,7 +126,7 @@ data Options = Options {verbosity :: Bool, optCommand :: Command}
 
 -- | The command to run.
 data Command
-    = Build
+    = Build RunMode
     -- ^ Generate the site.
     | Check   {internal_links :: Bool}
     -- ^ Validate the site output.
@@ -161,7 +162,7 @@ commandParser conf = OA.subparser $ foldr ((<>) . produceCommand) mempty command
 
     commands =
         [ ( "build"
-          , pure Build
+          , pure Build <*> OA.flag RunModeNormal RunModePrintOutOfDate (OA.long "dry-run" <> OA.help "Don't build, only print out-of-date items")
           , OA.fullDesc <> OA.progDesc "Generate the site"
           )
         , ( "check"

diff --git a/tests/Hakyll/Core/Runtime/Tests.hs b/tests/Hakyll/Core/Runtime/Tests.hs
@@ -30,7 +30,7 @@ tests = testGroup "Hakyll.Core.Runtime.Tests" $
 case01 :: Assertion
 case01 = do
     logger <- Logger.new Logger.Error
-    _      <- run testConfiguration logger $ do
+    _      <- run RunModeNormal testConfiguration logger $ do
         match "images/*" $ do
             route idRoute
             compile copyFileCompiler
@@ -81,7 +81,7 @@ case01 = do
 case02 :: Assertion
 case02 = do
     logger <- Logger.new Logger.Error
-    _      <- run testConfiguration logger $ do
+    _      <- run RunModeNormal testConfiguration logger $ do
         match "images/favicon.ico" $ do
             route   $ gsubRoute "images/" (const "")
             compile $ makeItem ("Test" :: String)
@@ -102,7 +102,7 @@ case02 = do
 case03 :: Assertion
 case03 = do
     logger  <- Logger.new Logger.Error
-    (ec, _) <- run testConfiguration logger $ do
+    (ec, _) <- run RunModeNormal testConfiguration logger $ do
 
         create ["partial.html.out1"] $ do
             route idRoute

diff --git a/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs b/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs
@@ -41,7 +41,7 @@ goldenTest01 =
             -- Code lifted from https://github.com/jaspervdj/hakyll-citeproc-example.
             logger <- Logger.new Logger.Error
             let config = testConfiguration { providerDirectory = goldenTestsDataDir }
-            _ <- run config logger $ do
+            _ <- run RunModeNormal config logger $ do
                 let myPandocBiblioCompiler = do
                         csl <- load "chicago.csl"
                         bib <- load "refs.bib"