From 3afebc0c8e80d1493e1605863176e9bfdf89784a Mon Sep 17 00:00:00 2001 From: "Laurent P. René de Cotret" Date: Tue, 30 Jun 2020 08:57:47 -0400 Subject: Continuous integration on Windows and Linux --- lib/Hakyll/Core/Util/File.hs | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/Hakyll/Core/Util/File.hs b/lib/Hakyll/Core/Util/File.hs index 9db6b11..02b8ece 100644 --- a/lib/Hakyll/Core/Util/File.hs +++ b/lib/Hakyll/Core/Util/File.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} -------------------------------------------------------------------------------- -- | A module containing various file utility functions module Hakyll.Core.Util.File @@ -8,10 +10,12 @@ module Hakyll.Core.Util.File -------------------------------------------------------------------------------- +import Control.Concurrent (threadDelay) +import Control.Exception (SomeException, catch) import Control.Monad (filterM, forM, when) import System.Directory (createDirectoryIfMissing, doesDirectoryExist, getDirectoryContents, - removeDirectoryRecursive) + removeDirectoryRecursive, removePathForcibly) import System.FilePath (takeDirectory, ()) @@ -51,6 +55,30 @@ getRecursiveContents ignore top = go "" -------------------------------------------------------------------------------- removeDirectory :: FilePath -> IO () +#ifndef mingw32_HOST_OS removeDirectory fp = do e <- doesDirectoryExist fp when e $ removeDirectoryRecursive fp +#else +-- Deleting files on Windows is unreliable. If a file/directory is open by a program (e.g. antivirus), +-- then removing related directories *quickly* may fail with strange messages. +-- See here for discussions: +-- https://github.com/haskell/directory/issues/96 +-- https://github.com/haskell/win32/pull/129 +-- +-- The hacky solution is to retry deleting directories a few times, +-- with a delay, on Windows only. +removeDirectory = retryWithDelay 10 . removePathForcibly +#endif + + +-------------------------------------------------------------------------------- +-- | Retry an operation at most /n/ times (/n/ must be positive). +-- If the operation fails the /n/th time it will throw that final exception. +-- A delay of 100ms is introduced between every retry. +retryWithDelay :: Int -> IO a -> IO a +retryWithDelay i x + | i <= 0 = error "Hakyll.Core.Util.File.retry: retry count must be 1 or more" + | i == 1 = x + | otherwise = catch x $ \(_::SomeException) -> threadDelay 100 >> retryWithDelay (i-1) x + -- cgit v1.2.3 From f24c5873ed5bb091f0ce5ebdf4df7ab160e87c75 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Wed, 30 Sep 2020 14:04:33 +0200 Subject: Bump template-haskell and pandoc versions * Bumped bound for pandoc and add Binary-instances for new constructors that were added to pandoc-types * Support most recent template-haskell release * Set lower bound of pandoc to version 2.10 * Update CI configuration * Bump QuickCheck upper bound to 2.15 Co-authored-by: OC4 --- .github/workflows/main.yml | 104 +++++++++++++++++++++++++++------------- hakyll.cabal | 8 ++-- lib/Hakyll/Web/Pandoc/Binary.hs | 10 ++++ stack.yaml | 11 ++++- stack.yaml.lock | 59 +++++++++++++++++++++-- 5 files changed, 147 insertions(+), 45 deletions(-) (limited to 'lib') diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 4e2b7c3..bfb65f2 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -1,55 +1,91 @@ -# This Github Actions workflow is modified from -# https://kodimensional.dev/github-actions -name: 'CI' +name: CI # Trigger the workflow on push or pull request, but only for the master branch -on: [push, pull_request] +on: + pull_request: + push: + branches: [master] jobs: - build: + cabal: + name: ${{ matrix.os }} / ghc ${{ matrix.ghc }} + runs-on: ${{ matrix.os }} + strategy: + matrix: + os: [ubuntu-latest, macOS-latest, windows-latest] + cabal: ["3.2"] + ghc: + - "8.6.5" + - "8.8.3" + - "8.10.1" + exclude: + - os: macOS-latest + ghc: 8.8.3 + - os: macOS-latest + ghc: 8.6.5 + - os: windows-latest + ghc: 8.8.3 + - os: windows-latest + ghc: 8.6.5 + + steps: + - uses: actions/checkout@v2 + if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' + + - uses: actions/setup-haskell@v1.1.1 + id: setup-haskell-cabal + name: Setup Haskell + with: + ghc-version: ${{ matrix.ghc }} + cabal-version: ${{ matrix.cabal }} + + - name: Freeze + run: | + cabal freeze + + - uses: actions/cache@v1 + name: Cache ~/.cabal/store + with: + path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }} + key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }} + + - name: Build + run: | + cabal configure --enable-tests --enable-benchmarks --test-show-details=direct + cabal build all + - name: Test + run: | + cabal test all + + stack: + name: stack / ghc ${{ matrix.ghc }} + runs-on: ubuntu-latest strategy: matrix: - os: [ubuntu-latest, windows-latest] + stack: ["2.3.1"] + ghc: ["8.8.3"] - env: - ARGS: --no-terminal --fast - - name: ${{ matrix.os }} - runs-on: ${{ matrix.os }} - steps: - uses: actions/checkout@v2 if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' - # https://github.com/actions/setup-haskell - uses: actions/setup-haskell@v1.1 name: Setup Haskell Stack with: - stack-version: "latest" - enable-stack: true - stack-no-global: true - - # https://github.com/actions/cache - - uses: actions/cache@v2 + ghc-version: ${{ matrix.ghc }} + stack-version: ${{ matrix.stack }} + + - uses: actions/cache@v1 name: Cache ~/.stack with: path: ~/.stack - key: ${{ runner.os }}-${{ hashFiles('stack.yaml') }} - - # There are strange problems with CI on Windows, where builds with GHC 8.8.* - # always fail. Therefore, we distinguish between builds on Ubuntu and Windows - # and use an older compiler on Windows. - # See here for bug reports: - # https://gitlab.haskell.org/ghc/ghc/issues/17599 - # https://gitlab.haskell.org/ghc/ghc/issues/17926 - - - name: Test (Ubuntu) + key: ${{ runner.os }}-${{ matrix.ghc }}-stack + + - name: Build run: | - stack test $ARGS --stack-yaml stack.yaml - if: ${{ runner.os == 'Linux' }} + stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks - - name: Test (Windows) + - name: Test run: | - stack test $ARGS --stack-yaml stack.yaml --compiler ghc-8.6.5 - if: ${{ runner.os == 'Windows' }} + stack test --system-ghc diff --git a/hakyll.cabal b/hakyll.cabal index c80c392..e7af07d 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -188,7 +188,7 @@ Library resourcet >= 1.1 && < 1.3, scientific >= 0.3.4 && < 0.4, tagsoup >= 0.13.1 && < 0.15, - template-haskell >= 2.14 && < 2.16, + template-haskell >= 2.14 && < 2.17, text >= 0.11 && < 1.3, time >= 1.8 && < 1.10, time-locale-compat >= 0.1 && < 0.2, @@ -232,7 +232,7 @@ Library Other-Modules: Hakyll.Web.Pandoc.Binary Build-Depends: - pandoc >= 2.0.5 && < 2.10, + pandoc >= 2.10 && < 2.11, pandoc-citeproc >= 0.14 && < 0.18 Cpp-options: -DUSE_PANDOC @@ -265,7 +265,7 @@ Test-suite hakyll-tests Build-Depends: hakyll, - QuickCheck >= 2.8 && < 2.14, + QuickCheck >= 2.8 && < 2.15, tasty >= 0.11 && < 1.4, tasty-hunit >= 0.9 && < 0.11, tasty-quickcheck >= 0.8 && < 0.11, @@ -327,4 +327,4 @@ Executable hakyll-website base >= 4 && < 5, directory >= 1.0 && < 1.4, filepath >= 1.0 && < 1.5, - pandoc >= 2.0.5 && < 2.10 + pandoc >= 2.10 && < 2.11 diff --git a/lib/Hakyll/Web/Pandoc/Binary.hs b/lib/Hakyll/Web/Pandoc/Binary.hs index deeaf08..5d3efea 100644 --- a/lib/Hakyll/Web/Pandoc/Binary.hs +++ b/lib/Hakyll/Web/Pandoc/Binary.hs @@ -14,6 +14,10 @@ import Text.Pandoc instance Binary Alignment instance Binary Block +instance Binary Caption +instance Binary Cell +instance Binary ColSpan +instance Binary ColWidth instance Binary CSL.Reference instance Binary Citation instance Binary CitationMode @@ -29,5 +33,11 @@ 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/stack.yaml b/stack.yaml index c3958dd..49c9f69 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-15.6 +resolver: lts-16.9 save-hackage-creds: false flags: @@ -22,4 +22,11 @@ build: haddock-hyperlink-source: true haddock-deps: false -extra-deps: [] +extra-deps: +- 'commonmark-0.1.0.2' +- 'commonmark-extensions-0.2.0.1' +- 'commonmark-pandoc-0.2.0.1' +- 'hslua-1.1.2' +- 'jira-wiki-markup-1.3.2' +- 'pandoc-2.10.1' +- 'pandoc-types-1.21' diff --git a/stack.yaml.lock b/stack.yaml.lock index ebcdead..5de18d3 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -3,10 +3,59 @@ # For more information, please see the documentation at: # https://docs.haskellstack.org/en/stable/lock_files -packages: [] +packages: +- completed: + hackage: commonmark-0.1.0.2@sha256:fbff7a2ade0ce7d699964a87f765e503a3a9e22542c05f0f02ba7aad64e38af4,3278 + pantry-tree: + size: 1346 + sha256: 991da6da60804286b9ea23a1522e18ceeabddfdf416787231db9fd047c163f53 + original: + hackage: commonmark-0.1.0.2 +- completed: + hackage: commonmark-extensions-0.2.0.1@sha256:647aa8dba5fd46984ddedc15c3693c9c4d9655503d42006576bd8f0dadf8cd39,3176 + pantry-tree: + size: 2927 + sha256: 89e1ee05938d558834c397a3a22cdacc755a1941c144f4c1f3daf8a1ede943ce + original: + hackage: commonmark-extensions-0.2.0.1 +- completed: + hackage: commonmark-pandoc-0.2.0.1@sha256:529c6e2c6cabf61558b66a28123eafc1d90d3324be29819f59f024e430312c1f,1105 + pantry-tree: + size: 326 + sha256: d9954a15f73c8fe55a5097e1cc0957fa626d340ef36e2beefb8caae66008c3dc + original: + hackage: commonmark-pandoc-0.2.0.1 +- completed: + hackage: hslua-1.1.2@sha256:6c231b2af447430d1ed04f065d40bb6882ece93cc7f32f4051dc99deb69beeae,9694 + pantry-tree: + size: 6820 + sha256: 62e61f6d08191159a070dcbaa20284a581835de620105a254dbee1c7ddfabd9d + original: + hackage: hslua-1.1.2 +- completed: + hackage: jira-wiki-markup-1.3.2@sha256:b5f0901208a0ee07aff60f5356aeb851b7aa7950c75a18a15fd34247a35886d8,3819 + pantry-tree: + size: 1180 + sha256: 90fa545210a211b8ec88b59f92fe2877ebf2f9e55e2ce2fba6103a3615bd0ab9 + original: + hackage: jira-wiki-markup-1.3.2 +- completed: + hackage: pandoc-2.10.1@sha256:23d7ec480c7cb86740475a419d6ca4819987b6dd23bbae9b50bc3d42a7ed2f9f,36933 + pantry-tree: + size: 89646 + sha256: 08c8b20356152b9ee8161bacafda2dc1bed13d7db4cbf38ab040c1977b2d28d5 + original: + hackage: pandoc-2.10.1 +- completed: + hackage: pandoc-types-1.21@sha256:b61ed625da4d1a0d8057fcca4c0c5e174c9f45d94b41504db1532f3fc581e945,4037 + pantry-tree: + size: 713 + sha256: e26eb93747538e29168032985a03b428039a16000fea1a4a8d9b9b032ac98b5f + original: + hackage: pandoc-types-1.21 snapshots: - completed: - size: 491387 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/6.yaml - sha256: 8d81505a6de861e167a58534ab62330afb75bfa108735c7db1204f7ef2a39d79 - original: lts-15.6 + size: 532380 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/9.yaml + sha256: 14a7cec114424e4286adde73364438927a553ed248cc50f069a30a67e3ee1e69 + original: lts-16.9 -- cgit v1.2.3 From ab9eea7029e2f666a0accce07ce5f5105f5c2155 Mon Sep 17 00:00:00 2001 From: Liang-Ting Chen Date: Thu, 12 Nov 2020 05:32:10 +0800 Subject: Remove unnecessary conditional compilation for parseTimeM (#781) --- lib/Hakyll/Web/Template/Context.hs | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) (limited to 'lib') diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs index 3f75466..9ce7440 100644 --- a/lib/Hakyll/Web/Template/Context.hs +++ b/lib/Hakyll/Web/Template/Context.hs @@ -60,8 +60,7 @@ import Data.List (intercalate, tails) 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 @@ teaserFieldWithSeparator separator key snapshot = field key $ \item -> do 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 -- cgit v1.2.3 From 84157674d955778c806efdafda311b2732242b38 Mon Sep 17 00:00:00 2001 From: Alexander Batischev Date: Thu, 12 Nov 2020 17:23:28 +0300 Subject: File.hs: +symlink-based static file compiler; for multi-gigabyte sites, this can be a major speedup (see #786) (#810) Co-authored-by: gwern --- lib/Hakyll/Core/File.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) (limited to 'lib') diff --git a/lib/Hakyll/Core/File.hs b/lib/Hakyll/Core/File.hs index 49af659..6a5775e 100644 --- a/lib/Hakyll/Core/File.hs +++ b/lib/Hakyll/Core/File.hs @@ -8,6 +8,8 @@ module Hakyll.Core.File , copyFileCompiler , TmpFile (..) , newTmpFile + , SymlinkFile (..) + , symlinkFileCompiler ) where @@ -20,6 +22,7 @@ import System.Directory (copyFileWithMetadata) import System.Directory (copyFile) #endif import System.Directory (doesFileExist, + createFileLink, renameFile) import System.FilePath (()) import System.Random (randomIO) @@ -56,6 +59,19 @@ copyFileCompiler = do provider <- compilerProvider <$> compilerAsk makeItem $ CopyFile $ resourceFilePath provider identifier +-------------------------------------------------------------------------------- +-- | This will not copy a file but create a symlink, which can save space & time for static sites with many large static files which would normally be handled by copyFileCompiler. (Note: the user will need to make sure their sync method handles symbolic links correctly!) +newtype SymlinkFile = SymlinkFile FilePath + deriving (Binary, Eq, Ord, Show, Typeable) +-------------------------------------------------------------------------------- +instance Writable SymlinkFile where + write dst (Item _ (SymlinkFile src)) = createFileLink src dst +-------------------------------------------------------------------------------- +symlinkFileCompiler :: Compiler (Item SymlinkFile) +symlinkFileCompiler = do + identifier <- getUnderlying + provider <- compilerProvider <$> compilerAsk + makeItem $ SymlinkFile $ resourceFilePath provider identifier -------------------------------------------------------------------------------- newtype TmpFile = TmpFile FilePath -- cgit v1.2.3 From 850cf285897c22d2f8892695217a6085c2ce4875 Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Mon, 16 Nov 2020 16:10:35 +0100 Subject: Derive Functor, Foldable and Traversable for Item (#815) --- lib/Hakyll/Core/Item.hs | 19 ++----------------- 1 file changed, 2 insertions(+), 17 deletions(-) (limited to 'lib') diff --git a/lib/Hakyll/Core/Item.hs b/lib/Hakyll/Core/Item.hs index e05df42..af15b94 100644 --- 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 @@ import Hakyll.Core.Identifier 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 -- cgit v1.2.3 From 77afcbc2937a4ee5db9666c1f3e0c090914d3980 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sun, 6 Dec 2020 19:24:06 +0100 Subject: Pandoc 2.11 compatibility (#826) * Pandoc 2.11 compatibility * Bump stack.yaml * Bump stack dependencies --- hakyll.cabal | 5 +- lib/Hakyll/Web/Pandoc/Biblio.hs | 102 ++++++++++++++++++++++------------------ lib/Hakyll/Web/Pandoc/Binary.hs | 12 ----- stack.yaml | 17 +++++-- stack.yaml.lock | 73 ++++++++++++++++++++-------- 5 files changed, 123 insertions(+), 86 deletions(-) (limited to 'lib') diff --git a/hakyll.cabal b/hakyll.cabal index a3c0cc3..94bbab8 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -232,8 +232,7 @@ Library Other-Modules: Hakyll.Web.Pandoc.Binary Build-Depends: - pandoc >= 2.10 && < 2.12, - pandoc-citeproc >= 0.14 && < 0.18 + pandoc >= 2.11 && < 2.12 Cpp-options: -DUSE_PANDOC @@ -327,4 +326,4 @@ Executable hakyll-website base >= 4 && < 5, directory >= 1.0 && < 1.4, filepath >= 1.0 && < 1.5, - pandoc >= 2.10 && < 2.12 + pandoc >= 2.11 && < 2.12 diff --git a/lib/Hakyll/Web/Pandoc/Biblio.hs b/lib/Hakyll/Web/Pandoc/Biblio.hs index 5127d88..567f478 100644 --- 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,33 +24,31 @@ module Hakyll.Web.Pandoc.Biblio -------------------------------------------------------------------------------- -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 @@ -59,21 +58,12 @@ instance Writable CSL where -------------------------------------------------------------------------------- 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 @@ instance Writable Biblio where -------------------------------------------------------------------------------- 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,19 +84,42 @@ readPandocBiblio :: ReaderOptions -> (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 - - -- 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 - - return $ fmap (const pandoc') item + -- 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 + + 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 + + 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 -------------------------------------------------------------------------------- pandocBiblioCompiler :: String -> String -> Compiler (Item String) diff --git a/lib/Hakyll/Web/Pandoc/Binary.hs b/lib/Hakyll/Web/Pandoc/Binary.hs index 5d3efea..3f7f4fb 100644 --- a/lib/Hakyll/Web/Pandoc/Binary.hs +++ b/lib/Hakyll/Web/Pandoc/Binary.hs @@ -4,9 +4,6 @@ module Hakyll.Web.Pandoc.Binary where 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 Caption 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 ListNumberDelim 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/stack.yaml b/stack.yaml index 63ee6a4..7820738 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,5 +1,7 @@ resolver: lts-16.21 save-hackage-creds: false +system-ghc: true +skip-ghc-check: true flags: hakyll: @@ -23,10 +25,15 @@ build: haddock-deps: false extra-deps: -- 'commonmark-0.1.0.2' -- 'commonmark-extensions-0.2.0.1' +- 'citeproc-0.2' +- 'commonmark-0.1.1.2' +- 'commonmark-extensions-0.2.0.4' - 'commonmark-pandoc-0.2.0.1' -- 'hslua-1.1.2' +- 'hslua-1.3.0' +- 'hslua-module-text-0.3.0.1' - 'jira-wiki-markup-1.3.2' -- 'pandoc-2.10.1' -- 'pandoc-types-1.21' +- 'pandoc-2.11.2' +- 'pandoc-types-1.22' +- 'rfc5051-0.2' +- 'skylighting-0.10.1' +- 'skylighting-core-0.10.1' diff --git a/stack.yaml.lock b/stack.yaml.lock index 8636225..caab7e9 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -5,19 +5,26 @@ packages: - completed: - hackage: commonmark-0.1.0.2@sha256:fbff7a2ade0ce7d699964a87f765e503a3a9e22542c05f0f02ba7aad64e38af4,3278 + hackage: citeproc-0.2@sha256:72a6b976a1d3ff2107043cfeb942e278ce2b93f0e31752da86bc6431b862ae19,5431 + pantry-tree: + size: 78527 + sha256: 1dd0f1ee7bc43367fbb745ba859ad6e2eb3b8d16d515c47deba31a5bd09bc0e2 + original: + hackage: citeproc-0.2 +- completed: + hackage: commonmark-0.1.1.2@sha256:c06ab05f0f224ab7982502a96e17952823a9b6dae8505fb35194b0baa9e2a975,3278 pantry-tree: size: 1346 - sha256: 991da6da60804286b9ea23a1522e18ceeabddfdf416787231db9fd047c163f53 + sha256: 6a187bbbfaf61b4b1bf87ee5027e7edb5b7157ad3380982b07b876e9a60cd63d original: - hackage: commonmark-0.1.0.2 + hackage: commonmark-0.1.1.2 - completed: - hackage: commonmark-extensions-0.2.0.1@sha256:647aa8dba5fd46984ddedc15c3693c9c4d9655503d42006576bd8f0dadf8cd39,3176 + hackage: commonmark-extensions-0.2.0.4@sha256:6a437bcfa3c757af4262b71336513619990eafb5cfdc33e57a499c93ad225608,3184 pantry-tree: - size: 2927 - sha256: 89e1ee05938d558834c397a3a22cdacc755a1941c144f4c1f3daf8a1ede943ce + size: 2928 + sha256: ac8993e356edabc65a40d6c6909696c5f2dfe2a5298089da820c29ca75852360 original: - hackage: commonmark-extensions-0.2.0.1 + hackage: commonmark-extensions-0.2.0.4 - completed: hackage: commonmark-pandoc-0.2.0.1@sha256:529c6e2c6cabf61558b66a28123eafc1d90d3324be29819f59f024e430312c1f,1105 pantry-tree: @@ -26,12 +33,19 @@ packages: original: hackage: commonmark-pandoc-0.2.0.1 - completed: - hackage: hslua-1.1.2@sha256:6c231b2af447430d1ed04f065d40bb6882ece93cc7f32f4051dc99deb69beeae,9694 + hackage: hslua-1.3.0@sha256:d9b758f6234286a7df267cae15332507a1d3be56baf03ff7ae073269bc55c4e8,11023 + pantry-tree: + size: 7716 + sha256: e2cc992f8ea4781718386c3c0def49f04be96b4b0c459b629df555b0c045efc2 + original: + hackage: hslua-1.3.0 +- completed: + hackage: hslua-module-text-0.3.0.1@sha256:e245d7bf9746101664dcde9c33b1c8cd792d404fddb8d9346ae6abb6b971dd93,1741 pantry-tree: - size: 6820 - sha256: 62e61f6d08191159a070dcbaa20284a581835de620105a254dbee1c7ddfabd9d + size: 415 + sha256: 70932f637ef2a81024d43270f3b28ce870d7b43c405fb399d51d07f170da76ea original: - hackage: hslua-1.1.2 + hackage: hslua-module-text-0.3.0.1 - completed: hackage: jira-wiki-markup-1.3.2@sha256:b5f0901208a0ee07aff60f5356aeb851b7aa7950c75a18a15fd34247a35886d8,3819 pantry-tree: @@ -40,19 +54,40 @@ packages: original: hackage: jira-wiki-markup-1.3.2 - completed: - hackage: pandoc-2.10.1@sha256:23d7ec480c7cb86740475a419d6ca4819987b6dd23bbae9b50bc3d42a7ed2f9f,36933 + hackage: pandoc-2.11.2@sha256:e21f0af1750c4d7a3cf9096c46403c55043c9ac06c7c37627ecb312499eb3136,39349 + pantry-tree: + size: 114848 + sha256: ef31f41960bd8ae1a1b02b2c56a692583398f2cb3fc7c0177583b698a6a60fdf + original: + hackage: pandoc-2.11.2 +- completed: + hackage: pandoc-types-1.22@sha256:15512ce011555ee720820f11cac0598317293406da5812337cbb1550d144e3bd,4071 + pantry-tree: + size: 737 + sha256: 28e43150f4bb0d4d880cf92ade20fefcd8705ee95cfe4a1d0bb5efd320982a9d + original: + hackage: pandoc-types-1.22 +- completed: + hackage: rfc5051-0.2@sha256:da5d77731f2ac6fe313a67919419b0833e09cd7f1a81869ed82a54dbf8962bf2,1678 + pantry-tree: + size: 446 + sha256: 191a30a13590a14dc8f606ff945298fee6afbb093a49bc5db71dbaf066f01930 + original: + hackage: rfc5051-0.2 +- completed: + hackage: skylighting-0.10.1@sha256:69f9175c606289164347a2ae1507218bf0c2479a1ed93356d24e83e4097ef493,10031 pantry-tree: - size: 89646 - sha256: 08c8b20356152b9ee8161bacafda2dc1bed13d7db4cbf38ab040c1977b2d28d5 + size: 10837 + sha256: 5b5516a196a75c6dffb33c3c9227d743d3c48e3d659fb7aad2cc01609e1e3a1f original: - hackage: pandoc-2.10.1 + hackage: skylighting-0.10.1 - completed: - hackage: pandoc-types-1.21@sha256:b61ed625da4d1a0d8057fcca4c0c5e174c9f45d94b41504db1532f3fc581e945,4037 + hackage: skylighting-core-0.10.1@sha256:da0b01c22322f1312e9a5e37343f2153a3a8ba65a3d88ef51cf9b1360c466e08,8159 pantry-tree: - size: 713 - sha256: e26eb93747538e29168032985a03b428039a16000fea1a4a8d9b9b032ac98b5f + size: 13517 + sha256: 48673ab1725d2aa6c019bb8a7d1419002d9a86a5dd54e2745b9d78846d793b29 original: - hackage: pandoc-types-1.21 + hackage: skylighting-core-0.10.1 snapshots: - completed: size: 532413 -- cgit v1.2.3 From ef1bad68d6e9d62da7a1115a7d75bad689b62817 Mon Sep 17 00:00:00 2001 From: Chris Jensen Date: Tue, 29 Dec 2020 17:07:28 +0000 Subject: Add documentation for the pandocBiblioCompiler (#828) * Add documentation for pandoc * Fix grammar --- lib/Hakyll/Web/Pandoc/Biblio.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'lib') diff --git a/lib/Hakyll/Web/Pandoc/Biblio.hs b/lib/Hakyll/Web/Pandoc/Biblio.hs index 567f478..566c706 100644 --- a/lib/Hakyll/Web/Pandoc/Biblio.hs +++ b/lib/Hakyll/Web/Pandoc/Biblio.hs @@ -122,6 +122,7 @@ readPandocBiblio ropt csl biblio item = do 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 -- cgit v1.2.3 From b54212c7e2b8a84f95815e93a13223e1525c4f85 Mon Sep 17 00:00:00 2001 From: Norman Liu <57917002+dreamsmasher@users.noreply.github.com> Date: Thu, 11 Mar 2021 16:38:21 -0500 Subject: Add `renderPandocWithTransform` and `renderPandocWithTransformM` * added function that allows for pre-pandoc transformations * modified haddock docstring * refactoring to avoid importing the kleisli fish * Renamed `applyPandoc` to `renderPandocWithTransformM`, added non-monadic variant. Exported previous new functions that I forgot to export. --- lib/Hakyll/Web/Pandoc.hs | 33 ++++++++++++++++++++++++++++++--- 1 file changed, 30 insertions(+), 3 deletions(-) (limited to 'lib') diff --git a/lib/Hakyll/Web/Pandoc.hs b/lib/Hakyll/Web/Pandoc.hs index 5f04de4..372465b 100644 --- a/lib/Hakyll/Web/Pandoc.hs +++ b/lib/Hakyll/Web/Pandoc.hs @@ -8,6 +8,8 @@ module Hakyll.Web.Pandoc , writePandocWith , renderPandoc , renderPandocWith + , renderPandocWithTransform + , renderPandocWithTransformM -- * Derived compilers , pandocCompiler @@ -103,6 +105,32 @@ renderPandocWith ropt wopt item = writePandocWith wopt <$> readPandocWith ropt item +-------------------------------------------------------------------------------- +-- | 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) @@ -137,9 +165,8 @@ pandocCompilerWithTransform ropt wopt f = 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 -------------------------------------------------------------------------------- -- cgit v1.2.3 From 470ebef4d5234d4f4a39ac069aff1561a627fde6 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sun, 14 Mar 2021 13:47:17 +0100 Subject: Revert "File.hs: +symlink-based static file compiler; for multi-gigabyte sites, this can be a major speedup (see #786) (#810)" This reverts commit 84157674d955778c806efdafda311b2732242b38. --- lib/Hakyll/Core/File.hs | 16 ---------------- 1 file changed, 16 deletions(-) (limited to 'lib') diff --git a/lib/Hakyll/Core/File.hs b/lib/Hakyll/Core/File.hs index 6a5775e..49af659 100644 --- a/lib/Hakyll/Core/File.hs +++ b/lib/Hakyll/Core/File.hs @@ -8,8 +8,6 @@ module Hakyll.Core.File , copyFileCompiler , TmpFile (..) , newTmpFile - , SymlinkFile (..) - , symlinkFileCompiler ) where @@ -22,7 +20,6 @@ import System.Directory (copyFileWithMetadata) import System.Directory (copyFile) #endif import System.Directory (doesFileExist, - createFileLink, renameFile) import System.FilePath (()) import System.Random (randomIO) @@ -59,19 +56,6 @@ copyFileCompiler = do provider <- compilerProvider <$> compilerAsk makeItem $ CopyFile $ resourceFilePath provider identifier --------------------------------------------------------------------------------- --- | This will not copy a file but create a symlink, which can save space & time for static sites with many large static files which would normally be handled by copyFileCompiler. (Note: the user will need to make sure their sync method handles symbolic links correctly!) -newtype SymlinkFile = SymlinkFile FilePath - deriving (Binary, Eq, Ord, Show, Typeable) --------------------------------------------------------------------------------- -instance Writable SymlinkFile where - write dst (Item _ (SymlinkFile src)) = createFileLink src dst --------------------------------------------------------------------------------- -symlinkFileCompiler :: Compiler (Item SymlinkFile) -symlinkFileCompiler = do - identifier <- getUnderlying - provider <- compilerProvider <$> compilerAsk - makeItem $ SymlinkFile $ resourceFilePath provider identifier -------------------------------------------------------------------------------- newtype TmpFile = TmpFile FilePath -- cgit v1.2.3 From 122dd424891f6c9be15ff5225886484386dd0956 Mon Sep 17 00:00:00 2001 From: "Laurent P. René de Cotret" Date: Thu, 15 Apr 2021 15:51:38 -0400 Subject: Remove dependency on cryptonite and memory (#843) --- hakyll.cabal | 3 +-- lib/Hakyll/Core/Store.hs | 29 +++-------------------------- test.hs | 6 ++---- 3 files changed, 6 insertions(+), 32 deletions(-) (limited to 'lib') diff --git a/hakyll.cabal b/hakyll.cabal index f799344..b09aff0 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -175,14 +175,13 @@ Library blaze-markup >= 0.5.1 && < 0.9, bytestring >= 0.9 && < 0.11, containers >= 0.3 && < 0.7, - cryptonite >= 0.25 && < 0.29, 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.14, filepath >= 1.0 && < 1.5, + hashable >= 1.0 && < 2, lrucache >= 1.1.1 && < 1.3, - memory >= 0.14.18 && < 0.16, mtl >= 1 && < 2.3, network-uri >= 2.6 && < 2.7, optparse-applicative >= 0.12 && < 0.17, diff --git a/lib/Hakyll/Core/Store.hs b/lib/Hakyll/Core/Store.hs index bfcd191..da16c6f 100644 --- a/lib/Hakyll/Core/Store.hs +++ b/lib/Hakyll/Core/Store.hs @@ -16,20 +16,14 @@ module Hakyll.Core.Store -------------------------------------------------------------------------------- -import qualified Data.ByteArray as BA -import qualified Crypto.Hash as CH +import qualified Data.Hashable as DH import Data.Binary (Binary, decode, encodeFile) -import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.Cache.LRU.IO as Lru import Data.List (intercalate) import Data.Maybe (isJust) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T import Data.Typeable (TypeRep, Typeable, cast, typeOf) -import Numeric (showHex) -import System.Directory (createDirectoryIfMissing) -import System.Directory (doesFileExist, removeFile) +import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile) import System.FilePath (()) import System.IO (IOMode (..), hClose, openFile) import System.IO.Error (catchIOError, ioeSetFileName, @@ -194,21 +188,4 @@ deleteFile = (`catchIOError` \_ -> return ()) . removeFile -------------------------------------------------------------------------------- -- | Mostly meant for internal usage hash :: [String] -> String -hash = toHex . B.unpack . hashMD5 . T.encodeUtf8 . T.pack . intercalate "/" - where - toHex [] = "" - toHex (x : xs) | x < 16 = '0' : showHex x (toHex xs) - | otherwise = showHex x (toHex xs) - - --------------------------------------------------------------------------------- --- | Hash by MD5 -hashMD5 :: B.ByteString -> B.ByteString -hashMD5 x = - let - digest :: CH.Digest CH.MD5 - digest = CH.hash x - bytes :: B.ByteString - bytes = BA.convert digest - in - bytes +hash = show . DH.hash . intercalate "/" \ No newline at end of file diff --git a/test.hs b/test.hs index 8b3a2de..aea447c 100644 --- a/test.hs +++ b/test.hs @@ -1,9 +1,9 @@ {-# LANGUAGE BangPatterns #-} import Control.Monad (forM) -import qualified Crypto.Hash.SHA256 as SHA256 import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as BSL +import qualified Data.Hashable as DH import Data.Map (Map) import qualified Data.Map as Map import Hakyll @@ -20,9 +20,7 @@ mkFileHashes dir = do return (fromFilePath path1, h) where hash :: FilePath -> IO String - hash fp = do - !h <- SHA256.hashlazy <$> BSL.readFile fp - return $! BS8.unpack $! Base16.encode h + hash fp = (show . DH.hash) <$> BSL.readFile fp main :: IO () main = hakyll $ do -- cgit v1.2.3 From 6e77b4e7d2f74da964fd95494dad1ee56d4c4536 Mon Sep 17 00:00:00 2001 From: "Laurent P. René de Cotret" Date: Sun, 30 May 2021 15:00:59 -0400 Subject: Async runtime with graph-based dependency cycle checks (#844) * Async runtime * Activate multi-threading in template repo * Style changes after feedback * Limiting the number of concurrent tasks * Revert "Limiting the number of concurrent tasks" This reverts commit 38984f6f5332632be8c4cab3e29d37e318492d70. --- hakyll.cabal | 3 + lib/Hakyll/Core/Runtime.hs | 319 +++++++++++++++++++++---------------- src/Init.hs | 2 +- tests/Hakyll/Core/Runtime/Tests.hs | 30 +++- 4 files changed, 216 insertions(+), 138 deletions(-) (limited to 'lib') diff --git a/hakyll.cabal b/hakyll.cabal index 89f251d..74e63e0 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -169,6 +169,7 @@ Library Paths_hakyll Build-Depends: + array >= 0.5 && < 1, base >= 4.8 && < 5, binary >= 0.5 && < 0.10, blaze-html >= 0.5 && < 0.10, @@ -181,6 +182,7 @@ Library file-embed >= 0.0.10.1 && < 0.0.14, filepath >= 1.0 && < 1.5, hashable >= 1.0 && < 2, + lifted-async >= 0.10 && < 1, lrucache >= 1.1.1 && < 1.3, mtl >= 1 && < 2.3, network-uri >= 2.6 && < 2.7, @@ -191,6 +193,7 @@ Library regex-tdfa >= 1.1 && < 1.4, resourcet >= 1.1 && < 1.3, scientific >= 0.3.4 && < 0.4, + stm >= 2.3 && < 3, tagsoup >= 0.13.1 && < 0.15, template-haskell >= 2.14 && < 2.17, text >= 0.11 && < 1.3, diff --git a/lib/Hakyll/Core/Runtime.hs b/lib/Hakyll/Core/Runtime.hs index 922b676..e0edf5b 100644 --- a/lib/Hakyll/Core/Runtime.hs +++ b/lib/Hakyll/Core/Runtime.hs @@ -5,19 +5,24 @@ module Hakyll.Core.Runtime -------------------------------------------------------------------------------- -import Control.Monad (unless) -import Control.Monad.Except (ExceptT, runExceptT, throwError) -import Control.Monad.Reader (ask) -import Control.Monad.RWS (RWST, runRWST) -import Control.Monad.State (get, modify) -import Control.Monad.Trans (liftIO) -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 System.Exit (ExitCode (..)) -import System.FilePath (()) +import Control.Concurrent.Async.Lifted (forConcurrently_) +import Control.Concurrent.STM (atomically, modifyTVar', readTVarIO, newTVarIO, TVar) +import Control.Monad (unless) +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.Trans (liftIO) +import qualified Data.Array as A +import Data.Graph (Graph) +import qualified Data.Graph as G +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 System.Exit (ExitCode (..)) +import System.FilePath (()) -------------------------------------------------------------------------------- @@ -67,11 +72,13 @@ run config logger rules = do , runtimeRoutes = rulesRoutes ruleSet , runtimeUniverse = M.fromList compilers } - state = RuntimeState - { runtimeDone = S.empty - , runtimeSnapshots = S.empty - , runtimeTodo = M.empty - , runtimeFacts = oldFacts + + state <- newTVarIO $ RuntimeState + { runtimeDone = S.empty + , runtimeSnapshots = S.empty + , runtimeTodo = M.empty + , runtimeFacts = oldFacts + , runtimeDependencies = M.empty } -- Run the program and fetch the resulting state @@ -83,7 +90,8 @@ run config logger rules = do return (ExitFailure 1, ruleSet) Right (_, s, _) -> do - Store.set store factsKey $ runtimeFacts s + facts <- fmap runtimeFacts . liftIO . readTVarIO $ s + Store.set store factsKey facts Logger.debug logger "Removing tmp directory..." removeDirectory $ tmpDirectory config @@ -107,15 +115,30 @@ data RuntimeRead = RuntimeRead -------------------------------------------------------------------------------- data RuntimeState = RuntimeState - { runtimeDone :: Set Identifier - , runtimeSnapshots :: Set (Identifier, Snapshot) - , runtimeTodo :: Map Identifier (Compiler SomeItem) - , runtimeFacts :: DependencyFacts + { runtimeDone :: Set Identifier + , runtimeSnapshots :: Set (Identifier, Snapshot) + , runtimeTodo :: Map Identifier (Compiler SomeItem) + , runtimeFacts :: DependencyFacts + , runtimeDependencies :: Map Identifier (Set Identifier) } -------------------------------------------------------------------------------- -type Runtime a = RWST RuntimeRead () RuntimeState (ExceptT String IO) a +type Runtime a = RWST RuntimeRead () (TVar RuntimeState) (ExceptT String IO) a + + +-------------------------------------------------------------------------------- +-- Because compilation of rules often revolves around IO, +-- it is not possible to live in the STM monad and hence benefit from +-- its guarantees. +-- Be very careful when modifying the state +modifyRuntimeState :: (RuntimeState -> RuntimeState) -> Runtime () +modifyRuntimeState f = get >>= \s -> liftIO . atomically $ modifyTVar' s f + + +-------------------------------------------------------------------------------- +getRuntimeState :: Runtime RuntimeState +getRuntimeState = liftIO . readTVarIO =<< get -------------------------------------------------------------------------------- @@ -135,13 +158,15 @@ scheduleOutOfDate = do logger <- runtimeLogger <$> ask provider <- runtimeProvider <$> ask universe <- runtimeUniverse <$> ask - facts <- runtimeFacts <$> get - todo <- runtimeTodo <$> get let identifiers = M.keys universe modified = S.fromList $ flip filter identifiers $ resourceModified provider - + + state <- getRuntimeState + let facts = runtimeFacts state + todo = runtimeTodo state + let (ood, facts', msgs) = outOfDate identifiers modified facts todo' = M.filterWithKey (\id' _ -> id' `S.member` ood) universe @@ -150,7 +175,7 @@ scheduleOutOfDate = do mapM_ (Logger.debug logger) msgs -- Update facts and todo items - modify $ \s -> s + modifyRuntimeState $ \s -> s { runtimeDone = runtimeDone s `S.union` (S.fromList identifiers `S.difference` ood) , runtimeTodo = todo `M.union` todo' @@ -161,116 +186,138 @@ scheduleOutOfDate = do -------------------------------------------------------------------------------- pickAndChase :: Runtime () pickAndChase = do - todo <- runtimeTodo <$> get - case M.minViewWithKey todo of - Nothing -> return () - Just ((id', _), _) -> do - chase [] id' - pickAndChase + todo <- runtimeTodo <$> getRuntimeState + unless (null todo) $ do + checkForDependencyCycle + forConcurrently_ (M.keys todo) chase + pickAndChase -------------------------------------------------------------------------------- -chase :: [Identifier] -> Identifier -> Runtime () -chase trail id' - | id' `elem` trail = throwError $ "Hakyll.Core.Runtime.chase: " ++ - "Dependency cycle detected: " ++ intercalate " depends on " - (map show $ dropWhile (/= id') (reverse trail) ++ [id']) - | otherwise = do - logger <- runtimeLogger <$> ask - todo <- runtimeTodo <$> get - provider <- runtimeProvider <$> ask - universe <- runtimeUniverse <$> ask - routes <- runtimeRoutes <$> ask - store <- runtimeStore <$> ask - config <- runtimeConfiguration <$> ask - Logger.debug logger $ "Processing " ++ show id' - - let compiler = todo M.! id' - read' = CompilerRead - { compilerConfig = config - , compilerUnderlying = id' - , compilerProvider = provider - , compilerUniverse = M.keysSet universe - , compilerRoutes = routes - , compilerStore = store - , compilerLogger = logger +-- | 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 + + 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 + + reachableFromAny :: Graph -> G.Vertex -> [G.Vertex] -> Bool + reachableFromAny graph node = elem node . concatMap (G.reachable graph) + + +-------------------------------------------------------------------------------- +chase :: Identifier -> Runtime () +chase id' = do + logger <- runtimeLogger <$> ask + provider <- runtimeProvider <$> ask + universe <- runtimeUniverse <$> ask + routes <- runtimeRoutes <$> ask + store <- runtimeStore <$> ask + config <- runtimeConfiguration <$> ask + + state <- getRuntimeState + + Logger.debug logger $ "Processing " ++ show id' + + let compiler = (runtimeTodo state) M.! id' + read' = CompilerRead + { compilerConfig = config + , compilerUnderlying = id' + , compilerProvider = provider + , compilerUniverse = M.keysSet universe + , compilerRoutes = routes + , compilerStore = store + , compilerLogger = logger + } + + result <- liftIO $ runCompiler compiler read' + case result of + -- Rethrow error + CompilerError e -> throwError $ case compilerErrorMessages e of + [] -> "Compiler failed but no info given, try running with -v?" + es -> intercalate "; " es + + -- Signal that a snapshot was saved -> + CompilerSnapshot snapshot c -> do + -- Update info. The next 'chase' will pick us again at some + -- point so we can continue then. + modifyRuntimeState $ \s -> s + { runtimeSnapshots = S.insert (id', snapshot) (runtimeSnapshots s) + , runtimeTodo = M.insert id' c (runtimeTodo s) + } + + + -- Huge success + CompilerDone (SomeItem item) cwrite -> do + -- Print some info + let facts = compilerDependencies cwrite + cacheHits + | compilerCacheHits cwrite <= 0 = "updated" + | otherwise = "cached " + Logger.message logger $ cacheHits ++ " " ++ show id' + + -- Sanity check + unless (itemIdentifier item == id') $ throwError $ + "The compiler yielded an Item with Identifier " ++ + show (itemIdentifier item) ++ ", but we were expecting " ++ + "an Item with Identifier " ++ show id' ++ " " ++ + "(you probably want to call makeItem to solve this problem)" + + -- Write if necessary + (mroute, _) <- liftIO $ runRoutes routes provider id' + case mroute of + Nothing -> return () + Just route -> do + let path = destinationDirectory config route + liftIO $ makeDirectories path + liftIO $ write path item + Logger.debug logger $ "Routed to " ++ path + + -- Save! (For load) + 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) + } + + -- Try something else first + CompilerRequire dep c -> do + let (depId, depSnapshot) = dep + Logger.debug logger $ + "Compiler requirement found for: " ++ show id' ++ + ", requirement: " ++ show depId + + 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 + + let deps' = if depDone + then deps + else M.insertWith S.union id' (S.singleton depId) deps + + modifyRuntimeState $ \s -> s + { runtimeTodo = M.insert id' + (if depDone then c else compilerResult result) + (runtimeTodo s) + , runtimeDependencies = deps' } - result <- liftIO $ runCompiler compiler read' - case result of - -- Rethrow error - CompilerError e -> throwError $ case compilerErrorMessages e of - [] -> "Compiler failed but no info given, try running with -v?" - es -> intercalate "; " es - - -- Signal that a snapshot was saved -> - CompilerSnapshot snapshot c -> do - -- Update info. The next 'chase' will pick us again at some - -- point so we can continue then. - modify $ \s -> s - { runtimeSnapshots = - S.insert (id', snapshot) (runtimeSnapshots s) - , runtimeTodo = M.insert id' c (runtimeTodo s) - } - - -- Huge success - CompilerDone (SomeItem item) cwrite -> do - -- Print some info - let facts = compilerDependencies cwrite - cacheHits - | compilerCacheHits cwrite <= 0 = "updated" - | otherwise = "cached " - Logger.message logger $ cacheHits ++ " " ++ show id' - - -- Sanity check - unless (itemIdentifier item == id') $ throwError $ - "The compiler yielded an Item with Identifier " ++ - show (itemIdentifier item) ++ ", but we were expecting " ++ - "an Item with Identifier " ++ show id' ++ " " ++ - "(you probably want to call makeItem to solve this problem)" - - -- Write if necessary - (mroute, _) <- liftIO $ runRoutes routes provider id' - case mroute of - Nothing -> return () - Just route -> do - let path = destinationDirectory config route - liftIO $ makeDirectories path - liftIO $ write path item - Logger.debug logger $ "Routed to " ++ path - - -- Save! (For load) - liftIO $ save store item - - -- Update state - modify $ \s -> s - { runtimeDone = S.insert id' (runtimeDone s) - , runtimeTodo = M.delete id' (runtimeTodo s) - , runtimeFacts = M.insert id' facts (runtimeFacts s) - } - - -- Try something else first - CompilerRequire dep c -> do - -- Update the compiler so we don't execute it twice - let (depId, depSnapshot) = dep - done <- runtimeDone <$> get - snapshots <- runtimeSnapshots <$> get - - -- 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 - - modify $ \s -> s - { runtimeTodo = M.insert id' - (if depDone then c else compilerResult result) - (runtimeTodo s) - } - - -- If the required item is already compiled, continue, or, start - -- chasing that - Logger.debug logger $ "Require " ++ show depId ++ - " (snapshot " ++ depSnapshot ++ "): " ++ - (if depDone then "OK" else "chasing") - if depDone then chase trail id' else chase (id' : trail) depId + Logger.debug logger $ "Require " ++ show depId ++ + " (snapshot " ++ depSnapshot ++ ") " + \ No newline at end of file diff --git a/src/Init.hs b/src/Init.hs index 63899e4..c79a76e 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -120,7 +120,7 @@ createCabal path name = , " main-is: site.hs" , " build-depends: base == 4.*" , " , hakyll == " ++ version' ++ ".*" - , " ghc-options: -threaded" + , " ghc-options: -threaded -rtsopts -with-rtsopts=-N" , " default-language: Haskell2010" ] where diff --git a/tests/Hakyll/Core/Runtime/Tests.hs b/tests/Hakyll/Core/Runtime/Tests.hs index 9c23162..615aaf2 100644 --- a/tests/Hakyll/Core/Runtime/Tests.hs +++ b/tests/Hakyll/Core/Runtime/Tests.hs @@ -8,6 +8,7 @@ module Hakyll.Core.Runtime.Tests -------------------------------------------------------------------------------- import qualified Data.ByteString as B import System.FilePath (()) +import System.Exit (ExitCode (..)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, (@?=)) @@ -22,7 +23,7 @@ import TestSuite.Util -------------------------------------------------------------------------------- tests :: TestTree tests = testGroup "Hakyll.Core.Runtime.Tests" $ - fromAssertions "run" [case01, case02] + fromAssertions "run" [case01, case02, case03] -------------------------------------------------------------------------------- @@ -94,3 +95,30 @@ case02 = do favicon @?= "Test" cleanTestEnv + + +-------------------------------------------------------------------------------- +-- Test that dependency cycles are correctly identified +case03 :: Assertion +case03 = do + logger <- Logger.new Logger.Error + (ec, _) <- run testConfiguration logger $ do + + create ["partial.html.out1"] $ do + route idRoute + compile $ do + example <- loadSnapshotBody "partial.html.out2" "raw" + makeItem example + >>= loadAndApplyTemplate "partial.html" defaultContext + + create ["partial.html.out2"] $ do + route idRoute + compile $ do + example <- loadSnapshotBody "partial.html.out1" "raw" + makeItem example + >>= loadAndApplyTemplate "partial.html" defaultContext + + + ec @?= ExitFailure 1 + + cleanTestEnv -- cgit v1.2.3 From 6d9bc845d5233c67e5eba3f54dcc7772ca1d79e2 Mon Sep 17 00:00:00 2001 From: Logan McGrath <81108848+ThisFieldWasGreen@users.noreply.github.com> Date: Sun, 6 Jun 2021 10:50:44 -0700 Subject: Allow demotion of headers by a given amount (#855) --- lib/Hakyll/Web/Html.hs | 12 ++++++++++-- tests/Hakyll/Web/Html/Tests.hs | 13 ++++++++++++- 2 files changed, 22 insertions(+), 3 deletions(-) (limited to 'lib') diff --git a/lib/Hakyll/Web/Html.hs b/lib/Hakyll/Web/Html.hs index 8cbfaa3..7aa3804 100644 --- a/lib/Hakyll/Web/Html.hs +++ b/lib/Hakyll/Web/Html.hs @@ -7,6 +7,7 @@ module Hakyll.Web.Html -- * Headers , demoteHeaders + , demoteHeadersBy -- * Url manipulation , getUrls @@ -50,13 +51,20 @@ withTagList f = renderTags' . f . parseTags' -------------------------------------------------------------------------------- -- | Map every @h1@ to an @h2@, @h2@ to @h3@, etc. demoteHeaders :: String -> String -demoteHeaders = withTags $ \tag -> case tag of +demoteHeaders = demoteHeadersBy 1 + +-------------------------------------------------------------------------------- +-- | Maps any @hN@ to an @hN+amount@ for any @amount > 0 && 1 <= N+amount <= 6@. +demoteHeadersBy :: Int -> String -> String +demoteHeadersBy amount + | amount < 1 = id + | otherwise = withTags $ \tag -> case tag of TS.TagOpen t a -> TS.TagOpen (demote t) a TS.TagClose t -> TS.TagClose (demote t) t -> t where demote t@['h', n] - | isDigit n = ['h', intToDigit (min 6 $ digitToInt n + 1)] + | isDigit n = ['h', intToDigit (min 6 $ digitToInt n + amount)] | otherwise = t demote t = t diff --git a/tests/Hakyll/Web/Html/Tests.hs b/tests/Hakyll/Web/Html/Tests.hs index cd362f4..9ab10bc 100644 --- a/tests/Hakyll/Web/Html/Tests.hs +++ b/tests/Hakyll/Web/Html/Tests.hs @@ -20,7 +20,18 @@ tests :: TestTree tests = testGroup "Hakyll.Web.Html.Tests" $ concat [ fromAssertions "demoteHeaders" [ "

