hakyll 4.14.1.0 → 4.15.0.0

raw patch · 15 files changed

+320/−153 lines, 15 filesdep −arrayPVP ok

version bump matches the API change (PVP)

Dependencies removed: array

API changes (from Hackage documentation)

Files

• CHANGELOG.md +18/−0
• hakyll.cabal +1/−2
• lib/Hakyll/Commands.hs +4/−4
• lib/Hakyll/Core/Compiler.hs +21/−11
• lib/Hakyll/Core/Compiler/Internal.hs +4/−5
• lib/Hakyll/Core/Compiler/Require.hs +41/−27
• lib/Hakyll/Core/Rules.hs +0/−9
• lib/Hakyll/Core/Runtime.hs +99/−80
• lib/Hakyll/Main.hs +4/−3
• lib/Hakyll/Web/Pandoc.hs +1/−0
• lib/Hakyll/Web/Pandoc/Biblio.hs +17/−5
• lib/Hakyll/Web/Pandoc/FileType.hs +2/−0
• tests/Hakyll/Core/Runtime/Tests.hs +105/−5
• tests/Hakyll/Web/Pandoc/Biblio/Tests.hs +1/−1
• tests/Hakyll/Web/Pandoc/FileType/Tests.hs +2/−1

@@ -4,6 +4,24 @@  # Releases +## Hakyll 4.15.0.0 (2021-10-01)++- Fix dependency cycles detector (contribution by Laurent P. René de Cotret)+- Add `--dry-run` to the `build` command (contribution by Fraser Tweedale)+- Add support for Jupyter notebooks (files with ".ipynb" extension)+    (contribution by fedeinthemix)+- Add `Hakyll.Web.Pandoc.Biblio.processPandocBiblio`, which works with `Item+    Pandoc` and is thus composable with other Pandoc-related compilers and+    functions (contribution by fedeinthemix)+- Speed up the runtime by about 9% (multiple contributions by Fraser Tweedale)+- Tolerate unexpected cache misses by recompiling the item; now there is no need+    to rebuild the entire site to fix cache corruption (contribution by Fraser+    Tweedale)+- Replace `Hakyll.Core.Rules.forceCompile` (introduced in 4.14.1.0) with+    `Hakyll.Core.Compiler.recompilingUnsafeCompiler`. The new facility is more+    versatile and composes better (contribution by Fraser Tweedale)+- Remove dependency on `array` (contribution by Laurent P. René de Cotret)+ ## Hakyll 4.14.1.0 (2021-08-30)  - Add `Hakyll.Web.Html.demoteHeaderBy` function, which demotes an HTML header by

@@ -1,5 +1,5 @@ Name:    hakyll-Version: 4.14.1.0+Version: 4.15.0.0  Synopsis: A static website compiler library Description:@@ -173,7 +173,6 @@    Build-Depends:     aeson                >= 1.0      && < 1.6,-    array                >= 0.5      && < 1,     base                 >= 4.8      && < 5,     binary               >= 0.5      && < 0.10,     blaze-html           >= 0.5      && < 0.10,

@@ -48,8 +48,8 @@  -------------------------------------------------------------------------------- -- | 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 @@     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 @@ -- | 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

@@ -22,6 +22,7 @@     , Internal.loadAllSnapshots      , cached+    , recompilingUnsafeCompiler     , unsafeCompiler     , debugCompiler     , noResult@@ -162,17 +163,17 @@     unless (resourceExists provider id') $ fail $ itDoesntEvenExist id'      let modified = resourceModified provider id'+        k = [name, show id']+        go = compiler >>= \v -> v <$ compilerUnsafeIO (Store.set store k v)     if modified-        then do-            x <- compiler-            compilerUnsafeIO $ Store.set store [name, show id'] x-            return x-        else do-            compilerTellCacheHits 1-            x        <- compilerUnsafeIO $ Store.get store [name, show id']-            progName <- compilerUnsafeIO getProgName-            case x of Store.Found x' -> return x'-                      _              -> fail $ error' progName+        then go+        else compilerUnsafeIO (Store.get store k) >>= \r -> case r of+            -- found: report cache hit and return value+            Store.Found v   -> v <$ compilerTellCacheHits 1+            -- not found: unexpected, but recoverable+            Store.NotFound  -> go+            -- other results: unrecoverable error+            _               -> fail . error' =<< compilerUnsafeIO getProgName   where     error' progName =         "Hakyll.Core.Compiler.cached: Cache corrupt! " ++@@ -185,9 +186,18 @@   ----------------------------------------------------------------------------------- | Run an IO computation without dependencies in a Compiler+-- | Run an IO computation without dependencies in a Compiler.+-- You probably want 'recompilingUnsafeCompiler' instead. unsafeCompiler :: IO a -> Compiler a unsafeCompiler = compilerUnsafeIO++--------------------------------------------------------------------------------+-- | Run an IO computation in a Compiler.  Unlike 'unsafeCompiler',+-- this function will cause the item to be recompiled every time.+recompilingUnsafeCompiler :: IO a -> Compiler a+recompilingUnsafeCompiler io = Compiler $ \_ -> do+  a <- io+  pure $ CompilerDone a mempty { compilerDependencies = [AlwaysOutOfDate] }   --------------------------------------------------------------------------------

