diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -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, diff --git a/lib/Hakyll/Commands.hs b/lib/Hakyll/Commands.hs --- a/lib/Hakyll/Commands.hs +++ b/lib/Hakyll/Commands.hs @@ -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 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 @@ -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] } -------------------------------------------------------------------------------- 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 @@ -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 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 @@ -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 -------------------------------------------------------------------------------- diff --git a/lib/Hakyll/Core/Rules.hs b/lib/Hakyll/Core/Rules.hs --- a/lib/Hakyll/Core/Rules.hs +++ b/lib/Hakyll/Core/Rules.hs @@ -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] 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 @@ -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 diff --git a/lib/Hakyll/Main.hs b/lib/Hakyll/Main.hs --- a/lib/Hakyll/Main.hs +++ b/lib/Hakyll/Main.hs @@ -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" 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 @@ -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 diff --git a/lib/Hakyll/Web/Pandoc/Biblio.hs b/lib/Hakyll/Web/Pandoc/Biblio.hs --- a/lib/Hakyll/Web/Pandoc/Biblio.hs +++ b/lib/Hakyll/Web/Pandoc/Biblio.hs @@ -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. 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 @@ -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 diff --git a/tests/Hakyll/Core/Runtime/Tests.hs b/tests/Hakyll/Core/Runtime/Tests.hs --- a/tests/Hakyll/Core/Runtime/Tests.hs +++ b/tests/Hakyll/Core/Runtime/Tests.hs @@ -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 diff --git a/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs b/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs --- a/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs +++ b/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs @@ -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" diff --git a/tests/Hakyll/Web/Pandoc/FileType/Tests.hs b/tests/Hakyll/Web/Pandoc/FileType/Tests.hs --- a/tests/Hakyll/Web/Pandoc/FileType/Tests.hs +++ b/tests/Hakyll/Web/Pandoc/FileType/Tests.hs @@ -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"