A h1 title

" @=? - demoteHeaders "

A h1 title

" + demoteHeaders "

A h1 title

" -- Assert single-step demotion + , "
A h6 title
" @=? + demoteHeaders "
A h6 title
" -- Assert maximum demotion is h6 + ] + + , fromAssertions "demoteHeadersBy" + [ "

A h1 title

" @=? + demoteHeadersBy 2 "

A h1 title

" + , "
A h5 title
" @=? + demoteHeadersBy 2 "
A h5 title
" -- Assert that h6 is the lowest possible demoted header. + , "

A h4 title

" @=? + demoteHeadersBy 0 "

A h4 title

" -- Assert that a demotion of @N < 1@ is a no-op. ] , fromAssertions "withUrls" -- cgit v1.2.3 From 6885325146aa46adf255c55de0e0345a0f84961e Mon Sep 17 00:00:00 2001 From: Fraser Tweedale Date: Wed, 23 Jun 2021 03:26:20 +1000 Subject: add 'forceCompile' rules modifier (#857) Compilers that use data from sources other than local files may need to be recompiled, but Hakyll's file-based dependency checking does not handle this situation. Add a new kind of dependency called 'AlwaysOutOfDate'. If an item has this dependency, it will be unconditionally rebuilt. Also add the 'forceCompile' rule modifier, which is a user-friendly way to force recompilation of specific items. Example usage: forceCompile $ create ["foo"] $ do route $ idRoute compile $ unsafeCompiler $ doSomeIO --- lib/Hakyll/Core/Dependencies.hs | 51 +++++++++++++++++++++++++++++++---------- lib/Hakyll/Core/Rules.hs | 9 ++++++++ 2 files changed, 48 insertions(+), 12 deletions(-) (limited to 'lib') diff --git a/lib/Hakyll/Core/Dependencies.hs b/lib/Hakyll/Core/Dependencies.hs index 4a51b9c..f9b8048 100644 --- a/lib/Hakyll/Core/Dependencies.hs +++ b/lib/Hakyll/Core/Dependencies.hs @@ -33,6 +33,7 @@ import Hakyll.Core.Identifier.Pattern data Dependency = PatternDependency Pattern (Set Identifier) | IdentifierDependency Identifier + | AlwaysOutOfDate deriving (Show, Typeable) @@ -40,9 +41,11 @@ data Dependency instance Binary Dependency where put (PatternDependency p is) = putWord8 0 >> put p >> put is put (IdentifierDependency i) = putWord8 1 >> put i + put AlwaysOutOfDate = putWord8 2 get = getWord8 >>= \t -> case t of 0 -> PatternDependency <$> get <*> get 1 -> IdentifierDependency <$> get + 2 -> pure AlwaysOutOfDate _ -> error "Data.Binary.get: Invalid Dependency" @@ -84,13 +87,30 @@ markOod id' = State.modify $ \s -> -------------------------------------------------------------------------------- -dependenciesFor :: Identifier -> DependencyM [Identifier] +-- | Collection of dependencies that should be checked to determine +-- if an identifier needs rebuilding. +data Dependencies + = DependsOn [Identifier] + | MustRebuild + deriving (Show) + +instance Semigroup Dependencies where + DependsOn ids <> DependsOn moreIds = DependsOn (ids <> moreIds) + MustRebuild <> _ = MustRebuild + _ <> MustRebuild = MustRebuild + +instance Monoid Dependencies where + mempty = DependsOn [] + +-------------------------------------------------------------------------------- +dependenciesFor :: Identifier -> DependencyM Dependencies dependenciesFor id' = do facts <- dependencyFacts <$> State.get - return $ concatMap dependenciesFor' $ fromMaybe [] $ M.lookup id' facts + return $ foldMap dependenciesFor' $ fromMaybe [] $ M.lookup id' facts where - dependenciesFor' (IdentifierDependency i) = [i] - dependenciesFor' (PatternDependency _ is) = S.toList is + dependenciesFor' (IdentifierDependency i) = DependsOn [i] + dependenciesFor' (PatternDependency _ is) = DependsOn $ S.toList is + dependenciesFor' AlwaysOutOfDate = MustRebuild -------------------------------------------------------------------------------- @@ -113,6 +133,7 @@ checkChangedPatterns = do {dependencyFacts = M.insert id' deps' $ dependencyFacts s} where go _ ds (IdentifierDependency i) = return $ IdentifierDependency i : ds + go _ ds AlwaysOutOfDate = return $ AlwaysOutOfDate : ds go id' ds (PatternDependency p ls) = do universe <- ask let ls' = S.fromList $ filterMatches p universe @@ -136,11 +157,17 @@ bruteForce = do check (todo, changed) id' = do deps <- dependenciesFor id' - ood <- dependencyOod <$> State.get - case find (`S.member` ood) deps of - Nothing -> return (id' : todo, changed) - Just d -> do - tell [show id' ++ " is out-of-date because " ++ - show d ++ " is out-of-date"] - markOod id' - return (todo, True) + case deps of + DependsOn depList -> do + ood <- dependencyOod <$> State.get + case find (`S.member` ood) depList of + Nothing -> return (id' : todo, changed) + Just d -> do + tell [show id' ++ " is out-of-date because " ++ + show d ++ " is out-of-date"] + markOod id' + return (todo, True) + MustRebuild -> do + tell [show id' ++ " will be forcibly rebuilt"] + markOod id' + return (todo, True) diff --git a/lib/Hakyll/Core/Rules.hs b/lib/Hakyll/Core/Rules.hs index 41b9a73..695665a 100644 --- a/lib/Hakyll/Core/Rules.hs +++ b/lib/Hakyll/Core/Rules.hs @@ -29,6 +29,7 @@ module Hakyll.Core.Rules , preprocess , Dependency (..) , rulesExtraDependencies + , forceCompile ) where @@ -221,3 +222,11 @@ rulesExtraDependencies deps rules = | (i, c) <- rulesCompilers ruleSet ] } + + +-------------------------------------------------------------------------------- +-- | Force the item(s) to always be recompiled, whether or not the +-- dependencies are out of date. This can be useful if you are using +-- I/O to generate part (or all) of an item. +forceCompile :: Rules a -> Rules a +forceCompile = rulesExtraDependencies [AlwaysOutOfDate] -- cgit v1.2.3 From d739fd1eea40de9ded3b4f682c849d3c31eba92c Mon Sep 17 00:00:00 2001 From: Jim McStanton Date: Fri, 16 Jul 2021 14:13:43 -0500 Subject: Supporting different field names for tags. (#862) * Supporting different field names for tags. * Removed buildTagsByField Removed to avoid exponential growth of helper functions. Renamed field parameter in getTagsByField to fieldName to avoid shadowing. * Drop obsolete export Co-authored-by: Alexander Batischev --- lib/Hakyll/Web/Tags.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) (limited to 'lib') diff --git a/lib/Hakyll/Web/Tags.hs b/lib/Hakyll/Web/Tags.hs index aab5d34..ccf34a5 100644 --- a/lib/Hakyll/Web/Tags.hs +++ b/lib/Hakyll/Web/Tags.hs @@ -43,6 +43,7 @@ module Hakyll.Web.Tags ( Tags (..) , getTags + , getTagsByField , getCategory , buildTagsWith , buildTags @@ -105,11 +106,16 @@ data Tags = Tags -- | Obtain tags from a page in the default way: parse them from the @tags@ -- metadata field. This can either be a list or a comma-separated string. getTags :: MonadMetadata m => Identifier -> m [String] -getTags identifier = do +getTags = getTagsByField "tags" + +-- | Obtain tags from a page by name of the metadata field. These can be a list +-- or a comma-separated string +getTagsByField :: MonadMetadata m => String -> Identifier -> m [String] +getTagsByField fieldName identifier = do metadata <- getMetadata identifier return $ fromMaybe [] $ - (lookupStringList "tags" metadata) `mplus` - (map trim . splitAll "," <$> lookupString "tags" metadata) + (lookupStringList fieldName metadata) `mplus` + (map trim . splitAll "," <$> lookupString fieldName metadata) -------------------------------------------------------------------------------- -- cgit v1.2.3