@@ -135,7 +135,7 @@ data CompilerResult a     = CompilerDone a CompilerWrite     | CompilerSnapshot Snapshot (Compiler a)-    | CompilerRequire (Identifier, Snapshot) (Compiler a)+    | CompilerRequire [(Identifier, Snapshot)] (Compiler a)     | CompilerError (CompilerErrors String)  @@ -364,7 +364,6 @@ compilerGetMatches :: Pattern -> Compiler [Identifier] compilerGetMatches pattern = do     universe <- compilerUniverse <$> compilerAsk-    let matching = filterMatches pattern $ S.toList universe-        set'     = S.fromList matching-    compilerTellDependencies [PatternDependency pattern set']-    return matching+    let matching = S.filter (matches pattern) universe+    compilerTellDependencies [PatternDependency pattern matching]+    pure $ S.toList matching

@@ -15,6 +15,8 @@ -------------------------------------------------------------------------------- import           Control.Monad                  (when) import           Data.Binary                    (Binary)+import           Data.Foldable                  (toList, traverse_)+import           Data.Functor.Identity          (Identity(Identity, runIdentity)) import qualified Data.Set                       as S import           Data.Typeable @@ -55,31 +57,8 @@ -- | Require a specific snapshot of an item. loadSnapshot :: (Binary a, Typeable a)              => Identifier -> Snapshot -> Compiler (Item a)-loadSnapshot id' snapshot = do-    store    <- compilerStore <$> compilerAsk-    universe <- compilerUniverse <$> compilerAsk--    -- Quick check for better error messages-    when (id' `S.notMember` universe) $ fail notFound--    compilerTellDependencies [IdentifierDependency id']-    compilerResult $ CompilerRequire (id', snapshot) $ do-        result <- compilerUnsafeIO $ Store.get store (key id' snapshot)-        case result of-            Store.NotFound      -> fail notFound-            Store.WrongType e r -> fail $ wrongType e r-            Store.Found x       -> return $ Item id' x-  where-    notFound =-        "Hakyll.Core.Compiler.Require.load: " ++ show id' ++-        " (snapshot " ++ snapshot ++ ") was not found in the cache, " ++-        "the cache might be corrupted or " ++-        "the item you are referring to might not exist"-    wrongType e r =-        "Hakyll.Core.Compiler.Require.load: " ++ show id' ++-        " (snapshot " ++ snapshot ++ ") was found in the cache, " ++-        "but does not have the right type: expected " ++ show e ++-        " but got " ++ show r+loadSnapshot id' snapshot =+    fmap runIdentity $ loadSnapshotCollection (Identity (id', snapshot))   --------------------------------------------------------------------------------@@ -108,8 +87,43 @@ loadAllSnapshots :: (Binary a, Typeable a)                  => Pattern -> Snapshot -> Compiler [Item a] loadAllSnapshots pattern snapshot = do-    matching <- getMatches pattern-    mapM (\i -> loadSnapshot i snapshot) matching+    ids <- fmap (\id' -> (id', snapshot)) <$> getMatches pattern+    loadSnapshotCollection ids+++--------------------------------------------------------------------------------+-- | Load a collection of snapshots.+-- Only the first NotFound or WrongType error will be reported.+loadSnapshotCollection :: (Binary a, Typeable a, Traversable t)+              => t (Identifier, Snapshot) -> Compiler (t (Item a))+loadSnapshotCollection ids = do+    store    <- compilerStore <$> compilerAsk+    universe <- compilerUniverse <$> compilerAsk++    -- Quick check for better error messages+    let checkMember (id', snap) =+            when (id' `S.notMember` universe) (fail $ notFound id' snap)+    traverse_ checkMember ids++    compilerTellDependencies $ IdentifierDependency . fst <$> toList ids+    let go (id', snap) = do+            result <- compilerUnsafeIO $ Store.get store (key id' snap)+            case result of+                Store.NotFound      -> fail $ notFound id' snap+                Store.WrongType e r -> fail $ wrongType id' snap e r+                Store.Found x       -> return $ Item id' x+    compilerResult $ CompilerRequire (toList ids) $ traverse go ids+  where+    notFound id' snapshot =+        "Hakyll.Core.Compiler.Require.load: " ++ show id' +++        " (snapshot " ++ snapshot ++ ") was not found in the cache, " +++        "the cache might be corrupted or " +++        "the item you are referring to might not exist"+    wrongType id' snapshot e r =+        "Hakyll.Core.Compiler.Require.load: " ++ show id' +++        " (snapshot " ++ snapshot ++ ") was found in the cache, " +++        "but does not have the right type: expected " ++ show e +++        " but got " ++ show r   --------------------------------------------------------------------------------

@@ -29,7 +29,6 @@     , preprocess     , Dependency (..)     , rulesExtraDependencies-    , forceCompile     ) where  @@ -222,11 +221,3 @@             | (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]

