diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,15 @@ # Releases +## Hakyll 4.14.0.0 (2021-03-14) + +- Add `renderPandocWithTransform` and `renderPandocWithTransformM` (by Norman + Liu) +- Make sure the initial project is writable (by Tobias Bora) +- Bump `pandoc` to 2.11.* +- Bump `file-embed` upper bound to 0.0.14 +- Bump `random` upper bound to 1.2 + ## Hakyll 4.13.4.1 (2020-09-30) - Bump `pandoc` to 2.10.* diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 4.13.4.1 +Version: 4.14.0.0 Synopsis: A static website compiler library Description: @@ -59,6 +59,11 @@ Extra-source-files: CHANGELOG.md + tests/data/biblio/biblio01.golden + tests/data/biblio/chicago.csl + tests/data/biblio/default.html + tests/data/biblio/page.markdown + tests/data/biblio/refs.bib tests/data/embed.html tests/data/example.md tests/data/example.md.metadata @@ -174,7 +179,7 @@ data-default >= 0.4 && < 0.8, deepseq >= 1.3 && < 1.5, directory >= 1.2.7.0 && < 1.4, - file-embed >= 0.0.10.1 && < 0.0.12, + file-embed >= 0.0.10.1 && < 0.0.14, filepath >= 1.0 && < 1.5, lrucache >= 1.1.1 && < 1.3, memory >= 0.14.18 && < 0.16, @@ -183,7 +188,7 @@ optparse-applicative >= 0.12 && < 0.16, parsec >= 3.0 && < 3.2, process >= 1.6 && < 1.7, - random >= 1.0 && < 1.2, + random >= 1.0 && < 1.3, regex-tdfa >= 1.1 && < 1.4, resourcet >= 1.1 && < 1.3, scientific >= 0.3.4 && < 0.4, @@ -232,8 +237,7 @@ Other-Modules: Hakyll.Web.Pandoc.Binary Build-Depends: - pandoc >= 2.10 && < 2.11, - pandoc-citeproc >= 0.14 && < 0.18 + pandoc >= 2.11 && < 2.12 Cpp-options: -DUSE_PANDOC @@ -267,6 +271,7 @@ hakyll, QuickCheck >= 2.8 && < 2.15, tasty >= 0.11 && < 1.4, + tasty-golden >= 2.3 && < 2.4, tasty-hunit >= 0.9 && < 0.11, tasty-quickcheck >= 0.8 && < 0.11, -- Copy pasted from hakyll dependencies: @@ -292,6 +297,7 @@ If flag(usePandoc) Other-modules: + Hakyll.Web.Pandoc.Biblio.Tests Hakyll.Web.Pandoc.FileType.Tests Cpp-options: -DUSE_PANDOC @@ -327,4 +333,4 @@ base >= 4 && < 5, directory >= 1.0 && < 1.4, filepath >= 1.0 && < 1.5, - pandoc >= 2.10 && < 2.11 + pandoc >= 2.11 && < 2.12 diff --git a/lib/Hakyll/Core/Item.hs b/lib/Hakyll/Core/Item.hs --- a/lib/Hakyll/Core/Item.hs +++ b/lib/Hakyll/Core/Item.hs @@ -2,6 +2,7 @@ -- | An item is a combination of some content and its 'Identifier'. This way, we -- can still use the 'Identifier' to access metadata. {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveTraversable #-} module Hakyll.Core.Item ( Item (..) , itemSetBody @@ -25,23 +26,7 @@ data Item a = Item { itemIdentifier :: Identifier , itemBody :: a - } deriving (Show, Typeable) - - --------------------------------------------------------------------------------- -instance Functor Item where - fmap f (Item i x) = Item i (f x) - - --------------------------------------------------------------------------------- -instance Foldable Item where - foldr f z (Item _ x) = f x z - - --------------------------------------------------------------------------------- -instance Traversable Item where - traverse f (Item i x) = Item i <$> f x - + } deriving (Show, Typeable, Functor, Foldable, Traversable) -------------------------------------------------------------------------------- instance Binary a => Binary (Item a) where 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 @@ -8,6 +8,8 @@ , writePandocWith , renderPandoc , renderPandocWith + , renderPandocWithTransform + , renderPandocWithTransformM -- * Derived compilers , pandocCompiler @@ -104,6 +106,32 @@ -------------------------------------------------------------------------------- +-- | An extension of `renderPandocWith`, which allows you to specify a custom +-- Pandoc transformation on the input `Item`. +-- Useful if you want to do your own transformations before running +-- custom Pandoc transformations, e.g. using a `funcField` to transform raw content. +renderPandocWithTransform :: ReaderOptions -> WriterOptions + -> (Pandoc -> Pandoc) + -> Item String + -> Compiler (Item String) +renderPandocWithTransform ropt wopt f = + renderPandocWithTransformM ropt wopt (return . f) + + +-------------------------------------------------------------------------------- +-- | Similar to `renderPandocWithTransform`, but the Pandoc transformation is +-- monadic. This is useful when you want the pandoc +-- transformation to use the `Compiler` information such as routes, +-- metadata, etc. along with your own transformations beforehand. +renderPandocWithTransformM :: ReaderOptions -> WriterOptions + -> (Pandoc -> Compiler Pandoc) + -> Item String + -> Compiler (Item String) +renderPandocWithTransformM ropt wopt f i = + writePandocWith wopt <$> (traverse f =<< readPandocWith ropt i) + + +-------------------------------------------------------------------------------- -- | Read a page render using pandoc pandocCompiler :: Compiler (Item String) pandocCompiler = @@ -137,9 +165,8 @@ pandocCompilerWithTransformM :: ReaderOptions -> WriterOptions -> (Pandoc -> Compiler Pandoc) -> Compiler (Item String) -pandocCompilerWithTransformM ropt wopt f = - writePandocWith wopt <$> - (traverse f =<< readPandocWith ropt =<< getResourceBody) +pandocCompilerWithTransformM ropt wopt f = + getResourceBody >>= renderPandocWithTransformM ropt wopt f -------------------------------------------------------------------------------- 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 @@ -12,6 +12,7 @@ {-# LANGUAGE Arrows #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} module Hakyll.Web.Pandoc.Biblio ( CSL , cslCompiler @@ -23,34 +24,32 @@ -------------------------------------------------------------------------------- -import Control.Monad (liftM, replicateM) -import Data.Binary (Binary (..)) -import Data.Typeable (Typeable) +import Control.Monad (liftM) +import Data.Binary (Binary (..)) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.Map as Map +import qualified Data.Time as Time +import Data.Typeable (Typeable) import Hakyll.Core.Compiler import Hakyll.Core.Compiler.Internal import Hakyll.Core.Identifier import Hakyll.Core.Item -import Hakyll.Core.Provider import Hakyll.Core.Writable import Hakyll.Web.Pandoc -import Hakyll.Web.Pandoc.Binary () -import qualified Text.CSL as CSL -import Text.CSL.Pandoc (processCites) -import Text.Pandoc (Pandoc, ReaderOptions (..), - enableExtension, Extension (..)) +import Text.Pandoc (Extension (..), Pandoc, + ReaderOptions (..), + enableExtension) +import qualified Text.Pandoc as Pandoc +import qualified Text.Pandoc.Citeproc as Pandoc (processCitations) -------------------------------------------------------------------------------- -data CSL = CSL - deriving (Show, Typeable) +newtype CSL = CSL {unCSL :: B.ByteString} + deriving (Binary, Show, Typeable) --------------------------------------------------------------------------------- -instance Binary CSL where - put CSL = return () - get = return CSL - -------------------------------------------------------------------------------- instance Writable CSL where -- Shouldn't be written. @@ -59,21 +58,12 @@ -------------------------------------------------------------------------------- cslCompiler :: Compiler (Item CSL) -cslCompiler = makeItem CSL - - --------------------------------------------------------------------------------- -newtype Biblio = Biblio [CSL.Reference] - deriving (Show, Typeable) +cslCompiler = fmap (CSL . BL.toStrict) <$> getResourceLBS -------------------------------------------------------------------------------- -instance Binary Biblio where - -- Ugly. - get = do - len <- get - Biblio <$> replicateM len get - put (Biblio rs) = put (length rs) >> mapM_ put rs +newtype Biblio = Biblio {unBiblio :: B.ByteString} + deriving (Binary, Show, Typeable) -------------------------------------------------------------------------------- @@ -84,12 +74,7 @@ -------------------------------------------------------------------------------- biblioCompiler :: Compiler (Item Biblio) -biblioCompiler = do - filePath <- getResourceFilePath - makeItem =<< unsafeCompiler (Biblio <$> CSL.readBiblioFile idpred filePath) - where - -- This is a filter on citations. We include all citations. - idpred = const True +biblioCompiler = fmap (Biblio . BL.toStrict) <$> getResourceLBS -------------------------------------------------------------------------------- @@ -99,21 +84,45 @@ -> (Item String) -> Compiler (Item Pandoc) readPandocBiblio ropt csl biblio item = do - -- Parse CSL file, if given - provider <- compilerProvider <$> compilerAsk - style <- unsafeCompiler $ - CSL.readCSLFile Nothing . (resourceFilePath provider) . itemIdentifier $ csl + -- 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. + -- + -- So instead, we try treating Pandoc as a black box. Pandoc can read + -- specific csl and bilbio files based on metadata keys. + -- + -- 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 - -- We need to know the citation keys, add then *before* actually parsing the - -- actual page. If we don't do this, pandoc won't even consider them - -- citations! - let Biblio refs = itemBody biblio - pandoc <- itemBody <$> readPandocWith ropt item - let pandoc' = processCites style refs pandoc + let cslFile = Pandoc.FileInfo zeroTime . unCSL $ itemBody csl + bibFile = Pandoc.FileInfo zeroTime . unBiblio $ itemBody biblio + addBiblioFiles = \st -> st + { Pandoc.stFiles = + Pandoc.insertInFileTree "_hakyll/style.csl" cslFile . + Pandoc.insertInFileTree "_hakyll/refs.bib" bibFile $ + Pandoc.stFiles st + } + biblioMeta = Pandoc.Meta . + Map.insert "csl" (Pandoc.MetaString "_hakyll/style.csl") . + Map.insert "bibliography" (Pandoc.MetaString "_hakyll/refs.bib") $ + meta + errOrPandoc = Pandoc.runPure $ do + Pandoc.modifyPureState addBiblioFiles + Pandoc.processCitations $ Pandoc.Pandoc biblioMeta blocks - return $ fmap (const pandoc') item + pandoc <- case errOrPandoc of + Left e -> compilerThrow ["Error during processCitations: " ++ show e] + Right x -> return x + return $ fmap (const pandoc) item + + 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. pandocBiblioCompiler :: String -> String -> Compiler (Item String) pandocBiblioCompiler cslFileName bibFileName = do csl <- load $ fromFilePath cslFileName diff --git a/lib/Hakyll/Web/Pandoc/Binary.hs b/lib/Hakyll/Web/Pandoc/Binary.hs --- a/lib/Hakyll/Web/Pandoc/Binary.hs +++ b/lib/Hakyll/Web/Pandoc/Binary.hs @@ -4,9 +4,6 @@ import Data.Binary (Binary (..)) -import qualified Text.CSL as CSL -import qualified Text.CSL.Reference as REF -import qualified Text.CSL.Style as STY import Text.Pandoc -------------------------------------------------------------------------------- @@ -18,7 +15,6 @@ instance Binary Cell instance Binary ColSpan instance Binary ColWidth -instance Binary CSL.Reference instance Binary Citation instance Binary CitationMode instance Binary Format @@ -27,17 +23,9 @@ instance Binary ListNumberStyle instance Binary MathType instance Binary QuoteType -instance Binary REF.CLabel -instance Binary REF.CNum -instance Binary REF.Literal -instance Binary REF.RefDate -instance Binary REF.RefType -instance Binary REF.Season instance Binary Row instance Binary RowHeadColumns instance Binary RowSpan -instance Binary STY.Agent -instance Binary STY.Formatted instance Binary TableBody instance Binary TableFoot instance Binary TableHead diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs --- a/lib/Hakyll/Web/Template/Context.hs +++ b/lib/Hakyll/Web/Template/Context.hs @@ -60,8 +60,7 @@ import Data.Semigroup (Semigroup (..)) #endif import Data.Time.Clock (UTCTime (..)) -import Data.Time.Format (formatTime) -import qualified Data.Time.Format as TF +import Data.Time.Format (formatTime, parseTimeM) import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale) import Hakyll.Core.Compiler import Hakyll.Core.Compiler.Internal @@ -463,10 +462,3 @@ missingField :: Context a missingField = Context $ \k _ _ -> noResult $ "Missing field '" ++ k ++ "' in context" - -parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime -#if MIN_VERSION_time(1,5,0) -parseTimeM = TF.parseTimeM -#else -parseTimeM _ = TF.parseTime -#endif diff --git a/src/Init.hs b/src/Init.hs --- a/src/Init.hs +++ b/src/Init.hs @@ -11,7 +11,8 @@ import Data.List (foldl', intercalate, isPrefixOf) import Data.Version (Version (..)) import System.Directory (canonicalizePath, copyFile, - doesFileExist) + doesFileExist, + setPermissions, getPermissions, writable) import System.Environment (getArgs, getProgName) import System.Exit (exitFailure) import System.FilePath (splitDirectories, ()) @@ -65,6 +66,10 @@ putStrLn $ "Creating " ++ dst makeDirectories dst copyFile src dst + -- On some systems, the source folder may be readonly, + -- and copyFile will therefore create a readonly project... + p <- getPermissions dst + setPermissions dst (p {writable = True}) putStrLn $ "Creating " ++ cabalPath createCabal cabalPath name diff --git a/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs b/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs @@ -0,0 +1,66 @@ +-------------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings #-} +module Hakyll.Web.Pandoc.Biblio.Tests + ( tests + ) where + + +-------------------------------------------------------------------------------- +import System.FilePath (()) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Golden (goldenVsString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as LBS + + +-------------------------------------------------------------------------------- +import Hakyll +import Hakyll.Core.Runtime +import Hakyll.Web.Pandoc.Biblio +import qualified Hakyll.Core.Logger as Logger +import TestSuite.Util + + +-------------------------------------------------------------------------------- +tests :: TestTree +tests = testGroup "Hakyll.Web.Pandoc.Biblio.Tests" $ + [ goldenTest01 + ] + +-------------------------------------------------------------------------------- +goldenTestsDataDir :: FilePath +goldenTestsDataDir = "tests/data/biblio" + +-------------------------------------------------------------------------------- +goldenTest01 :: TestTree +goldenTest01 = + goldenVsString + "biblio01" + (goldenTestsDataDir "biblio01.golden") + (do + -- Code lifted from https://github.com/jaspervdj/hakyll-citeproc-example. + logger <- Logger.new Logger.Error + let config = testConfiguration { providerDirectory = goldenTestsDataDir } + _ <- run config logger $ do + let myPandocBiblioCompiler = do + csl <- load "chicago.csl" + bib <- load "refs.bib" + getResourceBody >>= + readPandocBiblio defaultHakyllReaderOptions csl bib >>= + return . writePandoc + + match "default.html" $ compile templateCompiler + match "chicago.csl" $ compile cslCompiler + match "refs.bib" $ compile biblioCompiler + match "page.markdown" $ do + route $ setExtension "html" + compile $ + myPandocBiblioCompiler >>= + loadAndApplyTemplate "default.html" defaultContext + + output <- fmap LBS.fromStrict $ B.readFile $ + destinationDirectory testConfiguration "page.html" + + cleanTestEnv + + return output) diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -24,6 +24,7 @@ import qualified Hakyll.Web.Html.RelativizeUrls.Tests import qualified Hakyll.Web.Html.Tests #ifdef USE_PANDOC +import qualified Hakyll.Web.Pandoc.Biblio.Tests import qualified Hakyll.Web.Pandoc.FileType.Tests #endif import qualified Hakyll.Web.Template.Context.Tests @@ -48,6 +49,7 @@ , Hakyll.Web.Html.RelativizeUrls.Tests.tests , Hakyll.Web.Html.Tests.tests #ifdef USE_PANDOC + , Hakyll.Web.Pandoc.Biblio.Tests.tests , Hakyll.Web.Pandoc.FileType.Tests.tests #endif , Hakyll.Web.Tags.Tests.tests diff --git a/tests/data/biblio/biblio01.golden b/tests/data/biblio/biblio01.golden new file mode 100644 --- /dev/null +++ b/tests/data/biblio/biblio01.golden @@ -0,0 +1,16 @@ + + + + + This page cites a paper. + + +