@@ -1,26 +1,24 @@ -------------------------------------------------------------------------------- module Hakyll.Core.Runtime     ( run+    , RunMode(..)     ) where   ---------------------------------------------------------------------------------import           Control.Concurrent.Async.Lifted (forConcurrently_)+import           Control.Concurrent.Async.Lifted (forConcurrently) import           Control.Concurrent.MVar         (modifyMVar_, readMVar, newMVar, MVar)-import           Control.Monad                   (unless)+import           Control.Monad                   (join, unless, when) import           Control.Monad.Except            (ExceptT, runExceptT, throwError)-import           Control.Monad.Reader            (ask)-import           Control.Monad.RWS               (RWST, runRWST)-import           Control.Monad.State             (get)+import           Control.Monad.Reader            (ReaderT, ask, runReaderT) import           Control.Monad.Trans             (liftIO)-import qualified Data.Array                      as A-import           Data.Graph                      (Graph)-import qualified Data.Graph                      as G+import           Data.Foldable                   (traverse_) import           Data.List                       (intercalate) import           Data.Map                        (Map) import qualified Data.Map                        as M import           Data.Set                        (Set) import qualified Data.Set                        as S+import           Data.Traversable                (for) import           System.Exit                     (ExitCode (..)) import           System.FilePath                 ((</>)) @@ -44,9 +42,19 @@ import           Hakyll.Core.Writable  +factsKey :: [String]+factsKey = ["Hakyll.Core.Runtime.run", "facts"]++ ---------------------------------------------------------------------------------run :: Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)-run config logger rules = do+-- | Whether to execute a normal run (build the site) or a dry run.+data RunMode = RunModeNormal | RunModePrintOutOfDate+    deriving (Show)+++--------------------------------------------------------------------------------+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..."@@ -62,44 +70,40 @@     let (oldFacts) = case mOldFacts of Store.Found f -> f                                        _             -> mempty +    state <- newMVar $ RuntimeState+            { runtimeDone         = S.empty+            , runtimeSnapshots    = S.empty+            , runtimeTodo         = M.empty+            , runtimeFacts        = oldFacts+            , runtimeDependencies = M.empty+            }+     -- Build runtime read/state     let compilers = rulesCompilers ruleSet         read'     = RuntimeRead             { runtimeConfiguration = config             , runtimeLogger        = logger             , runtimeProvider      = provider+            , runtimeState         = state             , runtimeStore         = store             , runtimeRoutes        = rulesRoutes ruleSet             , runtimeUniverse      = M.fromList compilers             } -    state <- newMVar $ RuntimeState-            { runtimeDone         = S.empty-            , runtimeSnapshots    = S.empty-            , runtimeTodo         = M.empty-            , runtimeFacts        = oldFacts-            , runtimeDependencies = M.empty-            }-     -- Run the program and fetch the resulting state-    result <- runExceptT $ runRWST build read' state+    result <- runExceptT $ runReaderT (build mode) read'     case result of         Left e          -> do             Logger.error logger e             Logger.flush logger             return (ExitFailure 1, ruleSet) -        Right (_, s, _) -> do-            facts <- fmap runtimeFacts . liftIO . readMVar $ s-            Store.set store factsKey facts-+        Right _ -> do             Logger.debug logger "Removing tmp directory..."             removeDirectory $ tmpDirectory config              Logger.flush logger             return (ExitSuccess, ruleSet)-  where-    factsKey = ["Hakyll.Core.Runtime.run", "facts"]   --------------------------------------------------------------------------------@@ -107,6 +111,7 @@     { runtimeConfiguration :: Configuration     , runtimeLogger        :: Logger     , runtimeProvider      :: Provider+    , runtimeState         :: MVar RuntimeState     , runtimeStore         :: Store     , runtimeRoutes        :: Routes     , runtimeUniverse      :: Map Identifier (Compiler SomeItem)@@ -119,35 +124,44 @@     , runtimeSnapshots    :: Set (Identifier, Snapshot)     , runtimeTodo         :: Map Identifier (Compiler SomeItem)     , runtimeFacts        :: DependencyFacts-    , runtimeDependencies :: Map Identifier (Set Identifier)+    , runtimeDependencies :: Map Identifier (Set (Identifier, Snapshot))     }   ---------------------------------------------------------------------------------type Runtime a = RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) a+type Runtime a = ReaderT RuntimeRead (ExceptT String IO) a   -------------------------------------------------------------------------------- -- Because compilation of rules often revolves around IO, -- be very careful when modifying the state modifyRuntimeState :: (RuntimeState -> RuntimeState) -> Runtime ()-modifyRuntimeState f = get >>= \s -> liftIO $ modifyMVar_ s (pure . f)+modifyRuntimeState f = liftIO . flip modifyMVar_ (pure . f) . runtimeState =<< ask   -------------------------------------------------------------------------------- getRuntimeState :: Runtime RuntimeState-getRuntimeState = liftIO . readMVar =<< get+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)   --------------------------------------------------------------------------------@@ -158,24 +172,23 @@     universe <- runtimeUniverse <$> ask      let identifiers = M.keys universe-        modified    = S.fromList $ flip filter identifiers $-            resourceModified provider+        modified    = S.filter (resourceModified provider) (M.keysSet universe)      state <- getRuntimeState     let facts = runtimeFacts state         todo  = runtimeTodo state+        done  = runtimeDone state      let (ood, facts', msgs) = outOfDate identifiers modified facts-        todo'               = M.filterWithKey-            (\id' _ -> id' `S.member` ood) universe+        todo'               = M.filterWithKey (\id' _ -> id' `S.member` ood) universe+        done'               = done `S.union` (M.keysSet universe `S.difference` ood)      -- Print messages     mapM_ (Logger.debug logger) msgs      -- Update facts and todo items     modifyRuntimeState $ \s -> s-        { runtimeDone  = runtimeDone s `S.union`-            (S.fromList identifiers `S.difference` ood)+        { runtimeDone  = done'         , runtimeTodo  = todo `M.union` todo'         , runtimeFacts = facts'         }@@ -186,33 +199,32 @@ pickAndChase = do     todo <- runtimeTodo <$> getRuntimeState     unless (null todo) $ do-        checkForDependencyCycle-        forConcurrently_ (M.keys todo) chase+        acted <- mconcat <$> forConcurrently (M.keys todo) chase+        when (acted == Idled) $ do+            -- This clause happens when chasing *every item* in `todo` resulted in +            -- idling because tasks are all waiting on something: a dependency cycle  +            deps <- runtimeDependencies <$> getRuntimeState+            throwError $ "Hakyll.Core.Runtime.pickAndChase: Dependency cycle detected: " ++ +                intercalate ", " [show k ++ " depends on " ++ show (S.toList v) | (k, v) <- M.toList deps]         pickAndChase   ----------------------------------------------------------------------------------- | Check for cyclic dependencies in the current state-checkForDependencyCycle :: Runtime ()-checkForDependencyCycle = do-    deps <- runtimeDependencies <$> getRuntimeState-    let (depgraph, nodeFromVertex, _) = G.graphFromEdges [(k, k, S.toList dps) | (k, dps) <- M.toList deps]-        dependencyCycles = map ((\(_, k, _) -> k) . nodeFromVertex) $ cycles depgraph+-- | Tracks whether a set of tasks has progressed overall (at least one task progressed)+-- or has idled+data Progress = Progressed | Idled deriving (Eq) -    unless (null dependencyCycles) $ do-        throwError $ "Hakyll.Core.Runtime.pickAndChase: " ++-            "Dependency cycle detected: " ++ intercalate ", " (map show dependencyCycles) ++-            " are inter-dependent."-    where-        cycles :: Graph -> [G.Vertex]-        cycles g = map fst . filter (uncurry $ reachableFromAny g) . A.assocs $ g+instance Semigroup Progress where+    Idled      <> Idled      = Idled+    Progressed <> _          = Progressed+    _          <> Progressed = Progressed -        reachableFromAny :: Graph -> G.Vertex -> [G.Vertex] -> Bool-        reachableFromAny graph node = elem node . concatMap (G.reachable graph)+instance Monoid Progress where+    mempty = Idled   ---------------------------------------------------------------------------------chase :: Identifier -> Runtime ()+chase :: Identifier -> Runtime Progress chase id' = do     logger    <- runtimeLogger        <$> ask     provider  <- runtimeProvider      <$> ask@@ -252,7 +264,9 @@                 , runtimeTodo      = M.insert id' c (runtimeTodo s)                 } +            return Progressed +         -- Huge success         CompilerDone (SomeItem item) cwrite -> do             -- Print some info@@ -283,39 +297,44 @@             liftIO $ save store item              modifyRuntimeState $ \s -> s-                { runtimeDone  = S.insert id' (runtimeDone s)-                , runtimeTodo  = M.delete id' (runtimeTodo s)-                , runtimeFacts = M.insert id' facts (runtimeFacts s)+                { runtimeDone         = S.insert id' (runtimeDone s)+                , runtimeTodo         = M.delete id' (runtimeTodo s)+                , runtimeFacts        = M.insert id' facts (runtimeFacts s)+                , runtimeDependencies = M.delete id' (runtimeDependencies s)                 }+            +            return Progressed          -- Try something else first-        CompilerRequire dep c -> do-            let (depId, depSnapshot) = dep-            Logger.debug logger $-                "Compiler requirement found for: " ++ show id' ++-                ", requirement: " ++ show depId-+        CompilerRequire reqs c -> do             let done      = runtimeDone state                 snapshots = runtimeSnapshots state-                deps      = runtimeDependencies state -            -- Done if we either completed the entire item (runtimeDone) or-            -- if we previously saved the snapshot (runtimeSnapshots).-            let depDone =-                    depId `S.member` done ||-                    (depId, depSnapshot) `S.member` snapshots+            deps <- fmap join . for reqs $ \(depId, depSnapshot) -> do+                Logger.debug logger $+                    "Compiler requirement found for: " ++ show id' +++                    ": " ++ show depId ++ " (snapshot " ++ depSnapshot ++ ")" -            let deps' = if depDone-                            then deps-                            else M.insertWith S.union id' (S.singleton depId) deps+                -- Done if we either completed the entire item (runtimeDone) or+                -- if we previously saved the snapshot (runtimeSnapshots).+                let depDone =+                        depId `S.member` done ||+                        (depId, depSnapshot) `S.member` snapshots+                    actualDep = [(depId, depSnapshot) | not depDone] +                return actualDep  +             modifyRuntimeState $ \s -> s                 { runtimeTodo         = M.insert id'-                    (if depDone then c else compilerResult result)+                    (if null deps then c else compilerResult result)                     (runtimeTodo s)-                , runtimeDependencies = deps'+                 -- We track dependencies only to inform users when an infinite loop is detected+                , runtimeDependencies = M.insertWith S.union id' (S.fromList deps) (runtimeDependencies s)                 } -            Logger.debug logger $ "Require " ++ show depId ++-                " (snapshot " ++ depSnapshot ++ ") "+            -- Progress has been made if at least one of the +            -- requirements can move forwards at the next pass+            let progress | length deps < length reqs = Progressed+                         | otherwise                 = Idled +            return progress