This page cites a paper.

+

I would like to cite one of my favourite papers (Meijer, Fokkinga, and Paterson 1991) here.

+
+
+Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. “Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.” In Conference on Functional Programming Languages and Computer Architecture, 124–44. Springer. +
+
+ + diff --git a/tests/data/biblio/chicago.csl b/tests/data/biblio/chicago.csl new file mode 100644 --- /dev/null +++ b/tests/data/biblio/chicago.csl @@ -0,0 +1,648 @@ + + diff --git a/tests/data/biblio/default.html b/tests/data/biblio/default.html new file mode 100644 --- /dev/null +++ b/tests/data/biblio/default.html @@ -0,0 +1,11 @@ + + + + + $title$ + + +

$title$

+ $body$ + + diff --git a/tests/data/biblio/page.markdown b/tests/data/biblio/page.markdown new file mode 100644 --- /dev/null +++ b/tests/data/biblio/page.markdown @@ -0,0 +1,5 @@ +--- +title: This page cites a paper. +--- + +I would like to cite one of my favourite papers [@meijer1991functional] here. diff --git a/tests/data/biblio/refs.bib b/tests/data/biblio/refs.bib new file mode 100644 --- /dev/null +++ b/tests/data/biblio/refs.bib @@ -0,0 +1,8 @@ +@inproceedings{meijer1991functional, + title={Functional programming with bananas, lenses, envelopes and barbed wire}, + author={Meijer, Erik and Fokkinga, Maarten and Paterson, Ross}, + booktitle={Conference on Functional Programming Languages and Computer Architecture}, + pages={124--144}, + year={1991}, + organization={Springer} +}