@@ -39,6 +39,7 @@ 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 @@                   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 @@  -- | The command to run. data Command-    = Build+    = Build RunMode     -- ^ Generate the site.     | Check   {internal_links :: Bool}     -- ^ Validate the site output.@@ -161,7 +162,7 @@      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"

@@ -58,6 +58,7 @@     reader ro t = case t of         DocBook            -> readDocBook ro         Html               -> readHtml ro+        Jupyter            -> readIpynb ro         LaTeX              -> readLaTeX ro         LiterateHaskell t' -> reader (addExt ro Ext_literate_haskell) t'         Markdown           -> readMarkdown ro

@@ -6,7 +6,9 @@ -- respective compilers ('biblioCompiler' and 'cslCompiler'). Then, you can -- refer to these files when you use 'readPandocBiblio'. This function also -- takes the reader options for completeness -- you can use--- 'defaultHakyllReaderOptions' if you're unsure.+-- 'defaultHakyllReaderOptions' if you're unsure. If you already read the+-- source into a 'Pandoc' type and need to add processing for the bibliography,+-- you can use 'processPandocBiblio' instead. -- 'pandocBiblioCompiler' is a convenience wrapper which works like 'pandocCompiler', -- but also takes paths to compiled bibliography and csl files. {-# LANGUAGE Arrows                     #-}@@ -19,6 +21,7 @@     , Biblio (..)     , biblioCompiler     , readPandocBiblio+    , processPandocBiblio     , pandocBiblioCompiler     ) where @@ -84,6 +87,16 @@                  -> (Item String)                  -> Compiler (Item Pandoc) readPandocBiblio ropt csl biblio item = do+  pandoc <- readPandocWith ropt item+  processPandocBiblio csl biblio pandoc+++--------------------------------------------------------------------------------+processPandocBiblio :: Item CSL+                    -> Item Biblio+                    -> (Item Pandoc)+                    -> Compiler (Item Pandoc)+processPandocBiblio csl biblio item = do     -- It's not straightforward to use the Pandoc API as of 2.11 to deal with     -- citations, since it doesn't export many things in 'Text.Pandoc.Citeproc'.     -- The 'citeproc' package is also hard to use.@@ -93,10 +106,8 @@     --     -- So we load the CSL and Biblio files and pass them to Pandoc using the     -- ersatz filesystem.-    Pandoc.Pandoc (Pandoc.Meta meta) blocks <- itemBody <$>-        readPandocWith ropt item--    let cslFile = Pandoc.FileInfo zeroTime . unCSL $ itemBody csl+    let Pandoc.Pandoc (Pandoc.Meta meta) blocks = itemBody item+        cslFile = Pandoc.FileInfo zeroTime . unCSL $ itemBody csl         bibFile = Pandoc.FileInfo zeroTime . unBiblio $ itemBody biblio         addBiblioFiles = \st -> st             { Pandoc.stFiles =@@ -120,6 +131,7 @@    where     zeroTime = Time.UTCTime (toEnum 0) 0+  -------------------------------------------------------------------------------- -- | Compiles a markdown file via Pandoc. Requires the .csl and .bib files to be known to the compiler via match statements.

@@ -24,6 +24,7 @@     | Css     | DocBook     | Html+    | Jupyter     | LaTeX     | LiterateHaskell FileType     | Markdown@@ -42,6 +43,7 @@   where     fileType' _ ".css"       = Css     fileType' _ ".dbk"       = DocBook+    fileType' _ ".ipynb"     = Jupyter     fileType' _ ".htm"       = Html     fileType' _ ".html"      = Html     fileType' f ".lhs"       = LiterateHaskell $ case fileType f of

@@ -6,6 +6,7 @@   --------------------------------------------------------------------------------+import           Control.Monad       (void) import qualified Data.ByteString     as B import           System.FilePath     ((</>)) import           System.Exit         (ExitCode (..))@@ -23,14 +24,14 @@ -------------------------------------------------------------------------------- tests :: TestTree tests = testGroup "Hakyll.Core.Runtime.Tests" $-    fromAssertions "run" [case01, case02, case03]+    fromAssertions "run" [case01, case02, case03, case04, case05, case06]   -------------------------------------------------------------------------------- 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 +82,7 @@ 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,11 +103,39 @@ 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             compile $ do+                example <- loadBody "partial.html.out2"+                makeItem example+                    >>= loadAndApplyTemplate "partial.html" defaultContext++        create ["partial.html.out2"] $ do+            route idRoute+            compile $ do+                example <- loadBody "partial.html.out1"+                makeItem example+                    >>= loadAndApplyTemplate "partial.html" defaultContext+++    ec @?= ExitFailure 1++    cleanTestEnv+++--------------------------------------------------------------------------------+-- Test that dependency cycles are correctly identified when snapshots +-- are also involved. See issue #878.+case04 :: Assertion+case04 = do+    logger  <- Logger.new Logger.Error+    (ec, _) <- run RunModeNormal testConfiguration logger $ do++        create ["partial.html.out1"] $ do+            route idRoute+            compile $ do                 example <- loadSnapshotBody "partial.html.out2" "raw"                 makeItem example                     >>= loadAndApplyTemplate "partial.html" defaultContext@@ -118,7 +147,78 @@                 makeItem example                     >>= loadAndApplyTemplate "partial.html" defaultContext -     ec @?= ExitFailure 1++    cleanTestEnv+++--------------------------------------------------------------------------------+-- Test that dependency cycles are correctly identified in the presence of +-- snapshots. See issue #878.+case05 :: Assertion +case05 = do+    logger  <- Logger.new Logger.Error +    (ec, _) <- run RunModeNormal testConfiguration logger $ do++        match "posts/*" $ do+            route $ setExtension "html"+            compile $ do+                let applyDefaultTemplate item = do+                        footer <- loadBody "footer.html"+                        let postCtx' =+                                constField "footer" footer `mappend`+                                defaultContext+                        loadAndApplyTemplate "template-empty.html" postCtx' item++                pandocCompiler+                    >>= saveSnapshot "content"+                    >>= loadAndApplyTemplate "template-empty.html" defaultContext+                    >>= applyDefaultTemplate+                    >>= relativizeUrls++        create ["footer.html"] $+            compile $ do+                posts <- fmap (take 5) . recentFirst =<< loadAllSnapshots "posts/*" "content"+                let footerCtx =+                        listField "posts" defaultContext (return posts) `mappend`+                        defaultContext++                makeItem ""+                    >>= loadAndApplyTemplate "template-empty.html" footerCtx+        +        create ["template-empty.html"] $ compile templateCompiler++    ec @?= ExitSuccess ++    cleanTestEnv+++--------------------------------------------------------------------------------+-- Test that dependency cycles are correctly identified in the presence of +-- snapshots. The test case below was presented as an example which invalidated+-- a previous approach to dependency cycle checking. +-- See https://github.com/jaspervdj/hakyll/pull/880#discussion_r708650172+case06 :: Assertion+case06 = do+    logger  <- Logger.new Logger.Error+    (ec, _) <- run RunModeNormal testConfiguration logger $ do++        create ["one.html"] $ do+            route idRoute+            compile $ do+                void $ makeItem ("one-one" :: String) >>= saveSnapshot "one"+                _ <- loadSnapshotBody "two.html" "two" :: Compiler String+                void $ makeItem ("one-three" :: String) >>= saveSnapshot "three"+                makeItem ("one-two" :: String) >>= saveSnapshot "two"++        create ["two.html"] $ do+            route idRoute+            compile $ do+                _ <- loadSnapshotBody "one.html" "one" :: Compiler String+                void $ makeItem ("two-two" :: String) >>= saveSnapshot "two"+                text <- loadSnapshotBody "one.html" "two"+                makeItem (text :: String)++    ec @?= ExitSuccess      cleanTestEnv

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

@@ -19,7 +19,8 @@ tests :: TestTree tests = testGroup "Hakyll.Web.Pandoc.FileType.Tests" $     fromAssertions "fileType"-        [ Markdown                 @=? fileType "index.md"+        [ Jupyter                  @=? fileType "index.ipynb"+        , Markdown                 @=? fileType "index.md"         , Rst                      @=? fileType "about/foo.rst"         , LiterateHaskell Markdown @=? fileType "posts/bananas.lhs"         , LiterateHaskell LaTeX    @=? fileType "posts/bananas.tex.lhs"