packages feed

hakyll 3.5.3.0 → 4.17.0.0

raw patch · 190 files changed

Files

+ CHANGELOG.md view
@@ -0,0 +1,873 @@+---+title: Releases+---++# Releases++## 4.17.0.0++This release is nearly identical to 4.16.8.0. However, 4.16.8.0 contains a breaking change+which was not caught. Therefore, release 4.16.8.0 is deprecated on Hackage, and 4.17.0.0 should+be preferred++- Added support for QuickCheck 2.17 and 2.18 (#1099).++## 4.16.8.0++- Added support for djot for pandoc 3.1.12+ (#1096)+- Added support for pandoc 3.9 (#1095)+- Added support for declaring metadata-only dependencies (#1084).+- Added support for AsciiDoc for pandoc 3.8.3+ (#1089).+- Added support for tasty-1.5.4+ by disabling threaded tests.++## Hakyll 4.16.7.1 (2025-09-06)++- Added support for pandoc 3.8 (#1080).++## Hakyll 4.16.7.0 (2025-08-29)++- Validate the output of XML-based feed functions such as `renderRss` by default (#1078).+- Bump `containers` upper bound to include 0.8.+- Add support for Typst (#1067).++## Hakyll 4.16.6.0 (2025-02-18)++- Do not crawl directories for which we do not have permissions+  with `Hakyll.Core.Util.File.getRecursiveContents`. This used to+  throw an exception.+- Do not return broken symbolic links from+  `Hakyll.Core.Util.File.getRecursiveContents`.  This used to cause+  subsequent code to throw exceptions (e.g., when it attempts to+  `getModificationTime`) (#1065) (Contribution by Wren Romano).+- Ignore files in `dist-newstyle` and `.stack-work` directories, which+  are Haskell build directories.++## Hakyll 4.16.5.0 (2025-01-11)++- GHC 9.12 compatibility: bump `template-haskell` upper bound to include 2.23+- Add support for `nocite` metadata field to `processPandocBiblio` and+    `processPandocBiblios` (#1058) (contribution by Tony Zorman)++## Hakyll 4.16.4.0 (2024-12-08)++- Fixed an issue where compressing CSS with `clamp` expressions would+    result in invalid CSS (#1021) (contribution by Laurent P. René de Cotret)+- Added `boolFieldM` (#1044) (contribution by 0xd34df00d)+- Run HLint as part of GitHub Actions (#1045) (contribution by Yoo Chung)+- Running the `check` command will now consider URLs that respond with a 3XX code+    (redirection) to be alive.+- Bump `data-default` upper bound to include 0.8+- Bump `pandoc` upper bound to include 3.6++## Hakyll 4.16.3.0 (2024-10-24)++- Bump `pandoc` upper bound to include up to version 3.5+    (#1041, #1042, #1047) (contributions by Alexander Batischev)+- Add `renderPandocItemWithTransformM` and `pandocItemCompilerWithTransformM`+    (#1020) (contribution by Tony Zorman)++## Hakyll 4.16.2.2 (2024-07-05)++- Bump `tasty-quickcheck` upper bound to 0.12 (contribution by Alexander+    Batischev)+- GHC 9.10 compatibility: bump `template-haskell` upper bound to 0.23, fix+    `foldl'` imports (as the function is now part of `Prelude`) (contribution by+    David Binder and Alexander Batischev)++## Hakyll 4.16.2.1 (2024-06-02)++- Fix "thread blocked indefinitely in an MVar operation" errors caused by+    exceptions produced by `Items` (#1014) (contribution by Jasper Van der Jeugt)+- Improve `+watchServer` and `+previewServer` error messages: they now explain+    *how* to enable the flag when the user tries to run `watch`/`preview`+    without them (#1022) (contribution by Jasper Van der Jeugt)+- Assorted fixes and improvements to documentation (contributions by Alexander+    Batischev, Adrien, Tanya Bouman)+- Bump `bytestring` upper bound to 0.13 (contribution by Alexander Batischev)+- Bump `deepseq` upper bound to 1.6 (contribution by Laurent P. René de Cotret)+- Bump `template-haskell` upper bound to 2.22 (contribution by Laurent P. René+    de Cotret)+- Bump `text` upper bound to 2.2 (contribution by Laurent P. René de Cotret)+- Bump `file-embed` upper bound to 0.0.17 (contribution by Alexander Batischev)+- Bump `warp` upper bound to 3.5 (contribution by Alexander Batischev)+- Bump `filepath` upper bound to 1.6 (contribution by Alexander Batischev)+- Bump `containers` upper bound to 0.8 (contribution by Andreas Abel)+- Bump `time` upper bound to 1.15 (contribution by Andreas Abel)+- Bump `QuickCheck` upper bound to 2.16 (contribution by Andreas Abel)+- Bump `pandoc` upper bound to 3.3 (contribution by Alexander Batischev)++## Hakyll 4.16.2.0 (2023-09-20)++- Add errors for multiple `match`es that are routed to the same file+    (contribution by Jasper van der Jeugt)+- Fix Hakyll.Web.Pandoc.Biblio tests failing with Pandoc 3.1.8 (contribution by+    Alexander Batischev)+- Bump `tasty` upper bound to 1.6 (contribution by Alexander Batischev)++## Hakyll 4.16.1.0 (2023-08-23)++- Rewrite async scheduler; improves scaling and resource usage+- Add JSON Feed support (contribution by Berk Özkütük)+- Bump `aeson` upper bound to aeson 2.3 (contribution by Alexander Batischev)+- Bump `optparse-applicative` upper bound to aeson 0.19 (contribution by+    Alexander Batischev)++## Hakyll 4.16.0.0 (2023-04-27)++- Bump `base` *lower* bound to 4.12 (GHC >= 8.6). Hakyll already failed to build+    on earlier versions due to the template-haskell requirement, and nobody+    complained about that, so I assume nobody cares if the support is properly+    dropped (contribution by Alexander Batischev)+- Export `Hakyll.Tags.simpleRenderLink` (contribution by Alexander Batischev)+- Add `Hakyll.Web.Pandoc.Biblio.pandocBibliosCompiler` to load multiple bib+    files by glob (contribution by Liang-Ting Chen)+- Fix "Store.set: resource busy" error (contribution by Jasper Van der Jeugt)+- Teach `Hakyll.Web.Template.Context.getItemUTC` about another date format,+    "%d.%m.%Y" (contribution by dukzcry)+- Add `Hakyll.Web.Html.withTagListM`, a monadic version of `withTagList`+    (contribution by 0xd34df00d)+- Fix all the warnings and enable `-Werror` in CI (contribution by Alexander+    Batischev)+- Miscellaneous updates and fixes to the docs (contributions by Tony Zorman,+    Alexander Batischev, malteneuss, Agustín Mista, Martin Bukatovič, Muhammad+    Aviv Burhanudin, Jacek Galowicz, Daniel Mlot, Yoo Chung, Robert Pearce)+- Export `Hakyll.defaultCommands`, i.e. Hakyll's set of commands (`build`,+    `check`, `clean` etc.) (contribution by Alexander Batischev)+- Add a `Hakyll.Core.Configuration.Configuration.previewSettings` field which+    lets the user override the settings used by the preview server (contribution+    by Christopher League and Brian McKenna)+- Make email address in RSS/Atom feeds optional (just set it to an empty string)+    (contribution by Robert)+- `Hakyll.Web.Meta.TwitterCard`: use `name` instead of `property` for better+    spec compliance (contribution by ncaq)+- Add a `Hakyll.Core.Configuration.Configuration.checkHtmlFile` predicate which+    dictates what files will get link-checked by the `check` command. Default+    predicate accepts files with .html and .xhtml extensions (contribution by+    Yoo Chung, with earlier contribution from Michael Orlitzky)+- Add support for GHC 9.2 (contribution by Laurent P. René de Cotret)+- Bump `optparse-applicative` upper bound to allow 0.17 (contribution by+    Alexander Batischev)+- Bump `pandoc` upper bound to allow 2.19 (contribution by Alexander Batischev)+- Allow `text` 2.0 (contribution by Alexander Batischev)+- Bump `vector` upper bound to allow 0.13 (contribution by Alexander Batischev)+- Allow `aeson` 2.1 (contribution by Alexander Batischev)+- Bump `fsnotify` upper bound to allow 0.4 (contribution by Alexander Batischev)+- Bump `resourcet` upper bound to allow 1.3 (contribution by Alexander+    Batischev)+- Bump `template-haskell` upper bound to 2.20 (GHC 9.4.3) (contribution by+    Alexander Batischev)+- Allow `pandoc` 3.0. Note that the behavior of Hakyll's `readPandocBiblios` and+    `readPandocBiblio` is different whether pandoc 2 or 3 is installed+    (contribution by Laurent P. René de Cotret)+- Bump `mtl` upper bound to allow 2.3 (contribution by Alexander Batischev)+- Bump `pandoc` upper bound to allow 3.1 (contribution by Laurent P. René de+    Cotret)+- Bump `template-haskell` upper bound to 2.21 and `time` to 1.12 (GHC 9.6.1)+    (contribution by Laurent P. René de Cotret)++## Hakyll 4.15.1.1 (2022-01-20)++- Extend the documentation for `Hakyll.Core.Identifier` (contribution by+    malteneuss)+- Fix yet another regression caused by new dependency checking code+    (contribution by Laurent P. René de Cotret)+- Bump `pandoc` upper bound to allow 2.17 (contribution by Alexander Batischev)+- Website now points to Hackage rather than its own (often outdated) version of+    the docs (contribution by Jasper Van der Jeugt)++## Hakyll 4.15.1.0 (2021-10-25)++- Add `Hakyll.Web.Pandoc.Biblio` functions `readPandocBiblios` and+    `processPandocBiblios`, which let one use multiple bibliographies+    (contribution by Benjamin Eskola)+- Preserve file extension of bibliography files when passing them to Pandoc.+    This enables one to use not just BibTex, but also YAML and JSON files+    (contribution by Benjamin Eskola)+- Fix URL extraction for `srcset` attribute. This affects+    `Hakyll.Web.HTML.relativizeUrls` and other such functions (contribution by+    Alexander Batischev)+- Bump `bytestring` upper bound to allow 0.11 (contribution by Alexander+    Batischev)+- Bump `pandoc` upper bound to allow 2.15 (contribution by Alexander Batischev)+- Bump `aeson` bounds to allow 2.0 (contribution by Alexander Batischev)++## Hakyll 4.15.0.1 (2021-10-02)++- Add missing test file to the package (contribution by Alexander Batischev)++## 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+    a given amount (contribution by Logan McGrath)+- Add `Hakyll.Core.Rules.forceCompile` modifier which forces re-compilation of+    an item even if its file wasn't modified. This is useful for data sources+    which aren't local files (contribution by Fraser Tweedale)+- Add `Hakyll.Web.Tags.getTagsByField` which extracts tags from a given field+    instead of the default "tags" field (contribution by Jim McStanton and+    Alexander Batischev)+- Add `Hakyll.Core.Configuration.shouldWatchIgnore` function and the+    corresponding `watchIgnore` field for `Configuration`. These are used to+    ignore files in watch mode, which is useful when certain files are+    pre-processed and the results are saved into the provider directory+    (contribution by Aron Erben)+- Add `Hakyll.Web.Meta` modules `JSONLD`, `OpenGraph`, and `TwitterCard`. These+    help with semantic web metadata in pages. This adds dependency on `aeson`+    (contribution by Fraser Tweedale)+- Export `Hakyll.Web.Pandoc.Biblio.unCSL` function (contribution by Benjamin+    Bray)+- Make the runtime concurrent, which brings 30% speedups on real-world sites.+    This adds dependencies on `array` and `lifted-async`. Please note that it+    doesn't scale past the number of physical cores; ideas are welcome in+    https://github.com/jaspervdj/hakyll/issues/850 (contribution by+    Laurent P. René de Cotret and Vaibhav Sagar)+- Fix binary's name in the first tutorial (contribution by Alexander Batischev)+- Fix "Empty 'do' block" error in GitHub tutorial (contribution by+    alexandroid000)+- Move #hakyll IRC channel from Freenode to Libera.Chat (by Alexander Batischev+    and henk)+- Replace dependency on `cryptonite` and `memory` with dependency on `hashable`+    (contribution by Laurent P. René de Cotret)+- Bump `file-embed` upper bound to 0.0.15 (contribution by Alexander Batischev)+- Bump `optparse-applicative` upper bound to 0.16 (contribution by Felix Yan)+- Bump `pandoc` upper bound to 2.14 (contribution by Laurent P. René de Cotret)+- Bump `tasty` upper bound to 1.4 (contribution by Felix Yan)+- Bump `template-haskell` upper bound to 2.17, which is shipped with GHC 9+    (contribution by Alexander Batischev)+- Bump `time` upper bound to 1.11 (contribution by Alexander Batischev)++## 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.*+- Bump upper bound for `template-haskell` to 2.17+- Bump `QuickCheck` upper bound to 2.15++## Hakyll 4.13.4.0 (2020-06-20)++- Miscellaneous Windows-specific fixes and CI (by Laurent P. René de Cotret)+- Bump upper bound for `cryptonite` to 0.28+- Bump upper bound for `tasty` to 1.4++## Hakyll 4.13.3.0 (2020-04-12)++- Fix compilation issue related to `MonadFail` on Windows (by Martín Emanuel)+- Bump upper bound for `warp` to 3.4+- Bump upper bound for `pandoc-citeproc` to 0.18++## Hakyll 4.13.2.0 (2020-03-07)++- Fix compatibility with GHC-8.6 (by Nikolay Yakimov).++## Hakyll 4.13.1.0 (2020-02-26)++- Fix timezone parsing bug with time-1.9+- Remove constant field for homepage title in example site (by Liang-Ting Chen)+- Clean up `stack.yaml` (by Hexirp)+- Use crytonite instead of cryptohash (by Hexirp)+- Expose CLI argument parser internals (by Jim McStanton)+- Support GHC-8.8. Add `MonadFail` instances and constraints (by Veronika+  Romashkina)+- Fix file path compatibility with Windows (by Hexirp)+- Fix logging output flushing in `site server` (by robx)+- Fix spacing of command line usage in `hakyll-init` (by robx)+- Add titles to tag fields by default++## Hakyll 4.13.0.1 (2019-09-18)++- Add missing test files (contribution by Justin Humm)++## Hakyll 4.13.0.0 (2019-08-30)++- Improved documentation in many places (contribution by Bergi)+- Significantly improve error messages when reading and applying templates+  (contribution by Bergi)+    * `empty` and `fail` for `Compiler` now fail without or with a message,+      allowing for much better debug output+    * `renderFeed`, `renderRssWithTemplates` and `renderAtomWithTemplates` now+      take `Template` rather than `String` arguments+- Add option to specify date in directory structure,e.g.+  `posts/2019/05/10/tomorrow.md` (contribution by Taeer Bar-Ya)+- Bump QuickCheck to 2.13++## Hakyll 4.12.5.2 (2019-05-09)++- Bump pandoc to 2.7+- Add `srcset` to the list of URL attributes (contribution by c50a326)+- Expose `getCategory` in `Hakyll.Web.Tags` (contribution by Ng Wei En)+- Fix issue where `published` overwrites the user's context (contribution by+  ncaq)++## Hakyll 4.12.5.1 (2019-02-03)++- Bump pandoc to 2.6+- Bump pandoc-citeproc to 0.16++## Hakyll 4.12.5.0 (2019-01-12)++- Update dependencies (contribution by Hexirp):+    * Bump containers to 0.6+    * Bump yaml to 0.11+    * Bump pandoc to 2.5+    * Bump pandoc-citeproc to 0.15+    * Bump tasty to 1.2+- Correct assertion in unixFilterError test+  (contribution by Jim McStanton)+- Add renderRssWithTemplates, renderAtomWithTemplates+  (contribution by Abhinav Sarkar)+- Speed up hashing in cache (contribution by 0xd34df00d)+- Update type of fromFilePath to use FilePath instead of String+  (contribution by Jim McStanton)+- Drop extension when parsing dates in filepaths (contribution by+  Gabriel Aumala)++## Hakyll 4.12.4.0 (2018-08-13)++- Bump yaml to 0.10+- Bump file-embed to 0.0.11+- Bump QuickCheck to 2.12+- Use makeRelativeToProject with embedFile for stack ghci (contribution by+  Michael Sloan)++## Hakyll 4.12.3.0 (2018-05-29)++- Bump tasty to 1.1+- Bump fsnotify to 0.3++## Hakyll 4.12.2.0++- Bump pandoc to 2.2+- Fix path resolution in Pandoc.Biblio (contribution by knih)++## Hakyll 4.12.1.0++- Fix hakyll-init on older GHC versions+- Make the Pandoc dependency optional++## Hakyll 4.12.0.1++- Bump resourcet to 1.2 in test section++## Hakyll 4.12.0.0++- Add Semigroup instances for existing Monoids (contribution by+  Christian Barcenas)+- Fix issue with CPP and comment containing `/*`+- Add `withTagList` (contribution by Oleg Grenrus)+- Improve CSS compression (contribution by Bergi)+- Bump pandoc-citeproc to 0.14+- Bump resourcet to 1.2+- Bump time to 1.9+- Bump http-types to 0.12+- Bump http-conduit to 2.3+- Bump tasty-quickcheck to 0.10++## Hakyll 4.11.0.0++- Bump binary to 0.9+- Bump pandoc to 2.1+- Bump pandoc-citeproc to 0.13+- Bump http-types to 0.11+- Bump QuickCheck to 2.11+- Bump tasty to 1.0+- Bump tasty-hunit to 0.10+- Remove system-filepath dependency+- Embed feed templates rather than using data-files (contribution by Roman+  Kuznetsov)+- Fix pthread link error on GHC-8.2.2 (contribution by Shinya Yamaguchi)+- Extend capture with Regex handling (contribution by frederik-h)++## Hakyll 4.10.0.0++- Bump Pandoc to 2.0 (contribution by Vaibhav Sagar)+- Fix compression of calc() in CSS (contribution by Krzysztof Jurewicz)+- Make unixFilter output stderr when failing (contribution by Nick Boultbee)+- Export Check type from `Hakyll.Commands` (contribution by Futtetennista)+- Add overwritten files check to `hakyll-init` (contribution by Ilya Murzinov)+- Expose & document `hakyllWithExitCodeAndArgs`, `Options`, and `Command`+  (contribution by Michael Walker)+- Add check for non-overlapping redirects (contribution by gwern)+- Fix early exit when calling check as a library++## Hakyll 4.9.8.0++- Bump pandoc-citeproc to 0.10.5+- Bump optparse-applicative to 0.14+- Bump QuickCheck to 2.10+- Bump tasty-quickcheck to 0.9+- Restructure .cabal to avoid redundant compilation (contribution by+  Christopher League)++## Hakyll 4.9.7.0++- Fix compilation trouble with `Options.Applicative`+- Some small CSS compression improvements (contribution by Nicole Rauch)++## Hakyll 4.9.6.0++- Tighten dependency on `pandoc-citeproc` (contribution by Mikhail Glushenkov)+- Enable using a custom parser for command line arguments (contribution by+  Alberto)+- Update examples to semantic HTML (contribution by Elie Génard)+- Better error for `cached` on non-existing file+- Provide an `$allPages$` key when doing pagination+- Preserve file metadata in `copyFileCompiler` (contribution by frederik-h)++## Hakyll 4.9.5.1++- Bump blaze-html dependency to 0.9+- Bump blaze-markup dependency to 0.8+- Bump process dependency to 1.5++## Hakyll 4.9.5.0++- Fix compilation issue with `Hakyll.Check` if `checkExternal` is disabled+  (Fix by Magnus Therning)++## Hakyll 4.9.4.0++- Make `./site check` concurrent+- Bump directory dependency to 1.3+- Bump time dependency to 1.7+- Bump vector dependency to 0.12++## Hakyll 4.9.3.0++- Add a `Hakyll.Web.Redirect` module (contribution by gwern)+- Expose `Hakyll.Commands`+- Fix the exit code behaviour of `./site check`++## Hakyll 4.9.2.0++- Fix integer fields in YAML metadata (Fix by Nikolaos S. Papaspyrou)+- Bump pandoc dependency to 1.19++## Hakyll 4.9.1.0++- Allow optparse-applicative 0.13, QuickCheck 2.9, and pandoc 1.18+  (contributions by Chris Wong and Felix Yan)+- Fix extra test files for packaging source files (contribution by Julien+  Langlois)++## Hakyll 4.9.0.0++This release switches over some dependencies to alternatives, in order to clean+up some stuff and build on a wider variety of setups (stack/cabal).++- Move from `test-framework` to `tasty`+- Fix feed generator when item contains CDATA (contribution by Yann Esposito)+- Fix CompressCSS to not modify string constants (contribution by Nicole Rauch)+- Fix YAML dependency issue (contribution by Jens Peterson)+- Move from `cmdargs` to `optparse-applicative` (contribution by sk3r)+- Allow for trimming whitespace in templates (contribution by Sam Davis)+- Improve error messages for template parsing (contribution by Lorenzo+  Tabacchini)+- Improvements to the installation instructions (contribution by Thomas Koch)+- Move from `snap` to `warp` for preview server (contribution by Arguggi)+- Fix error in CompressCSS (contribution by Luca Molteni)+- Move example from XHTML to HTML5 (contribution by Peter Doherty)+- Make errors in check less verbose (contribution by Jan Tojnar)+- Work on building with GHC 8.0.1 (contribution by Rohan Jain)++## Hakyll 4.8.3.2++This release is compatible with GHC 8.0.1, although `previewServer` might not+work yet on some setups.++- Allow data-default 0.7, pandoc-citeproc 0.10, and tagsoup 0.14 (contributions+  by Paul van der Walt and Felix Yan)+- Allow binary 0.8, process 1.4, time 1.6 (contribution by Sergei Trofimovich)+- Fix issue with `.metadata` file reading++## Hakyll 4.8.3.1++- Bump scientific dependency to 0.3.4++## Hakyll 4.8.3.0++- Fix another compilation issue wrt. orphan `Show` instance from regex-tdfa+  (contribution by Sergei Trofimovich)++## Hakyll 4.8.2.0++- Fix compilation issue wrt. orphan `Show` instance from regex-tdfa++## Hakyll 4.8.1.0++- Fix compilation on windows++## Hakyll 4.8.0.1++- Fix issue with test suite++## Hakyll 4.8.0.0++- Support full YAML in page metadata+- Bump data-default dependency to 0.6+- Add snippet field for literal includes in templates (contribution by Nicolas+  Mattia)++## Hakyll 4.7.5.2++- Bump pandoc dependency to 1.17 (contribution by Felix Yan)+- Fix `unixFilter` documentation (contribution by Richard Cook)+- Bump example posts (contribution by Andrew Barchuk)+- Add a template compiler that only uses the template body (contribution by+  Bergi)++## Hakyll 4.7.5.1++- Bump pandoc and pandoc-citeproc dependencies to 1.16 and 0.9 respectively++## Hakyll 4.7.5.0++- Expose templating engine+- Fix bug in feed context precedence (contribution by Yuriy Syrovetskiy)+- Bump http-types dependency to 0.9++## Hakyll 4.7.4.0++- Expose `getItemModificationTime`++## Hakyll 4.7.3.1++- Bump pandoc-citeproc dependency to 0.8++## Hakyll 4.7.3.0++- Bump HUnit dependency to 1.3+- Add `poster` as an URL attribute (contribution by vtduncan)+- Prevent `hakyll-init` from generating directories with leading hyphen+  (contribution by Javran Cheng)++## Hakyll 4.7.2.3++- Fix time dependency in tests++## Hakyll 4.7.2.2++- Relax time dependency++## Hakyll 4.7.2.1++- Bump fsnotify dependency to 0.2++## Hakyll 4.7.2.0++- Improve documentation of `getResourceXXX` functions (contribution by Matthias+  C. M. Troffaes)+- Allow for empty templates+- Bump pandoc dependency to 1.15++## Hakyll 4.7.1.0++- Drop old-time, old-locale, time-locale-compat dependencies+- Add convenicence `pandocBiblioCompiler` (contribution by+  Matthias C. M. Troffaes)+- Add support for mediawiki (contribution by Chen Lei)++## Hakyll 4.7.0.0++- Bump pandoc to 1.14. This will break a lot of sites: since the pandoc parser+  might now return an error message, it is ran inside the `Compiler` monad where+  we can nicely handle the error.++## Hakyll 4.6.9.0++- Let caller decide exit (fix by Erik Dominikus)+- Bump pandoc-citeproc dependency++## Hakyll 4.6.8.1++- Fix test suite dependencies++## Hakyll 4.6.8.0++- Fix building on GHC 7.10 (fix by Charles Strahan)+- Add support for a custom teaser separator (contribution by Tom Sydney+  Kerckhove)+- Let Pandoc handle DocBook files (contribution by Joshua SImmons)++## Hakyll 4.6.7.1++- Bump dependencies++## Hakyll 4.6.7.0++- Bump dependencies+- Fix bug where hakyll-init would create a file called `name.cabal.cabal` (fix+  by Hans-Peter Deifel)++## Hakyll 4.6.6.0++- Fix compilation error when preview server is disabled (fix by Magnus Therning)+- Add author name by default to RSS feeds (contribution by Calen Pennington)++## Hakyll 4.6.5.0++- Bump dependencies+- Fix garbled "Listening on 0.0.0.0:8000" message+- Add `boolField` (contribution by Ferenc Wágner)++## Hakyll 4.6.4.0++- Fix another dependency handling bug when using snapshots+- Add `matchMetadata` for examining metadata when defining rules++## Hakyll 4.6.3.0++- Fix dependency handling bug++## Hakyll 4.6.2.0++- Loosen `binary` dependency+- Make dependency handling more granular so you can depend on specific snapshots+  of an item++## Hakyll 4.6.1.0++- Bump `fsnotify` and `pandoc-citeproc` dependencies+- Rewrite polling code a bit++## Hakyll 4.6.0.0++- Added `listFieldWith` function+- Improved `rulesExtraDependencies` behaviour+- Changed function syntax in templates from `$foo arg1 arg2$` to+  `$foo("arg1", "arg2")$`+- Support parsing date from directory names in addition to file names++## Hakyll 4.5.5.0++- Fix Binary instances for `pandoc` and `pandoc-citeproc`+- Fix `network-uri` dependency issue++## Hakyll 4.5.4.0++- Fix issue with HTML entities when running `withUrls` and `demoteHeaders`.+- Generate a cabal file for the initialised site.+- Add pagination support.++## Hakyll 4.5.3.0++- Bump Pandoc to 1.12.4 to include the org-mode reader.++## Hakyll 4.5.2.0++- Fix rebuilding everything issue with latest directory (contribution by Jorge+  Israel Peña)+- Fix issue with `toSiteRoot` (contribution by Izzy Cecil)+- Fix issue with tag dependencies, slightly improve caching++## Hakyll 4.5.0.0++- Fix issue with syntax highlighting and line numbers (contribution by Adelbert+  Chang)+- Improve documentation for `Context` (contribution by Daniil Frumin)+- Added `IsString` instance for `Template`+- Added the `pandocCompilerWithTransformM` function (contribution by Daniil+  Frumin)+- Make `./site check` return the right exit code (contribution by Andres Loeh)+- Use OS threads to make `./site watch` work nicely on Windows (contribution by+  Simonas Kazlauskas)+- Make the `unixFilter` function work better on windows by calling `shell`+  (contribution by Collin J. Doering)+- Add a command-line flag to bind on a user-specified host (contribution by+  chrisdotcode)++## Hakyll 4.4.3.0++- Fix issue when using `metadataRoute` after other custom routes++## Hakyll 4.4.2.0++- Fix issue where Hakyll would not detect a change if a `.metadata` file was+  deleted++## Hakyll 4.4.1.0++- Use Pandoc 1.12 highlighting by default++## Hakyll 4.4.0.0++- Update to work with Pandoc 1.12. This changes the type of `readPandocBibilio`:+  the `CSL` argument is no longer optional (contribution by Jorge Israel Peña)++- Fix incorrect output of `toSiteRoot` on windows (contribution by Saeid+  Al-Wazzan)++- Add a preview port option to `Configuration` (contribution by Jorge Israel+  Peña)++- Add `watch` command that polls for changes but does not necessarily launch a+  server (contribution by Eric Stolten)++- Generalise type of `metadataField`++- Fix issue where metadata was not correctly loaded when using versions++## Hakyll 4.3.3.0++- Re-add the `functionField` function++## Hakyll 4.3.2.0++- Re-add the `mapContext` function++- Unescape internal URLs when using `./site check` (contribution by Marc-Antoine+  Perennou)++## Hakyll 4.3.1.0++- Make teasers undefined if no `<!--more-->` comment is found++- Sanitize tag URLs (contribution by Simonas Kazlauskas)++## Hakyll 4.3.0.0++- Add conditionals, partials and for loops to the template system (includes a+  contribution by Ivan N. Veselov)++- Improvements to the preview functionality on windows (contribution by Jorge+  Israel Peña)++- Add pagination support (contribution by Anton Dubovik)++- Slight speedup for the Hakyll cache (contribution by justnoxx)++- Add teaser functionality (contribution by Ivan N. Veselov)++- Make `./site check` work with scheme-relative URLs (contribution by Simonas+  Kazlauskas)++- The `./site deploy` command can now be customized with Haskell code+  (contribution by Samuel Tardieu)++- Use `hsnotify` for proper polling instead of sleep loop on all platforms+  (contribution by Simonas Kazlauskas)++- More useful debug info available++## Hakyll 4.2.2.0++- Fix issue with `Alternative` instance of `Compiler`++## Hakyll 4.2.1.1++*March 9, 2013*++- Make `http-conduit` dependency optional by adding a `checkExternal` cabal flag++## Hakyll 4.2.1.0++*March 7, 2013*++- Fix issue where `copyFileCompiler` ignored `providerDirectory`++## Hakyll 4.2.0.0++*March 7, 2013*++- Read second extension for `.lhs`, e.g. `.md.lhs` or `.tex.lhs` (contribution+  by Alexander Vershilov)++- Speedup initialization by using modification times instead of hashing files++- Speedup initialization with a rewritten resource provider++- Fix `./site check` not working with sites that require a user agent (e.g.+  <http://www.wikipedia.org/>)++- Change `chronological` and `recentFirst` to actually look at the dates of+  items. This changes their types from:++        chronological, recentFirst :: [Item a] -> [Item a]++    to:++        chronological, recentFirst+            :: MonadMetadata m => [Item a] -> m [Item a]++    (contribution by Simonas Kazlauskas)++- Add `metadataRoute`, so it is now possible to use metadata when determining+  routes++- Improve metadata parser for multiline metadata fields (contribution by Peter+  Jones)++- Add the `getMetadataField` utility++## Hakyll 4.1.4.0++*January 26, 2013*++- Export the flexible `renderTags` function++## Hakyll 4.1.3.0++*January 26, 2013*++- Export the constructor of the `Tags` datatype++## Hakyll 4.1.2.0++*January 20, 2013*++- Fix an issue where a dependency cycle would lead to infinite recursion/stack+  overflow++## Hakyll 4.1.1.0++*January 20, 2013*++- Fix an issue regarding `relativizeUrls` expanding `<meta />` to+  `<meta></meta>`++## Hakyll 4.1.0.0++*January 20, 2013*++Update to use Pandoc 1.10, this requires changes to your `site.hs` if you're+using custom Pandoc options or the `Hakyll.Web.Pandoc.Biblio` module.++- `defaultHakyllParserState` renamed to `defaultHakyllReaderOptions`++- The type of `readPandocBiblio` changed++Because of the many changes, this release is no longer compatible with Pandoc+1.9.++## Hakyll 4.0.0.0++*January 16, 2013*++The Initial release of Hakyll 4, see+[this blogpost](http://jaspervdj.be/posts/2013-01-16-hakyll-4.0.html) and+[the migration guide](/tutorials/hakyll-3-to-hakyll4-migration-guide.html) for+an overview of changes.
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2009, Jasper Van der Jeugt+Copyright (c) 2009 - 2017, Jasper Van der Jeugt   All rights reserved.  
+ data/example/about.rst view
@@ -0,0 +1,17 @@+---+title: About+---+Nullam imperdiet sodales orci vitae molestie. Nunc quam orci, pharetra a+rhoncus vitae, eleifend id felis. Suspendisse potenti. Etiam vitae urna orci.+Quisque pellentesque dignissim felis, egestas tempus urna luctus vitae. In hac+habitasse platea dictumst. Morbi fringilla mattis odio, et mattis tellus+accumsan vitae.++1. Amamus Unicode 碁+2. Interdum nex magna.++Vivamus eget mauris sit amet nulla laoreet lobortis. Nulla in diam elementum+risus convallis commodo. Cras vehicula varius dui vitae facilisis. Proin+elementum libero eget leo aliquet quis euismod orci vestibulum. Duis rhoncus+lorem consequat tellus vestibulum aliquam. Quisque orci orci, malesuada porta+blandit et, interdum nec magna.
+ data/example/contact.markdown view
@@ -0,0 +1,6 @@+---+title: Contact+---++I live in a small hut in the mountains of Kumano Kodō on Kii Hantō and would not+like to be contacted.
+ data/example/css/default.css view
@@ -0,0 +1,141 @@+html {+  font-size: 62.5%;+}++body {+  font-size: 1.6rem;+  color: #000;+}++header {+  border-bottom: 0.2rem solid #000;+}++nav {+  text-align: right;+}++nav a {+  font-size: 1.8rem;+  font-weight: bold;+  color: black;+  text-decoration: none;+  text-transform: uppercase;+}++footer {+  margin-top: 3rem;+  padding: 1.2rem 0;+  border-top: 0.2rem solid #000;+  font-size: 1.2rem;+  color: #555;+}++h1 {+  font-size: 2.4rem;+}++h2 {+  font-size: 2rem;+}++article .header {+  font-size: 1.4rem;+  font-style: italic;+  color: #555;+}++.logo a {+  font-weight: bold;+  color: #000;+  text-decoration: none;+}++@media (max-width: 319px) {+  body {+    width: 90%;+    margin: 0;+    padding: 0 5%;+  }+  header {+    margin: 4.2rem 0;+  }+  nav {+    margin: 0 auto 3rem;+    text-align: center;+  }+  footer {+    text-align: center;+  }+  .logo {+    text-align: center;+    margin: 1rem auto 3rem;+  }+  .logo a {+    font-size: 2.4rem;+  }+  nav a {+    display: block;+    line-height: 1.6;+  }+}++@media (min-width: 320px) {+  body {+    width: 90%;+    margin: 0;+    padding: 0 5%;+  }+  header {+    margin: 4.2rem 0;+  }+  nav {+    margin: 0 auto 3rem;+    text-align: center;+  }+  footer {+    text-align: center;+  }+  .logo {+    text-align: center;+    margin: 1rem auto 3rem;+  }+  .logo a {+    font-size: 2.4rem;+  }+  nav a {+    display: inline;+    margin: 0 0.6rem;+  }+}++@media (min-width: 640px) {+  body {+    width: 60rem;+    margin: 0 auto;+    padding: 0;+  }+  header {+    margin: 0 0 3rem;+    padding: 1.2rem 0;+  }+  nav {+    margin: 0;+    text-align: right;+  }+  nav a {+    margin: 0 0 0 1.2rem;+    display: inline;+  }+  footer {+    text-align: right;+  }+  .logo {+    margin: 0;+    text-align: left;+  }+  .logo a {+    float: left;+    font-size: 1.8rem;+  }+}
+ data/example/images/haskell-logo.png view

binary file changed (absent → 5674 bytes)

+ data/example/index.html view
@@ -0,0 +1,16 @@+---+title: Home+---++<h2>Welcome</h2>++<img src="/images/haskell-logo.png" style="float: right; margin: 10px;" />++<p>Welcome to my blog!</p>++<p>I've reproduced a list of recent posts here for your reading pleasure:</p>++<h2>Posts</h2>+$partial("templates/post-list.html")$++<p>…or you can find more in the <a href="/archive.html">archives</a>.</p>
+ data/example/posts/2015-08-12-spqr.markdown view
@@ -0,0 +1,59 @@+---+title: S.P.Q.R.+---++Mauris in lorem nisl. Maecenas tempus facilisis ante, eget viverra nisl+tincidunt et. Donec turpis lectus, mattis ac malesuada a, accumsan eu libero.+Morbi condimentum, tortor et tincidunt ullamcorper, sem quam pretium nulla, id+convallis lectus libero nec turpis. Proin dapibus nisi id est sodales nec+ultrices tortor pellentesque. Vivamus vel nisi ac lacus sollicitudin vulputate+ac ut ligula. Nullam feugiat risus eget eros gravida in molestie sapien euismod.+Nunc sed hendrerit orci. Nulla mollis consequat lorem ac blandit. Ut et turpis+mauris. Nulla est odio, posuere id ullamcorper sit amet, tincidunt vel justo.+Curabitur placerat tincidunt varius. Nulla vulputate, ipsum eu consectetur+mollis, dui nibh aliquam neque, at ultricies leo ligula et arcu. Proin et mi+eget tellus sodales lobortis. Sed tempor, urna vel pulvinar faucibus, lectus+urna vehicula ante, at facilisis dolor odio at lorem. Morbi vehicula euismod+urna, et imperdiet urna ornare vitae.++Sed tincidunt sollicitudin ultrices. In hac habitasse platea dictumst. Morbi+ligula lectus, egestas at ultricies nec, fringilla et tellus. Duis urna lorem,+bibendum a ornare sed, euismod sed nunc. Aliquam tempor massa at velit fringilla+fringilla. Praesent sit amet tempor felis. Maecenas id felis ac velit aliquam+tempor a sit amet orci. Nunc placerat nulla pellentesque sem commodo cursus.+Praesent quis sapien orci, quis ultricies augue. Nam vestibulum sem non augue+semper tincidunt pellentesque ipsum volutpat. Duis congue, nunc a aliquam+luctus, quam ante convallis nisi, ac pellentesque lacus orci vel turpis. Cum+sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus+mus. Suspendisse hendrerit nisl eu felis sagittis faucibus. Nunc eu congue+lorem. Quisque non nibh nisi, et ultrices massa. Sed vitae erat vitae nulla+pellentesque fermentum.++Ut diam nunc, consectetur ut ultrices eu, iaculis sed felis. Sed lacinia, odio+et accumsan luctus, arcu ipsum accumsan erat, sit amet malesuada libero lacus et+velit. Donec accumsan tristique tristique. Proin a metus magna, vitae mattis+nisl. Integer a libero ipsum. Mauris faucibus eleifend metus id sodales. Morbi+ornare, nibh nec facilisis imperdiet, turpis sem commodo lorem, id commodo+mauris metus vitae justo. Etiam at pellentesque tortor. Proin mollis accumsan+ligula, nec tempus augue auctor quis. Nulla lacinia, mi quis lobortis auctor,+nisi diam posuere dui, pulvinar feugiat dui libero eget quam. Fusce eu risus+nunc, a consectetur orci. Class aptent taciti sociosqu ad litora torquent per+conubia nostra, per inceptos himenaeos. Maecenas venenatis aliquet orci, a+ultricies sem facilisis eu. Donec dolor purus, porta condimentum convallis nec,+dignissim nec libero.++Etiam rutrum ultricies dui, et interdum metus elementum et. Nulla sapien nunc,+interdum tristique porttitor in, laoreet vitae mi. Ut vehicula auctor mauris sit+amet bibendum. Phasellus adipiscing mattis libero, eget adipiscing erat+dignissim at. Vivamus convallis malesuada metus nec cursus. Ut cursus, lorem+eleifend sollicitudin condimentum, felis tortor sodales augue, ac tempus lacus+ipsum vitae quam. Vestibulum vitae lacus non tortor vehicula iaculis faucibus+quis massa.++Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus+mus. Duis malesuada neque nec ante porttitor accumsan. Suspendisse potenti.+Aliquam in lacus magna, imperdiet laoreet lectus. Praesent id diam nec ante+commodo rhoncus nec vel augue. Pellentesque tortor massa, dignissim ut sagittis+sed, hendrerit vitae nunc. Nam gravida, urna vitae hendrerit rutrum, felis augue+vulputate tortor, ut varius velit libero nec lectus. In adipiscing massa in est+scelerisque ullamcorper. Vivamus in nisi metus.
+ data/example/posts/2015-10-07-rosa-rosa-rosam.markdown view
@@ -0,0 +1,46 @@+---+title: Rosa Rosa Rosam+author: Ovidius+---++Suspendisse pharetra ullamcorper sem et auctor. Suspendisse vitae tellus eu+turpis dignissim gravida ut ut tortor. Cum sociis natoque penatibus et magnis+dis parturient montes, nascetur ridiculus mus. Morbi aliquam sapien quis nisl+sodales non aliquet nisl iaculis. Curabitur fermentum orci vel sapien+pellentesque id condimentum metus vehicula. Curabitur turpis purus, scelerisque+at interdum quis, placerat sit amet tortor. Aliquam erat volutpat.++Integer posuere felis non arcu suscipit ullamcorper. Nam tempus risus venenatis+orci sagittis eu aliquam ante tincidunt. Aenean vehicula ipsum id sapien+tincidunt commodo. Aliquam erat volutpat. Curabitur vehicula libero ac turpis+cursus consectetur. Praesent posuere egestas purus et dapibus. Mauris egestas,+lectus vitae scelerisque ultricies, metus lorem tempor nisi, sed vehicula tortor+mauris nec urna. Quisque urna tellus, facilisis at mollis eget, adipiscing in+nisl. Proin quam arcu, euismod et imperdiet sed, ultricies sed orci.++Nulla malesuada sem eget lectus scelerisque nec rhoncus metus interdum. In dui+felis, rhoncus id scelerisque eget, vulputate id sem. Nulla facilisi. Vestibulum+eleifend, metus dignissim lacinia ornare, magna nulla vehicula nisi, sed+molestie mauris ipsum vel turpis. Class aptent taciti sociosqu ad litora+torquent per conubia nostra, per inceptos himenaeos. Nulla urna leo, vehicula+eget dignissim a, hendrerit ut risus. Fusce ultricies elementum placerat. Nam at+dolor sed nisi mollis sollicitudin vitae at urna. Vestibulum iaculis adipiscing+eros et mollis.++Phasellus ultricies elit eu risus sagittis eu dictum ante ultrices. Nulla+congue, augue ac placerat tempor, orci mi luctus nisi, at varius ipsum sem sed+eros. Vivamus eget velit eget felis posuere ornare. In sed metus non est iaculis+facilisis dapibus sit amet enim. Aliquam viverra tortor eget neque volutpat in+auctor urna rutrum. Aliquam ligula augue, congue sit amet rutrum in, semper vel+nulla. Sed tempus porttitor faucibus. Donec cursus sodales nulla, quis lacinia+mi vehicula vel. Sed nec purus orci. Nam leo sapien, rutrum a ultrices quis,+placerat vel ligula. Donec massa quam, pellentesque et molestie nec, hendrerit+id mauris. In hac habitasse platea dictumst. Cras quis quam sem. Curabitur in+arcu diam, in interdum mauris.++Proin lorem sapien, iaculis et faucibus nec, dictum sed nunc. Pellentesque in+purus justo. Vestibulum facilisis rutrum nisi, a egestas nunc suscipit sed. Ut+quis tortor a arcu bibendum placerat non sed ante. Praesent orci sem, posuere+sit amet cursus molestie, volutpat ut purus. Curabitur aliquam, purus in+pharetra viverra, lorem leo aliquam tellus, vel consequat felis neque et mauris.+Aliquam erat volutpat.
+ data/example/posts/2015-11-28-carpe-diem.markdown view
@@ -0,0 +1,50 @@+---+title: Carpe Diem+---++Fusce tortor quam, egestas in posuere quis, porttitor vel turpis. Donec+vulputate porttitor augue at rhoncus. Proin iaculis consectetur sagittis.+Curabitur venenatis turpis sit amet purus tristique nec posuere risus laoreet.+Nullam nisi sem, dapibus id semper id, egestas vel arcu. Morbi porttitor ipsum+placerat erat consequat sed consequat purus feugiat. Donec auctor elit ut risus+mattis facilisis. Lorem ipsum dolor sit amet, consectetur adipiscing elit.++Proin vulputate sapien facilisis leo ornare pulvinar. Fusce tempus massa a risus+semper iaculis. Suspendisse sollicitudin posuere nunc, sit amet rutrum leo+facilisis mattis. Sed ornare auctor dui, vitae rutrum neque auctor sit amet.+Proin ac dui magna. Mauris vehicula interdum augue, nec ultrices libero egestas+quis. Nunc convallis euismod ipsum, id sollicitudin orci consequat ac. Fusce+bibendum congue libero, in rutrum nulla congue non. Cras sit amet risus tortor,+eu pellentesque dui. Phasellus euismod enim non nibh sodales quis consectetur+lorem laoreet. Vivamus a egestas quam. Curabitur in tortor augue, vitae varius+tellus. Integer varius, elit ac gravida suscipit, eros erat pellentesque nisi,+et tristique augue odio id nulla. Aliquam sit amet nunc vel tellus hendrerit+tempus ac vel sem.++Aenean tincidunt sollicitudin sapien ut porttitor. Curabitur molestie adipiscing+lorem vel scelerisque. Donec vitae interdum est. Proin rutrum vulputate+faucibus. Suspendisse sit amet felis odio, non volutpat ante. Sed eu lectus+quam. Curabitur tristique rhoncus est, vel commodo tortor suscipit semper.+Maecenas feugiat vestibulum nisi id facilisis. Nulla non tincidunt libero.+Praesent ultrices interdum commodo. Sed euismod nisl auctor leo ultrices rutrum.+Aliquam nibh felis, congue molestie blandit at, bibendum at eros. Aenean+tincidunt, tortor iaculis placerat sollicitudin, lorem justo tempor diam, et+posuere sapien leo et magna. Quisque vel aliquam mauris.++Proin varius tempus fermentum. Cum sociis natoque penatibus et magnis dis+parturient montes, nascetur ridiculus mus. Sed tincidunt nunc id magna+adipiscing non sollicitudin turpis tempor. Etiam vel elit ipsum, quis euismod+velit. Quisque elementum magna vitae quam venenatis lacinia. Sed at arcu ipsum.+Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos+himenaeos. Donec ut lorem ac sapien cursus lacinia sit amet mollis dolor.+Vivamus tempus odio nec magna faucibus sed hendrerit lorem tempor.++Vestibulum eu nisi arcu. Curabitur nisi risus, fermentum ut lacinia ut, interdum+nec magna. Nunc aliquet gravida massa, eu aliquam lorem faucibus at. Sed+sollicitudin volutpat velit id tempor. In nibh justo, pharetra et pretium+dignissim, tempus in turpis. Phasellus eget lobortis nisl. Phasellus sed+fermentum diam. Nam tempus pharetra odio, quis congue eros imperdiet eu. Aliquam+dui eros, hendrerit et vulputate vel, porta eu eros. Nullam nisi dui, commodo+eget pharetra ut, ornare sit amet nunc. Fusce vel neque urna. Maecenas nulla+ante, egestas at consequat quis, fermentum a enim. Aliquam id tristique urna.+Integer augue justo, scelerisque et consectetur id, rhoncus eget enim.
+ data/example/posts/2015-12-07-tu-quoque.markdown view
@@ -0,0 +1,58 @@+---+title: Tu Quoque+author: Julius+---++Vestibulum leo turpis, dignissim quis ultrices sit amet, iaculis ac ligula.+Pellentesque tristique, velit eget scelerisque scelerisque, est dolor ultrices+arcu, quis ullamcorper justo arcu luctus mauris. Integer congue molestie nisi id+posuere. Fusce pellentesque gravida tempus. Integer viverra tortor nec eros+mollis quis convallis sem laoreet. Nulla id libero ac erat varius laoreet. Proin+sed est est. Curabitur lacinia fermentum lorem, elementum malesuada ipsum+malesuada ut. Donec suscipit elit id leo vehicula mattis non sed leo. Morbi+varius eleifend varius. Nulla vestibulum, neque vitae aliquam eleifend, nisi+tellus placerat nunc, quis suscipit elit turpis eu tortor. Etiam euismod+convallis lectus quis venenatis. Phasellus laoreet magna in nibh cursus eu+egestas nulla convallis. Aliquam vel ullamcorper risus. Fusce dictum, massa id+consequat viverra, nulla ante tristique est, a faucibus nisi enim nec dui. Donec+metus ligula, condimentum at porttitor eget, lobortis at quam.++Aenean vel libero in magna ultricies congue in a odio. Donec faucibus rutrum+ornare. Fusce dictum eleifend fermentum. Vestibulum vel nibh a metus porttitor+rhoncus. Pellentesque id quam neque, eget molestie arcu. Integer in elit vel+neque viverra ultricies in eget massa. Nam ut convallis est. Pellentesque eros+eros, sodales non vehicula et, tincidunt ut odio. Cras suscipit ultrices metus+sit amet molestie. Fusce enim leo, vehicula sed sodales quis, adipiscing at+ipsum.++Nunc tempor dignissim enim, sed tincidunt eros bibendum quis. Curabitur et dolor+augue, id laoreet mi. Nulla cursus felis id dui vehicula vitae ornare lorem+blandit. Cras eget dui nec odio volutpat pharetra. Fusce hendrerit justo justo,+vel imperdiet enim. Vivamus elit risus, interdum ultrices accumsan eleifend,+vestibulum vitae sapien. Integer bibendum ullamcorper tristique. Nulla quis odio+lectus, quis eleifend augue. Integer a ligula mauris. Aenean et tempus tortor.+Quisque at tortor mi. Vivamus accumsan feugiat est a blandit. Sed vitae enim ut+dolor semper sodales. Duis tristique, ante et placerat elementum, nulla tellus+pellentesque sapien, quis posuere velit mi eget nulla. Sed vestibulum nunc non+est porttitor ut rutrum nibh semper. Pellentesque habitant morbi tristique+senectus et netus et malesuada fames ac turpis egestas.++Nulla adipiscing ultricies lobortis. Vivamus iaculis nisl vitae tellus laoreet+vitae aliquet lacus mollis. Phasellus ut lacus urna, sed sagittis ante. Etiam+consectetur pretium nisl sed dignissim. Pellentesque convallis, nisl eget+commodo mollis, sem magna consequat arcu, sed pretium ipsum arcu sit amet neque.+Aliquam erat volutpat. Morbi sed mi sed urna vestibulum placerat vitae vel+metus. Fusce ac ante at justo pharetra vehicula. Vivamus vel tortor eget augue+aliquet aliquet at vel odio. Nunc venenatis, magna quis facilisis fringilla,+augue tellus varius neque, in vulputate est eros ut tortor. Duis lorem neque,+aliquam congue posuere id, condimentum non dui. Phasellus ut dui massa,+porttitor suscipit augue. Praesent quis tellus quam, vel volutpat metus. Vivamus+enim est, aliquam in imperdiet et, sagittis eu ligula. Vestibulum hendrerit+placerat orci et aliquet. Cras pharetra, dolor placerat lobortis tempor, metus+odio cursus ligula, et posuere lacus ligula quis dui.++Donec a lectus eu nibh malesuada aliquam. Proin at metus quam, et tincidunt leo.+Quisque lacus justo, scelerisque sodales pulvinar sed, dignissim ut sapien.+Vivamus diam felis, adipiscing sollicitudin ultricies id, accumsan ac felis. In+eu posuere ligula. Suspendisse potenti. Donec porttitor dictum dui id vehicula.+Integer ante velit, congue id dictum et, adipiscing a tortor.
+ data/example/site.hs view
@@ -0,0 +1,66 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+import           Data.Monoid (mappend)+import           Hakyll+++--------------------------------------------------------------------------------+main :: IO ()+main = hakyll $ do+    match "images/*" $ do+        route   idRoute+        compile copyFileCompiler++    match "css/*" $ do+        route   idRoute+        compile compressCssCompiler++    match (fromList ["about.rst", "contact.markdown"]) $ do+        route   $ setExtension "html"+        compile $ pandocCompiler+            >>= loadAndApplyTemplate "templates/default.html" defaultContext+            >>= relativizeUrls++    match "posts/*" $ do+        route $ setExtension "html"+        compile $ pandocCompiler+            >>= loadAndApplyTemplate "templates/post.html"    postCtx+            >>= loadAndApplyTemplate "templates/default.html" postCtx+            >>= relativizeUrls++    create ["archive.html"] $ do+        route idRoute+        compile $ do+            posts <- recentFirst =<< loadAll "posts/*"+            let archiveCtx =+                    listField "posts" postCtx (return posts) `mappend`+                    constField "title" "Archives"            `mappend`+                    defaultContext++            makeItem ""+                >>= loadAndApplyTemplate "templates/archive.html" archiveCtx+                >>= loadAndApplyTemplate "templates/default.html" archiveCtx+                >>= relativizeUrls+++    match "index.html" $ do+        route idRoute+        compile $ do+            posts <- recentFirst =<< loadAll "posts/*"+            let indexCtx =+                    listField "posts" postCtx (return posts) `mappend`+                    defaultContext++            getResourceBody+                >>= applyAsTemplate indexCtx+                >>= loadAndApplyTemplate "templates/default.html" indexCtx+                >>= relativizeUrls++    match "templates/*" $ compile templateBodyCompiler+++--------------------------------------------------------------------------------+postCtx :: Context String+postCtx =+    dateField "date" "%B %e, %Y" `mappend`+    defaultContext
+ data/example/templates/archive.html view
@@ -0,0 +1,2 @@+Here you can find all my previous posts:+$partial("templates/post-list.html")$
+ data/example/templates/default.html view
@@ -0,0 +1,33 @@+<!doctype html>+<html lang="en">+    <head>+        <meta charset="utf-8">+        <meta http-equiv="x-ua-compatible" content="ie=edge">+        <meta name="viewport" content="width=device-width, initial-scale=1">+        <title>My Hakyll Blog - $title$</title>+        <link rel="stylesheet" href="/css/default.css" />+    </head>+    <body>+        <header>+            <div class="logo">+                <a href="/">My Hakyll Blog</a>+            </div>+            <nav>+                <a href="/">Home</a>+                <a href="/about.html">About</a>+                <a href="/contact.html">Contact</a>+                <a href="/archive.html">Archive</a>+            </nav>+        </header>++        <main role="main">+            <h1>$title$</h1>+            $body$+        </main>++        <footer>+            Site proudly generated by+            <a href="http://jaspervdj.be/hakyll">Hakyll</a>+        </footer>+    </body>+</html>
+ data/example/templates/post-list.html view
@@ -0,0 +1,7 @@+<ul>+    $for(posts)$+        <li>+            <a href="$url$">$title$</a> - $date$+        </li>+    $endfor$+</ul>
+ data/example/templates/post.html view
@@ -0,0 +1,11 @@+<article>+    <section class="header">+        Posted on $date$+        $if(author)$+            by $author$+        $endif$+    </section>+    <section>+        $body$+    </section>+</article>
data/templates/atom.xml view
@@ -1,12 +1,15 @@ <?xml version="1.0" encoding="utf-8"?> <feed xmlns="http://www.w3.org/2005/Atom">     <title>$title$</title>+    <subtitle><![CDATA[$description$]]></subtitle>     <link href="$root$$url$" rel="self" />     <link href="$root$" />     <id>$root$$url$</id>     <author>         <name>$authorName$</name>+        $if(authorEmail)$         <email>$authorEmail$</email>+        $endif$     </author>     <updated>$updated$</updated>     $body$
+ data/templates/feed-item.json view
@@ -0,0 +1,8 @@+{+    "id": "$root$$url$",+    "url": "$root$$url$",+    "content_html": "$description$",+    "title": "$title$",+    "date_published": "$published$",+    "date_modified": "$updated$"+}
+ data/templates/feed.json view
@@ -0,0 +1,18 @@+{+    "version": "https://www.jsonfeed.org/version/1.1",+    "title": "$title$",+    "description": "$description$",+    "home_page_url": "$root$",+    "feed_url": "$root$$url$",+    $if(authorName)$+    "authors": [+        {+            "name": "$authorName$"+            $if(authorEmail)$+            , "url": "mailto:$authorEmail$"+            $endif$+        }+    ],+    $endif$+    "items": [ $body$ ]+}
data/templates/rss-item.xml view
@@ -4,4 +4,5 @@     <description><![CDATA[$description$]]></description>     <pubDate>$published$</pubDate>     <guid>$root$$url$</guid>+    <dc:creator>$authorName$</dc:creator> </item>
data/templates/rss.xml view
@@ -1,5 +1,6 @@ <?xml version="1.0" encoding="utf-8"?>-<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">+<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom"+    xmlns:dc="http://purl.org/dc/elements/1.1/">     <channel>         <title>$title$</title>         <link>$root$</link>@@ -8,5 +9,5 @@                    type="application/rss+xml" />         <lastBuildDate>$updated$</lastBuildDate>         $body$-    </channel> +    </channel> </rss>
hakyll.cabal view
@@ -1,5 +1,5 @@ Name:    hakyll-Version: 3.5.3.0+Version: 4.17.0.0  Synopsis: A static website compiler library Description:@@ -22,7 +22,7 @@    . -  * An IRC channel, @#hakyll@ on freenode+  * An IRC channel, @#hakyll@ on irc.libera.chat (we *do not* have a channel on Freenode anymore)    . @@ -37,169 +37,327 @@ License-File: LICENSE Category:     Web -Cabal-Version: >= 1.8+Cabal-Version: >= 1.10 Build-Type:    Simple Data-Dir:      data-Data-Files:-  templates/atom.xml-  templates/atom-item.xml-  templates/rss.xml-  templates/rss-item.xml +Data-files:+  example/posts/2015-11-28-carpe-diem.markdown+  example/posts/2015-10-07-rosa-rosa-rosam.markdown+  example/posts/2015-12-07-tu-quoque.markdown+  example/posts/2015-08-12-spqr.markdown+  example/site.hs+  example/images/haskell-logo.png+  example/templates/post-list.html+  example/templates/default.html+  example/templates/archive.html+  example/templates/post.html+  example/css/default.css+  example/index.html+  example/about.rst+  example/contact.markdown++Extra-source-files:+  CHANGELOG.md+  tests/data/biblio/chicago.csl+  tests/data/biblio/cites-meijer-pandoc-2.0.0plus.golden+  tests/data/biblio/cites-meijer-pandoc-3.0.0plus.golden+  tests/data/biblio/cites-meijer-pandoc-3.1.8plus.golden+  tests/data/biblio/cites-multiple-pandoc-2.0.0plus.golden+  tests/data/biblio/cites-multiple-pandoc-3.0.0plus.golden+  tests/data/biblio/cites-multiple-pandoc-3.1.8plus.golden+  tests/data/biblio/cites-multiple.markdown+  tests/data/biblio/default.html+  tests/data/biblio/page.markdown+  tests/data/biblio/refs.bib+  tests/data/biblio/refs.yaml+  tests/data/biblio/refs2.yaml+  tests/data/embed.html+  tests/data/example.md+  tests/data/example.md.metadata+  tests/data/images/favicon.ico+  tests/data/just-meta.html+  tests/data/just-meta.html.out+  tests/data/partial-helper.html+  tests/data/partial.html+  tests/data/partial.html.out+  tests/data/posts/2010-08-26-birthday.md+  tests/data/posts/2018-09-26.md+  tests/data/posts/2019/05/10/tomorrow.md+  tests/data/russian.md+  tests/data/strip.html+  tests/data/strip.html.out+  tests/data/template-empty.html+  tests/data/template.html+  tests/data/template.html.out+  data/templates/atom-item.xml+  data/templates/atom.xml+  data/templates/rss-item.xml+  data/templates/rss.xml+  data/templates/feed.json+  data/templates/feed-item.json+ Source-Repository head   Type:     git-  Location: git://github.com/jaspervdj/hakyll.git+  Location: https://github.com/jaspervdj/hakyll.git  Flag previewServer   Description: Include the preview server   Default:     True+  Manual:      True -Library-  Ghc-Options:    -Wall-  Ghc-Prof-Options: -auto-all -caf-all-  Hs-Source-Dirs: src+Flag watchServer+  Description: Include the watch server+  Default:     True+  Manual:      True -  Build-Depends:-    base         >= 4      && < 5,-    binary       >= 0.5    && < 0.7,-    blaze-html   >= 0.5    && < 0.6,-    blaze-markup >= 0.5.1  && < 0.6,-    bytestring   >= 0.9    && < 0.11,-    citeproc-hs  >= 0.3.2  && < 0.4,-    containers   >= 0.3    && < 0.6,-    cryptohash   >= 0.7    && < 0.9,-    directory    >= 1.0    && < 1.3,-    filepath     >= 1.0    && < 1.4,-    hamlet       >= 1.0    && < 1.2,-    lrucache     >= 1.1.1  && < 1.2,-    mtl          >= 1      && < 2.2,-    old-locale   >= 1.0    && < 1.1,-    old-time     >= 1.0    && < 1.2,-    pandoc       >= 1.9.3  && < 1.10,-    parsec       >= 3.0    && < 3.2,-    process      >= 1.0    && < 1.2,-    regex-base   >= 0.93   && < 0.94,-    regex-tdfa   >= 1.1    && < 1.2,-    tagsoup      >= 0.12.6 && < 0.13,-    text         >= 0.11   && < 1.12,-    time         >= 1.1    && < 1.5+Flag checkExternal+  Description: Include external link checking+  Default:     True+  Manual:      True +Flag buildWebsite+  Description: Build the hakyll website+  Default:     False+  Manual:      True++Flag usePandoc+  Description: Include Pandoc support+  Default:     True+  Manual:      True++Library+  Ghc-Options:      -Wall+  Hs-Source-Dirs:   lib+  Default-language: Haskell2010+   Exposed-Modules:     Hakyll-    Hakyll.Core.CompiledItem+    Hakyll.Commands     Hakyll.Core.Compiler+    Hakyll.Core.Compiler.Internal     Hakyll.Core.Configuration-    Hakyll.Core.DependencyAnalyzer-    Hakyll.Core.DirectedGraph-    Hakyll.Core.DirectedGraph.Dot+    Hakyll.Core.Dependencies+    Hakyll.Core.File     Hakyll.Core.Identifier     Hakyll.Core.Identifier.Pattern+    Hakyll.Core.Item     Hakyll.Core.Logger-    Hakyll.Core.Resource-    Hakyll.Core.Resource.Provider-    Hakyll.Core.Resource.Provider.Dummy-    Hakyll.Core.Resource.Provider.File+    Hakyll.Core.Metadata+    Hakyll.Core.Provider+    Hakyll.Core.Provider.Metadata     Hakyll.Core.Routes     Hakyll.Core.Rules-    Hakyll.Core.Run+    Hakyll.Core.Rules.Internal+    Hakyll.Core.Runtime     Hakyll.Core.Store     Hakyll.Core.UnixFilter-    Hakyll.Core.Util.Arrow     Hakyll.Core.Util.File     Hakyll.Core.Util.String     Hakyll.Core.Writable-    Hakyll.Core.Writable.CopyFile-    Hakyll.Core.Writable.WritableTuple     Hakyll.Main-    Hakyll.Web.Blaze     Hakyll.Web.CompressCss     Hakyll.Web.Feed-    Hakyll.Web.Page-    Hakyll.Web.Page.List-    Hakyll.Web.Page.Metadata-    Hakyll.Web.Page.Read-    Hakyll.Web.Pandoc-    Hakyll.Web.Pandoc.Biblio-    Hakyll.Web.Pandoc.FileType+    Hakyll.Web.Html+    Hakyll.Web.Html.RelativizeUrls+    Hakyll.Web.Meta.JSONLD+    Hakyll.Web.Meta.OpenGraph+    Hakyll.Web.Meta.TwitterCard+    Hakyll.Web.Paginate+    Hakyll.Web.Redirect     Hakyll.Web.Tags     Hakyll.Web.Template-    Hakyll.Web.Template.Read-    Hakyll.Web.Urls-    Hakyll.Web.Urls.Relativize-    Hakyll.Web.Util.Html+    Hakyll.Web.Template.Context+    Hakyll.Web.Template.Internal+    Hakyll.Web.Template.Internal.Element+    Hakyll.Web.Template.Internal.Trim+    Hakyll.Web.Template.List    Other-Modules:-    Hakyll.Core.Compiler.Internal-    Hakyll.Core.DirectedGraph.Internal-    Hakyll.Core.Rules.Internal-    Hakyll.Web.Page.Internal-    Hakyll.Web.Template.Internal-    Hakyll.Web.Template.Read.Hakyll-    Hakyll.Web.Template.Read.Hamlet+    Data.List.Extended+    Data.Yaml.Extended+    Hakyll.Check+    Hakyll.Core.Compiler.Require+    Hakyll.Core.Identifier.Pattern.Internal+    Hakyll.Core.Item.SomeItem+    Hakyll.Core.Provider.Internal+    Hakyll.Core.Provider.MetadataCache+    Hakyll.Core.Util.Parser     Paths_hakyll +  Build-Depends:+    aeson                >= 1.0      && < 1.6 || >= 2.0 && < 2.3,+    base                 >= 4.12     && < 5,+    binary               >= 0.5      && < 0.10,+    blaze-html           >= 0.5      && < 0.10,+    bytestring           >= 0.9      && < 0.13,+    containers           >= 0.3      && < 0.9,+    contravariant        >= 1.5      && < 1.6,+    data-default         >= 0.4      && < 0.9,+    deepseq              >= 1.3      && < 1.6,+    directory            >= 1.2.7.0  && < 1.4,+    file-embed           >= 0.0.10.1 && < 0.0.17,+    filepath             >= 1.0      && < 1.6,+    hashable             >= 1.0      && < 2,+    lrucache             >= 1.1.1    && < 1.3,+    mtl                  >= 1        && < 2.4,+    network-uri          >= 2.6      && < 2.7,+    optparse-applicative >= 0.12     && < 0.20,+    parsec               >= 3.0      && < 3.2,+    process              >= 1.6      && < 1.7,+    random               >= 1.0      && < 1.4,+    regex-tdfa           >= 1.1      && < 1.4,+    resourcet            >= 1.1      && < 1.4,+    scientific           >= 0.3.4    && < 0.4,+    tagsoup              >= 0.13.1   && < 0.15,+    template-haskell     >= 2.14     && < 2.25,+    text                 >= 0.11     && < 1.3 || >= 2.0 && < 2.2,+    time                 >= 1.8      && < 1.16,+    time-locale-compat   >= 0.1      && < 0.2,+    vector               >= 0.11     && < 0.14,+    wai-app-static       >= 3.1      && < 3.3,+    yaml                 >= 0.8.11   && < 0.12,+    xml-conduit          >= 1.0      && < 1.11+   If flag(previewServer)     Build-depends:-      snap-core   >= 0.6 && < 0.10,-      snap-server >= 0.6 && < 0.10+      wai             >= 3.2   && < 3.3,+      warp            >= 3.2   && < 3.5,+      http-types      >= 0.9   && < 0.13,+      fsnotify        >= 0.2   && < 0.5     Cpp-options:       -DPREVIEW_SERVER     Other-modules:-      Hakyll.Web.Preview.Poll-      Hakyll.Web.Preview.Server+      Hakyll.Preview.Poll+      Hakyll.Preview.Server -Test-suite hakyll-tests-  Type:           exitcode-stdio-1.0-  Hs-source-dirs: src tests-  Main-is:        TestSuite.hs-  Ghc-options:    -Wall+  If flag(watchServer)+    Build-depends:+      fsnotify        >= 0.2   && < 0.5+    Cpp-options:+      -DWATCH_SERVER+    Other-modules:+      Hakyll.Preview.Poll -  Build-Depends:-    HUnit                      >= 1.2 && < 1.3,-    QuickCheck                 >= 2.4 && < 2.6,-    test-framework             >= 0.4 && < 0.7,-    test-framework-hunit       >= 0.2 && < 0.3,-    test-framework-quickcheck2 >= 0.2 && < 0.3,-    -- Copy pasted from hakyll dependencies:-    base         >= 4      && < 5,-    binary       >= 0.5    && < 0.7,-    blaze-html   >= 0.5    && < 0.6,-    blaze-markup >= 0.5.1  && < 0.6,-    bytestring   >= 0.9    && < 0.11,-    citeproc-hs  >= 0.3.2  && < 0.4,-    containers   >= 0.3    && < 0.6,-    cryptohash   >= 0.7    && < 0.9,-    directory    >= 1.0    && < 1.3,-    filepath     >= 1.0    && < 1.4,-    hamlet       >= 1.0    && < 1.2,-    lrucache     >= 1.1.1  && < 1.2,-    mtl          >= 1      && < 2.2,-    old-locale   >= 1.0    && < 1.1,-    old-time     >= 1.0    && < 1.2,-    pandoc       >= 1.9.3  && < 1.10,-    parsec       >= 3.0    && < 3.2,-    process      >= 1.0    && < 1.2,-    regex-base   >= 0.93   && < 0.94,-    regex-tdfa   >= 1.1    && < 1.2,-    tagsoup      >= 0.12.6 && < 0.13,-    text         >= 0.11   && < 1.12,-    time         >= 1.1    && < 1.5,-    unix         >= 2.4    && < 2.7+  If flag(checkExternal)+    Build-depends:+      http-conduit >= 2.2    && < 2.4,+      http-types   >= 0.7    && < 0.13+    Cpp-options:+      -DCHECK_EXTERNAL +  If flag(usePandoc)+    Exposed-Modules:+      Hakyll.Web.Pandoc+      Hakyll.Web.Pandoc.Biblio+      Hakyll.Web.Pandoc.FileType+    Other-Modules:+      Hakyll.Web.Pandoc.Binary+    Build-Depends:+      pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.10,+      pandoc-types >= 1.22 && < 1.24+    Cpp-options:+      -DUSE_PANDOC++Test-suite hakyll-tests+  Type:             exitcode-stdio-1.0+  Hs-source-dirs:   tests+  Main-is:          TestSuite.hs+  -- Note that tests are purposefully run without+  -- -threaded because of their side-effects. Test+  -- failures became apparent with tasty-1.5.4+  Ghc-options:      -Wall+  Default-language: Haskell2010+   Other-modules:-    Hakyll.Web.Util.Html.Tests-    Hakyll.Web.Urls.Relativize.Tests-    Hakyll.Web.Urls.Tests-    Hakyll.Web.Template.Tests-    Hakyll.Web.Page.Metadata.Tests-    Hakyll.Web.Page.Tests-    Hakyll.Core.Compiler.Tests+    Hakyll.Core.Dependencies.Tests     Hakyll.Core.Identifier.Tests-    Hakyll.Core.Util.Arrow.Tests-    Hakyll.Core.Util.String.Tests-    Hakyll.Core.UnixFilter.Tests+    Hakyll.Core.Provider.Metadata.Tests+    Hakyll.Core.Provider.Tests     Hakyll.Core.Routes.Tests-    Hakyll.Core.Store.Tests     Hakyll.Core.Rules.Tests-    Hakyll.Core.DependencyAnalyzer.Tests+    Hakyll.Core.Runtime.Tests+    Hakyll.Core.Store.Tests+    Hakyll.Core.UnixFilter.Tests+    Hakyll.Core.Util.String.Tests+    Hakyll.Web.CompressCss.Tests+    Hakyll.Web.Html.RelativizeUrls.Tests+    Hakyll.Web.Html.Tests+    Hakyll.Web.Tags.Tests+    Hakyll.Web.Template.Context.Tests+    Hakyll.Web.Template.Tests+    Hakyll.Web.Feed.Tests     TestSuite.Util++  Build-Depends:+    hakyll,+    QuickCheck                 >= 2.8  && < 2.19,+    tasty                      >= 0.11 && < 1.6,+    tasty-golden               >= 2.3  && < 2.4,+    tasty-hunit                >= 0.9  && < 0.11,+    tasty-quickcheck           >= 0.8  && < 0.12,+    -- Copy pasted from hakyll dependencies:+    aeson                >= 1.0      && < 1.6 || >= 2.0 && < 2.3,+    base                 >= 4.12     && < 5,+    bytestring           >= 0.9      && < 0.13,+    containers           >= 0.3      && < 0.9,+    filepath             >= 1.0      && < 1.6,+    tagsoup              >= 0.13.1   && < 0.15,+    yaml                 >= 0.8.11   && < 0.12++  If flag(previewServer)+    Cpp-options:+      -DPREVIEW_SERVER++  If flag(watchServer)+    Cpp-options:+      -DWATCH_SERVER++  If flag(checkExternal)+    Cpp-options:+      -DCHECK_EXTERNAL++  If flag(usePandoc)+    Other-modules:+      Hakyll.Web.Pandoc.Biblio.Tests+      Hakyll.Web.Pandoc.FileType.Tests+    Cpp-options:+      -DUSE_PANDOC+    Build-Depends:+      pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.10,+      pandoc-types >= 1.22 && < 1.24+++Executable hakyll-init+  Main-is:          Init.hs+  Ghc-options:      -Wall -threaded+  Hs-source-dirs:   src+  Default-language: Haskell2010++  Other-modules:+    Paths_hakyll++  Build-depends:+    hakyll,+    base      >= 4.12 && < 5,+    directory >= 1.0  && < 1.4,+    filepath  >= 1.0  && < 1.6++Executable hakyll-website+  Main-is:          site.hs+  Ghc-options:      -Wall -threaded+  Hs-source-dirs:   web+  Default-language: Haskell2010++  If flag(buildWebsite)+    Buildable: True+  Else+    Buildable: False++  Build-depends:+    hakyll,+    base      >= 4.12  && < 5,+    directory >= 1.0   && < 1.4,+    filepath  >= 1.0   && < 1.6,+    pandoc    >= 2.11  && < 2.20 || >= 3.0 && < 3.10,+    pandoc-types >= 1.22 && < 1.24
+ lib/Data/List/Extended.hs view
@@ -0,0 +1,15 @@+module Data.List.Extended+    ( module Data.List+    , breakWhen+    ) where++import           Data.List++-- | Like 'break', but can act on the entire tail of the list.+breakWhen :: ([a] -> Bool) -> [a] -> ([a], [a])+breakWhen predicate = go []+  where+    go buf []                = (reverse buf, [])+    go buf (x : xs)+        | predicate (x : xs) = (reverse buf, x : xs)+        | otherwise          = go (x : buf) xs
+ lib/Data/Yaml/Extended.hs view
@@ -0,0 +1,24 @@+module Data.Yaml.Extended+    ( module Data.Yaml+    , toString+    , toList+    ) where++import qualified Data.Text   as T+import qualified Data.Vector as V+import           Data.Yaml+import           Data.Scientific++toString :: Value -> Maybe String+toString (String t)     = Just (T.unpack t)+toString (Bool   True)  = Just "true"+toString (Bool   False) = Just "false"+-- | Make sure that numeric fields containing integer numbers are shown as+-- | integers (i.e., "42" instead of "42.0").+toString (Number d) | isInteger d = Just (formatScientific Fixed (Just 0) d)+                    | otherwise   = Just (show d)+toString _              = Nothing++toList :: Value -> Maybe [Value]+toList (Array a) = Just (V.toList a)+toList _         = Nothing
+ lib/Hakyll.hs view
@@ -0,0 +1,72 @@+--------------------------------------------------------------------------------+-- | Top-level module exporting all modules that are interesting for the user+{-# LANGUAGE CPP #-}+module Hakyll+    ( module Hakyll.Core.Compiler+    , module Hakyll.Core.Configuration+    , module Hakyll.Core.File+    , module Hakyll.Core.Identifier+    , module Hakyll.Core.Identifier.Pattern+    , module Hakyll.Core.Item+    , module Hakyll.Core.Metadata+    , module Hakyll.Core.Routes+    , module Hakyll.Core.Rules+    , module Hakyll.Core.UnixFilter+    , module Hakyll.Core.Util.File+    , module Hakyll.Core.Util.String+    , module Hakyll.Core.Writable+    , module Hakyll.Main+    , module Hakyll.Web.CompressCss+    , module Hakyll.Web.Feed+    , module Hakyll.Web.Html+    , module Hakyll.Web.Html.RelativizeUrls+    , module Hakyll.Web.Meta.JSONLD+    , module Hakyll.Web.Meta.OpenGraph+    , module Hakyll.Web.Meta.TwitterCard+    , module Hakyll.Web.Paginate+#ifdef USE_PANDOC+    , module Hakyll.Web.Pandoc+    , module Hakyll.Web.Pandoc.Biblio+    , module Hakyll.Web.Pandoc.FileType+#endif+    , module Hakyll.Web.Redirect+    , module Hakyll.Web.Tags+    , module Hakyll.Web.Template+    , module Hakyll.Web.Template.Context+    , module Hakyll.Web.Template.List+    ) where+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Configuration+import           Hakyll.Core.File+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern+import           Hakyll.Core.Item+import           Hakyll.Core.Metadata+import           Hakyll.Core.Routes+import           Hakyll.Core.Rules+import           Hakyll.Core.UnixFilter+import           Hakyll.Core.Util.File+import           Hakyll.Core.Util.String+import           Hakyll.Core.Writable+import           Hakyll.Main+import           Hakyll.Web.CompressCss+import           Hakyll.Web.Feed+import           Hakyll.Web.Html+import           Hakyll.Web.Html.RelativizeUrls+import           Hakyll.Web.Meta.JSONLD+import           Hakyll.Web.Meta.OpenGraph+import           Hakyll.Web.Meta.TwitterCard+import           Hakyll.Web.Paginate+#ifdef USE_PANDOC+import           Hakyll.Web.Pandoc+import           Hakyll.Web.Pandoc.Biblio+import           Hakyll.Web.Pandoc.FileType+#endif+import           Hakyll.Web.Redirect+import           Hakyll.Web.Tags+import           Hakyll.Web.Template+import           Hakyll.Web.Template.Context+import           Hakyll.Web.Template.List
+ lib/Hakyll/Check.hs view
@@ -0,0 +1,294 @@+--------------------------------------------------------------------------------+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Check+    ( Check (..)+    , check+    ) where+++--------------------------------------------------------------------------------+import           Control.Concurrent.MVar      (MVar, newEmptyMVar, putMVar,+                                               readMVar)+import           Control.Exception            (SomeAsyncException (..),+                                               SomeException (..), throw, try)+import           Control.Monad                (foldM, forM_)+import           Control.Monad.Reader         (ReaderT, ask, runReaderT)+import           Control.Monad.State          (StateT, get, modify, runStateT)+import           Control.Monad.Trans          (liftIO)+import           Control.Monad.Trans.Resource (runResourceT)+import           Data.List                    (isPrefixOf)+import qualified Data.Map.Lazy                as Map+import           Network.URI                  (unEscapeString)+import           System.Directory             (doesDirectoryExist,+                                               doesFileExist)+import           System.Exit                  (ExitCode (..))+import           System.FilePath              (takeDirectory, (</>))+import qualified Text.HTML.TagSoup            as TS+++--------------------------------------------------------------------------------+#ifdef CHECK_EXTERNAL+import           Data.List                    (intercalate)+import           Data.Typeable                (cast)+import           Data.Version                 (versionBranch)+import           GHC.Exts                     (fromString)+import qualified Network.HTTP.Conduit         as Http+import qualified Network.HTTP.Types           as Http+import qualified Paths_hakyll                 as Paths_hakyll+#endif+++--------------------------------------------------------------------------------+import           Hakyll.Core.Configuration+import           Hakyll.Core.Logger           (Logger)+import qualified Hakyll.Core.Logger           as Logger+import           Hakyll.Core.Util.File+import           Hakyll.Web.Html+++--------------------------------------------------------------------------------+data Check = All | InternalLinks+    deriving (Eq, Ord, Show)+++--------------------------------------------------------------------------------+check :: Configuration -> Logger -> Check -> IO ExitCode+check config logger check' = do+    ((), state) <- runChecker checkDestination config logger check'+    failed <- countFailedLinks state+    return $ if failed > 0 then ExitFailure 1 else ExitSuccess+++--------------------------------------------------------------------------------+countFailedLinks :: CheckerState -> IO Int+countFailedLinks state = foldM addIfFailure 0 (Map.elems state)+    where addIfFailure failures mvar = do+              checkerWrite <- readMVar mvar+              return $ failures + checkerFaulty checkerWrite+++--------------------------------------------------------------------------------+data CheckerRead = CheckerRead+    { checkerConfig :: Configuration+    , checkerLogger :: Logger+    , checkerCheck  :: Check+    }+++--------------------------------------------------------------------------------+data CheckerWrite = CheckerWrite+    { checkerFaulty :: Int+    , checkerOk     :: Int+    } deriving (Show)+++--------------------------------------------------------------------------------+instance Semigroup CheckerWrite where+    (<>) (CheckerWrite f1 o1) (CheckerWrite f2 o2) =+        CheckerWrite (f1 + f2) (o1 + o2)++instance Monoid CheckerWrite where+    mempty  = CheckerWrite 0 0+    mappend = (<>)+++--------------------------------------------------------------------------------+type CheckerState = Map.Map URL (MVar CheckerWrite)+++--------------------------------------------------------------------------------+type Checker a = ReaderT CheckerRead (StateT CheckerState IO) a+++--------------------------------------------------------------------------------+type URL = String+++--------------------------------------------------------------------------------+runChecker :: Checker a -> Configuration -> Logger -> Check+           -> IO (a, CheckerState)+runChecker checker config logger check' = do+    let read' = CheckerRead+                    { checkerConfig = config+                    , checkerLogger = logger+                    , checkerCheck  = check'+                    }+    Logger.flush logger+    runStateT (runReaderT checker read') Map.empty+++--------------------------------------------------------------------------------+checkDestination :: Checker ()+checkDestination = do+    config <- checkerConfig <$> ask+    files  <- liftIO $ getRecursiveContents+        (const $ return False) (destinationDirectory config)++    let htmls =+            [ destinationDirectory config </> file+            | file <- files+            , checkHtmlFile config file+            ]++    forM_ htmls checkFile+++--------------------------------------------------------------------------------+checkFile :: FilePath -> Checker ()+checkFile filePath = do+    logger   <- checkerLogger <$> ask+    contents <- liftIO $ readFile filePath+    Logger.header logger $ "Checking file " ++ filePath++    let urls = getUrls $ TS.parseTags contents+    forM_ urls $ \url -> do+        Logger.debug logger $ "Checking link " ++ url+        m <- liftIO newEmptyMVar+        checkUrlIfNeeded filePath (canonicalizeUrl url) m+    where+        -- Check scheme-relative links+        canonicalizeUrl url = if schemeRelative url then "http:" ++ url else url+        schemeRelative = isPrefixOf "//"+++--------------------------------------------------------------------------------+checkUrlIfNeeded :: FilePath -> URL -> MVar CheckerWrite -> Checker ()+checkUrlIfNeeded filepath url m = do+    logger     <- checkerLogger           <$> ask+    needsCheck <- (== All) . checkerCheck <$> ask+    checked    <- (url `Map.member`)      <$> get+    if not needsCheck || checked+        then Logger.debug logger "Already checked, skipping"+        else do modify $ Map.insert url m+                checkUrl filepath url+++--------------------------------------------------------------------------------+checkUrl :: FilePath -> URL -> Checker ()+checkUrl filePath url+    | isExternal url  = checkExternalUrl url+    | hasProtocol url = skip url $ Just "Unknown protocol, skipping"+    | otherwise       = checkInternalUrl filePath url+  where+    validProtoChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "+-."+    hasProtocol str = case break (== ':') str of+        (proto, ':' : _) -> all (`elem` validProtoChars) proto+        _                -> False+++--------------------------------------------------------------------------------+ok :: URL -> Checker ()+ok url = putCheckResult url mempty {checkerOk = 1}+++--------------------------------------------------------------------------------+skip :: URL -> Maybe String -> Checker ()+skip url maybeReason = do+    logger <- checkerLogger <$> ask+    case maybeReason of+        Nothing     -> return ()+        Just reason -> Logger.debug logger reason+    putCheckResult url mempty {checkerOk = 1}+++--------------------------------------------------------------------------------+faulty :: URL -> Maybe String -> Checker ()+faulty url reason = do+    logger <- checkerLogger <$> ask+    Logger.error logger $ "Broken link to " ++ show url ++ explanation+    putCheckResult url mempty {checkerFaulty = 1}+  where+    formatExplanation = (" (" ++) . (++ ")")+    explanation = maybe "" formatExplanation reason+++--------------------------------------------------------------------------------+putCheckResult :: URL -> CheckerWrite -> Checker ()+putCheckResult url result = do+    state <- get+    let maybeMVar = Map.lookup url state+    case maybeMVar of+        Just m -> liftIO $ putMVar m result+        Nothing -> do+            logger <- checkerLogger <$> ask+            Logger.debug logger "Failed to find existing entry for checked URL"+++--------------------------------------------------------------------------------+checkInternalUrl :: FilePath -> URL -> Checker ()+checkInternalUrl base url = case url' of+    "" -> ok url+    _  -> do+        config <- checkerConfig <$> ask+        let dest = destinationDirectory config+            dir  = takeDirectory base+            filePath+                | "/" `isPrefixOf` url' = dest ++ url'+                | otherwise             = dir </> url'++        exists <- checkFileExists filePath+        if exists then ok url else faulty url Nothing+  where+    url' = stripFragments $ unEscapeString url+++--------------------------------------------------------------------------------+checkExternalUrl :: URL -> Checker ()+#ifdef CHECK_EXTERNAL+checkExternalUrl url = do+    result <- requestExternalUrl url+    case result of+        Left (SomeException e) ->+            case (cast e :: Maybe SomeAsyncException) of+                Just ae -> throw ae+                _       -> faulty url (Just $ showException e)+        Right _ -> ok url+    where+        -- Convert exception to a concise form+        showException e = case cast e of+            Just (Http.HttpExceptionRequest _ e') -> show e'+            _                                     -> case words $ show e of+              w:_ -> w+              []  -> error "Hakyll.Check.checkExternalUrl: impossible"++requestExternalUrl :: URL -> Checker (Either SomeException Bool)+requestExternalUrl url = liftIO $ try $ do+    mgr <- Http.newManager Http.tlsManagerSettings+    runResourceT $ do+        request  <- Http.parseRequest url+        response <- Http.http (settings request) mgr+        let code = Http.statusCode (Http.responseStatus response)+        -- Recall that 3XX status codes are redirections, which aren't necessarily errors. +        return $ code >= 200 && code < 400+    where+        -- Add additional request info+        settings r = r+            { Http.method         = "HEAD"+            , Http.redirectCount  = 10+            , Http.requestHeaders = ("User-Agent", ua) : Http.requestHeaders r+            }++        -- Nice user agent info+        ua = fromString $ "hakyll-check/" +++             (intercalate "." $ map show $ versionBranch Paths_hakyll.version)+#else+checkExternalUrl url = skip url Nothing+#endif+++--------------------------------------------------------------------------------+-- | Wraps doesFileExist, also checks for index.html+checkFileExists :: FilePath -> Checker Bool+checkFileExists filePath = liftIO $ do+    file <- doesFileExist filePath+    dir  <- doesDirectoryExist filePath+    case (file, dir) of+        (True, _) -> return True+        (_, True) -> doesFileExist $ filePath </> "index.html"+        _         -> return False+++--------------------------------------------------------------------------------+stripFragments :: String -> String+stripFragments = takeWhile (not . flip elem ['?', '#'])
+ lib/Hakyll/Commands.hs view
@@ -0,0 +1,170 @@+ --------------------------------------------------------------------------------+-- | Implementation of Hakyll commands: build, preview...+{-# LANGUAGE CPP #-}+module Hakyll.Commands+    ( Check(..)+    , build+    , check+    , clean+    , preview+    , rebuild+    , server+    , deploy+    , watch+    ) where+++--------------------------------------------------------------------------------+import           Control.Concurrent+import           System.Exit                (ExitCode)+++--------------------------------------------------------------------------------+import           Hakyll.Check               (Check(..))+import qualified Hakyll.Check               as Check+import           Hakyll.Core.Configuration+import           Hakyll.Core.Logger         (Logger)+import qualified Hakyll.Core.Logger         as Logger+import           Hakyll.Core.Rules+import           Hakyll.Core.Rules.Internal+import           Hakyll.Core.Runtime+import           Hakyll.Core.Util.File+++--------------------------------------------------------------------------------+#ifdef WATCH_SERVER+import           Hakyll.Preview.Poll        (watchUpdates)+#endif++#ifdef PREVIEW_SERVER+import           Hakyll.Preview.Server+#endif++#ifdef mingw32_HOST_OS+import           Control.Monad              (void)+import           System.IO.Error            (catchIOError)+#endif+++--------------------------------------------------------------------------------+-- | Build the site+build :: RunMode -> Configuration -> Logger -> Rules a -> IO ExitCode+build mode conf logger rules = fst <$> run mode conf logger rules+++--------------------------------------------------------------------------------+-- | Run the checker and exit+check :: Configuration -> Logger -> Check.Check -> IO ExitCode+check = Check.check+++--------------------------------------------------------------------------------+-- | Remove the output directories+clean :: Configuration -> Logger -> IO ()+clean conf logger = do+    remove $ destinationDirectory conf+    remove $ storeDirectory conf+    remove $ tmpDirectory conf+  where+    remove dir = do+        Logger.header logger $ "Removing " ++ dir ++ "..."+        removeDirectory dir+++--------------------------------------------------------------------------------+-- | Preview the site+preview :: Configuration -> Logger -> Rules a -> Int -> IO ()+#ifdef PREVIEW_SERVER+preview conf logger rules port  = do+    deprecatedMessage+    watch conf logger "0.0.0.0" port True rules+  where+    deprecatedMessage = mapM_ putStrLn [ "The preview command has been deprecated."+                                       , "Use the watch command for recompilation and serving."+                                       ]+#else+preview _ _ _ _ = previewServerDisabled+#endif+++--------------------------------------------------------------------------------+-- | Watch and recompile for changes++watch :: Configuration -> Logger -> String -> Int -> Bool -> Rules a -> IO ()+#ifdef WATCH_SERVER+watch conf logger host port runServer rules = do+#ifndef mingw32_HOST_OS+    _ <- forkIO $ watchUpdates conf update+#else+    -- Force windows users to compile with -threaded flag, as otherwise+    -- thread is blocked indefinitely.+    catchIOError (void $ forkOS $ watchUpdates conf update) $ \_ -> do+        fail $ "Hakyll.Commands.watch: Could not start update watching " +++               "thread. Did you compile with -threaded flag?"+#endif+    server'+  where+    update = do+        (_, ruleSet) <- run RunModeNormal conf logger rules+        return $ rulesPattern ruleSet+    loop = threadDelay 100000 >> loop+    server' = if runServer then server conf logger host port else loop+#else+watch _ _ _ _ _ _ = watchServerDisabled+#endif++--------------------------------------------------------------------------------+-- | Rebuild the site+rebuild :: Configuration -> Logger -> Rules a -> IO ExitCode+rebuild conf logger rules =+    clean conf logger *> build RunModeNormal conf logger rules++--------------------------------------------------------------------------------+-- | Start a server+server :: Configuration -> Logger -> String -> Int -> IO ()+#ifdef PREVIEW_SERVER+server conf logger host port = do+    let settings = previewSettings conf $ destinationDirectory conf+    staticServer logger settings host port+#else+server _ _ _ _ = previewServerDisabled+#endif+++--------------------------------------------------------------------------------+-- | Upload the site+deploy :: Configuration -> IO ExitCode+deploy conf = deploySite conf conf+++--------------------------------------------------------------------------------+-- | Print a warning message about the preview serving not being enabled+#ifndef PREVIEW_SERVER+previewServerDisabled :: IO ()+previewServerDisabled = mapM_ putStrLn+    [ "PREVIEW SERVER"+    , ""+    , "The preview server is not enabled in this version of Hakyll. To enable"+    , "it, toggle the cabal configuration flag to True, for example by adding"+    , "the following to your `cabal.project` file:"+    , ""+    , "    constraints: hakyll +previewServer"+    , ""+    , "Alternatively, use an external tool to serve your site directory."+    ]+#endif++#ifndef WATCH_SERVER+watchServerDisabled :: IO ()+watchServerDisabled = mapM_ putStrLn+    [ "WATCH SERVER"+    , ""+    , "The watch server is not enabled in this version of Hakyll. To enable"+    , "it, toggle the cabal configuration flag to True, for example by adding"+    , "the following to your `cabal.project` file:"+    , ""+    , "    constraints: hakyll +watchServer"+    , ""+    , "Alternatively, use an external tool to serve your site directory."+    ]+#endif
+ lib/Hakyll/Core/Compiler.hs view
@@ -0,0 +1,232 @@+--------------------------------------------------------------------------------+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables        #-}+module Hakyll.Core.Compiler+    ( Compiler+    , getUnderlying+    , getUnderlyingExtension+    , makeItem+    , getRoute+    , getResourceBody+    , getResourceString+    , getResourceLBS+    , getResourceFilePath++    , Internal.Snapshot+    , saveSnapshot+    , Internal.load+    , Internal.loadSnapshot+    , Internal.loadBody+    , Internal.loadSnapshotBody+    , Internal.loadAll+    , Internal.loadAllSnapshots++    , cached+    , recompilingUnsafeCompiler+    , unsafeCompiler+    , debugCompiler+    , noResult+    , withErrorMessage+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad                 (unless, when, (>=>))+import           Data.Binary                   (Binary)+import           Data.ByteString.Lazy          (ByteString)+import qualified Data.List.NonEmpty            as NonEmpty+import           Data.Typeable                 (Typeable)+import           System.Environment            (getProgName)+import           System.FilePath               (takeExtension)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler.Internal+import qualified Hakyll.Core.Compiler.Require  as Internal+import           Hakyll.Core.Dependencies+import           Hakyll.Core.Identifier+import           Hakyll.Core.Item+import           Hakyll.Core.Logger            as Logger+import           Hakyll.Core.Provider+import           Hakyll.Core.Routes+import qualified Hakyll.Core.Store             as Store+++--------------------------------------------------------------------------------+-- | Get the underlying identifier.+getUnderlying :: Compiler Identifier+getUnderlying = compilerUnderlying <$> compilerAsk+++--------------------------------------------------------------------------------+-- | Get the extension of the underlying identifier. Returns something like+-- @".html"@+getUnderlyingExtension :: Compiler String+getUnderlyingExtension = takeExtension . toFilePath <$> getUnderlying+++--------------------------------------------------------------------------------+-- | Create an item from the underlying identifier and a given value.+makeItem :: a -> Compiler (Item a)+makeItem x = do+    identifier <- getUnderlying+    return $ Item identifier x+++--------------------------------------------------------------------------------+-- | Get the route for a specified item+getRoute :: Identifier -> Compiler (Maybe FilePath)+getRoute identifier = do+    provider <- compilerProvider <$> compilerAsk+    routes   <- compilerRoutes <$> compilerAsk+    -- Note that this makes us dependend on that identifier: when the metadata+    -- of that item changes, the route may change, hence we have to recompile+    (mfp, um) <- compilerUnsafeIO $ runRoutes routes provider identifier+    when um $ compilerTellDependencies [metadataDependency $ IdentifierDependency identifier]+    return mfp+++--------------------------------------------------------------------------------+-- | Get the full contents of the matched source file as a string,+-- but without metadata preamble, if there was one.+getResourceBody :: Compiler (Item String)+getResourceBody = getResourceWith resourceBody+++--------------------------------------------------------------------------------+-- | Get the full contents of the matched source file as a string.+getResourceString :: Compiler (Item String)+getResourceString = getResourceWith resourceString+++--------------------------------------------------------------------------------+-- | Get the full contents of the matched source file as a lazy bytestring.+getResourceLBS :: Compiler (Item ByteString)+getResourceLBS = getResourceWith resourceLBS+++--------------------------------------------------------------------------------+-- | Get the file path of the resource we are compiling+getResourceFilePath :: Compiler FilePath+getResourceFilePath = do+    provider <- compilerProvider   <$> compilerAsk+    id'      <- compilerUnderlying <$> compilerAsk+    return $ resourceFilePath provider id'+++--------------------------------------------------------------------------------+-- | Overloadable function for 'getResourceString' and 'getResourceLBS'+getResourceWith :: (Provider -> Identifier -> IO a) -> Compiler (Item a)+getResourceWith reader = do+    provider <- compilerProvider   <$> compilerAsk+    id'      <- compilerUnderlying <$> compilerAsk+    let filePath = toFilePath id'+    if resourceExists provider id'+        then compilerUnsafeIO $ Item id' <$> reader provider id'+        else fail $ error' filePath+  where+    error' fp = "Hakyll.Core.Compiler.getResourceWith: resource " +++        show fp ++ " not found"+++--------------------------------------------------------------------------------+-- | Save a snapshot of the item. This function returns the same item, which+-- convenient for building '>>=' chains.+saveSnapshot :: (Binary a, Typeable a)+             => Internal.Snapshot -> Item a -> Compiler (Item a)+saveSnapshot snapshot item = do+    store  <- compilerStore <$> compilerAsk+    logger <- compilerLogger <$> compilerAsk+    compilerUnsafeIO $ do+        Logger.debug logger $ "Storing snapshot: " ++ snapshot+        Internal.saveSnapshot store snapshot item++    -- Signal that we saved the snapshot.+    Compiler $ \_ -> return $ CompilerSnapshot snapshot (return item)+++--------------------------------------------------------------------------------+-- | Turn on caching for a compilation value to avoid recomputing it+-- on subsequent Hakyll runs.+-- The storage key consists of the underlying identifier of the compiled+-- ressource and the given name.+cached :: (Binary a, Typeable a)+       => String+       -> Compiler a+       -> Compiler a+cached name compiler = do+    id'      <- compilerUnderlying <$> compilerAsk+    store    <- compilerStore      <$> compilerAsk+    provider <- compilerProvider   <$> compilerAsk++    -- Give a better error message when the resource is not there at all.+    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 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! " +++         "Try running: " ++ progName ++ " clean"++    itDoesntEvenExist id' =+        "Hakyll.Core.Compiler.cached: You are trying to (perhaps "    +++        "indirectly) use `cached` on a non-existing resource: there " +++        "is no file backing " ++ show id'+++--------------------------------------------------------------------------------+-- | 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] }+++--------------------------------------------------------------------------------+-- | Fail so that it is treated as non-defined in an @\$if()\$@ branching+-- "Hakyll.Web.Template" macro, and alternative+-- 'Hakyll.Web.Template.Context.Context's are tried+--+-- @since 4.13.0+noResult :: String -> Compiler a+noResult = compilerNoResult . return+++--------------------------------------------------------------------------------+-- | Prepend an error line to the error, if there is one.  This allows you to+-- add helpful context to error messages.+--+-- @since 4.13.0+withErrorMessage :: String -> Compiler a -> Compiler a+withErrorMessage x = do+    compilerTry >=> either (compilerResult . CompilerError . prepend) return+  where+    prepend (CompilationFailure  es) = CompilationFailure  (x `NonEmpty.cons` es)+    prepend (CompilationNoResult es) = CompilationNoResult (x : es)+++--------------------------------------------------------------------------------+-- | Compiler for debugging purposes.+-- Passes a message to the debug logger that is printed in verbose mode.+debugCompiler :: String -> Compiler ()+debugCompiler msg = do+    logger <- compilerLogger <$> compilerAsk+    compilerUnsafeIO $ Logger.debug logger msg
+ lib/Hakyll/Core/Compiler/Internal.hs view
@@ -0,0 +1,364 @@+--------------------------------------------------------------------------------+-- | Internally used compiler module+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+module Hakyll.Core.Compiler.Internal+    ( -- * Types+      Snapshot+    , CompilerRead (..)+    , CompilerWrite (..)+    , CompilerErrors (..)+    , CompilerResult (..)+    , Compiler (..)+    , runCompiler++      -- * Core operations+    , compilerResult+    , compilerTell+    , compilerAsk+    , compilerUnsafeIO++      -- * Error operations+    , compilerThrow+    , compilerNoResult+    , compilerCatch+    , compilerTry+    , compilerErrorMessages++      -- * Utilities+    , compilerDebugEntries+    , compilerTellDependencies+    , compilerTellCacheHits+    ) where+++--------------------------------------------------------------------------------+import           Control.Applicative            (Alternative (..))+import           Control.Exception              (SomeException, handle)+import           Control.Monad                  (forM, forM_)+import qualified Control.Monad.Fail             as Fail+import           Control.Monad.Except           (MonadError (..))+import           Data.List.NonEmpty             (NonEmpty (..))+import qualified Data.List.NonEmpty             as NonEmpty+import           Data.Set                       (Set)+import qualified Data.Set                       as S+++--------------------------------------------------------------------------------+import           Hakyll.Core.Configuration+import           Hakyll.Core.Dependencies+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern+import qualified Hakyll.Core.Logger             as Logger+import           Hakyll.Core.Metadata+import           Hakyll.Core.Provider+import           Hakyll.Core.Routes+import           Hakyll.Core.Store+++--------------------------------------------------------------------------------+-- | Whilst compiling an item, it possible to save multiple snapshots of it, and+-- not just the final result.+type Snapshot = String+++--------------------------------------------------------------------------------+-- | Environment in which a compiler runs+data CompilerRead = CompilerRead+    { -- | Main configuration+      compilerConfig     :: Configuration+    , -- | Underlying identifier+      compilerUnderlying :: Identifier+    , -- | Resource provider+      compilerProvider   :: Provider+    , -- | List of all known identifiers+      compilerUniverse   :: Set Identifier+    , -- | Site routes+      compilerRoutes     :: Routes+    , -- | Compiler store+      compilerStore      :: Store+    , -- | Logger+      compilerLogger     :: Logger.Logger+    }+++--------------------------------------------------------------------------------+data CompilerWrite = CompilerWrite+    { compilerDependencies :: [Dependency]+    , compilerCacheHits    :: Int+    } deriving (Show)+++--------------------------------------------------------------------------------+instance Semigroup CompilerWrite where+    (<>) (CompilerWrite d1 h1) (CompilerWrite d2 h2) =+        CompilerWrite (d1 ++ d2) (h1 + h2)++instance Monoid CompilerWrite where+    mempty  = CompilerWrite [] 0+    mappend = (<>)+++--------------------------------------------------------------------------------+-- | Distinguishes reasons in a 'CompilerError'+data CompilerErrors a+    -- | One or more exceptions occured during compilation+    = CompilationFailure (NonEmpty a)+    -- | Absence of any result, most notably in template contexts.  May still+    -- have error messages.+    | CompilationNoResult [a]+    deriving Functor+++-- | Unwrap a `CompilerErrors`+compilerErrorMessages :: CompilerErrors a -> [a]+compilerErrorMessages (CompilationFailure x)  = NonEmpty.toList x+compilerErrorMessages (CompilationNoResult x) = x+++--------------------------------------------------------------------------------+-- | An intermediate result of a compilation step+data CompilerResult a+    = CompilerDone a CompilerWrite+    | CompilerSnapshot Snapshot (Compiler a)+    | CompilerRequire [(Identifier, Snapshot)] (Compiler a)+    | CompilerError (CompilerErrors String)+++--------------------------------------------------------------------------------+-- | A monad which lets you compile items and takes care of dependency tracking+-- for you.+newtype Compiler a = Compiler+    { unCompiler :: CompilerRead -> IO (CompilerResult a)+    }+++--------------------------------------------------------------------------------+instance Functor Compiler where+    fmap f (Compiler c) = Compiler $ \r -> do+        res <- c r+        return $ case res of+            CompilerDone x w      -> CompilerDone (f x) w+            CompilerSnapshot s c' -> CompilerSnapshot s (fmap f c')+            CompilerRequire i c'  -> CompilerRequire i (fmap f c')+            CompilerError e       -> CompilerError e+    {-# INLINE fmap #-}+++--------------------------------------------------------------------------------+instance Monad Compiler where+    return = pure+    {-# INLINE return #-}++    Compiler c >>= f = Compiler $ \r -> do+        res <- c r+        case res of+            CompilerDone x w    -> do+                res' <- unCompiler (f x) r+                return $ case res' of+                    CompilerDone y w'     -> CompilerDone y (w `mappend` w')+                    CompilerSnapshot s c' -> CompilerSnapshot s $ do+                        compilerTell w  -- Save dependencies!+                        c'+                    CompilerRequire i c'  -> CompilerRequire i $ do+                        compilerTell w  -- Save dependencies!+                        c'+                    CompilerError e       -> CompilerError e++            CompilerSnapshot s c' -> return $ CompilerSnapshot s (c' >>= f)+            CompilerRequire i c'  -> return $ CompilerRequire i (c' >>= f)+            CompilerError e       -> return $ CompilerError e+    {-# INLINE (>>=) #-}++#if !(MIN_VERSION_base(4,13,0))+    fail = Fail.fail+    {-# INLINE fail #-}+#endif++instance Fail.MonadFail Compiler where+    fail = compilerThrow . return+    {-# INLINE fail #-}++--------------------------------------------------------------------------------+instance Applicative Compiler where+    pure x = compilerResult $ CompilerDone x mempty+    {-# INLINE pure #-}++    f <*> x = f >>= \f' -> fmap f' x+    {-# INLINE (<*>) #-}+++--------------------------------------------------------------------------------+-- | Access provided metadata from anywhere+instance MonadMetadata Compiler where+    getMetadata = compilerGetMetadata+    getMatches  = compilerGetMatches KindContent+    getAllMetadata pattern = do+        matches' <- compilerGetMatches KindMetadata pattern+        forM matches' $ \id' -> do+            metadata <- getMetadata id'+            return (id', metadata)+++--------------------------------------------------------------------------------+-- | Compilation may fail with multiple error messages.+-- 'catchError' handles errors from 'throwError', 'fail' and 'Hakyll.Core.Compiler.noResult'+instance MonadError [String] Compiler where+    throwError = compilerThrow+    catchError c = compilerCatch c . (. compilerErrorMessages)+++--------------------------------------------------------------------------------+-- | Like 'unCompiler' but treating IO exceptions as 'CompilerError's+runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)+runCompiler compiler read' = handle handler $ unCompiler compiler read'+  where+    handler :: SomeException -> IO (CompilerResult a)+    handler e = return $ CompilerError $ CompilationFailure $ show e :| []+++--------------------------------------------------------------------------------+-- | Trying alternative compilers if the first fails, regardless whether through+-- 'fail', 'throwError' or 'Hakyll.Core.Compiler.noResult'.+-- Aggregates error messages if all fail.+instance Alternative Compiler where+    empty   = compilerNoResult []+    x <|> y = x `compilerCatch` (\rx -> y `compilerCatch` (\ry ->+        case (rx, ry) of+          (CompilationFailure xs,  CompilationFailure ys)  ->+            compilerThrow $ NonEmpty.toList xs ++ NonEmpty.toList ys+          (CompilationFailure xs,  CompilationNoResult ys) ->+            debug ys >> compilerThrow (NonEmpty.toList xs)+          (CompilationNoResult xs, CompilationFailure ys)  ->+            debug xs >> compilerThrow (NonEmpty.toList ys)+          (CompilationNoResult xs, CompilationNoResult ys) -> compilerNoResult $ xs ++ ys+        ))+      where+        debug = compilerDebugEntries "Hakyll.Core.Compiler.Internal: Alternative fail suppressed"+    {-# INLINE (<|>) #-}+++--------------------------------------------------------------------------------+-- | Put the result back in a compiler+compilerResult :: CompilerResult a -> Compiler a+compilerResult x = Compiler $ \_ -> return x+{-# INLINE compilerResult #-}+++--------------------------------------------------------------------------------+-- | Get the current environment+compilerAsk :: Compiler CompilerRead+compilerAsk = Compiler $ \r -> return $ CompilerDone r mempty+{-# INLINE compilerAsk #-}+++--------------------------------------------------------------------------------+-- | Put a 'CompilerWrite'+compilerTell :: CompilerWrite -> Compiler ()+compilerTell = compilerResult . CompilerDone ()+{-# INLINE compilerTell #-}+++--------------------------------------------------------------------------------+-- | Run an IO computation without dependencies in a Compiler+compilerUnsafeIO :: IO a -> Compiler a+compilerUnsafeIO io = Compiler $ \_ -> do+    x <- io+    return $ CompilerDone x mempty+{-# INLINE compilerUnsafeIO #-}+++--------------------------------------------------------------------------------+-- | Throw errors in the 'Compiler'.+--+-- If no messages are given, this is considered a 'CompilationNoResult' error.+-- Otherwise, it is treated as a proper compilation failure.+compilerThrow :: [String] -> Compiler a+compilerThrow = compilerResult . CompilerError .+    maybe (CompilationNoResult []) CompilationFailure .+    NonEmpty.nonEmpty++-- | Put a 'CompilerError' with  multiple messages as 'CompilationNoResult'+compilerNoResult :: [String] -> Compiler a+compilerNoResult = compilerResult . CompilerError . CompilationNoResult+++--------------------------------------------------------------------------------+-- | Allows to distinguish 'CompilerError's and branch on them with 'Either'+--+-- prop> compilerTry = (`compilerCatch` return . Left) . fmap Right+compilerTry :: Compiler a -> Compiler (Either (CompilerErrors String) a)+compilerTry (Compiler x) = Compiler $ \r -> do+    res <- x r+    case res of+        CompilerDone res' w  -> return (CompilerDone (Right res') w)+        CompilerSnapshot s c -> return (CompilerSnapshot s (compilerTry c))+        CompilerRequire i c  -> return (CompilerRequire i (compilerTry c))+        CompilerError e      -> return (CompilerDone (Left e) mempty)+{-# INLINE compilerTry #-}+++--------------------------------------------------------------------------------+-- | Allows you to recover from 'CompilerError's.+-- Uses the same parameter order as 'catchError' so that it can be used infix.+--+-- prop> c `compilerCatch` f = compilerTry c >>= either f return+compilerCatch :: Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a+compilerCatch (Compiler x) f = Compiler $ \r -> do+    res <- x r+    case res of+        CompilerDone res' w  -> return (CompilerDone res' w)+        CompilerSnapshot s c -> return (CompilerSnapshot s (compilerCatch c f))+        CompilerRequire i c  -> return (CompilerRequire i (compilerCatch c f))+        CompilerError e      -> unCompiler (f e) r+{-# INLINE compilerCatch #-}+++--------------------------------------------------------------------------------+compilerDebugLog :: [String] -> Compiler ()+compilerDebugLog ms = do+  logger <- compilerLogger <$> compilerAsk+  compilerUnsafeIO $ forM_ ms $ Logger.debug logger++--------------------------------------------------------------------------------+-- | Pass a list of messages with a heading to the debug logger+compilerDebugEntries :: String -> [String] -> Compiler ()+compilerDebugEntries msg = compilerDebugLog . (msg:) . map indent+  where+    indent = unlines . map ("    "++) . lines+++--------------------------------------------------------------------------------+compilerTellDependencies :: [Dependency] -> Compiler ()+compilerTellDependencies ds = do+  compilerDebugLog $ map (\d ->+      "Hakyll.Core.Compiler.Internal: Adding dependency: " ++ show d) ds+  compilerTell mempty {compilerDependencies = ds}+{-# INLINE compilerTellDependencies #-}+++--------------------------------------------------------------------------------+compilerTellCacheHits :: Int -> Compiler ()+compilerTellCacheHits ch = compilerTell mempty {compilerCacheHits = ch}+{-# INLINE compilerTellCacheHits #-}+++--------------------------------------------------------------------------------+compilerGetMetadata :: Identifier -> Compiler Metadata+compilerGetMetadata identifier = do+    provider <- compilerProvider <$> compilerAsk+    compilerTellDependencies [metadataDependency $ IdentifierDependency identifier]+    compilerUnsafeIO $ resourceMetadata provider identifier+++--------------------------------------------------------------------------------+compilerGetMatches :: DependencyKind -> Pattern -> Compiler [Identifier]+compilerGetMatches kind pattern = do+    universe <- compilerUniverse <$> compilerAsk+    let matching = S.filter (matches pattern) universe+    compilerTellDependencies [Dependency kind $ PatternDependency pattern matching]+    pure $ S.toList matching
+ lib/Hakyll/Core/Compiler/Require.hs view
@@ -0,0 +1,137 @@+--------------------------------------------------------------------------------+module Hakyll.Core.Compiler.Require+    ( Snapshot+    , save+    , saveSnapshot+    , load+    , loadSnapshot+    , loadBody+    , loadSnapshotBody+    , loadAll+    , loadAllSnapshots+    ) where+++--------------------------------------------------------------------------------+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+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler.Internal+import           Hakyll.Core.Dependencies+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern+import           Hakyll.Core.Item+import           Hakyll.Core.Metadata+import           Hakyll.Core.Store              (Store)+import qualified Hakyll.Core.Store              as Store+++--------------------------------------------------------------------------------+save :: (Binary a, Typeable a) => Store -> Item a -> IO ()+save store item = saveSnapshot store final item+++--------------------------------------------------------------------------------+-- | Save a specific snapshot of an item, so you can load it later using+-- 'loadSnapshot'.+saveSnapshot :: (Binary a, Typeable a)+             => Store -> Snapshot -> Item a -> IO ()+saveSnapshot store snapshot item =+    Store.set store (key (itemIdentifier item) snapshot) (itemBody item)+++--------------------------------------------------------------------------------+-- | Load an item compiled elsewhere. If the required item is not yet compiled,+-- the build system will take care of that automatically.+load :: (Binary a, Typeable a) => Identifier -> Compiler (Item a)+load id' = loadSnapshot id' final+++--------------------------------------------------------------------------------+-- | Require a specific snapshot of an item.+loadSnapshot :: (Binary a, Typeable a)+             => Identifier -> Snapshot -> Compiler (Item a)+loadSnapshot id' snapshot =+    fmap runIdentity $ loadSnapshotCollection (Identity (id', snapshot))+++--------------------------------------------------------------------------------+-- | A shortcut for only requiring the body of an item.+--+-- > loadBody = fmap itemBody . load+loadBody :: (Binary a, Typeable a) => Identifier -> Compiler a+loadBody id' = loadSnapshotBody id' final+++--------------------------------------------------------------------------------+-- | A shortcut for only requiring the body for a specific snapshot of an item+loadSnapshotBody :: (Binary a, Typeable a)+                 => Identifier -> Snapshot -> Compiler a+loadSnapshotBody id' snapshot = fmap itemBody $ loadSnapshot id' snapshot+++--------------------------------------------------------------------------------+-- | This function allows you to 'load' a dynamic list of items+loadAll :: (Binary a, Typeable a) => Pattern -> Compiler [Item a]+loadAll pattern = loadAllSnapshots pattern final+++--------------------------------------------------------------------------------+-- | Load a specific snapshot for each of dynamic list of items+loadAllSnapshots :: (Binary a, Typeable a)+                 => Pattern -> Snapshot -> Compiler [Item a]+loadAllSnapshots pattern snapshot = do+    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 $ contentDependency . 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+++--------------------------------------------------------------------------------+key :: Identifier -> String -> [String]+key identifier snapshot =+    ["Hakyll.Core.Compiler.Require", show identifier, snapshot]+++--------------------------------------------------------------------------------+final :: Snapshot+final = "_final"
+ lib/Hakyll/Core/Configuration.hs view
@@ -0,0 +1,165 @@+--------------------------------------------------------------------------------+-- | Exports a datastructure for the top-level hakyll configuration+module Hakyll.Core.Configuration+    ( Configuration (..)+    , shouldIgnoreFile+    , shouldWatchIgnore+    , defaultConfiguration+    ) where+++--------------------------------------------------------------------------------+import           Data.Default     (Default (..))+import           Data.List        (isPrefixOf, isSuffixOf)+import qualified Network.Wai.Application.Static as Static+import           System.Directory (canonicalizePath)+import           System.Exit      (ExitCode)+import           System.FilePath  (isAbsolute, makeRelative, normalise,+                                   takeExtension, takeFileName)+import           System.IO.Error  (catchIOError)+import           System.Process   (system)+++--------------------------------------------------------------------------------+data Configuration = Configuration+    { -- | Directory in which the output written+      destinationDirectory :: FilePath+    , -- | Directory where hakyll's internal store is kept+      storeDirectory       :: FilePath+    , -- | Directory in which some temporary files will be kept+      tmpDirectory         :: FilePath+    , -- | Directory where hakyll finds the files to compile. This is @.@ by+      -- default.+      providerDirectory    :: FilePath+    , -- | Function to determine ignored files+      --+      -- In 'defaultConfiguration', the following files are ignored:+      --+      -- * files starting with a @.@+      --+      -- * files starting with a @#@+      --+      -- * files ending with a @~@+      --+      -- * files ending with @.swp@+      --+      -- Note that the files in 'destinationDirectory' and 'storeDirectory' will+      -- also be ignored. Note that this is the configuration parameter, if you+      -- want to use the test, you should use 'shouldIgnoreFile'.+      --+      ignoreFile           :: FilePath -> Bool+    , -- | Function to determine HTML files whose links are to be checked.+      --+      -- In 'defaultConfiguration', files with the @.html@ extension are checked.+      checkHtmlFile        :: FilePath -> Bool+    , -- | Function to determine files and directories that should not trigger+      -- a rebuild when touched in watch mode.+      --+      -- Paths are passed in relative to the providerDirectory.+      --+      -- All files that are ignored by 'ignoreFile' are also always ignored by+      -- 'watchIgnore'.+      watchIgnore          :: FilePath -> Bool+    , -- | Here, you can plug in a system command to upload/deploy your site.+      --+      -- Example:+      --+      -- > rsync -ave 'ssh -p 2217' _site jaspervdj@jaspervdj.be:hakyll+      --+      -- You can execute this by using+      --+      -- > ./site deploy+      --+      deployCommand        :: String+    , -- | Function to deploy the site from Haskell.+      --+      -- By default, this command executes the shell command stored in+      -- 'deployCommand'. If you override it, 'deployCommand' will not+      -- be used implicitely.+      --+      -- The 'Configuration' object is passed as a parameter to this+      -- function.+      --+      deploySite           :: Configuration -> IO ExitCode+    , -- | Use an in-memory cache for items. This is faster but uses more+      -- memory.+      inMemoryCache        :: Bool+    , -- | Override default host for preview server. Default is "127.0.0.1",+      -- which binds only on the loopback address.+      -- One can also override the host as a command line argument:+      -- ./site preview -h "0.0.0.0"+      previewHost          :: String+    , -- | Override default port for preview server. Default is 8000.+      -- One can also override the port as a command line argument:+      -- ./site preview -p 1234+      previewPort          :: Int+    , -- | Override other settings used by the preview server. Default is+      -- 'Static.defaultFileServerSettings'.+      previewSettings      :: FilePath -> Static.StaticSettings+    }++--------------------------------------------------------------------------------+instance Default Configuration where+    def = defaultConfiguration++--------------------------------------------------------------------------------+-- | Default configuration for a hakyll application+defaultConfiguration :: Configuration+defaultConfiguration = Configuration+    { destinationDirectory = "_site"+    , storeDirectory       = "_cache"+    , tmpDirectory         = "_cache/tmp"+    , providerDirectory    = "."+    , ignoreFile           = ignoreFile'+    , checkHtmlFile        = flip elem [".html", ".xhtml"] . takeExtension+    , watchIgnore          = const False+    , deployCommand        = "echo 'No deploy command specified' && exit 1"+    , deploySite           = system . deployCommand+    , inMemoryCache        = True+    , previewHost          = "127.0.0.1"+    , previewPort          = 8000+    , previewSettings      = Static.defaultFileServerSettings+    }+  where+    ignoreFile' path+        | "."    `isPrefixOf` fileName = True+        | "#"    `isPrefixOf` fileName = True+        | "~"    `isSuffixOf` fileName = True+        | ".swp" `isSuffixOf` fileName = True+        | otherwise                    = False+      where+        fileName = takeFileName path+++--------------------------------------------------------------------------------+-- | Check if a file should be ignored+shouldIgnoreFile :: Configuration -> FilePath -> IO Bool+shouldIgnoreFile conf path = orM+    [ inDir ("dist-newstyle") -- build directory for cabal-install+    , inDir (".stack-work")   -- build directory for stack+    , inDir (destinationDirectory conf)+    , inDir (storeDirectory conf)+    , inDir (tmpDirectory conf)+    , return (ignoreFile conf path')+    ]+  where+    path'    = normalise path+    absolute = isAbsolute path++    inDir dir+        | absolute  = do+            dir' <- catchIOError (canonicalizePath dir) (const $ return dir)+            return $ dir' `isPrefixOf` path'+        | otherwise = return $ dir `isPrefixOf` path'++    orM :: [IO Bool] -> IO Bool+    orM []       = return False+    orM (x : xs) = x >>= \b -> if b then return True else orM xs++-- | Returns a function to check if a file should be ignored in watch mode+shouldWatchIgnore :: Configuration -> IO (FilePath -> IO Bool)+shouldWatchIgnore conf = do+    fullProviderDir <- canonicalizePath $ providerDirectory conf+    return (\path ->+              let path' = makeRelative fullProviderDir path+              in (|| watchIgnore conf path') <$> shouldIgnoreFile conf path)
+ lib/Hakyll/Core/Dependencies.hs view
@@ -0,0 +1,237 @@+--------------------------------------------------------------------------------+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TupleSections #-}+module Hakyll.Core.Dependencies+    ( Dependency (..)+    , DependencySelector (..)+    , DependencyKind (..)+    , DependencyFacts+    , outOfDate+    , contentDependency+    , metadataDependency+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad                  (foldM, forM_, unless, when)+import           Control.Monad.Reader           (ask)+import           Control.Monad.RWS              (RWS, runRWS)+import qualified Control.Monad.State            as State+import           Control.Monad.Writer           (tell)+import           Data.Binary                    (Binary (..), getWord8,+                                                 putWord8)+import           Data.Functor                   ((<&>))+import           Data.List                      (find)+import           Data.Map                       (Map)+import qualified Data.Map                       as M+import           Data.Maybe                     (fromMaybe)+import           Data.Set                       (Set)+import qualified Data.Set                       as S+import           Data.Typeable                  (Typeable)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern+++--------------------------------------------------------------------------------+data DependencySelector+    = PatternDependency Pattern (Set Identifier)+    | IdentifierDependency Identifier+    deriving (Show, Typeable)++--------------------------------------------------------------------------------+instance Binary DependencySelector where+    put (PatternDependency p is) = putWord8 0 >> put p >> put is+    put (IdentifierDependency i) = putWord8 1 >> put i+    get = getWord8 >>= \t -> case t of+        0 -> PatternDependency <$> get <*> get+        1 -> IdentifierDependency <$> get+        _ -> fail "Data.Binary.get: Invalid DependencySelector"+++--------------------------------------------------------------------------------+-- | A data type representing a dependency on another 'Identifier'. We can+-- depend either on the 'Hakyll.Core.Metadata.Metadata' or the entire content of+-- the underlying file. This is signified by the supplied 'DependencyKind'.+data Dependency+    = Dependency DependencyKind DependencySelector+    | AlwaysOutOfDate+    deriving (Show, Typeable)+++--------------------------------------------------------------------------------+-- | Utility function to create a new content dependency.+contentDependency :: DependencySelector -> Dependency+contentDependency = Dependency KindContent++-- | Utility function to a create a new metadata dependency.+metadataDependency :: DependencySelector -> Dependency+metadataDependency = Dependency KindMetadata+++--------------------------------------------------------------------------------+instance Binary Dependency where+    put AlwaysOutOfDate = putWord8 2+    put (Dependency k s) = putWord8 3 >> put k >> put s++    get = getWord8 >>= \t -> case t of+        -- XXX: Backwards compatability with Hakyll <=4.16.7.1.+        0 -> (\p i -> contentDependency $ PatternDependency p i) <$> get <*> get+        1 -> contentDependency . IdentifierDependency <$> get++        2 -> pure AlwaysOutOfDate+        3 -> Dependency <$> get <*> get+        _ -> fail "Data.Binary.get: Invalid Dependency"+++--------------------------------------------------------------------------------+type DependencyFacts = Map Identifier [Dependency]+++--------------------------------------------------------------------------------+outOfDate+    :: [Identifier]     -- ^ All known identifiers+    -> Set Identifier   -- ^ Changed content+    -> Set Identifier   -- ^ Changed metadata+    -> DependencyFacts  -- ^ Old dependency facts+    -> (Set Identifier, DependencyFacts, [String])+outOfDate universe ood oodMeta oldFacts =+    let (_, state, logs) = runRWS rws universe (DependencyState oldFacts ood oodMeta)+    in (dependencyOod state, dependencyFacts state, logs)+  where+    rws = do+        checkNew+        checkChangedPatterns+        bruteForce+++--------------------------------------------------------------------------------+data DependencyState = DependencyState+    { dependencyFacts   :: DependencyFacts+    , dependencyOod     :: Set Identifier+    , dependencyOodMeta :: Set Identifier+    } deriving (Show)+++--------------------------------------------------------------------------------+type DependencyM a = RWS [Identifier] [String] DependencyState a+++--------------------------------------------------------------------------------+markOod :: Identifier -> DependencyM ()+markOod id' = State.modify $ \s ->+    s {dependencyOod = S.insert id' $ dependencyOod s}+++--------------------------------------------------------------------------------+data DependencyKind = KindContent | KindMetadata+  deriving (Show)++instance Binary DependencyKind where+  put KindContent = putWord8 0+  put KindMetadata = putWord8 1++  get = getWord8 >>= \t -> case t of+      0 -> pure KindContent+      1 -> pure KindMetadata+      _ -> fail "Data.Binary.get: Invalid DependencyKind"++--------------------------------------------------------------------------------+-- | Collection of dependencies that should be checked to determine+-- if an identifier needs rebuilding.+data Dependencies+  = DependsOn [(DependencyKind, 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 $ foldMap dependenciesFor' $ fromMaybe [] $ M.lookup id' facts+  where+    dependenciesForSelector (IdentifierDependency i) = [i]+    dependenciesForSelector (PatternDependency _ is) = S.toList is++    dependenciesFor' AlwaysOutOfDate            = MustRebuild+    dependenciesFor' (Dependency kind selector) = DependsOn $+        map (kind,) $ dependenciesForSelector selector+++--------------------------------------------------------------------------------+checkNew :: DependencyM ()+checkNew = do+    universe <- ask+    facts    <- dependencyFacts <$> State.get+    forM_ universe $ \id' -> unless (id' `M.member` facts) $ do+        tell [show id' ++ " is out-of-date because it is new"]+        markOod id'+++--------------------------------------------------------------------------------+checkChangedPatterns :: DependencyM ()+checkChangedPatterns = do+    facts <- M.toList . dependencyFacts <$> State.get+    forM_ facts $ \(id', deps) -> do+        deps' <- foldM (go id') [] deps+        State.modify $ \s -> s+            {dependencyFacts = M.insert id' deps' $ dependencyFacts s}+  where+    go' _   (IdentifierDependency i) = return $ IdentifierDependency i+    go' id' (PatternDependency p ls) = do+        universe <- ask+        let ls' = S.fromList $ filterMatches p universe+        if ls == ls'+            then return $ PatternDependency p ls+            else do+                tell [show id' ++ " is out-of-date because a pattern changed"]+                markOod id'+                return $ PatternDependency p ls'++    go _   ds AlwaysOutOfDate          = return $ AlwaysOutOfDate : ds+    go id' ds (Dependency kind select) = (Dependency kind <$> go' id' select) <&> (: ds)+++--------------------------------------------------------------------------------+bruteForce :: DependencyM ()+bruteForce = do+    todo <- ask+    go todo+  where+    go todo = do+        (todo', changed) <- foldM check ([], False) todo+        when changed (go todo')++    findOod oodContent oodMetadata (k, i)+      = S.member i $+          case k of+            KindContent  -> oodContent+            KindMetadata -> oodMetadata++    check (todo, changed) id' = do+        deps <- dependenciesFor id'+        case deps of+          DependsOn depList -> do+            ood     <- dependencyOod <$> State.get+            oodMeta <- dependencyOodMeta <$> State.get+            case find (findOod ood oodMeta) 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)
+ lib/Hakyll/Core/File.hs view
@@ -0,0 +1,93 @@+--------------------------------------------------------------------------------+-- | Exports simple compilers to just copy files+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Hakyll.Core.File+    ( CopyFile (..)+    , copyFileCompiler+    , TmpFile (..)+    , newTmpFile+    ) where+++--------------------------------------------------------------------------------+import           Data.Binary                   (Binary (..))+import           Data.Typeable                 (Typeable)+#if MIN_VERSION_directory(1,2,6)+import           System.Directory              (copyFileWithMetadata)+#else+import           System.Directory              (copyFile)+#endif+import           System.Directory              (doesFileExist,+                                                renameFile)+import           System.FilePath               ((</>))+import           System.Random                 (randomIO)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Compiler.Internal+import           Hakyll.Core.Configuration+import           Hakyll.Core.Item+import           Hakyll.Core.Provider+import qualified Hakyll.Core.Store             as Store+import           Hakyll.Core.Util.File+import           Hakyll.Core.Writable+++--------------------------------------------------------------------------------+-- | This will copy any file directly by using a system call+newtype CopyFile = CopyFile FilePath+    deriving (Binary, Eq, Ord, Show, Typeable)+++--------------------------------------------------------------------------------+instance Writable CopyFile where+#if MIN_VERSION_directory(1,2,6)+    write dst (Item _ (CopyFile src)) = copyFileWithMetadata src dst+#else+    write dst (Item _ (CopyFile src)) = copyFile src dst+#endif+--------------------------------------------------------------------------------+copyFileCompiler :: Compiler (Item CopyFile)+copyFileCompiler = do+    identifier <- getUnderlying+    provider   <- compilerProvider <$> compilerAsk+    makeItem $ CopyFile $ resourceFilePath provider identifier+++--------------------------------------------------------------------------------+newtype TmpFile = TmpFile FilePath+    deriving (Typeable)+++--------------------------------------------------------------------------------+instance Binary TmpFile where+    put _ = return ()+    get   = error $+        "Hakyll.Core.File.TmpFile: You tried to load a TmpFile, however, " +++        "this is not possible since these are deleted as soon as possible."+++--------------------------------------------------------------------------------+instance Writable TmpFile where+    write dst (Item _ (TmpFile fp)) = renameFile fp dst+++--------------------------------------------------------------------------------+-- | Create a tmp file+newTmpFile :: String            -- ^ Suffix and extension+           -> Compiler TmpFile  -- ^ Resulting tmp path+newTmpFile suffix = do+    path <- mkPath+    compilerUnsafeIO $ makeDirectories path+    debugCompiler $ "newTmpFile " ++ path+    return $ TmpFile path+  where+    mkPath = do+        rand <- compilerUnsafeIO $ randomIO :: Compiler Int+        tmp  <- tmpDirectory . compilerConfig <$> compilerAsk+        let path = tmp </> Store.hash [show rand] ++ "-" ++ suffix+        exists <- compilerUnsafeIO $ doesFileExist path+        if exists then mkPath else return path
+ lib/Hakyll/Core/Identifier.hs view
@@ -0,0 +1,169 @@+--------------------------------------------------------------------------------+-- | An identifier is a type used to uniquely name an item. An identifier+-- is similar to a file path, but can contain additional details (e.g.+-- item's version). Examples of identifiers are:+--+-- * @posts/foo.markdown@+--+-- * @index@+--+-- * @error/404@+--+-- See 'Identifier' for details.++{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Hakyll.Core.Identifier+    ( Identifier+    , fromFilePath+    , toFilePath+    , identifierVersion+    , setVersion+    ) where+++--------------------------------------------------------------------------------+import           Control.DeepSeq     (NFData (..))+import           System.FilePath     (normalise)+++--------------------------------------------------------------------------------+import           Data.Binary         (Binary (..))+import           Data.Typeable       (Typeable)+import           GHC.Exts            (IsString, fromString)+++--------------------------------------------------------------------------------+{- | A key data type to identify a compiled 'Hakyll.Core.Item.Item' in the 'Hakyll.Core.Store.Store'.+Conceptually, it's a combination of a file path and a version name.+The version is used only when a file is+compiled within a rule using the 'version' wrapper function+(the same source file+can be compiled into several items in the store, so the version exists to distinguish+them).+Use functions like 'fromFilePath', 'setVersion', 'Hakyll.Core.Metadata.getMatches' to build an 'Identifier'.++=== __Usage Examples__+Normally, compiled items are saved to the store by 'Hakyll.Core.Rules.Rules' with an automatic, implicit identifier+and loaded from the store by the user in another rule with a manual, explicit identifier.++__Identifiers when using match__.+Using 'Hakyll.Core.Rules.match' builds an implicit identifier that corresponds to the expanded, relative path+of the source file on disk (relative to the project directory configured+with 'Hakyll.Core.Configuration.providerDirectory'):++@+-- e.g. file on disk: 'posts\/hakyll.md'+match "posts/*" $ do                                          -- saved with implicit identifier 'posts\/hakyll.md'+    compile pandocCompiler++match "about/*" $ do+    compile $ do+        compiledPost <- load (fromFilePath "posts/hakyll.md") -- load with explicit identifier+        ...+@+Normally, the identifier is only explicitly created to pass to one of the 'Hakyll.Core.Compiler.load' functions.++__Identifiers when using create__.+Using 'Hakyll.Core.Rules.create' (thereby inventing a file path with no underlying file on disk)+builds an implicit identifier that corresponds to the invented file path:++@+create ["index.html"] $ do                                -- saved with implicit identifier 'index.html'+    compile $ makeItem ("Hello world" :: String)++match "about/*" $ do+    compile $ do+        compiledIndex <- load (fromFilePath "index.html") -- load with an explicit identifier+        ...+@++__Identifiers when using versions__.+With 'Hakyll.Core.Rules.version' the same file can be compiled into several items in the store.+A version name is needed to distinguish them:++@+-- e.g. file on disk: 'posts\/hakyll.md'+match "posts/*" $ do                              -- saved with implicit identifier ('posts\/hakyll.md', no-version)+    compile pandocCompiler++match "posts/*" $ version "raw" $ do              -- saved with implicit identifier ('posts\/hakyll.md', version 'raw')+    compile getResourceBody++match "about/*" $ do+    compile $ do+        compiledPost <- load (fromFilePath "posts/hakyll.md")                      -- load no-version version+        rawPost <- load . setVersion (Just "raw") $ fromFilePath "posts/hakyll.md" -- load version 'raw'+    ...+@+Use 'setVersion' to set (or replace) the version of an identifier like @fromFilePath "posts/hakyll.md"@.+-}+data Identifier = Identifier+    { identifierVersion :: Maybe String+    , identifierPath    :: String+    } deriving (Eq, Ord, Typeable)+++--------------------------------------------------------------------------------+instance Binary Identifier where+    put (Identifier v p) = put v >> put p+    get = Identifier <$> get <*> get+++--------------------------------------------------------------------------------+instance IsString Identifier where+    fromString = fromFilePath+++--------------------------------------------------------------------------------+instance NFData Identifier where+    rnf (Identifier v p) = rnf v `seq` rnf p `seq` ()+++--------------------------------------------------------------------------------+instance Show Identifier where+    show i = case identifierVersion i of+        Nothing -> toFilePath i+        Just v  -> toFilePath i ++ " (" ++ v ++ ")"+++--------------------------------------------------------------------------------+{- | Parse an identifier from a file path string. For example,++@+-- e.g. file on disk: 'posts\/hakyll.md'+match "posts/*" $ do                                          -- saved with implicit identifier 'posts\/hakyll.md'+    compile pandocCompiler++match "about/*" $ do+    compile $ do+        compiledPost <- load (fromFilePath "posts/hakyll.md") -- load with explicit identifier+        ...+@+-}+fromFilePath :: FilePath -> Identifier+fromFilePath = Identifier Nothing . normalise+++--------------------------------------------------------------------------------+-- | Convert an identifier back to a relative 'FilePath'.+toFilePath :: Identifier -> FilePath+toFilePath = normalise . identifierPath+++--------------------------------------------------------------------------------+{- | Set or override the version of an identifier in order to specify which version of an 'Hakyll.Core.Item.Item'+to 'Hakyll.Core.Compiler.load' from the 'Hakyll.Core.Store.Store'. For example,++@+match "posts/*" $ version "raw" $ do              -- saved with implicit identifier ('posts\/hakyll.md', version 'raw')+    compile getResourceBody++match "about/*" $ do+    compile $ do+        rawPost <- load . setVersion (Just "raw") $ fromFilePath "posts/hakyll.md" -- load version 'raw'+        ...+@+-}+setVersion :: Maybe String -> Identifier -> Identifier+setVersion v i = i {identifierVersion = v}
+ lib/Hakyll/Core/Identifier/Pattern.hs view
@@ -0,0 +1,266 @@+--------------------------------------------------------------------------------+-- | As 'Identifier' is used to specify a single item, a 'Pattern' is used to+-- specify a list of items.+--+-- In most cases, globs are used for patterns.+--+-- A very simple pattern of such a pattern is @\"foo\/bar\"@. This pattern will+-- only match the exact @foo\/bar@ identifier.+--+-- To match more than one identifier, there are different captures that one can+-- use:+--+-- * @\"*\"@: matches at most one element of an identifier;+--+-- * @\"**\"@: matches one or more elements of an identifier.+--+-- Some examples:+--+-- * @\"foo\/*\"@ will match @\"foo\/bar\"@ and @\"foo\/foo\"@, but not+--   @\"foo\/bar\/qux\"@;+--+-- * @\"**\"@ will match any identifier;+--+-- * @\"foo\/**\"@ will match @\"foo\/bar\"@ and @\"foo\/bar\/qux\"@, but not+--   @\"bar\/foo\"@;+--+-- * @\"foo\/*.html\"@ will match all HTML files in the @\"foo\/\"@ directory.+--+-- The 'capture' function allows the user to get access to the elements captured+-- by the capture elements in a glob or regex pattern.+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Hakyll.Core.Identifier.Pattern+    ( -- * The pattern type+      Pattern++      -- * Creating patterns+    , fromGlob+    , fromList+    , fromRegex+    , fromVersion+    , hasVersion+    , hasNoVersion++      -- * Composing patterns+    , (.&&.)+    , (.||.)+    , complement++      -- * Applying patterns+    , matches+    , filterMatches++      -- * Capturing strings+    , capture+    , fromCapture+    , fromCaptures+    ) where+++--------------------------------------------------------------------------------+import           Control.Arrow                           ((&&&), (>>>))+import           Control.Monad                           (msum)+import           Data.List                               (inits, isPrefixOf,+                                                          tails)+import           Data.Maybe                              (isJust)+import qualified Data.Set                                as S+import           System.FilePath                         (normalise, pathSeparator)+++--------------------------------------------------------------------------------+import           GHC.Exts                                (IsString, fromString)+import           Text.Regex.TDFA                         ((=~))+++--------------------------------------------------------------------------------+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern.Internal+import           Hakyll.Core.Util.String                 (removeWinPathSeparator)+++--------------------------------------------------------------------------------+instance IsString Pattern where+    fromString = fromGlob+++--------------------------------------------------------------------------------+-- | Parse a pattern from a string+fromGlob :: String -> Pattern+fromGlob = Glob . parse' . normalise+  where+    parse' str = +        let (chunk, rest) = break (== '*') str+        in case rest of+            ('*'  : '*' : xs) -> Literal chunk : CaptureMany : parse' xs+            ('*'  : xs)       -> Literal chunk : Capture : parse' xs+            ""                -> Literal chunk : []+            xs                -> Literal chunk : Literal xs : []+++--------------------------------------------------------------------------------+-- | Create a 'Pattern' from a list of 'Identifier's it should match.+--+-- /Warning/: use this carefully with 'hasNoVersion' and 'hasVersion'. The+-- 'Identifier's in the list /already/ have versions assigned, and the pattern+-- will then only match the intersection of both versions.+--+-- A more concrete example,+--+-- > fromList ["foo.markdown"] .&&. hasVersion "pdf"+--+-- will not match anything! The @"foo.markdown"@ 'Identifier' has no version+-- assigned, so the LHS of '.&&.' will only match this 'Identifier' with no+-- version. The RHS only matches 'Identifier's with version set to @"pdf"@ --+-- hence, this pattern matches nothing.+--+-- The correct way to use this is:+--+-- > fromList $ map (setVersion $ Just "pdf") ["foo.markdown"]+fromList :: [Identifier] -> Pattern+fromList = List . S.fromList+++--------------------------------------------------------------------------------+-- | Create a 'Pattern' from a regex+--+-- Example:+--+-- > regex "^foo/[^x]*$+fromRegex :: String -> Pattern+fromRegex = Regex+++--------------------------------------------------------------------------------+-- | Create a pattern which matches all items with the given version.+fromVersion :: Maybe String -> Pattern+fromVersion = Version+++--------------------------------------------------------------------------------+-- | Specify a version, e.g.+--+-- > "foo/*.markdown" .&&. hasVersion "pdf"+hasVersion :: String -> Pattern+hasVersion = fromVersion . Just+++--------------------------------------------------------------------------------+-- | Match only if the identifier has no version set, e.g.+--+-- > "foo/*.markdown" .&&. hasNoVersion+hasNoVersion :: Pattern+hasNoVersion = fromVersion Nothing+++--------------------------------------------------------------------------------+-- | '&&' for patterns: the given identifier must match both subterms+(.&&.) :: Pattern -> Pattern -> Pattern+x .&&. y = And x y+infixr 3 .&&.+++--------------------------------------------------------------------------------+-- | '||' for patterns: the given identifier must match any subterm+(.||.) :: Pattern -> Pattern -> Pattern+x .||. y = complement (complement x `And` complement y)  -- De Morgan's law+infixr 2 .||.+++--------------------------------------------------------------------------------+-- | Inverts a pattern, e.g.+--+-- > complement "foo/bar.html"+--+-- will match /anything/ except @\"foo\/bar.html\"@+complement :: Pattern -> Pattern+complement = Complement+++--------------------------------------------------------------------------------+-- | Check if an identifier matches a pattern+matches :: Pattern -> Identifier -> Bool+matches Everything     _ = True+matches (Complement p) i = not $ matches p i+matches (And x y)      i = matches x i && matches y i+matches (Glob p)       i = isJust $ capture (Glob p) i+matches (List l)       i = i `S.member` l+matches (Regex r)      i = (removeWinPathSeparator $ toFilePath i) =~ r+matches (Version v)    i = identifierVersion i == v+++--------------------------------------------------------------------------------+-- | Given a list of identifiers, retain only those who match the given pattern+filterMatches :: Pattern -> [Identifier] -> [Identifier]+filterMatches = filter . matches+++--------------------------------------------------------------------------------+-- | Split a list at every possible point, generate a list of (init, tail)+-- cases. The result is sorted with inits decreasing in length.+splits :: [a] -> [([a], [a])]+splits = inits &&& tails >>> uncurry zip >>> reverse+++--------------------------------------------------------------------------------+-- | Match a glob or regex pattern against an identifier, generating a list of captures+capture :: Pattern -> Identifier -> Maybe [String]+capture (Glob p) i = capture' p (toFilePath i)+capture (Regex pat) i = Just groups+  where (_, _, _, groups) = ((removeWinPathSeparator $ toFilePath i) =~ pat) :: (String, String, String, [String])+capture _        _ = Nothing+++--------------------------------------------------------------------------------+-- | Internal verion of 'capture'+capture' :: [GlobComponent] -> String -> Maybe [String]+capture' [] [] = Just []  -- An empty match+capture' [] _  = Nothing  -- No match+capture' (Literal l : ms) str+    -- Match the literal against the string+    | l `isPrefixOf` str = capture' ms $ drop (length l) str+    | otherwise          = Nothing+capture' (Capture : ms) str =+    -- Match until the next path separator+    let (chunk, rest) = break (== pathSeparator) str+    in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]+capture' (CaptureMany : ms) str =+    -- Match everything+    msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]+++--------------------------------------------------------------------------------+-- | Create an identifier from a pattern by filling in the captures with a given+-- string+--+-- Example:+--+-- > fromCapture (fromGlob "tags/*") "foo"+--+-- Result:+--+-- > "tags/foo"+fromCapture :: Pattern -> String -> Identifier+fromCapture pattern = fromCaptures pattern . repeat+++--------------------------------------------------------------------------------+-- | Create an identifier from a pattern by filling in the captures with the+-- given list of strings+fromCaptures :: Pattern -> [String] -> Identifier+fromCaptures (Glob p) = fromFilePath . fromCaptures' p+fromCaptures _        = error $+    "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " +++    "on simple globs!"+++--------------------------------------------------------------------------------+-- | Internally used version of 'fromCaptures'+fromCaptures' :: [GlobComponent] -> [String] -> String+fromCaptures' []        _ = mempty+fromCaptures' (m : ms) [] = case m of+    Literal l -> l `mappend` fromCaptures' ms []+    _         -> error $  "Hakyll.Core.Identifier.Pattern.fromCaptures': "+                       ++ "identifier list exhausted"+fromCaptures' (m : ms) ids@(i : is) = case m of+    Literal l -> l `mappend` fromCaptures' ms ids+    _         -> i `mappend` fromCaptures' ms is
+ lib/Hakyll/Core/Identifier/Pattern/Internal.hs view
@@ -0,0 +1,79 @@+-- | This internal module is mostly here to prevent CPP conflicting with Haskell+-- comments.+module Hakyll.Core.Identifier.Pattern.Internal+    ( GlobComponent (..)+    , Pattern (..)+    ) where+++--------------------------------------------------------------------------------+import           Data.Binary            (Binary (..), getWord8, putWord8)+import           Data.Set               (Set)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Identifier+++--------------------------------------------------------------------------------+-- | Elements of a glob pattern+data GlobComponent+    = Capture+    | CaptureMany+    | Literal String+    deriving (Eq, Show)+++--------------------------------------------------------------------------------+instance Binary GlobComponent where+    put Capture     = putWord8 0+    put CaptureMany = putWord8 1+    put (Literal s) = putWord8 2 >> put s++    get = getWord8 >>= \t -> case t of+        0 -> pure Capture+        1 -> pure CaptureMany+        2 -> Literal <$> get+        _ -> error "Data.Binary.get: Invalid GlobComponent"+++--------------------------------------------------------------------------------+-- | Type that allows matching on identifiers+data Pattern+    = Everything+    | Complement Pattern+    | And Pattern Pattern+    | Glob [GlobComponent]+    | List (Set Identifier)+    | Regex String+    | Version (Maybe String)+    deriving (Show)+++--------------------------------------------------------------------------------+instance Binary Pattern where+    put Everything     = putWord8 0+    put (Complement p) = putWord8 1 >> put p+    put (And x y)      = putWord8 2 >> put x >> put y+    put (Glob g)       = putWord8 3 >> put g+    put (List is)      = putWord8 4 >> put is+    put (Regex r)      = putWord8 5 >> put r+    put (Version v)    = putWord8 6 >> put v++    get = getWord8 >>= \t -> case t of+        0 -> pure Everything+        1 -> Complement <$> get+        2 -> And <$> get <*> get+        3 -> Glob <$> get+        4 -> List <$> get+        5 -> Regex <$> get+        _ -> Version <$> get+++--------------------------------------------------------------------------------+instance Semigroup Pattern where+    (<>) = And++instance Monoid Pattern where+    mempty  = Everything+    mappend = (<>)
+ lib/Hakyll/Core/Item.hs view
@@ -0,0 +1,47 @@+--------------------------------------------------------------------------------+-- | 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+    , withItemBody+    ) where+++--------------------------------------------------------------------------------+import           Data.Binary                   (Binary (..))+import           Data.Typeable                 (Typeable)+import           Prelude                       hiding (foldr)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler.Internal+import           Hakyll.Core.Identifier+++--------------------------------------------------------------------------------+data Item a = Item+    { itemIdentifier :: Identifier+    , itemBody       :: a+    } deriving (Show, Typeable, Functor, Foldable, Traversable)++--------------------------------------------------------------------------------+instance Binary a => Binary (Item a) where+    put (Item i x) = put i >> put x+    get            = Item <$> get <*> get+++--------------------------------------------------------------------------------+itemSetBody :: a -> Item b -> Item a+itemSetBody x (Item i _) = Item i x+++--------------------------------------------------------------------------------+-- | Perform a compiler action on the item body. This is the same as 'traverse',+-- but looks less intimidating.+--+-- > withItemBody = traverse+withItemBody :: (a -> Compiler b) -> Item a -> Compiler (Item b)+withItemBody = traverse
+ lib/Hakyll/Core/Item/SomeItem.hs view
@@ -0,0 +1,23 @@+--------------------------------------------------------------------------------+{-# LANGUAGE DeriveDataTypeable        #-}+{-# LANGUAGE ExistentialQuantification #-}+module Hakyll.Core.Item.SomeItem+    ( SomeItem (..)+    ) where+++--------------------------------------------------------------------------------+import           Data.Binary          (Binary)+import           Data.Typeable        (Typeable)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Item+import           Hakyll.Core.Writable+++--------------------------------------------------------------------------------+-- | An existential type, mostly for internal usage.+data SomeItem = forall a.+    (Binary a, Typeable a, Writable a) => SomeItem (Item a)+    deriving (Typeable)
+ lib/Hakyll/Core/Logger.hs view
@@ -0,0 +1,107 @@+--------------------------------------------------------------------------------+-- | Produce pretty, thread-safe logs+{-# LANGUAGE Rank2Types #-}+module Hakyll.Core.Logger+    ( Verbosity (..)+    , Logger+    , new+    , flush+    , error+    , header+    , message+    , debug++    -- * Testing utilities+    , newInMem+    ) where+++--------------------------------------------------------------------------------+import           Control.Concurrent      (forkIO)+import           Control.Concurrent.Chan (newChan, readChan, writeChan)+import           Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import           Control.Monad           (forever, when)+import           Control.Monad.Trans     (MonadIO, liftIO)+import qualified Data.IORef              as IORef+import           Data.List               (intercalate)+import           Prelude                 hiding (error)+++--------------------------------------------------------------------------------+data Verbosity+    = Error+    | Message+    | Debug+    deriving (Eq, Ord, Show)+++--------------------------------------------------------------------------------+data Logger = Logger+    { -- | Flush the logger (blocks until flushed)+      flush  :: forall m. MonadIO m => m ()+    , string :: forall m. MonadIO m => Verbosity -> String -> m ()+    }+++--------------------------------------------------------------------------------+-- | Create a new logger+new :: Verbosity -> IO Logger+new vbty = do+    chan <- newChan+    sync <- newEmptyMVar+    _    <- forkIO $ forever $ do+        msg <- readChan chan+        case msg of+            -- Stop: sync+            Nothing -> putMVar sync ()+            -- Print and continue+            Just m  -> putStrLn m+    return $ Logger+        { flush = liftIO $ do+            writeChan chan Nothing+            () <- takeMVar sync+            return ()+        , string = \v m -> when (vbty >= v) $+            liftIO $ writeChan chan (Just m)+        }+++--------------------------------------------------------------------------------+error :: MonadIO m => Logger -> String -> m ()+error l m = string l Error $ "  [ERROR] " ++ indent m+++--------------------------------------------------------------------------------+header :: MonadIO m => Logger -> String -> m ()+header l = string l Message+++--------------------------------------------------------------------------------+message :: MonadIO m => Logger -> String -> m ()+message l m = string l Message $ "  " ++ indent m+++--------------------------------------------------------------------------------+debug :: MonadIO m => Logger -> String -> m ()+debug l m = string l Debug $ "  [DEBUG] " ++ indent m+++--------------------------------------------------------------------------------+indent :: String -> String+indent = intercalate "\n    " . lines+++--------------------------------------------------------------------------------+-- | Create a new logger that just stores all the messages, useful for writing+-- tests.+newInMem :: IO (Logger, IO [(Verbosity, String)])+newInMem = do+    ref <- IORef.newIORef []+    pure+        ( Logger+            { string = \vbty msg -> liftIO $ IORef.atomicModifyIORef' ref $+                \msgs -> ((vbty, msg) : msgs, ())+            , flush  = pure ()+            }+        , reverse <$> IORef.readIORef ref+        )
+ lib/Hakyll/Core/Metadata.hs view
@@ -0,0 +1,168 @@+--------------------------------------------------------------------------------+{-# LANGUAGE CPP #-}+module Hakyll.Core.Metadata+    ( Metadata+    , lookupString+    , lookupStringList++    , MonadMetadata (..)+    , getMetadataField+    , getMetadataField'+    , makePatternDependency++    , BinaryMetadata (..)+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad                  (forM)+#if !MIN_VERSION_base(4,13,0)+import           Control.Monad.Fail             (MonadFail)+#endif+import           Data.Binary                    (Binary (..), getWord8,+                                                 putWord8, Get)+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap              as KeyMap+import qualified Data.Aeson.Key                 as AK+#else+import qualified Data.HashMap.Strict            as KeyMap+#endif+import qualified Data.Set                       as S+import qualified Data.Text                      as T+import qualified Data.Vector                    as V+import qualified Data.Yaml.Extended                      as Yaml+import           Hakyll.Core.Dependencies+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern+++--------------------------------------------------------------------------------+type Metadata = Yaml.Object+++--------------------------------------------------------------------------------+lookupString :: String -> Metadata -> Maybe String+lookupString key meta = KeyMap.lookup (keyFromString key) meta >>= Yaml.toString+++--------------------------------------------------------------------------------+lookupStringList :: String -> Metadata -> Maybe [String]+lookupStringList key meta =+    KeyMap.lookup (keyFromString key) meta >>= Yaml.toList >>= mapM Yaml.toString+++--------------------------------------------------------------------------------+class Monad m => MonadMetadata m where+    getMetadata    :: Identifier -> m Metadata+    getMatches     :: Pattern -> m [Identifier]++    getAllMetadata :: Pattern -> m [(Identifier, Metadata)]+    getAllMetadata pattern = do+        matches' <- getMatches pattern+        forM matches' $ \id' -> do+            metadata <- getMetadata id'+            return (id', metadata)+++--------------------------------------------------------------------------------+getMetadataField :: MonadMetadata m => Identifier -> String -> m (Maybe String)+getMetadataField identifier key = do+    metadata <- getMetadata identifier+    return $ lookupString key metadata+++--------------------------------------------------------------------------------+-- | Version of 'getMetadataField' which throws an error if the field does not+-- exist.+getMetadataField' :: (MonadFail m, MonadMetadata m) => Identifier -> String -> m String+getMetadataField' identifier key = do+    field <- getMetadataField identifier key+    case field of+        Just v  -> return v+        Nothing -> fail $ "Hakyll.Core.Metadata.getMetadataField': " +++            "Item " ++ show identifier ++ " has no metadata field " ++ show key+++--------------------------------------------------------------------------------+makePatternDependency :: MonadMetadata m => DependencyKind -> Pattern -> m Dependency+makePatternDependency kind pattern = do+    matches' <- getMatches pattern+    return $ Dependency kind (PatternDependency pattern (S.fromList matches'))+++--------------------------------------------------------------------------------+-- | Newtype wrapper for serialization.+newtype BinaryMetadata = BinaryMetadata+    {unBinaryMetadata :: Metadata}+++instance Binary BinaryMetadata where+    put (BinaryMetadata obj) = put (BinaryYaml $ Yaml.Object obj)+    get = do+        BinaryYaml (Yaml.Object obj) <- get+        return $ BinaryMetadata obj+++--------------------------------------------------------------------------------+newtype BinaryYaml = BinaryYaml {unBinaryYaml :: Yaml.Value}+++--------------------------------------------------------------------------------+instance Binary BinaryYaml where+    put (BinaryYaml yaml) = case yaml of+        Yaml.Object obj -> do+            putWord8 0+            let list :: [(T.Text, BinaryYaml)]+                list = map (\(k, v) -> (keyToText k, BinaryYaml v)) $ KeyMap.toList obj+            put list++        Yaml.Array arr -> do+            putWord8 1+            let list = map BinaryYaml (V.toList arr) :: [BinaryYaml]+            put list++        Yaml.String s -> putWord8 2 >> put s+        Yaml.Number n -> putWord8 3 >> put n+        Yaml.Bool   b -> putWord8 4 >> put b+        Yaml.Null     -> putWord8 5++    get = do+        tag <- getWord8+        case tag of+            0 -> do+                list <- get :: Get [(T.Text, BinaryYaml)]+                return $ BinaryYaml $ Yaml.Object $+                    KeyMap.fromList $ map (\(k, v) -> (keyFromText k, unBinaryYaml v)) list++            1 -> do+                list <- get :: Get [BinaryYaml]+                return $ BinaryYaml $+                    Yaml.Array $ V.fromList $ map unBinaryYaml list++            2 -> BinaryYaml . Yaml.String <$> get+            3 -> BinaryYaml . Yaml.Number <$> get+            4 -> BinaryYaml . Yaml.Bool   <$> get+            5 -> return $ BinaryYaml Yaml.Null+            _ -> fail "Data.Binary.get: Invalid Binary Metadata"+++--------------------------------------------------------------------------------+#if MIN_VERSION_aeson(2,0,0)+keyFromString :: String -> AK.Key+keyFromString = AK.fromString++keyToText :: AK.Key -> T.Text+keyToText = AK.toText++keyFromText :: T.Text -> AK.Key+keyFromText = AK.fromText+#else+keyFromString :: String -> T.Text+keyFromString = T.pack++keyToText :: T.Text -> T.Text+keyToText = id++keyFromText :: T.Text -> T.Text+keyFromText = id+#endif
+ lib/Hakyll/Core/Provider.hs view
@@ -0,0 +1,59 @@+--------------------------------------------------------------------------------+-- | This module provides an wrapper API around the file system which does some+-- caching.+module Hakyll.Core.Provider+    ( -- * Constructing resource providers+      Internal.Provider+    , newProvider++      -- * Querying resource properties+    , Internal.resourceList+    , Internal.resourceExists+    , Internal.resourceFilePath+    , Internal.resourceModified+    , Internal.resourceModificationTime++      -- * Access to raw resource content+    , Internal.resourceString+    , Internal.resourceLBS++      -- * Access to metadata and body content+    , Internal.resourceMetadata+    , Internal.resourceBody+    ) where++--------------------------------------------------------------------------------+import           Control.Monad                      (forM)+import qualified Hakyll.Core.Provider.Internal      as Internal+import qualified Hakyll.Core.Provider.MetadataCache as Internal+import           Hakyll.Core.Store                  (Store)+import           Hakyll.Core.Identifier             (Identifier)+++--------------------------------------------------------------------------------+-- | Create a resource provider+newProvider :: Store                                -- ^ Store to use+            -> (FilePath -> IO Bool)                -- ^ Should we ignore this file?+            -> FilePath                             -- ^ Search directory+            -> IO (Internal.Provider, [Identifier]) -- ^ Resulting provider and modified metadata+newProvider store ignore directory = do+  p <- Internal.newProvider store ignore directory++  let modified =+        filter+          (Internal.resourceModified p)+          (Internal.resourceList p)++  -- Delete metadata cache where necessary and extract identifiers for which the+  -- metadata was actually modified. That is, exclude identifiers where the body+  -- was modified but the metadata wasn't.+  modifiedMetadata <- fmap concat $ forM modified $ \identifier -> do+    mbCachedMetadata <- Internal.resourceLookupMetadataCache p identifier+    case mbCachedMetadata of+      Nothing -> pure []+      Just oldMeta -> do+        Internal.resourceInvalidateMetadataCache p identifier+        newMeta <- Internal.resourceMetadata p identifier+        pure $ if oldMeta == newMeta then [] else [identifier]++  return (p, modifiedMetadata)
+ lib/Hakyll/Core/Provider/Internal.hs view
@@ -0,0 +1,202 @@+--------------------------------------------------------------------------------+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Hakyll.Core.Provider.Internal+    ( ResourceInfo (..)+    , Provider (..)+    , newProvider++    , resourceList+    , resourceExists++    , resourceFilePath+    , resourceString+    , resourceLBS++    , resourceModified+    , resourceModificationTime+    ) where+++--------------------------------------------------------------------------------+import           Control.DeepSeq        (NFData (..), deepseq)+import           Control.Monad          (forM)+import           Data.Binary            (Binary (..))+import qualified Data.ByteString.Lazy   as BL+import           Data.Map               (Map)+import qualified Data.Map               as M+import           Data.Maybe             (fromMaybe)+import           Data.Set               (Set)+import qualified Data.Set               as S+import           Data.Time              (Day (..), UTCTime (..))+import           Data.Typeable          (Typeable)+import           System.Directory       (getModificationTime)+import           System.FilePath        (addExtension, (</>))+++--------------------------------------------------------------------------------+#if !MIN_VERSION_directory(1,2,0)+import           Data.Time              (readTime)+import           System.Locale          (defaultTimeLocale)+import           System.Time            (formatCalendarTime, toCalendarTime)+#endif+++--------------------------------------------------------------------------------+import           Hakyll.Core.Identifier+import           Hakyll.Core.Store      (Store)+import qualified Hakyll.Core.Store      as Store+import           Hakyll.Core.Util.File+++--------------------------------------------------------------------------------+-- | Because UTCTime doesn't have a Binary instance...+newtype BinaryTime = BinaryTime {unBinaryTime :: UTCTime}+    deriving (Eq, NFData, Ord, Show, Typeable)+++--------------------------------------------------------------------------------+instance Binary BinaryTime where+    put (BinaryTime (UTCTime (ModifiedJulianDay d) dt)) =+        put d >> put (toRational dt)++    get = fmap BinaryTime $ UTCTime+        <$> (ModifiedJulianDay <$> get)+        <*> (fromRational <$> get)+++--------------------------------------------------------------------------------+data ResourceInfo = ResourceInfo+    { resourceInfoModified :: BinaryTime+    , resourceInfoMetadata :: Maybe Identifier+    } deriving (Show, Typeable)+++--------------------------------------------------------------------------------+instance Binary ResourceInfo where+    put (ResourceInfo mtime meta) = put mtime >> put meta+    get = ResourceInfo <$> get <*> get+++--------------------------------------------------------------------------------+instance NFData ResourceInfo where+    rnf (ResourceInfo mtime meta) = rnf mtime `seq` rnf meta `seq` ()+++--------------------------------------------------------------------------------+-- | Responsible for retrieving and listing resources+data Provider = Provider+    { -- Top of the provided directory+      providerDirectory :: FilePath+    , -- | A list of all files found+      providerFiles     :: Map Identifier ResourceInfo+    , -- | A list of the files from the previous run+      providerOldFiles  :: Map Identifier ResourceInfo+    , -- | Underlying persistent store for caching+      providerStore     :: Store+    } deriving (Show)+++--------------------------------------------------------------------------------+-- | Create a resource provider+newProvider :: Store                  -- ^ Store to use+            -> (FilePath -> IO Bool)  -- ^ Should we ignore this file?+            -> FilePath               -- ^ Search directory+            -> IO Provider            -- ^ Resulting provider+newProvider store ignore directory = do+    list <- map fromFilePath <$> getRecursiveContents ignore directory+    let universe = S.fromList list+    files <- fmap (maxmtime . M.fromList) $ forM list $ \identifier -> do+        rInfo <- getResourceInfo directory universe identifier+        return (identifier, rInfo)++    -- Get the old files from the store, and then immediately replace them by+    -- the new files.+    oldFiles <- fromMaybe mempty . Store.toMaybe <$> Store.get store oldKey+    oldFiles `deepseq` Store.set store oldKey files++    return $ Provider directory files oldFiles store+  where+    oldKey = ["Hakyll.Core.Provider.Internal.newProvider", "oldFiles"]++    -- Update modified if metadata is modified+    maxmtime files = flip M.map files $ \rInfo@(ResourceInfo mtime meta) ->+        let metaMod = fmap resourceInfoModified $ meta >>= flip M.lookup files+        in rInfo {resourceInfoModified = maybe mtime (max mtime) metaMod}+++--------------------------------------------------------------------------------+getResourceInfo :: FilePath -> Set Identifier -> Identifier -> IO ResourceInfo+getResourceInfo directory universe identifier = do+    mtime <- fileModificationTime $ directory </> toFilePath identifier+    return $ ResourceInfo (BinaryTime mtime) $+        if mdRsc `S.member` universe then Just mdRsc else Nothing+  where+    mdRsc = fromFilePath $ flip addExtension "metadata" $ toFilePath identifier+++--------------------------------------------------------------------------------+resourceList :: Provider -> [Identifier]+resourceList = M.keys . providerFiles+++--------------------------------------------------------------------------------+-- | Check if a given resource exists+resourceExists :: Provider -> Identifier -> Bool+resourceExists provider =+    (`M.member` providerFiles provider) . setVersion Nothing+++--------------------------------------------------------------------------------+resourceFilePath :: Provider -> Identifier -> FilePath+resourceFilePath p i = providerDirectory p </> toFilePath i+++--------------------------------------------------------------------------------+-- | Get the raw body of a resource as string+resourceString :: Provider -> Identifier -> IO String+resourceString p i = readFile $ resourceFilePath p i+++--------------------------------------------------------------------------------+-- | Get the raw body of a resource of a lazy bytestring+resourceLBS :: Provider -> Identifier -> IO BL.ByteString+resourceLBS p i = BL.readFile $ resourceFilePath p i+++--------------------------------------------------------------------------------+-- | A resource is modified if it or its metadata has changed+resourceModified :: Provider -> Identifier -> Bool+resourceModified p r = case (ri, oldRi) of+    (Nothing, _)      -> False+    (Just _, Nothing) -> True+    (Just n, Just o)  ->+        resourceInfoModified n >  resourceInfoModified o ||+        resourceInfoMetadata n /= resourceInfoMetadata o+  where+    normal = setVersion Nothing r+    ri     = M.lookup normal (providerFiles p)+    oldRi  = M.lookup normal (providerOldFiles p)+++--------------------------------------------------------------------------------+resourceModificationTime :: Provider -> Identifier -> UTCTime+resourceModificationTime p i =+    case M.lookup (setVersion Nothing i) (providerFiles p) of+        Just ri -> unBinaryTime $ resourceInfoModified ri+        Nothing -> error $+            "Hakyll.Core.Provider.Internal.resourceModificationTime: " +++            "resource " ++ show i ++ " does not exist"+++--------------------------------------------------------------------------------+fileModificationTime :: FilePath -> IO UTCTime+fileModificationTime fp = do+#if MIN_VERSION_directory(1,2,0)+    getModificationTime fp+#else+    ct <- toCalendarTime =<< getModificationTime fp+    let str = formatCalendarTime defaultTimeLocale "%s" ct+    return $ readTime defaultTimeLocale "%s" str+#endif
+ lib/Hakyll/Core/Provider/Metadata.hs view
@@ -0,0 +1,151 @@+--------------------------------------------------------------------------------+-- | Internal module to parse metadata+{-# LANGUAGE BangPatterns    #-}+{-# LANGUAGE RecordWildCards #-}+module Hakyll.Core.Provider.Metadata+    ( loadMetadata+    , parsePage++    , MetadataException (..)+    ) where+++--------------------------------------------------------------------------------+import           Control.Arrow                 (second)+import           Control.Exception             (Exception, throwIO)+import           Control.Monad                 (guard)+import qualified Data.ByteString               as B+import qualified Data.ByteString.Char8         as BC+import           Data.List.Extended            (breakWhen)+import qualified Data.Map                      as M+import           Data.Maybe                    (fromMaybe)+import qualified Data.Text                     as T+import qualified Data.Text.Encoding            as T+import qualified Data.Yaml                     as Yaml+import           Hakyll.Core.Identifier+import           Hakyll.Core.Metadata+import           Hakyll.Core.Provider.Internal+import           System.IO                     as IO+import           System.IO.Error               (modifyIOError, ioeSetLocation)+++--------------------------------------------------------------------------------+loadMetadata :: Provider -> Identifier -> IO (Metadata, Maybe String)+loadMetadata p identifier = do+    hasHeader  <- probablyHasMetadataHeader fp+    (md, body) <- if hasHeader+        then second Just <$> loadMetadataHeader fp+        else return (mempty, Nothing)++    emd <- case mi of+        Nothing  -> return mempty+        Just mi' -> loadMetadataFile $ resourceFilePath p mi'++    return (md <> emd, body)+  where+    normal = setVersion Nothing identifier+    fp     = resourceFilePath p identifier+    mi     = M.lookup normal (providerFiles p) >>= resourceInfoMetadata+++--------------------------------------------------------------------------------+loadMetadataHeader :: FilePath -> IO (Metadata, String)+loadMetadataHeader fp = do+    fileContent <- modifyIOError (`ioeSetLocation` "loadMetadataHeader") $ readFile fp+    case parsePage fileContent of+        Right x   -> return x+        Left  err -> throwIO $ MetadataException fp err+++--------------------------------------------------------------------------------+loadMetadataFile :: FilePath -> IO Metadata+loadMetadataFile fp = do+    fileContent <- modifyIOError (`ioeSetLocation` "loadMetadataFile") $ B.readFile fp+    let errOrMeta = Yaml.decodeEither' fileContent+    either (fail . show) return errOrMeta+++--------------------------------------------------------------------------------+-- | Check if a file "probably" has a metadata header. The main goal of this is+-- to exclude binary files (which are unlikely to start with "---").+probablyHasMetadataHeader :: FilePath -> IO Bool+probablyHasMetadataHeader fp = do+    handle <- IO.openFile fp IO.ReadMode+    bs     <- BC.hGet handle 1024+    IO.hClose handle+    return $ isMetadataHeader bs+  where+    isMetadataHeader bs =+        let pre = BC.takeWhile (\x -> x /= '\n' && x /= '\r') bs+        in  BC.length pre >= 3 && BC.all (== '-') pre+++--------------------------------------------------------------------------------+-- | Parse the page metadata and body.+splitMetadata :: String -> (Maybe String, String)+splitMetadata str0 = fromMaybe (Nothing, str0) $ do+    guard $ leading >= 3+    let !str1 = drop leading str0+    guard $ all isNewline (take 1 str1)+    let !(!meta, !content0) = breakWhen isTrailing str1+    guard $ not $ null content0+    let !content1 = drop (leading + 1) content0+        !content2 = dropWhile isNewline $ dropWhile isInlineSpace content1+    -- Adding this newline fixes the line numbers reported by the YAML parser.+    -- It's a bit ugly but it works.+    return (Just ('\n' : meta), content2)+  where+    -- Parse the leading "---"+    !leading = length $ takeWhile (== '-') str0++    -- Predicate to recognize the trailing "---" or "..."+    isTrailing []       = False+    isTrailing (x : xs) =+        isNewline x && length (takeWhile isDash xs) == leading++    -- Characters+    isNewline     c = c == '\n' || c == '\r'+    isDash        c = c == '-'  || c == '.'+    isInlineSpace c = c == '\t' || c == ' '+++--------------------------------------------------------------------------------+parseMetadata :: String -> Either Yaml.ParseException Metadata+parseMetadata = Yaml.decodeEither' . T.encodeUtf8 . T.pack+++--------------------------------------------------------------------------------+parsePage :: String -> Either Yaml.ParseException (Metadata, String)+parsePage fileContent = case mbMetaBlock of+    Nothing        -> return (mempty, content)+    Just metaBlock -> case parseMetadata metaBlock of+        Left  err  -> Left   err+        Right meta -> return (meta, content)+  where+    !(!mbMetaBlock, !content) = splitMetadata fileContent+++--------------------------------------------------------------------------------+-- | Thrown in the IO monad if things go wrong. Provides a nice-ish error+-- message.+data MetadataException = MetadataException FilePath Yaml.ParseException+++--------------------------------------------------------------------------------+instance Exception MetadataException+++--------------------------------------------------------------------------------+instance Show MetadataException where+    show (MetadataException fp err) =+        fp ++ ": " ++ Yaml.prettyPrintParseException err ++ hint++      where+        hint = case err of+            Yaml.InvalidYaml (Just (Yaml.YamlParseException {..}))+                | yamlProblem ==  "mapping values are not allowed in this context" -> "\n" +++                    "Hint: if the metadata value contains characters such\n" +++                    "as ':' or '-', try enclosing it in quotes."+            Yaml.AesonException "Error in $: parsing HashMap ~Text failed, expected Object, but encountered String"+                -> "\nHint: in metadata, keys and values are separated by a colon *and* a space."+            _ -> ""
+ lib/Hakyll/Core/Provider/MetadataCache.hs view
@@ -0,0 +1,74 @@+--------------------------------------------------------------------------------+module Hakyll.Core.Provider.MetadataCache+    ( resourceMetadata+    , resourceBody+    , resourceLookupMetadataCache+    , resourceInvalidateMetadataCache+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad                 (unless)+import           Data.Maybe                    (fromMaybe)+import           Hakyll.Core.Identifier+import           Hakyll.Core.Metadata+import           Hakyll.Core.Provider.Internal+import           Hakyll.Core.Provider.Metadata+import qualified Hakyll.Core.Store             as Store+++--------------------------------------------------------------------------------+resourceMetadata :: Provider -> Identifier -> IO Metadata+resourceMetadata p r+    | not (resourceExists p r) = return mempty+    | otherwise                = do+        -- TODO keep time in md cache+        load p r+        fromMaybe mempty <$> resourceLookupMetadataCache p r+++--------------------------------------------------------------------------------+resourceBody :: Provider -> Identifier -> IO String+resourceBody p r = do+    load p r+    Store.Found bd <- Store.get (providerStore p)+        [name, toFilePath r, "body"]+    maybe (resourceString p r) return bd+++--------------------------------------------------------------------------------+-- | Perform a lookup for metadata in the cache only.+-- Useful internally for invalidation.+resourceLookupMetadataCache :: Provider -> Identifier -> IO (Maybe Metadata)+resourceLookupMetadataCache p r = do+    result <- Store.get (providerStore p) [name, toFilePath r, "metadata"]+    pure $ case result of+      Store.Found (BinaryMetadata m) -> Just m+      Store.NotFound                 -> Nothing+      Store.WrongType _ _            -> error "unexpected WrongType"+++--------------------------------------------------------------------------------+resourceInvalidateMetadataCache :: Provider -> Identifier -> IO ()+resourceInvalidateMetadataCache p r = do+    Store.delete (providerStore p) [name, toFilePath r, "metadata"]+    Store.delete (providerStore p) [name, toFilePath r, "body"]+++--------------------------------------------------------------------------------+load :: Provider -> Identifier -> IO ()+load p r = do+    mmof <- Store.isMember store mdk+    unless mmof $ do+        (md, body) <- loadMetadata p r+        Store.set store mdk (BinaryMetadata md)+        Store.set store bk  body+  where+    store = providerStore p+    mdk   = [name, toFilePath r, "metadata"]+    bk    = [name, toFilePath r, "body"]+++--------------------------------------------------------------------------------+name :: String+name = "Hakyll.Core.Resource.Provider.MetadataCache"
+ lib/Hakyll/Core/Routes.hs view
@@ -0,0 +1,356 @@+--------------------------------------------------------------------------------+{- | 'Routes' is part of the 'Hakyll.Core.Rules.Rules' processing pipeline.+It determines if and where the compilation result of the underlying+'Hakyll.Core.Item.Item' being processed is written out to+(relative to the destination directory as configured in+'Hakyll.Core.Configuration.destinationDirectory').++* __If there is no route for an item, the compiled item won't be written__+__out to a file__ and so won't appear in the destination (site) directory.++* If an item matches multiple routes, the first route will be chosen.++__Examples__++Suppose we have a markdown file @posts\/hakyll.md@. We can route its+compilation result to @posts\/hakyll.html@ using 'setExtension':++> -- file on disk: '<project-directory>/posts/hakyll.md'+> match "posts/*" $ do+>     -- compilation result is written to '<destination-directory>/posts/hakyll.html'+>     route (setExtension "html")+>     compile pandocCompiler+Hint: You can configure the destination directory with+'Hakyll.Core.Configuration.destinationDirectory'.++If we do not want to change the extension, we can replace 'setExtension' with+'idRoute' (the simplest route available):++>     -- compilation result is written to '<destination-directory>/posts/hakyll.md'+>     route idRoute++That will route the file @posts\/hakyll.md@ from the project directory to+@posts\/hakyll.md@ in the destination directory.++Note:+__The extension of the destination filepath says nothing about the content!__+If you set the extension to @.html@, you have to ensure that the+compilation result is indeed HTML (for example with the+'Hakyll.Web.Pandoc.pandocCompiler' to transform Markdown to HTML).++Take a look at the built-in routes here for detailed usage examples.+-}+{-# LANGUAGE Rank2Types #-}+module Hakyll.Core.Routes+    ( Routes+    , UsedMetadata+    , runRoutes+    , idRoute+    , setExtension+    , matchRoute+    , customRoute+    , constRoute+    , gsubRoute+    , metadataRoute+    , composeRoutes+    ) where+++--------------------------------------------------------------------------------+import           System.FilePath                (replaceExtension, normalise)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern+import           Hakyll.Core.Metadata+import           Hakyll.Core.Provider+import           Hakyll.Core.Util.String+++--------------------------------------------------------------------------------+-- | When you ran a route, it's useful to know whether or not this used+-- metadata. This allows us to do more granular dependency analysis.+type UsedMetadata = Bool+++--------------------------------------------------------------------------------+data RoutesRead = RoutesRead+    { routesProvider   :: Provider+    , routesUnderlying :: Identifier+    }+++--------------------------------------------------------------------------------+-- | Type used for a route+newtype Routes = Routes+    { unRoutes :: RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)+    }+++--------------------------------------------------------------------------------+instance Semigroup Routes where+    (<>) (Routes f) (Routes g) = Routes $ \p id' -> do+        (mfp, um) <- f p id'+        case mfp of+            Nothing -> g p id'+            Just _  -> return (mfp, um)++instance Monoid Routes where+    mempty  = Routes $ \_ _ -> return (Nothing, False)+    mappend = (<>)+++--------------------------------------------------------------------------------+-- | Apply a route to an identifier+runRoutes :: Routes -> Provider -> Identifier+          -> IO (Maybe FilePath, UsedMetadata)+runRoutes routes provider identifier =+    unRoutes routes (RoutesRead provider identifier) identifier+++--------------------------------------------------------------------------------+{- | An "identity" route that interprets the identifier (of the item being+processed) as the destination filepath. This identifier is normally the+filepath of the source file being processed.+See 'Hakyll.Core.Identifier.Identifier' for details.++=== __Examples__+__Route when using match__++> -- e.g. file on disk: '<project-directory>/posts/hakyll.md'+>+> -- 'hakyll.md' source file implicitly gets filepath as identifier:+> -- 'posts/hakyll.md'+> match "posts/*" $ do+>+>     -- compilation result is written to '<destination-directory>/posts/hakyll.md'+>     route idRoute+>+>     compile getResourceBody+-}+idRoute :: Routes+idRoute = customRoute toFilePath+++--------------------------------------------------------------------------------+{- | Create a route like 'idRoute' that interprets the identifier (of the item+being processed) as the destination filepath but also sets (or replaces) the+extension suffix of that path. This identifier is normally the filepath of the+source file being processed.+See 'Hakyll.Core.Identifier.Identifier' for details.++=== __Examples__+__Route with an existing extension__++> -- e.g. file on disk: '<project-directory>/posts/hakyll.md'+>+> -- 'hakyll.md' source file implicitly gets filepath as identifier:+> -- 'posts/hakyll.md'+> match "posts/*" $ do+>+>     -- compilation result is written to '<destination-directory>/posts/hakyll.html'+>     route (setExtension "html")+>+>     compile pandocCompiler++__Route without an existing extension__++> -- implicitly gets identifier: 'about'+> create ["about"] $ do+>+>     -- compilation result is written to '<destination-directory>/about.html'+>     route (setExtension "html")+>+>     compile $ makeItem ("Hello world" :: String)+-}+setExtension :: String -> Routes+setExtension extension = customRoute $+    (`replaceExtension` extension) . toFilePath+++--------------------------------------------------------------------------------+-- | Apply the route if the identifier matches the given pattern, fail+-- otherwise+matchRoute :: Pattern -> Routes -> Routes+matchRoute pattern (Routes route) = Routes $ \p id' ->+    if matches pattern id' then route p id' else return (Nothing, False)+++--------------------------------------------------------------------------------+{- | Create a route where the destination filepath is built with the given+construction function. The provided identifier for that function is normally the+filepath of the source file being processed.+See 'Hakyll.Core.Identifier.Identifier' for details.++=== __Examples__+__Route that appends a custom extension__++> -- e.g. file on disk: '<project-directory>/posts/hakyll.md'+>+> -- 'hakyll.md' source file implicitly gets filepath as identifier:+> -- 'posts/hakyll.md'+> match "posts/*" $ do+>+>     -- compilation result is written to '<destination-directory>/posts/hakyll.md.html'+>     route $ customRoute ((<> ".html") . toFilePath)+>+>     compile pandocCompiler+Note that the last part of the destination filepath becomes @.md.html@+-}+customRoute :: (Identifier -> FilePath) -- ^ Destination filepath construction function+            -> Routes                   -- ^ Resulting route+customRoute f = Routes $ const $ \id' -> return (Just (f id'), False)+++--------------------------------------------------------------------------------+{- | Create a route that writes the compiled item to the given destination+filepath (ignoring any identifier or other data about the item being processed).+Warning: you should __use a specific destination path only for a single file in__+__a single compilation rule__. Otherwise it's unclear which of the contents+should be written to that route.++=== __Examples__+__Route to a specific filepath__++> -- implicitly gets identifier: 'main' (ignored on next line)+> create ["main"] $ do+>+>     -- compilation result is written to '<destination-directory>/index.html'+>     route $ constRoute "index.html"+>+>     compile $ makeItem ("<h1>Hello World</h1>" :: String)+-}+constRoute :: FilePath -> Routes+constRoute = customRoute . const+++--------------------------------------------------------------------------------+{- | Create a "substituting" route that searches for substrings (in the+underlying identifier) that match the given pattern and transforms them+according to the given replacement function.+The identifier here is that of the underlying item being processed and is+interpreted as an destination filepath. It's normally the filepath of the+source file being processed.+See 'Hakyll.Core.Identifier.Identifier' for details.++Hint: The name "gsub" comes from a similar function in+[R](https://www.r-project.org) and can be read as "globally substituting"+(globally in the Unix sense of repeated, not just once).++=== __Examples__+__Route that replaces part of the filepath__++> -- e.g. file on disk: '<project-directory>/posts/hakyll.md'+>+> -- 'hakyll.md' source file implicitly gets filepath as identifier:+> -- 'posts/hakyll.md'+> match "posts/*" $ do+>+>     -- compilation result is written to '<destination-directory>/haskell/hakyll.md'+>     route $ gsubRoute "posts/" (const "haskell/")+>+>     compile getResourceBody+Note that "posts\/" is replaced with "haskell\/" in the destination filepath.++__Route that removes part of the filepath__++> -- implicitly gets identifier: 'tags/rss/bar.xml'+> create ["tags/rss/bar.xml"] $ do+>+>     -- compilation result is written to '<destination-directory>/tags/bar.xml'+>     route $ gsubRoute "rss/" (const "")+>+>     compile ...+Note that "rss\/" is removed from the destination filepath.+-}+gsubRoute :: String              -- ^ Pattern to repeatedly match against in the underlying identifier+          -> (String -> String)  -- ^ Replacement function to apply to the matched substrings+          -> Routes              -- ^ Resulting route+gsubRoute pattern replacement = customRoute $+    normalise . replaceAll pattern (replacement . removeWinPathSeparator) . removeWinPathSeparator . toFilePath+    where+        -- Filepaths on Windows containing `\\' will trip Regex matching, which+        -- is used in replaceAll. We normalise filepaths to have '/' as a path separator+        -- using removeWinPathSeparator+++--------------------------------------------------------------------------------+{- | Wrapper function around other route construction functions to get+access to the metadata (of the underlying item being processed) and use that for+the destination filepath construction.+Warning: you have to+__ensure that the accessed metadata fields actually exist__.++=== __Examples__+__Route that uses a custom slug markdown metadata field__++To create a search engine optimized yet human-readable url, we can introduce+a [slug](https://en.wikipedia.org/wiki/Clean_URL#Slug) metadata field to our+files, e.g. like in the following Markdown file: 'posts\/hakyll.md'++> ---+> title: Hakyll Post+> slug: awesome-post+> ...+> ---+> In this blog post we learn about Hakyll ...++Then we can construct a route whose destination filepath is based on that field:++> match "posts/*" $ do+>+>     -- compilation result is written to '<destination-directory>/awesome-post.html'+>     route $ metadataRoute $ \meta ->+>         constRoute $ fromJust (lookupString "slug" meta) <> ".html"+>+>     compile pandocCompiler+Note how we wrap 'metadataRoute' around the 'constRoute' function and how the+slug is looked up from the markdown field to construct the destination filepath.+You can use helper functions like 'Hakyll.Core.Metadata.lookupString' to access+a specific metadata field.+-}+metadataRoute :: (Metadata -> Routes) -- ^ Wrapped route construction function+              -> Routes               -- ^ Resulting route+metadataRoute f = Routes $ \r i -> do+    metadata <- resourceMetadata (routesProvider r) (routesUnderlying r)+    unRoutes (f metadata) r i+++--------------------------------------------------------------------------------+{- | Compose two routes where __the first route is applied before the second__.+So @f \`composeRoutes\` g@ is more or less equivalent with @g . f@.++Warning: If the first route fails (e.g. when using 'matchRoute'), Hakyll will+not apply the second route (if you need Hakyll to try the second route,+use '<>' on 'Routes' instead).++=== __Examples__+__Route that applies two transformations__++> -- e.g. file on disk: '<project-directory>/posts/hakyll.md'+>+> -- 'hakyll.md' source file implicitly gets filepath as identifier:+> -- 'posts/hakyll.md'+> match "posts/*" $ do+>+>     -- compilation result is written to '<destination-directory>/hakyll.html'+>     route $ gsubRoute "posts/" (const "") `composeRoutes` setExtension "html"+>+>     compile pandocCompiler+The identifier here is that of the underlying item being processed and is+interpreted as an destination filepath.+See 'Hakyll.Core.Identifier.Identifier' for details.+Note how we first remove the "posts\/" substring from that destination filepath+ with 'gsubRoute' and then replace the extension with 'setExtension'.+-}+composeRoutes :: Routes  -- ^ First route to apply+              -> Routes  -- ^ Second route to apply+              -> Routes  -- ^ Resulting route+composeRoutes (Routes f) (Routes g) = Routes $ \p i -> do+    (mfp, um) <- f p i+    case mfp of+        Nothing -> return (Nothing, um)+        Just fp -> do+            (mfp', um') <- g p (fromFilePath fp)+            return (mfp', um || um')
+ lib/Hakyll/Core/Rules.hs view
@@ -0,0 +1,495 @@+--------------------------------------------------------------------------------+-- | This module provides a declarative Domain Specific Language (DSL) to+-- generate a static site by specifying transformation 'Rules' (although the+-- use case is not limited to static sites).+-- Each rule normally consists of three parts:+-- +-- 1. Source files (like Markdown files) to process (collected with e.g.+-- 'match' or 'create').+-- 2. Compilation steps (like Markdown to HTML) to transform files' content+-- to some output content (steps are collected within +-- 'Hakyll.Core.Compiler.Compiler' and executed with 'compile').+-- 3. Routing to determine if and where an output content will be written out. +-- For a static site this determines under which URL the output content will +-- be available (configured with 'route' and 'Hakyll.Core.Routes.Routes').+-- +-- A typical usage example looks as follows:+-- +-- > -- write 'match "posts/**.md"' instead of 'match $ fromGlob "posts/**.md"'+-- > {-# LANGUAGE OverloadedStrings #-}    +-- > ...+-- >+-- > main = hakyll $ do+-- >+-- >     -- Rule 1+-- >     -- Source files: all Markdown files like 'hakyll.md' in the 'posts' directory+-- >     match "posts/**.md" $ do          +-- >         -- Routing: Only replace extension, so '<destination-directory>/posts/hakyll.html'.+-- >         route $ setExtension "html"   +-- >         -- Compilation step(s): Transform Markdown file content into HTML output.+-- >         compile pandocCompiler        +-- >+-- >     -- Rule 2+-- >     match "css/*" $ do+-- >         route idRoute+-- >         compile compressCssCompiler+-- >     ...+-- __The order of rules doesn't matter.__ +-- +-- See official [Hakyll Rules tutorial](https://jaspervdj.be/hakyll/tutorials/03-rules-routes-compilers.html)+-- for other examples.+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+module Hakyll.Core.Rules+    ( Rules+    , match+    , matchMetadata+    , create+    , version+    , compile+    , route++      -- * Advanced usage+    , preprocess+    , Dependency (..)+    , rulesExtraDependencies+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad.Reader           (ask, local)+import           Control.Monad.State            (get, modify, put)+import           Control.Monad.Trans            (liftIO)+import           Control.Monad.Writer           (censor, tell)+import           Data.Maybe                     (fromMaybe)+import qualified Data.Set                       as S+++--------------------------------------------------------------------------------+import           Data.Binary                    (Binary)+import           Data.Typeable                  (Typeable)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler.Internal+import           Hakyll.Core.Dependencies+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern+import           Hakyll.Core.Item+import           Hakyll.Core.Item.SomeItem+import           Hakyll.Core.Metadata+import           Hakyll.Core.Routes+import           Hakyll.Core.Rules.Internal+import           Hakyll.Core.Writable+++--------------------------------------------------------------------------------+-- | Add a route+tellRoute :: Routes -> Rules ()+tellRoute route' = Rules $ tell $ RuleSet route' mempty mempty mempty+++--------------------------------------------------------------------------------+-- | Add a number of compilers+tellCompilers :: [(Identifier, Compiler SomeItem)] -> Rules ()+tellCompilers compilers = Rules $ tell $ RuleSet mempty compilers mempty mempty+++--------------------------------------------------------------------------------+-- | Add resources+tellResources :: [Identifier] -> Rules ()+tellResources resources' = Rules $ tell $+    RuleSet mempty mempty (S.fromList resources') mempty+++--------------------------------------------------------------------------------+-- | Add a pattern+tellPattern :: Pattern -> Rules ()+tellPattern pattern = Rules $ tell $ RuleSet mempty mempty mempty pattern+++--------------------------------------------------------------------------------+flush :: Rules ()+flush = Rules $ do+    mcompiler <- rulesCompiler <$> get+    case mcompiler of+        Nothing       -> return ()+        Just compiler -> do+            matches' <- rulesMatches                  <$> ask+            version' <- rulesVersion                  <$> ask+            route'   <- fromMaybe mempty . rulesRoute <$> get++            -- The version is possibly not set correctly at this point (yet)+            let ids = map (setVersion version') matches'++            {-+            ids      <- case fromLiteral pattern of+                Just id' -> return [setVersion version' id']+                Nothing  -> do+                    ids <- unRules $ getMatches pattern+                    unRules $ tellResources ids+                    return $ map (setVersion version') ids+            -}++            -- Create a fast pattern for routing that matches exactly the+            -- compilers created in the block given to match+            let fastPattern = fromList ids++            -- Write out the compilers and routes+            unRules $ tellRoute $ matchRoute fastPattern route'+            unRules $ tellCompilers $ [(id', compiler) | id' <- ids]++    put $ emptyRulesState+++--------------------------------------------------------------------------------+matchInternal :: Pattern -> Rules [Identifier] -> Rules () -> Rules ()+matchInternal pattern getIDs rules = do+    tellPattern pattern+    flush+    ids <- getIDs+    tellResources ids+    Rules $ local (setMatches ids) $ unRules $ rules >> flush+  where+    setMatches ids env = env {rulesMatches = ids}++--------------------------------------------------------------------------------+{- | Add a selection of which source files to process (using the+given [glob pattern](https://en.wikipedia.org/wiki/Glob_(programming\))) to the+given remaining 'Rules' value.++The expanded, relative path of the matched source file on disk (relative to the+project directory configured with 'Hakyll.Core.Configuration.providerDirectory')+becomes the identifier under which the compilation result is saved to the+'Hakyll.Core.Store.Store' (in case you want to 'Hakyll.Core.Compiler.load' it+within another rule).+See 'Hakyll.Core.Identifier.Identifier' for details.++=== __Examples__++__Select all markdown files within a directory (but without subdirectories)__++> -- Match all Markdown files in the immediate 'posts' directory+> -- e.g. '<project-directory>/posts/hakyll.md'+> -- but NOT  '<project-directory>/posts/haskell/monad.md'+> match "posts/*.md" $ do+>     route $ setExtension "html"+>     compile pandocCompiler++__Select all markdown files within a directory (including subdirectories recursively)__++> -- Match all Markdown files in the 'posts' directory and any subdirectory+> -- e.g. '<project-directory>/posts/hakyll.md'+> -- and  '<project-directory>/posts/haskell/monad.md'+> match "posts/**.md" $ do+>     route $ setExtension "html"+>     compile pandocCompiler+See 'Hakyll.Core.Identifier.Pattern.Pattern' or search "glob patterns" online+for more details. To control where the compilation result will be written out,+use routing functions like 'Hakyll.Core.Routes.setExtension'.+-}+match :: Pattern  -- ^ Glob pattern+      -> Rules () -- ^ Remaining processing parts+      -> Rules () -- ^ Result+match pattern = matchInternal pattern $ getMatches pattern+++--------------------------------------------------------------------------------+{- | Add a selection of which source files to process (using the+given [glob pattern](https://en.wikipedia.org/wiki/Glob_(programming\)) and+metadata predicate) to the given remaining 'Rules' values. Same as 'match' but+allows to filter files further based on their (metadata) content (a file is+added only when the metadata predicate returns @True@).++The expanded, relative path of the matched source file on disk (relative to the+project directory configured with 'Hakyll.Core.Configuration.providerDirectory')+becomes the identifier under which the compilation result is saved to+the 'Hakyll.Core.Store.Store' (in case you want to 'Hakyll.Core.Compiler.load'+it within another rule).+See 'Hakyll.Core.Identifier.Identifier' for details.++=== __Examples__+__Select all markdown files with enabled draft flag within a directory__++> matchMetadata "posts/*.md" (\meta -> maybe False (=="true") $ lookupString "draft" meta) $ do+>     route $ setExtension "html"+>     compile pandocCompiler++For example, the following 'posts/hakyll.md' file with @draft: true@ metadata+would match:++> ---+> draft: true+> title: Hakyll Post+> ...+> ---+> In this blog post we learn about Hakyll ...+Note that files that have @draft: false@ or no such draft field at all, would+not match. You can use helper functions like 'Hakyll.Core.Metadata.lookupString'+to access a specific metadata field, and 'Data.Maybe.maybe' to work with+'Data.Maybe.Maybe'. To control where the compilation result will be written out,+use routing functions like 'Hakyll.Core.Routes.setExtension'.+-}+matchMetadata :: Pattern             -- ^ Glob pattern+              -> (Metadata -> Bool)  -- ^ Metadata predicate+              -> Rules ()            -- ^ Remaining processing parts+              -> Rules ()            -- ^ Result+matchMetadata pattern metadataPred = matchInternal pattern $+    map fst . filter (metadataPred . snd) <$> getAllMetadata pattern+++--------------------------------------------------------------------------------+{- | Assign (and thereby create) the given identifier(s) to content that has no+underlying source file on disk. That content must be created within the+'compile' part of the given remaining 'Rules' value. The given identifier is the+id under which the compilation is saved to the 'Hakyll.Core.Store.Store' (in+case you want to 'Hakyll.Core.Compiler.load' it within another rule).+See 'Hakyll.Core.Identifier.Identifier' for details.++Use this function for example to create an overview page that doesn't have or+need its content prepared in a file (unlike blog posts which normally have a+corresponding Markdown source file on disk).++=== __Examples__+__Create a webpage without an underlying source file__++> -- saved with implicit identifier 'index.html' to Store+> create ["index.html"] $ do+>+>     -- compilation result is written to '<destination-directory>/index.html'+>     route idRoute+>+>     -- create content without a source file from disk+>     compile $ makeItem ("<h1>Hello World</h1>" :: String)+Note how you can use 'Hakyll.Core.Compiler.makeItem' to create content inline+(to be processed as a 'Hakyll.Core.Compiler.Compiler' value) as if that content+was loaded from a file (as it's the case when using 'match').+To control where the compilation result will be written out, use routing+functions like 'Hakyll.Core.Routes.idRoute'.+-}+create :: [Identifier] -- ^ Identifiers to assign to created content in next argument+       -> Rules ()     -- ^ Remaining processing parts that must create content+       -> Rules ()     -- ^ Resulting rule+create ids rules = do+    flush+    -- TODO Maybe check if the resources exist and call tellResources on that+    Rules $ local setMatches $ unRules $ rules >> flush+  where+    setMatches env = env {rulesMatches = ids}+++--------------------------------------------------------------------------------+{- | Add the given version name to the implicit identifier(s) under which the+compilation result of the given remaining 'Rules' value is saved to the+'Hakyll.Core.Store.Store'.+See 'Hakyll.Core.Identifier.Identifier' for details.++Use this wrapper function for example when you need to compile the same source+file into two or more different results, each with a different version name.+The version is needed to distinguish between these different compilation results+in the store, otherwise they would get the same conflicting identifier in the+store.++Warning:+__If you add a version name with this function, you need to supply the same name__+when you 'Hakyll.Core.Compiler.load' the content from the store from+within another rule.++=== __Examples__+__Compile source file into differently versioned outputs and load both__++> -- e.g. file on disk: 'posts/hakyll.md'+>+> -- saved with implicit identifier ('posts/hakyll.md', no-version)+> match "posts/*" $ do+>     route $ setExtension "html"+>     compile pandocCompiler+>+> -- saved with implicit identifier ('posts/hakyll.md', version 'raw')+> match "posts/*" $ version "raw" $ do+>     route idRoute+>     compile getResourceBody+>+> -- use compilation results from rules above+> create ["index.html"] $ do+>     route idRoute+>     compile $ do+>         -- load no-version version+>         compiledPost <- load (fromFilePath "posts/hakyll.md")+>         -- load version 'raw'+>         rawPost <- load . setVersion (Just "raw") $ fromFilePath "posts/hakyll.md"+>         ...+Note how a version name is needed to distinguish the unversioned and the "raw"+version when loading the Hakyll post for the @index.html@ page.+To control where the compilation result will be written out, use routing+functions like 'Hakyll.Core.Routes.idRoute' and 'Hakyll.Core.Routes.setExtension'.+-}+version :: String   -- ^ Version name to add+        -> Rules () -- ^ Remaining processing parts+        -> Rules () -- ^ Result+version v rules = do+    flush+    Rules $ local setVersion' $ unRules $ rules >> flush+  where+    setVersion' env = env {rulesVersion = Just v}+++--------------------------------------------------------------------------------+{- | Add (or replace) the given compilation steps within the given+'Hakyll.Core.Compiler.Compiler' value to the current 'Rules' value.+__This functions controls HOW the content within a rule is processed__ (use one+of the 'match' functions to control WHAT content is processed).++The compilation result is saved to the 'Hakyll.Core.Store.Store' under an+implicit identifier.+See 'Hakyll.Core.Identifier.Identifier' for details.++If there's routing attached to the rule where this function is used, the+compilation result is also written out to a file according to that route.+See 'route' and 'Hakyll.Core.Routes.Routes' for details.++=== __Examples__+__Compile Markdown to HTML__++> -- Select all Markdown files in 'posts' directory+> match "posts/**.md" $ do+>+>     route $ setExtension "html"+>+>     -- use pandoc to transform Markdown to HTML in a single step+>     compile pandocCompiler+Note how we set the content to be processed with+'Hakyll.Web.Pandoc.pandocCompiler'. The content comes implicitly from the+matched Markdown files on disk. We don't have to pass that content around+manually. Every file is processed the same way within this one rule.++To control where the compilation result will be written out, use routing+functions like 'Hakyll.Core.Routes.setExtension'.+Here the compilation result of a file like @posts\/hakyll.md@ is written out+to @posts\/hakyll.html@.++__Compile Markdown to HTML and embed it in a template__++> -- Select all Markdown files in 'posts' directory+> match "posts/**.md" $ do+>     route $ setExtension "html"+>     compile $+>         pandocCompiler >>=+>           loadAndApplyTemplate "templates/post.html" defaultContext+>+> -- To Hakyll templates are just plain files that have to be processed+> -- and placed into the store like any other file (but without routing).+> -- e.g. file on disk: 'templates/post.html'+> match "templates/*" $ compile templateBodyCompiler+Note how a Markdown post that is compiled to HTML using+'Hakyll.Web.Pandoc.pandocCompiler' in a first step and then embedded into+a HTMl 'Hakyll.Web.Template.Template' in a second step by using+'Hakyll.Web.Template.loadAndApplyTemplate'.+We can use templates to control the design and layout of a webpage.+A template may look as follows:++> <h1>$title$</h1>+> $body$+See "Hakyll.Web.Template" to see examples of the templating syntax.+-}+compile :: (Binary a, Typeable a, Writable a) => Compiler (Item a) -- ^ How to transform content+                                              -> Rules ()          -- ^ Result+compile compiler = Rules $ modify $ \s ->+    s {rulesCompiler = Just (fmap SomeItem compiler)}+++--------------------------------------------------------------------------------+{- | Add (or replace) routing in the current 'Rules' value.+__This functions controls IF and WHERE the compiled results are written out__+(use one of the 'match' functions to control WHAT content is processed and+'compile' to control HOW).+See 'Hakyll.Core.Routes.Routes' and 'Hakyll.Core.Identifier.Identifier' for+details on how output filepaths are computed.++Hint:+__If there's no route attached to a rule, the compilation result is not written out__.+However, the compilation result is saved to the 'Hakyll.Core.Store.Store'+and can be loaded and used within another rule. This behavior is needed,+for example, for templates.++=== __Examples__+__Rules with and without routing__++> -- e.g. file on disk: 'templates/post.html'+>+> -- Rule 1 (without routing)+> match "templates/*" $ do+>     -- compilation result saved to store with implicit identifier, e.g. 'templates/post.html'+>     compile templateCompiler+>+> -- Rule 2 (with routing)+> match "posts/**.md" $ do+>     route $ setExtension "html"+>     compile $ do+>        -- load compiled result of other rule with explicit identifier.+>        postTemplate <- loadBody "templates/post.html"+>        pandocCompiler >>= applyTemplate postTemplate defaultContext+Note that we don't set a route in the first rule to avoid writing out our+compiled templates.+However, we can still 'Hakyll.Core.Compiler.load' (or+'Hakyll.Core.Compiler.loadBody') the compiled templates to apply them in a+second rule.+The content for 'Hakyll.Web.Template.templateCompiler' comes implicitly from the+matched template files on disk. We don't have to pass that content around+manually. See 'match' and 'compile' for details.++To control where a compilation result will be written out (as done in the second+rule), use routing functions like 'Hakyll.Core.Routes.setExtension'.++See "Hakyll.Web.Template" for examples of templates and the templating syntax.+-}+route :: Routes   -- ^ Where to output compilation results+      -> Rules () -- ^ Result+route route' = Rules $ modify $ \s -> s {rulesRoute = Just route'}+++--------------------------------------------------------------------------------+-- | Execute an 'IO' action immediately while the rules are being evaluated.+-- This should be avoided if possible, but occasionally comes in useful.+preprocess :: IO a -> Rules a+preprocess = Rules . liftIO+++--------------------------------------------------------------------------------+-- | Advanced usage: add extra dependencies to compilers. Basically this is+-- needed when you're doing unsafe tricky stuff in the rules monad, but you+-- still want correct builds.+--+-- A useful utility for this purpose is 'makePatternDependency'.+rulesExtraDependencies :: [Dependency] -> Rules a -> Rules a+rulesExtraDependencies deps rules =+    -- Note that we add the dependencies seemingly twice here. However, this is+    -- done so that 'rulesExtraDependencies' works both if we have something+    -- like:+    --+    -- > match "*.css" $ rulesExtraDependencies [foo] $ ...+    --+    -- and something like:+    --+    -- > rulesExtraDependencies [foo] $ match "*.css" $ ...+    --+    -- (1) takes care of the latter and (2) of the former.+    Rules $ censor fixRuleSet $ do+        x <- unRules rules+        fixCompiler+        return x+  where+    -- (1) Adds the dependencies to the compilers we are yet to create+    fixCompiler = modify $ \s -> case rulesCompiler s of+        Nothing -> s+        Just c  -> s+            { rulesCompiler = Just $ compilerTellDependencies deps >> c+            }++    -- (2) Adds the dependencies to the compilers that are already in the ruleset+    fixRuleSet ruleSet = ruleSet+        { rulesCompilers =+            [ (i, compilerTellDependencies deps >> c)+            | (i, c) <- rulesCompilers ruleSet+            ]+        }
+ lib/Hakyll/Core/Rules/Internal.hs view
@@ -0,0 +1,116 @@+--------------------------------------------------------------------------------+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE Rank2Types                 #-}+module Hakyll.Core.Rules.Internal+    ( RulesRead (..)+    , RuleSet (..)+    , RulesState (..)+    , emptyRulesState+    , Rules (..)+    , runRules+    ) where+++--------------------------------------------------------------------------------+#if !MIN_VERSION_base(4,13,0)+import           Control.Monad.Fail             (MonadFail)+#endif+import           Control.Monad.Reader           (ask)+import           Control.Monad.RWS              (RWST, runRWST)+import           Control.Monad.Trans            (liftIO)+import qualified Data.Map                       as M+import           Data.Set                       (Set)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler.Internal+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern+import           Hakyll.Core.Item.SomeItem+import           Hakyll.Core.Metadata+import           Hakyll.Core.Provider+import           Hakyll.Core.Routes+++--------------------------------------------------------------------------------+data RulesRead = RulesRead+    { rulesProvider :: Provider+    , rulesMatches  :: [Identifier]+    , rulesVersion  :: Maybe String+    }+++--------------------------------------------------------------------------------+data RuleSet = RuleSet+    { -- | Accumulated routes+      rulesRoutes    :: Routes+    , -- | Accumulated compilers+      rulesCompilers :: [(Identifier, Compiler SomeItem)]+    , -- | A set of the actually used files+      rulesResources :: Set Identifier+    , -- | A pattern we can use to check if a file *would* be used. This is+      -- needed for the preview server.+      rulesPattern   :: Pattern+    }+++--------------------------------------------------------------------------------+instance Semigroup RuleSet where+    (<>) (RuleSet r1 c1 s1 p1) (RuleSet r2 c2 s2 p2) =+        RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) (p1 .||. p2)++instance Monoid RuleSet where+    mempty  = RuleSet mempty mempty mempty mempty+    mappend = (<>)+++--------------------------------------------------------------------------------+data RulesState = RulesState+    { rulesRoute    :: Maybe Routes+    , rulesCompiler :: Maybe (Compiler SomeItem)+    }+++--------------------------------------------------------------------------------+emptyRulesState :: RulesState+emptyRulesState = RulesState Nothing Nothing+++--------------------------------------------------------------------------------+-- | The monad used to compose rules+newtype Rules a = Rules+    { unRules :: RWST RulesRead RuleSet RulesState IO a+    } deriving (Monad, MonadFail, Functor, Applicative)+++--------------------------------------------------------------------------------+instance MonadMetadata Rules where+    getMetadata identifier = Rules $ do+        provider <- rulesProvider <$> ask+        liftIO $ resourceMetadata provider identifier++    getMatches pattern = Rules $ do+        provider <- rulesProvider <$> ask+        return $ filterMatches pattern $ resourceList provider+++--------------------------------------------------------------------------------+-- | Run a Rules monad, resulting in a 'RuleSet'+runRules :: Rules a -> Provider -> IO RuleSet+runRules rules provider = do+    (_, _, ruleSet) <- runRWST (unRules rules) env emptyRulesState++    -- Ensure compiler uniqueness+    let ruleSet' = ruleSet+            { rulesCompilers = M.toList $+                M.fromListWith (flip const) (rulesCompilers ruleSet)+            }++    return ruleSet'+  where+    env = RulesRead+        { rulesProvider = provider+        , rulesMatches  = []+        , rulesVersion  = Nothing+        }
+ lib/Hakyll/Core/Runtime.hs view
@@ -0,0 +1,539 @@+--------------------------------------------------------------------------------+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}+module Hakyll.Core.Runtime+    ( run+    , RunMode(..)+    ) where+++--------------------------------------------------------------------------------+import           Control.Concurrent            (forkIO, getNumCapabilities,+                                                rtsSupportsBoundThreads)+import qualified Control.Concurrent.MVar       as MVar+import           Control.Exception             (SomeException, try)+import           Control.Monad                 (replicateM_, unless, void, when)+import           Control.Monad.Reader          (ReaderT, ask, runReaderT)+import           Control.Monad.Trans           (liftIO)+import           Data.Foldable                 (for_, traverse_)+import qualified Data.Graph                    as Graph+import           Data.IORef                    (IORef)+import qualified Data.IORef                    as IORef+import           Data.List                     (intercalate)+#if !(MIN_VERSION_base(4,20,0))+import           Data.List                     (foldl')+#endif+import           Data.Map                      (Map)+import qualified Data.Map                      as Map+import           Data.Maybe                    (fromMaybe)+import           Data.Sequence                 (Seq)+import qualified Data.Sequence                 as Seq+import           Data.Set                      (Set)+import qualified Data.Set                      as Set+import           System.Exit                   (ExitCode (..))+import           System.FilePath               ((</>))+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler.Internal+import           Hakyll.Core.Compiler.Require+import           Hakyll.Core.Configuration+import           Hakyll.Core.Dependencies+import           Hakyll.Core.Identifier+import           Hakyll.Core.Item+import           Hakyll.Core.Item.SomeItem+import           Hakyll.Core.Logger            (Logger)+import qualified Hakyll.Core.Logger            as Logger+import           Hakyll.Core.Provider+import           Hakyll.Core.Routes+import           Hakyll.Core.Rules.Internal+import           Hakyll.Core.Store             (Store)+import qualified Hakyll.Core.Store             as Store+import           Hakyll.Core.Util.File+import           Hakyll.Core.Writable+++factsKey :: [String]+factsKey = ["Hakyll.Core.Runtime.run", "facts"]+++--------------------------------------------------------------------------------+-- | Whether to execute a normal run (build the site) or a dry run.+data RunMode = RunModeNormal | RunModePrintOutOfDate+    deriving (Show)+++--------------------------------------------------------------------------------+run :: RunMode -> Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)+run mode config logger rules = do+    -- Initialization+    Logger.header logger "Initialising..."+    Logger.message logger "Creating store..."+    store <- Store.new (inMemoryCache config) $ storeDirectory config+    Logger.message logger "Creating provider..."+    (provider, modifiedMeta) <- newProvider store (shouldIgnoreFile config) $+        providerDirectory config+    Logger.message logger "Running rules..."+    ruleSet  <- runRules rules provider++    -- Get old facts+    mOldFacts <- Store.get store factsKey+    let (oldFacts) = case mOldFacts of Store.Found f -> f+                                       _             -> mempty++    -- Build runtime read/state+    scheduler <- IORef.newIORef $ emptyScheduler {schedulerFacts = oldFacts}+    let compilers = rulesCompilers ruleSet+        read'     = RuntimeRead+            { runtimeConfiguration = config+            , runtimeLogger        = logger+            , runtimeProvider      = provider+            , runtimeModifiedMeta  = Set.fromList modifiedMeta+            , runtimeStore         = store+            , runtimeRoutes        = rulesRoutes ruleSet+            , runtimeUniverse      = Map.fromList compilers+            , runtimeScheduler     = scheduler+            }++    -- Run the program and fetch the resulting state+    runReaderT (build mode) read'+    errors <- schedulerErrors <$> IORef.readIORef scheduler+    if null errors then do+        Logger.debug logger "Removing tmp directory..."+        removeDirectory $ tmpDirectory config++        Logger.flush logger+        return (ExitSuccess, ruleSet)+    else do+        for_ errors $ \(mbId, err) -> Logger.error logger $ case mbId of+            Just identifier -> show identifier <> ": " <> err+            Nothing         -> err+        Logger.flush logger+        return (ExitFailure 1, ruleSet)+++--------------------------------------------------------------------------------+data RuntimeRead = RuntimeRead+    { runtimeConfiguration :: Configuration+    , runtimeLogger        :: Logger+    , runtimeProvider      :: Provider+    , runtimeModifiedMeta  :: Set Identifier+    , runtimeStore         :: Store+    , runtimeRoutes        :: Routes+    , runtimeUniverse      :: Map Identifier (Compiler SomeItem)+    , runtimeScheduler     :: IORef Scheduler+    }+++--------------------------------------------------------------------------------+-- | A Scheduler is a pure representation of work going on, works that needs+-- to be done, and work already done.  Workers can obtain things to do+-- by interacting with the Scheduler, and execute them synchronously or+-- asynchronously.+--+-- All operations on Scheduler look like 'Scheduler -> (Scheduler, a)' and+-- should be used with atomicModifyIORef'.+data Scheduler = Scheduler+    { -- | Items to work on next.  Identifiers may appear multiple times.+      schedulerQueue     :: !(Seq Identifier)+    , -- | Items that we haven't started yet.+      schedulerTodo      :: !(Map Identifier (Compiler SomeItem))+    , -- | Currently processing+      schedulerWorking   :: !(Set Identifier)+    , -- | Finished+      schedulerDone      :: !(Set Identifier)+    , -- | Any snapshots stored.+      schedulerSnapshots :: !(Set (Identifier, Snapshot))+    , -- | Any routed files and who wrote them.  This is used to detect multiple+      -- writes to the same file, which can yield inconsistent results.+      schedulerRoutes    :: !(Map FilePath Identifier)+    , -- | Currently blocked compilers.+      schedulerBlocked   :: !(Set Identifier)+    , -- | Compilers that may resume on triggers+      schedulerTriggers  :: !(Map Identifier (Set Identifier))+    , -- | Number of starved pops; tracking this allows us to start a new+      -- number of threads again later.+      schedulerStarved   :: !Int+    , -- | Dynamic dependency info.+      schedulerFacts     :: !DependencyFacts+    , -- | Errors encountered.+      schedulerErrors    :: ![(Maybe Identifier, String)]+    }+++--------------------------------------------------------------------------------+emptyScheduler :: Scheduler+emptyScheduler = Scheduler {..}+  where+    schedulerTodo      = Map.empty+    schedulerDone      = Set.empty+    schedulerQueue     = Seq.empty+    schedulerWorking   = Set.empty+    schedulerSnapshots = Set.empty+    schedulerRoutes    = Map.empty+    schedulerBlocked   = Set.empty+    schedulerTriggers  = Map.empty+    schedulerStarved   = 0+    schedulerFacts     = Map.empty+    schedulerErrors    = []+++--------------------------------------------------------------------------------+schedulerError :: Maybe Identifier -> String -> Scheduler -> (Scheduler, ())+schedulerError i e s = (s {schedulerErrors = (i, e) : schedulerErrors s}, ())+++--------------------------------------------------------------------------------+schedulerMarkOutOfDate+    :: Map Identifier (Compiler SomeItem)+    -> Set Identifier+    -> Set Identifier+    -> Scheduler+    -> (Scheduler, [String])+schedulerMarkOutOfDate universe modifiedC modifiedM scheduler@Scheduler {..} =+    ( scheduler+        { schedulerQueue = schedulerQueue <> Seq.fromList (Map.keys todo)+        , schedulerDone  = schedulerDone <>+            (Map.keysSet universe `Set.difference` ood)+        , schedulerTodo  = schedulerTodo <> todo+        , schedulerFacts = facts'+        }+    , msgs+    )+  where+    (ood, facts', msgs) = outOfDate (Map.keys universe) modifiedC modifiedM schedulerFacts+    todo = Map.filterWithKey (\id' _ -> id' `Set.member` ood) universe+++--------------------------------------------------------------------------------+data SchedulerStep+    -- | The scheduler instructs to offer some work on the given item.  It+    -- also returns the number of threads that can be resumed after they have+    -- starved.+    = SchedulerWork Identifier (Compiler SomeItem) Int+    -- | There's currently no work available, but there will be after other+    -- threads have finished whatever they are doing.+    | SchedulerStarve+    -- | We've finished all work.+    | SchedulerFinish+    -- | An error occurred.  You can retrieve the errors from 'schedulerErrors'.+    | SchedulerError+++--------------------------------------------------------------------------------+schedulerPop :: Scheduler -> (Scheduler, SchedulerStep)+schedulerPop scheduler@Scheduler {..} = case Seq.viewl schedulerQueue of+    Seq.EmptyL+        | not $ Set.null schedulerWorking ->+            ( scheduler {schedulerStarved = schedulerStarved + 1}+            , SchedulerStarve+            )+        | not $ Set.null schedulerBlocked ->+            let cycles = schedulerCycles scheduler+                msg | null cycles = "Possible dependency cycle in: " <>+                        intercalate ", " (show <$> Set.toList schedulerBlocked)+                    | otherwise = "Dependency cycles: " <>+                        intercalate "; "+                            (map (intercalate " -> " . map show) cycles) in+            SchedulerError <$ schedulerError Nothing msg scheduler+        | otherwise -> (scheduler, SchedulerFinish)+    x Seq.:< xs+        | x `Set.member` schedulerDone ->+            schedulerPop scheduler {schedulerQueue = xs}+        | x `Set.member` schedulerWorking ->+            schedulerPop scheduler {schedulerQueue = xs}+        | x `Set.member` schedulerBlocked ->+            schedulerPop scheduler {schedulerQueue = xs}+        | otherwise -> case Map.lookup x schedulerTodo of+            Nothing -> SchedulerError <$+                schedulerError (Just x) "Compiler not found" scheduler+            Just c  ->+                ( scheduler+                    { schedulerQueue   = xs+                    , schedulerWorking = Set.insert x schedulerWorking+                    }+                , SchedulerWork x c 0+                )+++--------------------------------------------------------------------------------+schedulerCycles :: Scheduler -> [[Identifier]]+schedulerCycles Scheduler {..} =+    [c | Graph.CyclicSCC c <- Graph.stronglyConnComp graph]+  where+    graph = [(x, x, Set.toList ys) | (x, ys) <- Map.toList edges]+    edges = Map.fromListWith Set.union $ do+        (dep, xs) <- Map.toList $ schedulerTriggers+        x <- Set.toList xs+        pure (x, Set.singleton dep)+++--------------------------------------------------------------------------------+schedulerBlock+    :: Identifier+    -> [(Identifier, Snapshot)]+    -> Compiler SomeItem+    -> Scheduler+    -> (Scheduler, SchedulerStep)+schedulerBlock identifier deps0 compiler scheduler@Scheduler {..}+    | null deps1 = (scheduler, SchedulerWork identifier compiler 0)+    | otherwise  = schedulerPop $ scheduler+         { schedulerQueue    =+             -- Optimization: move deps to the front and item to the back+             Seq.fromList depIds <>+             schedulerQueue <>+             Seq.singleton identifier+         , schedulerTodo     =+             Map.insert identifier+                 (Compiler $ \_ -> pure $ CompilerRequire deps0 compiler)+                 schedulerTodo+         , schedulerWorking  = Set.delete identifier schedulerWorking+         , schedulerBlocked  = Set.insert identifier schedulerBlocked+         , schedulerTriggers = foldl'+             (\acc (depId, _) ->+                 Map.insertWith Set.union depId (Set.singleton identifier) acc)+             schedulerTriggers+             deps1+         }+  where+    deps1  = filter (not . done) deps0+    depIds = map fst deps1++    -- Done if we either completed the entire item (runtimeDone) or+    -- if we previously saved the snapshot (runtimeSnapshots).+    done (depId, depSnapshot) =+        depId `Set.member` schedulerDone ||+        (depId, depSnapshot) `Set.member` schedulerSnapshots+++--------------------------------------------------------------------------------+schedulerUnblock :: Identifier -> Scheduler -> (Scheduler, Int)+schedulerUnblock identifier scheduler@Scheduler {..} =+    ( scheduler+        { schedulerQueue    =+            schedulerQueue <> Seq.fromList (Set.toList triggered)+        , schedulerStarved  = 0+        , schedulerBlocked  = Set.delete identifier $+            schedulerBlocked `Set.difference` triggered+        , schedulerTriggers = Map.delete identifier schedulerTriggers+        }+    , schedulerStarved+    )+  where+    triggered = fromMaybe Set.empty $ Map.lookup identifier schedulerTriggers+++--------------------------------------------------------------------------------+schedulerSnapshot+    :: Identifier -> Snapshot -> Compiler SomeItem+    -> Scheduler -> (Scheduler, SchedulerStep)+schedulerSnapshot identifier snapshot compiler scheduler@Scheduler {..} =+    let (scheduler', resume) = schedulerUnblock identifier scheduler+            { schedulerSnapshots =+                Set.insert (identifier, snapshot) schedulerSnapshots+            } in+    (scheduler', SchedulerWork identifier compiler resume)+++--------------------------------------------------------------------------------+schedulerWrite+    :: Identifier+    -> [Dependency]+    -> Scheduler+    -> (Scheduler, SchedulerStep)+schedulerWrite identifier depFacts scheduler0@Scheduler {..} =+    let (scheduler1, resume) = schedulerUnblock identifier scheduler0+            { schedulerWorking = Set.delete identifier schedulerWorking+            , schedulerFacts   = Map.insert identifier depFacts schedulerFacts+            , schedulerDone    =+                Set.insert identifier schedulerDone+            , schedulerTodo    =+                Map.delete identifier schedulerTodo+            }+        (scheduler2, step) = schedulerPop scheduler1 in+    case step of+        SchedulerWork i c n -> (scheduler2, SchedulerWork i c (n + resume))+        _                   -> (scheduler2, step)+++--------------------------------------------------------------------------------+-- | Record that a specific identifier was routed to a specific filepath.+-- This is used to detect multiple (inconsistent) writes to the same file.+schedulerRoute+    :: Identifier+    -> FilePath+    -> Scheduler+    -> (Scheduler, ())+schedulerRoute id0 path scheduler0@Scheduler {..}+    | Just id1 <- Map.lookup path schedulerRoutes, id0 /= id1 =+        let msg = "multiple writes for route " ++ path ++ ": " +++                show id0 ++ " and " ++ show id1 in+        schedulerError (Just id0) msg scheduler0+    | otherwise =+        let routes = Map.insert path id0 schedulerRoutes in+        (scheduler0 {schedulerRoutes = routes}, ())+++--------------------------------------------------------------------------------+build :: RunMode -> ReaderT RuntimeRead IO ()+build mode = do+    logger <- runtimeLogger <$> ask+    Logger.header logger "Checking for out-of-date items"+    schedulerRef <- runtimeScheduler <$> ask+    scheduleOutOfDate+    case mode of+        RunModeNormal -> do+            Logger.header logger "Compiling"+            if rtsSupportsBoundThreads then pickAndChaseAsync else pickAndChase+            errs <- liftIO $ schedulerErrors <$> IORef.readIORef schedulerRef+            when (null errs) $ Logger.header logger "Success"+            facts <- liftIO $ schedulerFacts <$> IORef.readIORef schedulerRef+            store <- runtimeStore <$> ask+            liftIO $ Store.set store factsKey facts+        RunModePrintOutOfDate -> do+            Logger.header logger "Out of date items:"+            todo <- liftIO $ schedulerTodo <$> IORef.readIORef schedulerRef+            traverse_ (Logger.message logger . show) (Map.keys todo)+++--------------------------------------------------------------------------------+scheduleOutOfDate :: ReaderT RuntimeRead IO ()+scheduleOutOfDate = do+    logger       <- runtimeLogger       <$> ask+    provider     <- runtimeProvider     <$> ask+    modifiedMeta <- runtimeModifiedMeta <$> ask+    universe     <- runtimeUniverse     <$> ask+    schedulerRef <- runtimeScheduler    <$> ask+    let modifiedContent = Set.filter (resourceModified provider) (Map.keysSet universe)+    msgs <- liftIO . IORef.atomicModifyIORef' schedulerRef $+        schedulerMarkOutOfDate universe modifiedContent modifiedMeta++    -- Print messages+    mapM_ (Logger.debug logger) msgs+++--------------------------------------------------------------------------------+pickAndChase :: ReaderT RuntimeRead IO ()+pickAndChase = do+    scheduler <- runtimeScheduler <$> ask+    let go SchedulerFinish       = pure ()+        go SchedulerError        = pure ()+        go (SchedulerWork i c _) = work i c >>= go+        go SchedulerStarve       =+            liftIO . IORef.atomicModifyIORef' scheduler $+            schedulerError Nothing "Starved, possible dependency cycle?"+    pop <- liftIO . IORef.atomicModifyIORef' scheduler $ schedulerPop+    go pop+++--------------------------------------------------------------------------------+pickAndChaseAsync :: ReaderT RuntimeRead IO ()+pickAndChaseAsync = do+    runtimeRead <- ask+    numThreads  <- liftIO getNumCapabilities+    let scheduler = runtimeScheduler runtimeRead+    Logger.message (runtimeLogger runtimeRead) $+        "Using async runtime with " <> show numThreads <> " threads..."+    liftIO $ do+        signal     <- MVar.newEmptyMVar++        let spawnN :: Int -> IO ()+            spawnN n = replicateM_ n $ forkIO $+                IORef.atomicModifyIORef' scheduler schedulerPop >>= go++            go :: SchedulerStep -> IO ()+            go step = case step of+                SchedulerFinish       -> void $ MVar.tryPutMVar signal ()+                SchedulerStarve       -> pure ()+                SchedulerError        -> void $ MVar.tryPutMVar signal ()+                (SchedulerWork i c n) -> do+                    spawnN n+                    step' <- runReaderT (work i c) runtimeRead+                    go step'++        spawnN numThreads+        MVar.readMVar signal+++--------------------------------------------------------------------------------+work :: Identifier -> Compiler SomeItem -> ReaderT RuntimeRead IO SchedulerStep+work id' compiler = do+    logger    <- runtimeLogger        <$> ask+    provider  <- runtimeProvider      <$> ask+    universe  <- runtimeUniverse      <$> ask+    routes    <- runtimeRoutes        <$> ask+    store     <- runtimeStore         <$> ask+    config    <- runtimeConfiguration <$> ask+    scheduler <- runtimeScheduler     <$> ask++    let cread = CompilerRead+            { compilerConfig     = config+            , compilerUnderlying = id'+            , compilerProvider   = provider+            , compilerUniverse   = Map.keysSet universe+            , compilerRoutes     = routes+            , compilerStore      = store+            , compilerLogger     = logger+            }+    result <- liftIO $ runCompiler compiler cread+    case result of+        CompilerError e -> do+            let msgs = case compilerErrorMessages e of+                    [] -> ["Compiler failed but no info given, try running with -v?"]+                    es -> es+            for_ msgs $ \msg -> liftIO . IORef.atomicModifyIORef' scheduler $+                schedulerError (Just id') msg+            return SchedulerError++        CompilerSnapshot snapshot c ->+            liftIO . IORef.atomicModifyIORef' scheduler $+            schedulerSnapshot id' snapshot c++        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+            liftIO . unless (itemIdentifier item == id') $+                IORef.atomicModifyIORef' scheduler $ schedulerError+                    (Just id') $+                    "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.  Note that we want another exception handler+            -- around this: some compilers may successfully produce a+            -- 'CompilerResult', but the thing they are supposed to 'write' can+            -- have an un-evaluated 'error' them.+            routeOrErr <- liftIO $ try $ do+                (mroute, _) <- runRoutes routes provider id'+                for_ mroute $ \route -> do+                    IORef.atomicModifyIORef' scheduler $+                        schedulerRoute id' route+                    let path = destinationDirectory config </> route+                    makeDirectories path+                    write path item+                save store item+                pure mroute++            case routeOrErr of+                Left e -> do+                    liftIO $ IORef.atomicModifyIORef' scheduler $+                        schedulerError (Just id') $+                        "An exception was thrown when persisting " +++                        "the compiler result: " ++ show (e :: SomeException)+                    pure SchedulerError+                Right mroute -> do+                    for_ mroute $ \route ->+                        Logger.debug logger $ "Routed to " ++ show route+                    liftIO . IORef.atomicModifyIORef' scheduler $+                        schedulerWrite id' facts++        CompilerRequire reqs c ->+            liftIO . IORef.atomicModifyIORef' scheduler $+            schedulerBlock id' reqs c
+ lib/Hakyll/Core/Store.hs view
@@ -0,0 +1,233 @@+--------------------------------------------------------------------------------+-- | A store for storing and retreiving items+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables       #-}+module Hakyll.Core.Store+    ( Store+    , Result (..)+    , toMaybe+    , new+    , set+    , get+    , isMember+    , delete+    , hash+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad        (when)+import           Data.Binary          (Binary, decode, encodeFile)+import qualified Data.ByteString.Lazy as BL+import qualified Data.Cache.LRU.IO    as Lru+import qualified Data.Hashable        as DH+import qualified Data.IORef           as IORef+import           Data.List            (intercalate)+import qualified Data.Map             as Map+import           Data.Maybe           (isJust)+import           Data.Typeable        (TypeRep, Typeable, cast, typeOf)+import           System.Directory     (createDirectoryIfMissing, doesFileExist,+                                       removeFile)+import           System.FilePath      ((</>))+import           System.IO            (IOMode (..), hClose, openFile)+import           System.IO.Error      (catchIOError, ioeSetFileName,+                                       ioeSetLocation, modifyIOError)+++--------------------------------------------------------------------------------+-- | Simple wrapper type+data Box = forall a. Typeable a => Box a+++--------------------------------------------------------------------------------+data Store = Store+    { -- | All items are stored on the filesystem+      storeDirectory  :: FilePath+    , -- | See 'set'+      storeWriteAhead :: IORef.IORef (Map.Map String Box)+      -- | Optionally, items are also kept in-memory+    , storeMap        :: Maybe (Lru.AtomicLRU FilePath Box)+    }+++--------------------------------------------------------------------------------+instance Show Store where+    show _ = "<Store>"+++--------------------------------------------------------------------------------+-- | Result of a store query+data Result a+    = Found a                    -- ^ Found, result+    | NotFound                   -- ^ Not found+    | WrongType TypeRep TypeRep  -- ^ Expected, true type+    deriving (Show, Eq)+++--------------------------------------------------------------------------------+-- | Convert result to 'Maybe'+toMaybe :: Result a -> Maybe a+toMaybe (Found x) = Just x+toMaybe _         = Nothing+++--------------------------------------------------------------------------------+-- | Initialize the store+new :: Bool      -- ^ Use in-memory caching+    -> FilePath  -- ^ Directory to use for hard disk storage+    -> IO Store  -- ^ Store+new inMemory directory = do+    createDirectoryIfMissing True directory+    writeAhead <- IORef.newIORef Map.empty+    ref <- if inMemory then Just <$> Lru.newAtomicLRU csize else return Nothing+    return Store+        { storeDirectory  = directory+        , storeWriteAhead = writeAhead+        , storeMap        = ref+        }+  where+    csize = Just 500++--------------------------------------------------------------------------------+withStore :: Store -> String -> (String -> FilePath -> IO a) -> [String] -> IO a+withStore store loc run identifier = modifyIOError handle $ run key path+  where+    key = hash identifier+    path = storeDirectory store </> key+    handle e = e `ioeSetFileName` (path ++ " for " ++ intercalate "/" identifier)+                 `ioeSetLocation` ("Store." ++ loc)++--------------------------------------------------------------------------------+-- | Auxiliary: add an item to the in-memory cache+cacheInsert :: Typeable a => Store -> String -> a -> IO ()+cacheInsert (Store _ _ Nothing)    _   _     = return ()+cacheInsert (Store _ _ (Just lru)) key x =+    Lru.insert key (Box x) lru+++--------------------------------------------------------------------------------+-- | Auxiliary: get an item from the in-memory cache+cacheLookup :: forall a. Typeable a => Store -> String -> IO (Result a)+cacheLookup (Store _ _ Nothing)    _   = return NotFound+cacheLookup (Store _ _ (Just lru)) key = do+    res <- Lru.lookup key lru+    return $ case res of+        Nothing      -> NotFound+        Just (Box x) -> case cast x of+            Just x' -> Found x'+            Nothing -> WrongType (typeOf (undefined :: a)) (typeOf x)+++--------------------------------------------------------------------------------+cacheIsMember :: Store -> String -> IO Bool+cacheIsMember (Store _ _ Nothing)    _   = return False+cacheIsMember (Store _ _ (Just lru)) key = isJust <$> Lru.lookup key lru+++--------------------------------------------------------------------------------+-- | Auxiliary: delete an item from the in-memory cache+cacheDelete :: Store -> String -> IO ()+cacheDelete (Store _ _ Nothing)    _   = return ()+cacheDelete (Store _ _ (Just lru)) key = do+    _ <- Lru.delete key lru+    return ()+++--------------------------------------------------------------------------------+-- | Store an item+set :: (Binary a, Typeable a) => Store -> [String] -> a -> IO ()+set store identifier value = withStore store "set" (\key path -> do+    -- We need to avoid concurrent writes to the filesystem.  Imagine the+    -- follow scenario:+    --+    --  *  We compile multiple posts+    --  *  All of these fetch some common metadata+    --  *  This metadata is missing; we fetch it and then store it.+    --+    -- To solve this, we skip duplicate writes by tracking their status+    -- in 'storeWriteAhead'.  Since this set will usually be small, the+    -- required locking should be fast.  Additionally the actual IO operation+    -- still happens outside of the locking.+    first <- IORef.atomicModifyIORef' (storeWriteAhead store) $+        \wa -> case Map.lookup key wa of+            Nothing -> (Map.insert key (Box value) wa, True)+            Just _  -> (wa, False)++    cacheInsert store key value++    -- Only the thread that stored the writeAhead should actually write this+    -- file.  That way, only one thread at a time will try to write this.+    -- Release the writeAhead value once we're done.+    when first $ do+        encodeFile path value+        IORef.atomicModifyIORef' (storeWriteAhead store) $+            \wa -> (Map.delete key wa, ())+  ) identifier+++--------------------------------------------------------------------------------+-- | Load an item+get :: forall a. (Binary a, Typeable a) => Store -> [String] -> IO (Result a)+get store = withStore store "get" $ \key path -> do+    -- Check the writeAhead value+    writeAhead <- IORef.readIORef $ storeWriteAhead store+    case Map.lookup key writeAhead of+        Just (Box x) -> case cast x of+            Just x' -> pure $ Found x'+            Nothing -> pure $ WrongType (typeOf (undefined :: a)) (typeOf x)+        Nothing -> do+            -- Check the in-memory map+            ref <- cacheLookup store key+            case ref of+                -- Not found in the map, try the filesystem+                NotFound -> do+                    exists <- doesFileExist path+                    if not exists+                        -- Not found in the filesystem either+                        then return NotFound+                        -- Found in the filesystem+                        else do+                            v <- decodeClose path+                            cacheInsert store key v+                            return $ Found v+                -- Found in the in-memory map (or wrong type), just return+                s -> return s+  where+    -- 'decodeFile' from Data.Binary which closes the file ASAP+    decodeClose path = do+        h   <- openFile path ReadMode+        lbs <- BL.hGetContents h+        BL.length lbs `seq` hClose h+        return $ decode lbs+++--------------------------------------------------------------------------------+-- | Strict function+isMember :: Store -> [String] -> IO Bool+isMember store = withStore store "isMember" $ \key path -> do+    writeAhead <- IORef.readIORef $ storeWriteAhead store+    if Map.member key writeAhead+        then pure True+        else do+            inCache <- cacheIsMember store key+            if inCache then return True else doesFileExist path+++--------------------------------------------------------------------------------+-- | Delete an item+delete :: Store -> [String] -> IO ()+delete store = withStore store "delete" $ \key path -> do+    cacheDelete store key+    deleteFile path+++--------------------------------------------------------------------------------+-- | Delete a file unless it doesn't exist...+deleteFile :: FilePath -> IO ()+deleteFile = (`catchIOError` \_ -> return ()) . removeFile+++--------------------------------------------------------------------------------+-- | Mostly meant for internal usage+hash :: [String] -> String+hash = show . DH.hash . intercalate "/"
+ lib/Hakyll/Core/UnixFilter.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE CPP #-}++--------------------------------------------------------------------------------+-- | A Compiler that supports unix filters.+module Hakyll.Core.UnixFilter+    ( unixFilter+    , unixFilterLBS+    ) where+++--------------------------------------------------------------------------------+import           Control.Concurrent      (forkIO)+import           Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import           Control.DeepSeq         (deepseq)+import           Control.Monad           (forM_)+import           Data.ByteString.Lazy    (ByteString)+import qualified Data.ByteString.Lazy    as LB+import           Data.IORef              (newIORef, readIORef, writeIORef)+import           System.Exit             (ExitCode (..))+import           System.IO               (Handle, hClose, hFlush, hGetContents,+                                          hPutStr, hSetEncoding, localeEncoding)+import           System.Process++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+++--------------------------------------------------------------------------------+-- | Use a unix filter as compiler. For example, we could use the 'rev' program+-- as a compiler.+--+-- > rev :: Compiler (Item String)+-- > rev = getResourceString >>= withItemBody (unixFilter "rev" [])+--+-- A more realistic example: one can use this to call, for example, the sass+-- compiler on CSS files. More information about sass can be found here:+--+-- <http://sass-lang.com/>+--+-- The code is fairly straightforward, given that we use @.scss@ for sass:+--+-- > match "style.scss" $ do+-- >     route   $ setExtension "css"+-- >     compile $ getResourceString >>=+-- >         withItemBody (unixFilter "sass" ["-s", "--scss"]) >>=+-- >         return . fmap compressCss+unixFilter :: String           -- ^ Program name+           -> [String]         -- ^ Program args+           -> String           -- ^ Program input+           -> Compiler String  -- ^ Program output+unixFilter = unixFilterWith writer reader+  where+    writer handle input = do+        hSetEncoding handle localeEncoding+        hPutStr handle input+    reader handle = do+        hSetEncoding handle localeEncoding+        out <- hGetContents handle+        deepseq out (return out)+++--------------------------------------------------------------------------------+-- | Variant of 'unixFilter' that should be used for binary files+--+-- > match "music.wav" $ do+-- >     route   $ setExtension "ogg"+-- >     compile $ getResourceLBS >>= withItemBody (unixFilterLBS "oggenc" ["-"])+unixFilterLBS :: String               -- ^ Program name+              -> [String]             -- ^ Program args+              -> ByteString           -- ^ Program input+              -> Compiler ByteString  -- ^ Program output+unixFilterLBS = unixFilterWith LB.hPutStr $ \handle -> do+    out <- LB.hGetContents handle+    LB.length out `seq` return out+++--------------------------------------------------------------------------------+-- | Overloaded compiler+unixFilterWith :: Monoid o+               => (Handle -> i -> IO ())  -- ^ Writer+               -> (Handle -> IO o)        -- ^ Reader+               -> String                  -- ^ Program name+               -> [String]                -- ^ Program args+               -> i                       -- ^ Program input+               -> Compiler o              -- ^ Program output+unixFilterWith writer reader programName args input = do+    debugCompiler ("Executing external program " ++ programName)+    (output, err, exitCode) <- unsafeCompiler $+        unixFilterIO writer reader programName args input+    forM_ (lines err) debugCompiler+    case exitCode of+        ExitSuccess   -> return output+        ExitFailure e -> fail $+            "Hakyll.Core.UnixFilter.unixFilterWith: " +++            unwords (programName : args) ++ " gave exit code " ++ show e +++            ". (Error: " ++ err ++ ")"+++--------------------------------------------------------------------------------+-- | Internally used function+unixFilterIO :: Monoid o+             => (Handle -> i -> IO ())+             -> (Handle -> IO o)+             -> String+             -> [String]+             -> i+             -> IO (o, String, ExitCode)+unixFilterIO writer reader programName args input = do+    -- The problem on Windows is that `proc` is unable to execute+    -- batch stubs (eg. anything created using 'gem install ...') even if its in+    -- `$PATH`. A solution to this issue is to execute the batch file explicitly+    -- using `cmd /c batchfile` but there is no rational way to know where said+    -- batchfile is on the system. Hence, we detect windows using the+    -- CPP and instead of using `proc` to create the process, use `shell`+    -- which will be able to execute everything `proc` can+    -- as well as batch files.+#ifdef mingw32_HOST_OS+    let pr = shell $ unwords (programName : args)+#else+    let pr = proc programName args+#endif++    (Just inh, Just outh, Just errh, pid) <-+        createProcess pr+                { std_in  = CreatePipe+                , std_out = CreatePipe+                , std_err = CreatePipe+                }++    -- Create boxes+    lock   <- newEmptyMVar+    outRef <- newIORef mempty+    errRef <- newIORef ""++    -- Write the input to the child pipe+    _ <- forkIO $ writer inh input >> hFlush inh >> hClose inh++    -- Read from stdout+    _ <- forkIO $ do+        out <- reader outh+        hClose outh+        writeIORef outRef out+        putMVar lock ()++    -- Read from stderr+    _ <- forkIO $ do+        hSetEncoding errh localeEncoding+        err <- hGetContents errh+        _   <- deepseq err (return err)+        hClose errh+        writeIORef errRef err+        putMVar lock ()++    -- Get exit code & return+    takeMVar lock+    takeMVar lock+    exitCode <- waitForProcess pid+    out      <- readIORef outRef+    err      <- readIORef errRef+    return (out, err, exitCode)
+ lib/Hakyll/Core/Util/File.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP                 #-}+--------------------------------------------------------------------------------+-- | A module containing various file utility functions+module Hakyll.Core.Util.File+    ( makeDirectories+    , getRecursiveContents+    , removeDirectory+    , withPermissions+    ) where+++--------------------------------------------------------------------------------+import           Control.Exception   (throw)+import           Control.Monad       (filterM, forM)+import           System.Directory    (createDirectoryIfMissing, doesPathExist,+                                      doesDirectoryExist, getDirectoryContents)+import           System.FilePath     (takeDirectory, (</>))+import           System.IO.Error     (catchIOError, isPermissionError)+#ifndef mingw32_HOST_OS+import           Control.Monad       (when)+import           System.Directory    (removeDirectoryRecursive)+#else+import           Control.Concurrent  (threadDelay)+import           Control.Exception   (SomeException, catch)+import           System.Directory    (removePathForcibly)+#endif+++--------------------------------------------------------------------------------+-- | Given a path to a file, try to make the path writable by making+--   all directories on the path.+makeDirectories :: FilePath -> IO ()+makeDirectories = createDirectoryIfMissing True . takeDirectory+++--------------------------------------------------------------------------------+-- | Get all contents of a directory.+--+-- If a directory is encountered for which you do not have+-- permission, the directory will be skipped instead of+-- an exception being thrown.+--+-- If a dangling\/broken symbolic link is encountered, then it will+-- be skipped (since returning it may cause callers to throw exceptions).+getRecursiveContents :: (FilePath -> IO Bool)  -- ^ Ignore this file/directory+                     -> FilePath               -- ^ Directory to search+                     -> IO [FilePath]          -- ^ List of files found for which you have permissions+getRecursiveContents ignore top = go ""+  where+    isProper x+        | x `elem` [".", ".."] = return False+        | otherwise            = not <$> ignore x++    getProperDirectoryContents absDir =+        filterM isProper =<< withPermissions (getDirectoryContents absDir) []++    go relDir = do+        let absDir = top </> relDir+        dirExists <- doesDirectoryExist absDir+        if not dirExists+            then return []+            else do+                names <- getProperDirectoryContents absDir+                fmap concat . forM names $ \name -> do+                    let relPath = relDir </> name+                        absPath = top </> relPath+                    isDirectory <- doesDirectoryExist absPath+                    if isDirectory+                        then go relPath+                        else do+                            pathExists <- doesPathExist absPath+                            return $ if pathExists then [relPath] else []+++--------------------------------------------------------------------------------+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++--------------------------------------------------------------------------------+-- | 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+#endif++--------------------------------------------------------------------------------+-- | Perform an IO action, catching any permission errors and returning+--   a default value in their place.  All other exceptions are rethrown.+withPermissions :: IO a+                -> a  -- ^ Default value to return in case of a permission error+                -> IO a+withPermissions act onError+    = act `catchIOError` \e ->+        if isPermissionError e+            then pure onError+            else throw e
+ lib/Hakyll/Core/Util/Parser.hs view
@@ -0,0 +1,31 @@+--------------------------------------------------------------------------------+-- | Parser utilities+module Hakyll.Core.Util.Parser+    ( metadataKey+    ) where+++--------------------------------------------------------------------------------+import           Control.Applicative ((<|>))+import           Control.Monad       (guard, mzero, void)+import qualified Text.Parsec         as P+import           Text.Parsec.String  (Parser)+++--------------------------------------------------------------------------------+metadataKey :: Parser String+metadataKey = do+    -- Ensure trailing '-' binds to '$' if present.+    let hyphon = P.try $ do+            void $ P.char '-'+            x <- P.lookAhead P.anyChar+            guard $ x /= '$'+            pure '-'++    i <- (:) <$> P.letter <*> P.many (P.alphaNum <|> P.oneOf "_." <|> hyphon)+    if i `elem` reservedKeys then mzero else return i+++--------------------------------------------------------------------------------+reservedKeys :: [String]+reservedKeys = ["if", "else", "endif", "for", "sep", "endfor", "partial"]
+ lib/Hakyll/Core/Util/String.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}+--------------------------------------------------------------------------------+-- | Miscellaneous string manipulation functions.+module Hakyll.Core.Util.String+    ( trim+    , replaceAll+    , splitAll+    , needlePrefix+    , removeWinPathSeparator+    ) where+++--------------------------------------------------------------------------------+import Data.Char (isSpace)+import Data.List (isPrefixOf)+import Text.Regex.TDFA ((=~~))+++--------------------------------------------------------------------------------+-- | Trim a string (drop spaces, tabs and newlines at both sides).+trim :: String -> String+trim = reverse . trim' . reverse . trim'+  where+    trim' = dropWhile isSpace+++--------------------------------------------------------------------------------+-- | A simple (but inefficient) regex replace funcion+replaceAll :: String              -- ^ Pattern+           -> (String -> String)  -- ^ Replacement (called on match)+           -> String              -- ^ Source string+           -> String              -- ^ Result+replaceAll pattern f source = replaceAll' source+  where+    replaceAll' ""  = ""+    replaceAll' src = case src =~~ pattern of+        Nothing                       -> src+        Just (before, capture, after) -> before ++ f capture ++ replaceAll' after+++--------------------------------------------------------------------------------+-- | A simple regex split function. The resulting list will contain no empty+-- strings.+splitAll :: String    -- ^ Pattern+         -> String    -- ^ String to split+         -> [String]  -- ^ Result+splitAll pattern = filter (not . null) . splitAll'+  where+    splitAll' ""  = []+    splitAll' src = case src =~~ pattern of+        Nothing                         -> [src]+        Just (before, _::String, after) -> before : splitAll' after++++--------------------------------------------------------------------------------+-- | Find the first instance of needle (must be non-empty) in haystack. We+-- return the prefix of haystack before needle is matched.+--+-- Examples:+--+-- > needlePrefix "cd" "abcde" = "ab"+--+-- > needlePrefix "ab" "abc" = ""+--+-- > needlePrefix "ab" "xxab" = "xx"+--+-- > needlePrefix "a" "xx" = "xx"+needlePrefix :: String -> String -> Maybe String+needlePrefix needle haystack = go [] haystack+  where+    go _   []                     = Nothing+    go acc xss@(x:xs)+        | needle `isPrefixOf` xss = Just $ reverse acc+        | otherwise               = go (x : acc) xs+++--------------------------------------------------------------------------------+-- | Translate native Windows path separators '\\' to '/' if present.+removeWinPathSeparator :: String -> String+removeWinPathSeparator = concatMap (\c -> if c == '\\' then ['/'] else [c])
+ lib/Hakyll/Core/Writable.hs view
@@ -0,0 +1,56 @@+--------------------------------------------------------------------------------+-- | Describes writable items; items that can be saved to the disk+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE TypeSynonymInstances #-}+module Hakyll.Core.Writable+    ( Writable (..)+    ) where+++--------------------------------------------------------------------------------+import qualified Data.ByteString                 as SB+import qualified Data.ByteString.Lazy            as LB+import           Data.Word                       (Word8)+import           Text.Blaze.Html                 (Html)+import           Text.Blaze.Html.Renderer.String (renderHtml)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Item+++--------------------------------------------------------------------------------+-- | Describes an item that can be saved to the disk+class Writable a where+    -- | Save an item to the given filepath+    write :: FilePath -> Item a -> IO ()+++--------------------------------------------------------------------------------+instance Writable () where+    write _ _ = return ()+++--------------------------------------------------------------------------------+instance Writable [Char] where+    write p = writeFile p . itemBody+++--------------------------------------------------------------------------------+instance Writable SB.ByteString where+    write p = SB.writeFile p . itemBody+++--------------------------------------------------------------------------------+instance Writable LB.ByteString where+    write p = LB.writeFile p . itemBody+++--------------------------------------------------------------------------------+instance Writable [Word8] where+    write p = write p . fmap SB.pack+++--------------------------------------------------------------------------------+instance Writable Html where+    write p = write p . fmap renderHtml
+ lib/Hakyll/Main.hs view
@@ -0,0 +1,203 @@+--------------------------------------------------------------------------------+-- | Module providing the main hakyll function and command-line argument parsing+module Hakyll.Main+    ( -- * Entry points+      hakyll+    , hakyllWith+    , hakyllWithArgs+    , hakyllWithExitCode+    , hakyllWithExitCodeAndArgs++      -- * Command line argument parsers+    , Options(..)+    , Command(..)+    , optionParser+    , commandParser+    , defaultCommands+    , defaultParser+    , defaultParserPure+    , defaultParserPrefs+    , defaultParserInfo+    ) where+++--------------------------------------------------------------------------------+import           System.Environment        (getProgName)+import           System.Exit               (ExitCode (ExitSuccess), exitWith)+import           System.IO.Unsafe          (unsafePerformIO)+++--------------------------------------------------------------------------------+import qualified Options.Applicative       as OA+++--------------------------------------------------------------------------------+import qualified Hakyll.Check              as Check+import qualified Hakyll.Commands           as Commands+import qualified Hakyll.Core.Configuration as Config+import qualified Hakyll.Core.Logger        as Logger+import           Hakyll.Core.Rules+import           Hakyll.Core.Runtime+++--------------------------------------------------------------------------------+-- | This usually is the function with which the user runs the hakyll compiler+hakyll :: Rules a -> IO ()+hakyll = hakyllWith Config.defaultConfiguration++--------------------------------------------------------------------------------+-- | A variant of 'hakyll' which allows the user to specify a custom+-- configuration+hakyllWith :: Config.Configuration -> Rules a -> IO ()+hakyllWith conf rules = hakyllWithExitCode conf rules >>= exitWith++--------------------------------------------------------------------------------+-- | A variant of 'hakyll' which returns an 'ExitCode'+hakyllWithExitCode :: Config.Configuration -> Rules a -> IO ExitCode+hakyllWithExitCode conf rules =  do+    args <- defaultParser conf+    hakyllWithExitCodeAndArgs conf args rules++--------------------------------------------------------------------------------+-- | A variant of 'hakyll' which expects a 'Configuration' and command-line+-- 'Options'. This gives freedom to implement your own parsing.+hakyllWithArgs :: Config.Configuration -> Options -> Rules a -> IO ()+hakyllWithArgs conf args rules =+    hakyllWithExitCodeAndArgs conf args rules >>= exitWith++--------------------------------------------------------------------------------+hakyllWithExitCodeAndArgs :: Config.Configuration ->+                              Options -> Rules a -> IO ExitCode+hakyllWithExitCodeAndArgs conf args rules = do+    let args' = optCommand args+        verbosity' = if verbosity args then Logger.Debug else Logger.Message+        check     =+            if internal_links args' then Check.InternalLinks else Check.All++    logger <- Logger.new verbosity'+    invokeCommands args' conf check logger rules++--------------------------------------------------------------------------------+defaultParser :: Config.Configuration -> IO Options+defaultParser conf =+    OA.customExecParser defaultParserPrefs (defaultParserInfo conf)+++--------------------------------------------------------------------------------+defaultParserPure :: Config.Configuration -> [String] -> OA.ParserResult Options+defaultParserPure conf =+  OA.execParserPure defaultParserPrefs (defaultParserInfo conf)+++--------------------------------------------------------------------------------+defaultParserPrefs :: OA.ParserPrefs+defaultParserPrefs = OA.prefs OA.showHelpOnError++--------------------------------------------------------------------------------+defaultParserInfo :: Config.Configuration -> OA.ParserInfo Options+defaultParserInfo conf =+  OA.info (OA.helper <*> optionParser conf) (OA.fullDesc <> OA.progDesc (+                                                progName ++ " - Static site compiler created with Hakyll"))++--------------------------------------------------------------------------------+invokeCommands :: Command -> Config.Configuration ->+                  Check.Check -> Logger.Logger -> Rules a -> IO ExitCode+invokeCommands args conf check logger rules =+    case args of+        Build   mode   -> Commands.build mode conf logger rules+        Check   _      -> Commands.check conf logger check+        Clean          -> Commands.clean conf logger >> ok+        Deploy         -> Commands.deploy conf+        Preview p      -> Commands.preview conf logger rules p >> ok+        Rebuild        -> Commands.rebuild conf logger rules+        Server  _ _    -> Commands.server conf logger (host args) (port args) >> ok+        Watch   _ p s  -> Commands.watch conf logger (host args) p (not s) rules >> ok+    where+        ok = return ExitSuccess+++--------------------------------------------------------------------------------++-- | The parsed command-line options.+data Options = Options {verbosity :: Bool, optCommand :: Command}+    deriving (Show)++-- | The command to run.+data Command+    = Build RunMode+    -- ^ Generate the site.+    | Check   {internal_links :: Bool}+    -- ^ Validate the site output.+    | Clean+    -- ^ Clean up and remove cache.+    | Deploy+    -- ^ Upload/deploy your site.+    | Preview {port :: Int}+    -- ^ [DEPRECATED] Please use the watch command.+    | Rebuild+    -- ^ Clean and build again.+    | Server  {host :: String, port :: Int}+    -- ^ Start a preview server.+    | Watch   {host :: String, port :: Int, no_server :: Bool }+    -- ^ Autocompile on changes and start a preview server.+    deriving (Show)++{-# DEPRECATED Preview "Use Watch instead." #-}++optionParser :: Config.Configuration -> OA.Parser Options+optionParser conf = Options <$> verboseParser <*> commandParser conf+    where+    verboseParser = OA.switch (OA.long "verbose" <> OA.short 'v' <> OA.help "Run in verbose mode")+++commandParser :: Config.Configuration -> OA.Parser Command+commandParser conf =  OA.subparser $ foldr ((<>) . produceCommand) mempty (defaultCommands conf)+    where+    produceCommand (c,a,b) = OA.command c (OA.info (OA.helper <*> a) (b))+++defaultCommands :: Config.Configuration -> [(String, OA.Parser Command, OA.InfoMod a)]+defaultCommands conf =+    [ ( "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"+      , pure Check <*> OA.switch (OA.long "internal-links" <> OA.help "Check internal links only")+      , OA.fullDesc <> OA.progDesc "Validate the site output"+      )+    , ( "clean"+      , pure Clean+      , OA.fullDesc <> OA.progDesc "Clean up and remove cache"+      )+    , ( "deploy"+      , pure Deploy+      , OA.fullDesc <> OA.progDesc "Upload/deploy your site"+       )+    , ( "preview"+      , pure Preview <*> portParser+      , OA.fullDesc <> OA.progDesc "[DEPRECATED] Please use the watch command"+      )+    , ( "rebuild"+      , pure Rebuild+      , OA.fullDesc <> OA.progDesc "Clean and build again"+      )+    , ( "server"+      , pure Server <*> hostParser <*> portParser+      , OA.fullDesc <> OA.progDesc "Start a preview server"+      )+    , ( "watch"+      , pure Watch <*> hostParser <*> portParser <*> OA.switch (OA.long "no-server" <> OA.help "Disable the built-in web server")+      , OA.fullDesc <> OA.progDesc "Autocompile on changes and start a preview server.  You can watch and recompile without running a server with --no-server."+      )+    ]+    where+    portParser = OA.option OA.auto (OA.long "port" <> OA.help "Port to listen on" <> OA.value (Config.previewPort conf))+    hostParser = OA.strOption (OA.long "host" <> OA.help "Host to bind on" <> OA.value (Config.previewHost conf))+++--------------------------------------------------------------------------------+-- | This is necessary because not everyone calls their program the same...+progName :: String+progName = unsafePerformIO getProgName+{-# NOINLINE progName #-}
+ lib/Hakyll/Preview/Poll.hs view
@@ -0,0 +1,109 @@+--------------------------------------------------------------------------------+{-# LANGUAGE CPP #-}+module Hakyll.Preview.Poll+    ( watchUpdates+    ) where+++--------------------------------------------------------------------------------+import           Control.Concurrent             (forkIO)+import           Control.Concurrent.MVar        (newEmptyMVar, takeMVar,+                                                 tryPutMVar)+import           Control.Exception              (AsyncException, fromException,+                                                 handle, throw)+import           Control.Monad                  (forever, void, when)+import           System.Directory               (canonicalizePath)+import           System.FilePath                (pathSeparators)+import qualified System.FSNotify                as FSNotify++#ifdef mingw32_HOST_OS+import           Control.Concurrent             (threadDelay)+import           Control.Exception              (IOException, try)+import           System.Directory               (doesFileExist)+import           System.Exit                    (exitFailure)+import           System.FilePath                ((</>))+import           System.IO                      (Handle, IOMode (ReadMode),+                                                 hClose, openFile)+import           System.IO.Error                (isPermissionError)+#endif+++--------------------------------------------------------------------------------+import           Hakyll.Core.Configuration+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern+++--------------------------------------------------------------------------------+-- | A thread that watches for updates in a 'providerDirectory' and recompiles+-- a site as soon as any changes occur+watchUpdates :: Configuration -> IO Pattern -> IO ()+watchUpdates conf update = do+    let providerDir = providerDirectory conf+    shouldBuild     <- newEmptyMVar+    pattern         <- update+    fullProviderDir <- canonicalizePath providerDir+    manager         <- FSNotify.startManager+    checkIgnore     <- shouldWatchIgnore conf++    let allowed event = do+            -- Absolute path of the changed file. This must be inside provider+            -- dir, since that's the only dir we're watching.+            let path       = FSNotify.eventPath event+                relative   = dropWhile (`elem` pathSeparators) $+                    drop (length fullProviderDir) path+                identifier = fromFilePath relative+            shouldIgnore <- checkIgnore path+            return $ not shouldIgnore && matches pattern identifier++    -- This thread continually watches the `shouldBuild` MVar and builds+    -- whenever a value is present.+    _ <- forkIO $ forever $ do+        event <- takeMVar shouldBuild+        handle+            (\e -> case fromException e of+                Nothing    -> putStrLn (show e)+                Just async -> throw (async :: AsyncException))+            (update' event providerDir)++    -- Send an event whenever something occurs so that the thread described+    -- above will do a build.+    void $ FSNotify.watchTree manager providerDir (not . isRemove) $ \event -> do+        allowed' <- allowed event+        when allowed' $ void $ tryPutMVar shouldBuild event+  where+#ifndef mingw32_HOST_OS+    update' _     _        = void update+#else+    update' event provider = do+        let path = provider </> FSNotify.eventPath event+        -- on windows, a 'Modified' event is also sent on file deletion+        fileExists <- doesFileExist path++        when fileExists . void $ waitOpen path ReadMode (\_ -> update) 10++    -- continuously attempts to open the file in between sleep intervals+    -- handler is run only once it is able to open the file+    waitOpen :: FilePath -> IOMode -> (Handle -> IO r) -> Integer -> IO r+    waitOpen _    _    _       0 = do+        putStrLn "[ERROR] Failed to retrieve modified file for regeneration"+        exitFailure+    waitOpen path mode handler retries = do+        res <- try $ openFile path mode :: IO (Either IOException Handle)+        case res of+            Left ex -> if isPermissionError ex+                       then do+                           threadDelay 100000+                           waitOpen path mode handler (retries - 1)+                       else throw ex+            Right h -> do+                handled <- handler h+                hClose h+                return handled+#endif+++--------------------------------------------------------------------------------+isRemove :: FSNotify.Event -> Bool+isRemove (FSNotify.Removed {}) = True+isRemove _                     = False
+ lib/Hakyll/Preview/Server.hs view
@@ -0,0 +1,35 @@+--------------------------------------------------------------------------------+-- | Implements a basic static file server for previewing options+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Preview.Server+    ( staticServer+    ) where+++--------------------------------------------------------------------------------+import           Data.String+import qualified Network.Wai.Handler.Warp       as Warp+import qualified Network.Wai.Application.Static as Static+import qualified Network.Wai                    as Wai+import           Network.HTTP.Types.Status      (Status)++--------------------------------------------------------------------------------+import           Hakyll.Core.Logger    (Logger)+import qualified Hakyll.Core.Logger    as Logger++staticServer :: Logger               -- ^ Logger+             -> Static.StaticSettings -- ^ Static file server settings+             -> String               -- ^ Host to bind on+             -> Int                  -- ^ Port to listen on+             -> IO ()                -- ^ Blocks forever+staticServer logger settings host port = do+    Logger.header logger $ "Listening on http://" ++ host ++ ":" ++ show port+    Logger.flush logger -- ensure this line is logged before Warp errors+    Warp.runSettings warpSettings $ Static.staticApp settings+  where+    warpSettings = Warp.setLogger noLog+        $ Warp.setHost (fromString host)+        $ Warp.setPort port Warp.defaultSettings++noLog :: Wai.Request -> Status -> Maybe Integer -> IO ()+noLog _ _ _ = return ()
+ lib/Hakyll/Web/CompressCss.hs view
@@ -0,0 +1,105 @@+--------------------------------------------------------------------------------+-- | Module used for CSS compression. The compression is currently in a simple+-- state, but would typically reduce the number of bytes by about 25%.+module Hakyll.Web.CompressCss+    ( compressCssCompiler+    , compressCss+    ) where+++--------------------------------------------------------------------------------+import           Data.Char               (isSpace)+import           Data.List               (dropWhileEnd, isPrefixOf)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Item+import           Hakyll.Core.Util.String+++--------------------------------------------------------------------------------+-- | Compiler form of 'compressCss'+compressCssCompiler :: Compiler (Item String)+compressCssCompiler = fmap compressCss <$> getResourceString+++--------------------------------------------------------------------------------+-- | Compress CSS to speed up your site.+compressCss :: String -> String+compressCss = withoutStrings (handleCalcExpressions compressSeparators . compressWhitespace)+            . dropWhileEnd isSpace+            . dropWhile isSpace+            . stripComments+++--------------------------------------------------------------------------------+-- | Compresses certain forms of separators.+compressSeparators :: String -> String+compressSeparators =+    replaceAll "; *}" (const "}") .+    replaceAll ";+" (const ";") .+    replaceAll " *[{};,>+~!] *" (take 1 . dropWhile isSpace) .+    replaceAll ": *" (take 1) -- not destroying pseudo selectors (#323)++-- | Uses `compressExpression` on all parenthesised calc and +-- clamp expressions, and applies `transform` to all parts +-- outside of them+handleCalcExpressions :: (String -> String) -> String -> String+handleCalcExpressions transform = top transform+  where+    top f ""                              = f ""+    top f str | "calc(" `isPrefixOf` str  = f "calc"  ++ nested 0 compressExpression (drop 4 str)+              -- See issue #1021+              | "clamp(" `isPrefixOf` str = f "clamp" ++ nested 0 compressExpression (drop 5 str) +    top f (x:xs)                          = top (f . (x:)) xs+    +    -- when called with depth=0, the first character must be a '('+    nested :: Int -> (String -> String) -> String -> String+    nested _     f ""                             = f "" -- shouldn't happen, mismatched nesting+    nested depth f str | "calc(" `isPrefixOf` str = nested depth f (drop 4 str)+    nested 1     f (')':xs)                       = f ")" ++ top transform xs+    nested depth f (x:xs)                         = nested (case x of+                                                      '(' -> depth + 1+                                                      ')' -> depth - 1 -- assert: depth > 1+                                                      _   -> depth+                                                    ) (f . (x:)) xs++-- | does not remove whitespace around + and -, which is important +-- in calc() and clamp() expressions+compressExpression :: String -> String+compressExpression =+    replaceAll " *[*/] *| *\\)|\\( *" (take 1 . dropWhile isSpace)++--------------------------------------------------------------------------------+-- | Compresses all whitespace.+compressWhitespace :: String -> String+compressWhitespace = replaceAll "[ \t\n\r]+" (const " ")++--------------------------------------------------------------------------------+-- | Function that strips CSS comments away (outside of strings).+stripComments :: String -> String+stripComments ""                       = ""+stripComments ('/':'*':str)            = stripComments $ eatComment str+stripComments (x:xs) | x `elem` "\"'"  = retainString x xs stripComments+                     | otherwise       = x : stripComments xs++eatComment :: String -> String+eatComment "" = ""+eatComment ('*':'/':str) = str+eatComment (_:str) = eatComment str+++--------------------------------------------------------------------------------+-- | Helper functions to handle string tokens correctly.++-- TODO: handle backslash escapes+withoutStrings :: (String -> String) -> String -> String+withoutStrings f str = case span (`notElem` "\"'") str of+    (text, "")     -> f text+    (text, d:rest) -> f text ++ retainString d rest (withoutStrings f)++retainString :: Char -> String -> (String -> String) -> String+retainString delim str cont = case span (/= delim) str of+    (val, "")     -> delim : val+    (val, _:rest) -> delim : val ++ delim : cont rest
+ lib/Hakyll/Web/Feed.hs view
@@ -0,0 +1,363 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++--------------------------------------------------------------------------------+-- | A Module that allows easy rendering of RSS feeds.+--+-- The main rendering functions (@renderRss@, @renderAtom@) all assume that+-- you pass the list of items so that the most recent entry in the feed is the+-- first item in the list.+--+-- Also note that the context should have (at least) the following fields to+-- produce a correct feed:+--+-- - @$title$@: Title of the item+--+-- - @$description$@: Description to appear in the feed+--+-- - @$url$@: URL to the item - this is usually set automatically.+--+-- In addition, the posts should be named according to the rules for+-- 'Hakyll.Web.Template.Context.dateField'+--+-- Note that for XML-based feeds (i.e. Atom and RSS) field values are not escaped!+-- However, the default 'renderRss' and 'renderAtom' functions will validate the+-- produced XML. Use the -NoValidate functions instead if you need to skip this+-- validation.+module Hakyll.Web.Feed+    ( FeedConfiguration (..)+    , renderRss+    , renderRssNoValidate+    , renderAtom+    , renderAtomNoValidate+    , renderJson+    , renderRssWithTemplates+    , renderRssWithTemplatesNoValidate+    , renderAtomWithTemplates+    , renderAtomWithTemplatesNoValidate+    , renderJsonWithTemplates+    , validateXMLFeed+    ) where+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Compiler.Internal (compilerThrow)+import           Hakyll.Core.Item+import           Hakyll.Core.Util.String       (replaceAll)+import           Hakyll.Web.Template+import           Hakyll.Web.Template.Context+import           Hakyll.Web.Template.List+++--------------------------------------------------------------------------------+import           Data.FileEmbed                (makeRelativeToProject)+import           System.FilePath               ((</>))+import           Text.Printf                   (printf)+import           Control.Exception             (displayException)+import           Text.XML                      (parseText, def)+import qualified Data.Text.Lazy as T+++--------------------------------------------------------------------------------+rssTemplate :: Template+rssTemplate =+    $(makeRelativeToProject ("data" </> "templates" </> "rss.xml")+        >>= embedTemplate)++rssItemTemplate :: Template+rssItemTemplate =+    $(makeRelativeToProject ("data" </> "templates" </> "rss-item.xml")+        >>= embedTemplate)++atomTemplate :: Template+atomTemplate =+    $(makeRelativeToProject ("data" </> "templates" </> "atom.xml")+        >>= embedTemplate)++atomItemTemplate :: Template+atomItemTemplate =+    $(makeRelativeToProject ("data" </> "templates" </> "atom-item.xml")+        >>= embedTemplate)++jsonTemplate :: Template+jsonTemplate =+    $(makeRelativeToProject ("data" </> "templates" </> "feed.json")+        >>= embedTemplate)++jsonItemTemplate :: Template+jsonItemTemplate =+    $(makeRelativeToProject ("data" </> "templates" </> "feed-item.json")+        >>= embedTemplate)+++--------------------------------------------------------------------------------+-- | This is a data structure to keep the configuration of a feed.+data FeedConfiguration = FeedConfiguration+    { -- | Title of the feed.+      feedTitle       :: String+    , -- | Description of the feed.+      feedDescription :: String+    , -- | Name of the feed author.+      feedAuthorName  :: String+    , -- | Email of the feed author.  Set this to the empty String to leave out+      -- the email address.+      feedAuthorEmail :: String+    , -- | Absolute root URL of the feed site (e.g. @http://jaspervdj.be@)+      feedRoot        :: String+    } deriving (Show, Eq)+++--------------------------------------------------------------------------------+-- | Different types a feed can have.+data FeedType = XmlFeed | JsonFeed+  deriving (Show, Eq)+++--------------------------------------------------------------------------------+-- | Abstract function to render any feed.+renderFeed :: FeedType                -- ^ Feed type+           -> Template                -- ^ Default feed template+           -> Template                -- ^ Default item template+           -> FeedConfiguration       -- ^ Feed configuration+           -> Context String          -- ^ Context for the items+           -> [Item String]           -- ^ Input items+           -> Compiler (Item String)  -- ^ Resulting item+renderFeed feedType feedTpl itemTpl config itemContext items = do+    protectedItems <-+      case feedType of+        XmlFeed  -> mapM (applyFilter protectCDATA) items+        JsonFeed -> pure items+    let itemDelim = case feedType of+          XmlFeed  -> ""+          JsonFeed -> ", "++    body <- makeItem =<< applyJoinTemplateList itemDelim itemTpl itemContext' protectedItems+    applyTemplate feedTpl feedContext body+  where+    applyFilter :: (Monad m,Functor f) => (String -> String) -> f String -> m (f String)+    applyFilter tr str = return $ fmap tr str+    protectCDATA :: String -> String+    protectCDATA = replaceAll "]]>" (const "]]&gt;")++    itemContext' = mconcat+        [ escapeDescription itemContext+        , constField "root" (feedRoot config)+        , constField "authorName"  (feedAuthorName config)+        , emailField+        ]++    feedContext = mconcat+         [ bodyField  "body"+         , constField "title"       (feedTitle config)+         , constField "description" (feedDescription config)+         , constField "authorName"  (feedAuthorName config)+         , emailField+         , constField "root"        (feedRoot config)+         , urlField   "url"+         , updatedField+         , missingField+         ]++    -- Take the first "updated" field from all items -- this should be the most+    -- recent.+    updatedField = field "updated" $ \_ -> case items of+        []      -> return "Unknown"+        (x : _) -> unContext itemContext' "updated" [] x >>= \cf -> case cf of+            StringField s -> return s+            _             -> fail "Hakyll.Web.Feed.renderFeed: Internal error"++    emailField = case feedAuthorEmail config of+        ""    -> missingField+        email -> constField "authorEmail" email++    escapeDescription = case feedType of+        XmlFeed  -> id+        JsonFeed -> mapContextBy (== "description") escapeString+++--------------------------------------------------------------------------------+-- | Validate that a feed contains only correct XML.+validateXMLFeed :: Item String -> Compiler (Item String)+validateXMLFeed rendered = case parseText def $ T.pack (itemBody rendered) of+      Right _ -> pure rendered+      Left err -> compilerThrow+        ["Generated feed contains invalid XML (perhaps you id not escape a metadata field?)",+          displayException err]+++--------------------------------------------------------------------------------+-- | Render an RSS feed using given templates with a number of items.+--+-- The resulting feed will not be validated. Prefer to use 'renderRssWithTemplates'+-- when possible.+--+-- @since 4.16.7.0+renderRssWithTemplatesNoValidate ::+       Template                -- ^ Feed template+    -> Template                -- ^ Item template+    -> FeedConfiguration       -- ^ Feed configuration+    -> Context String          -- ^ Item context+    -> [Item String]           -- ^ Feed items+    -> Compiler (Item String)  -- ^ Resulting feed+renderRssWithTemplatesNoValidate feedTemplate itemTemplate config context = renderFeed+    XmlFeed feedTemplate itemTemplate config+    (makeItemContext "%a, %d %b %Y %H:%M:%S UT" context)+++--------------------------------------------------------------------------------+-- | Render an RSS feed using given templates with a number of items.+--+-- The resulting RSS feed will be validated automatically.+renderRssWithTemplates ::+       Template                -- ^ Feed template+    -> Template                -- ^ Item template+    -> FeedConfiguration       -- ^ Feed configuration+    -> Context String          -- ^ Item context+    -> [Item String]           -- ^ Feed items+    -> Compiler (Item String)  -- ^ Resulting feed+renderRssWithTemplates feedTemplate itemTemplate config context items =+  renderRssWithTemplatesNoValidate feedTemplate itemTemplate config context items+  >>= validateXMLFeed+++--------------------------------------------------------------------------------+-- | Render an Atom feed using given templates with a number of items.+--+-- The resulting feed will not be validated. Prefer to use 'renderAtomWithTemplates'+-- when possible.+--+-- @since 4.16.7.0+renderAtomWithTemplatesNoValidate ::+       Template                -- ^ Feed template+    -> Template                -- ^ Item template+    -> FeedConfiguration       -- ^ Feed configuration+    -> Context String          -- ^ Item context+    -> [Item String]           -- ^ Feed items+    -> Compiler (Item String)  -- ^ Resulting feed+renderAtomWithTemplatesNoValidate feedTemplate itemTemplate config context items = renderFeed+    XmlFeed feedTemplate itemTemplate config+    (makeItemContext "%Y-%m-%dT%H:%M:%SZ" context)+    items+++--------------------------------------------------------------------------------+-- | Render an Atom feed using given templates with a number of items.+--+-- The resulting Atom feed will be validated automatically.+renderAtomWithTemplates ::+       Template                -- ^ Feed template+    -> Template                -- ^ Item template+    -> FeedConfiguration       -- ^ Feed configuration+    -> Context String          -- ^ Item context+    -> [Item String]           -- ^ Feed items+    -> Compiler (Item String)  -- ^ Resulting feed+renderAtomWithTemplates feedTemplate itemTemplate config context items =+  renderAtomWithTemplatesNoValidate feedTemplate itemTemplate config context items+  >>= validateXMLFeed+++--------------------------------------------------------------------------------+-- | Render a JSON feed using given templates with a number of items.+renderJsonWithTemplates ::+       Template                -- ^ Feed template+    -> Template                -- ^ Item template+    -> FeedConfiguration       -- ^ Feed configuration+    -> Context String          -- ^ Item context+    -> [Item String]           -- ^ Feed items+    -> Compiler (Item String)  -- ^ Resulting feed+renderJsonWithTemplates feedTemplate itemTemplate config context = renderFeed+    JsonFeed feedTemplate itemTemplate config+    (makeItemContext "%Y-%m-%dT%H:%M:%SZ" context)+++--------------------------------------------------------------------------------+-- | Render an RSS feed with a number of items.+--+-- The resulting feed will not be validated. Prefer to use 'renderRss'+-- when possible.+--+-- @since 4.16.7.0+renderRssNoValidate :: FeedConfiguration       -- ^ Feed configuration+          -> Context String          -- ^ Item context+          -> [Item String]           -- ^ Feed items+          -> Compiler (Item String)  -- ^ Resulting feed+renderRssNoValidate = renderRssWithTemplatesNoValidate rssTemplate rssItemTemplate+++--------------------------------------------------------------------------------+-- | Render an RSS feed with a number of items.+--+-- The resulting RSS feed will be validated automatically.+renderRss :: FeedConfiguration       -- ^ Feed configuration+          -> Context String          -- ^ Item context+          -> [Item String]           -- ^ Feed items+          -> Compiler (Item String)  -- ^ Resulting feed+renderRss config context items = renderRssNoValidate config context items+  >>= validateXMLFeed+++--------------------------------------------------------------------------------+-- | Render an Atom feed with a number of items.+--+-- The resulting feed will not be validated. Prefer to use 'renderAtom'+-- when possible.+--+-- @since 4.16.7.0+renderAtomNoValidate :: FeedConfiguration       -- ^ Feed configuration+           -> Context String          -- ^ Item context+           -> [Item String]           -- ^ Feed items+           -> Compiler (Item String)  -- ^ Resulting feed+renderAtomNoValidate = renderAtomWithTemplatesNoValidate atomTemplate atomItemTemplate+++--------------------------------------------------------------------------------+-- | Render an Atom feed with a number of items.+--+-- The resulting Atom feed will be validated automatically.+renderAtom :: FeedConfiguration       -- ^ Feed configuration+           -> Context String          -- ^ Item context+           -> [Item String]           -- ^ Feed items+           -> Compiler (Item String)  -- ^ Resulting feed+renderAtom config context items = renderAtomNoValidate config context items+  >>= validateXMLFeed+++--------------------------------------------------------------------------------+-- | Render a JSON feed with a number of items.+--+-- Items' bodies will be put into @content_html@ field of the resulting JSON;+-- the @content@ field will not be set.+renderJson :: FeedConfiguration       -- ^ Feed configuration+           -> Context String          -- ^ Item context+           -> [Item String]           -- ^ Feed items+           -> Compiler (Item String)  -- ^ Resulting feed+renderJson = renderJsonWithTemplates jsonTemplate jsonItemTemplate+++--------------------------------------------------------------------------------+-- | Copies @$updated$@ from @$published$@ if it is not already set.+makeItemContext :: String -> Context a -> Context a+makeItemContext fmt context = mconcat+    [context, dateField "published" fmt, dateField "updated" fmt]+++--------------------------------------------------------------------------------+-- | Escape the string according to [RFC8259 §7](https://www.rfc-editor.org/rfc/rfc8259#section-7). In other words,+--   * quotation marks and backslashes are prefixed with a backslash+--   * control characters (i.e. 0x00 - 0x1F) are escaped s.t. their+--   hex representation are prefixed with "\u00" (e.g. 0x15 -> \u0015)+--   * the rest of the characters are untouched.+escapeString :: String -> String+escapeString = flip escapeString' ""+  where+    escapeString' :: String -> ShowS+    escapeString' [] s = s+    escapeString' ('"' : cs) s = showString "\\\"" (escapeString' cs s)+    escapeString' ('\\' : cs) s = showString "\\\\" (escapeString' cs s)+    escapeString' (c : cs) s+      | c < ' ' = escapeChar c (escapeString' cs s)+      | otherwise = showChar c (escapeString' cs s)++    escapeChar :: Char -> ShowS+    escapeChar = showString . printf "\\u%04X"
+ lib/Hakyll/Web/Html.hs view
@@ -0,0 +1,309 @@+--------------------------------------------------------------------------------+-- | Provides utilities to manipulate HTML pages+module Hakyll.Web.Html+    ( -- * Generic+      withTags+    , withTagList+    , withTagListM++      -- * Headers+    , demoteHeaders+    , demoteHeadersBy++      -- * Url manipulation+    , getUrls+    , withUrls+    , toUrl+    , toSiteRoot+    , isExternal++      -- * Stripping/escaping+    , stripTags+    , escapeHtml+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad                   (void)+import           Control.Monad.Identity          (Identity(runIdentity))+import           Data.Char                       (digitToInt, intToDigit,+                                                  isDigit, toLower)+import           Data.Either                     (fromRight)+import           Data.List                       (isPrefixOf, intercalate)+import           Data.Maybe                      (fromMaybe)+import qualified Data.Set                        as S+import           System.FilePath                 (joinPath, splitPath,+                                                  takeDirectory)+import           Text.Blaze.Html                 (toHtml)+import           Text.Blaze.Html.Renderer.String (renderHtml)+import qualified Text.Parsec                     as P+import qualified Text.Parsec.Char                as PC+import qualified Text.HTML.TagSoup               as TS+import           Network.URI                     (isUnreserved, escapeURIString)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Util.String         (removeWinPathSeparator)+++--------------------------------------------------------------------------------+-- | Map over all tags in the document+withTags :: (TS.Tag String -> TS.Tag String) -> String -> String+withTags = withTagList . map++-- | Map over all tags (as list) in the document+withTagList :: ([TS.Tag String] -> [TS.Tag String]) -> String -> String+withTagList f = runIdentity . withTagListM (pure . f)++-- | Map over all tags (as list) in the document, in a monad+withTagListM :: Monad m => ([TS.Tag String] -> m [TS.Tag String]) -> String -> m String+withTagListM f = fmap renderTags' . f . parseTags'+{-# INLINE withTagListM #-}++--------------------------------------------------------------------------------+-- | Map every @h1@ to an @h2@, @h2@ to @h3@, etc.+demoteHeaders :: String -> String+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 + amount)]+        | otherwise = t+    demote t        = t+++--------------------------------------------------------------------------------+isUrlAttribute :: String -> Bool+isUrlAttribute = (`elem` ["src", "href", "data", "poster"])+++--------------------------------------------------------------------------------+-- | Extract URLs from tags' attributes. Those would be the same URLs on which+-- `withUrls` would act.+getUrls :: [TS.Tag String] -> [String]+getUrls tags = [u | TS.TagOpen _ as <- tags, (k, v) <- as, u <- extractUrls k v]+  where+  extractUrls "srcset" value =+    let srcset = fmap unSrcset $ P.parse srcsetParser "" value+    in map srcsetImageCandidateUrl $ fromRight [] srcset+  extractUrls key value+    | isUrlAttribute key = [value]+    | otherwise = []+++--------------------------------------------------------------------------------+-- | Apply a function to each URL on a webpage+withUrls :: (String -> String) -> String -> String+withUrls f = withTags tag+  where+    tag (TS.TagOpen s a) = TS.TagOpen s $ map attr a+    tag x                = x++    attr input@("srcset", v)   =+      case fmap unSrcset $ P.parse srcsetParser "" v of+        Right srcset ->+          let srcset' = map (\i -> i { srcsetImageCandidateUrl = f $ srcsetImageCandidateUrl i }) srcset+              srcset'' = show $ Srcset srcset'+          in ("srcset", srcset'')+        Left _ -> input+    attr (k, v)          = (k, if isUrlAttribute k then f v else v)+++--------------------------------------------------------------------------------+-- | Customized TagSoup renderer. The default TagSoup renderer escape CSS+-- within style tags, and doesn't properly minimize.+renderTags' :: [TS.Tag String] -> String+renderTags' = TS.renderTagsOptions TS.RenderOptions+    { TS.optRawTag   = (`elem` ["script", "style"]) . map toLower+    , TS.optMinimize = (`S.member` minimize) . map toLower+    , TS.optEscape   = id+    }+  where+    -- A list of elements which must be minimized+    minimize = S.fromList+        [ "area", "br", "col", "embed", "hr", "img", "input", "meta", "link"+        , "param"+        ]+++--------------------------------------------------------------------------------+-- | Customized TagSoup parser: do not decode any entities.+parseTags' :: String -> [TS.Tag String]+parseTags' = TS.parseTagsOptions (TS.parseOptions :: TS.ParseOptions String)+    { TS.optEntityData   = \(str, b) -> [TS.TagText $ "&" ++ str ++ [';' | b]]+    , TS.optEntityAttrib = \(str, b) -> ("&" ++ str ++ [';' | b], [])+    }+++--------------------------------------------------------------------------------+-- | Convert a filepath to an URL starting from the site root+--+-- Example:+--+-- > toUrl "foo/bar.html"+--+-- Result:+--+-- > "/foo/bar.html"+--+-- This also sanitizes the URL, e.g. converting spaces into '%20'+toUrl :: FilePath -> String+toUrl url = case (removeWinPathSeparator url) of+    ('/' : xs) -> '/' : sanitize xs+    xs         -> '/' : sanitize xs+  where+    -- Everything but unreserved characters should be escaped as we are+    -- sanitising the path therefore reserved characters which have a+    -- meaning in URI does not appear. Special casing for `/`, because it has+    -- a special meaning in FilePath as well as in URI.+    sanitize = escapeURIString (\c -> c == '/' || isUnreserved c)+++--------------------------------------------------------------------------------+-- | Get the relative url to the site root, for a given (absolute) url+toSiteRoot :: String -> String+toSiteRoot = removeWinPathSeparator . emptyException . joinPath+           . map parent . filter relevant . splitPath . takeDirectory+  where+    parent            = const ".."+    emptyException [] = "."+    emptyException x  = x+    relevant "."      = False+    relevant "/"      = False+    relevant "./"     = False+    relevant _        = True+++--------------------------------------------------------------------------------+-- | Check if an URL links to an external HTTP(S) source+isExternal :: String -> Bool+isExternal url = any (flip isPrefixOf url) ["http://", "https://", "//"]+++--------------------------------------------------------------------------------+-- | Strip all HTML tags from a string+--+-- Example:+--+-- > stripTags "<p>foo</p>"+--+-- Result:+--+-- > "foo"+--+-- This also works for incomplete tags+--+-- Example:+--+-- > stripTags "<p>foo</p"+--+-- Result:+--+-- > "foo"+stripTags :: String -> String+stripTags []         = []+stripTags ('<' : xs) = stripTags $ drop 1 $ dropWhile (/= '>') xs+stripTags (x : xs)   = x : stripTags xs+++--------------------------------------------------------------------------------+-- | HTML-escape a string+--+-- Example:+--+-- > escapeHtml "Me & Dean"+--+-- Result:+--+-- > "Me &amp; Dean"+escapeHtml :: String -> String+escapeHtml = renderHtml . toHtml+++--------------------------------------------------------------------------------+data Srcset = Srcset {+    unSrcset :: [SrcsetImageCandidate]+  }+++--------------------------------------------------------------------------------+instance Show Srcset where+  show set = intercalate ", " $ map show $ unSrcset set+++--------------------------------------------------------------------------------+data SrcsetImageCandidate = SrcsetImageCandidate {+    srcsetImageCandidateUrl :: String+  , srcsetImageCandidateDescriptor :: Maybe String+  }+++--------------------------------------------------------------------------------+instance Show SrcsetImageCandidate where+  show candidate =+    let url = srcsetImageCandidateUrl candidate+    in case srcsetImageCandidateDescriptor candidate of+      Just desc -> concat [url, " ", desc]+      Nothing -> url+++--------------------------------------------------------------------------------+-- HTML spec: https://html.spec.whatwg.org/#srcset-attributes+srcsetParser :: P.Parsec String () Srcset+srcsetParser = do+  result <- candidate `P.sepBy1` (PC.char ',')+  P.eof+  return $ Srcset result+  where+  candidate :: P.Parsec String () SrcsetImageCandidate+  candidate = do+    P.skipMany ascii_whitespace+    u <- url+    P.skipMany ascii_whitespace+    desc <- P.optionMaybe $ P.choice $ fmap P.try [width_descriptor, px_density_descriptor]+    P.skipMany ascii_whitespace+    return $ SrcsetImageCandidate {+        srcsetImageCandidateUrl = u+      , srcsetImageCandidateDescriptor = desc+      }++  -- This is an over-simplification, but should be good enough for our purposes+  url :: P.Parsec String () String+  url = P.many1 $ PC.noneOf " ,"++  ascii_whitespace :: P.Parsec String () ()+  ascii_whitespace = void $ P.oneOf "\x09\x0A\x0C\x0D\x20"++  width_descriptor :: P.Parsec String () String+  width_descriptor = do+    number <- P.many1 PC.digit+    void $ PC.char 'w'+    return $ concat [number, "w"]++  px_density_descriptor :: P.Parsec String () String+  px_density_descriptor = do+    sign <- P.optionMaybe $ PC.char '-'+    int <- P.many1 PC.digit+    frac <- P.optionMaybe $ do+      void $ PC.char '.'+      frac <- P.many1 PC.digit+      return $ concat [".", frac]+    expon <- P.optionMaybe $ do+      letter <- P.oneOf "eE"+      e_sign <- P.optionMaybe $ PC.oneOf "-+"+      number <- P.many1 PC.digit+      return $ concat [[letter], mb $ fmap show e_sign, number]+    void $ PC.char 'x'+    return $ concat [mb $ fmap show sign, int, mb frac, mb expon, "x"]++  mb :: Maybe String -> String+  mb = fromMaybe ""
+ lib/Hakyll/Web/Html/RelativizeUrls.hs view
@@ -0,0 +1,52 @@+--------------------------------------------------------------------------------+-- | This module exposes a function which can relativize URL's on a webpage.+--+-- This means that one can deploy the resulting site on+-- @http:\/\/example.com\/@, but also on @http:\/\/example.com\/some-folder\/@+-- without having to change anything (simply copy over the files).+--+-- To use it, you should use absolute URL's from the site root everywhere. For+-- example, use+--+-- > <img src="/images/lolcat.png" alt="Funny zomgroflcopter" />+--+-- in a blogpost. When running this through the relativize URL's module, this+-- will result in (suppose your blogpost is located at @\/posts\/foo.html@:+--+-- > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" />+module Hakyll.Web.Html.RelativizeUrls+    ( relativizeUrls+    , relativizeUrlsWith+    ) where+++--------------------------------------------------------------------------------+import           Data.List            (isPrefixOf)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Item+import           Hakyll.Web.Html+++--------------------------------------------------------------------------------+-- | Compiler form of 'relativizeUrls' which automatically picks the right root+-- path+relativizeUrls :: Item String -> Compiler (Item String)+relativizeUrls item = do+    route <- getRoute $ itemIdentifier item+    return $ case route of+        Nothing -> item+        Just r  -> fmap (relativizeUrlsWith $ toSiteRoot r) item+++--------------------------------------------------------------------------------+-- | Relativize URL's in HTML+relativizeUrlsWith :: String  -- ^ Path to the site root+                   -> String  -- ^ HTML to relativize+                   -> String  -- ^ Resulting HTML+relativizeUrlsWith root = withUrls rel+  where+    isRel x = "/" `isPrefixOf` x && not ("//" `isPrefixOf` x)+    rel x   = if isRel x then root ++ x else x
+ lib/Hakyll/Web/Meta/JSONLD.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE OverloadedStrings #-}++{- |++JSON-LD metadata, using <https://schema.org/ Schema.org> vocabulary+for articles.  Google applications and other search engines use+these data to improve search results and links.++This implementation supports the following fields:+++-------------------+----------------------------------------------------++| @\@type@          | __Hardcoded__ value @\"Article"@.                  |++-------------------+----------------------------------------------------++| @headline@        | __Required__ taken from context field @title@.     |++-------------------+----------------------------------------------------++| @datePublished@   | __Required__ date of publication, via 'dateField'. |++-------------------+----------------------------------------------------+++To use, add a 'jsonldField' to your template context:++@+let+  context = 'defaultContext' <> …+  postContext =+    context+    <> 'jsonldField' "jsonld" context+@++And update the template:++@+\<head>+  \<title>$title$\</title>+  \<link rel="stylesheet" type="text\/css" href="\/css\/default.css" />+  $if(jsonld)$$jsonld("embed")$$endif$+\</head>+@++The @"embed"@ argument generates a @\<script …>@ tag to be directly+included in page HTML.  To get the raw JSON string, use @"raw"@+instead.++-}+module Hakyll.Web.Meta.JSONLD+  ( jsonldField+  ) where++import Data.Aeson ((.=), pairs)+import Data.Aeson.Encoding (encodingToLazyByteString)+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT++import Hakyll.Core.Compiler+import Hakyll.Core.Compiler.Internal+import Hakyll.Core.Item+import Hakyll.Web.Template+import Hakyll.Web.Template.Context++runContext :: Context String -> String -> Compiler String+runContext ctx k = do+  i <- makeItem "dummy"+  unContext ctx k [] i >>= \cf -> case cf of+    StringField s -> pure s+    _             -> fail $ "Error: '" <> k <> "' is not a StringField"++getContext :: Context String -> String -> Compiler String+getContext ctx k = compilerTry (runContext ctx k) >>= either f pure+  where+  f (CompilationNoResult _) = compilerResult . CompilerError . CompilationFailure . pure $+                              "missing required field '" <> k <> "'"+  f err = compilerResult (CompilerError err)++-- This may come in handy later+_lookupContext :: Context String -> String -> Compiler (Maybe String)+_lookupContext ctx k = compilerTry (runContext ctx k) >>= either f (pure . Just)+  where+  f (CompilationNoResult _) = pure Nothing+  f err = compilerResult (CompilerError err)++-- | Render JSON-LD for an article.+-- Requires context with "title", and the item must be able to yield+-- a valid date via 'getItemUTC'+--+renderJSONLD :: Context String -> Compiler (Item String)+renderJSONLD ctx = do+  dateString <- getContext (dateField "" "%Y-%m-%dT%H:%M:%S") ""+  titleString <- getContext ctx "title"++  let+    obj = pairs $+      "@context" .= ("https://schema.org" :: String)+      <> "@type" .= ("Article" :: String)+      <> "headline" .= titleString+      <> "datePublished" .= dateString++  makeItem . LT.unpack . LT.decodeUtf8 . encodingToLazyByteString $ obj++jsonldField :: String -> Context String -> Context String+jsonldField k ctx = functionField k (\args _i -> go args)+  where+  -- The zero argument case cannot be a compiler error,+  -- otherwise @$if(k)$@ evaluates false.+  go [] = pure $ "<!-- Whoops! Try this instead: $if(" <> k <> ")$$" <> k <> "(\"embed\")$$endif$ -->"+  go ["raw"] = itemBody <$> renderJSONLD ctx+  go ["embed"] = do+    template <- jsonldTemplate+    i <- renderJSONLD ctx >>= applyTemplate template (bodyField "body")+    pure $ itemBody i+  go [_] = fail $ "invalid argument to jsonldField '" <> k <> "'. use \"raw\" or \"embed\""+  go _ = fail $ "too many arguments to jsonldField '" <> k <> "'"++jsonldTemplate :: Compiler Template+jsonldTemplate = do+  makeItem "<script type=\"application/ld+json\">$body$</script>"+  >>= compileTemplateItem
+ lib/Hakyll/Web/Meta/OpenGraph.hs view
@@ -0,0 +1,71 @@+{- |++Open Graph metadata, as described at <https://ogp.me/>.  This+implementation supports the following properties:+++------------------+----------------------------------------------------++| @og:type@        | __Hardcoded__ value @"article"@                    |++------------------+----------------------------------------------------++| @og:url@         | __Required__ concatenation of @root@ and @url@     |+|                  | context fields, both of which are required.        |++------------------+----------------------------------------------------++| @og:title@       | __Required__ title of article, from @title@ field. |++------------------+----------------------------------------------------++| @og:description@ | __Optional__ brief description taken from context  |+|                  | field @og-description@, if set.                    |++------------------+----------------------------------------------------++| @og:image@       | __Optional__ image URL taken from context          |+|                  | field @og-image@, if set.                          |++------------------+----------------------------------------------------+++To use, add 'openGraphField' to the template context:++@+let+  context = 'defaultContext' <> …+  postContext = context <> 'openGraphField' "opengraph" context+@++and update the template:++@+\<head>+  \<title>$title$</title>+  \<link rel="stylesheet" type="text\/css" href="\/css\/default.css" />+  $if(opengraph)$$opengraph$$endif$+\</head>+@++See also "Hakyll.Web.Meta.TwitterCard".++-}+module Hakyll.Web.Meta.OpenGraph+  ( openGraphField+  ) where++import Hakyll.Core.Compiler+import Hakyll.Core.Item+import Hakyll.Web.Template+import Hakyll.Web.Template.Context++openGraphField :: String -> Context String -> Context String+openGraphField k ctx = functionField k $ \_args i -> do+  template <- openGraphTemplate+  itemBody <$> applyTemplate template ctx i++openGraphTemplate :: Compiler Template+openGraphTemplate = do+  makeItem openGraphTemplateString >>= compileTemplateItem++openGraphTemplateString :: String+openGraphTemplateString =+  "<meta property=\"og:type\" content=\"article\" />\+  \<meta property=\"og:url\" content=\"$root$$url$\" />\+  \<meta property=\"og:title\" content=\"$title$\" />\+  \$if(og-description)$\+  \<meta property=\"og:description\" content=\"$og-description$\" />\+  \$endif$\+  \$if(og-image)$\+  \<meta property=\"og:image\" content=\"$og-image$\" />\+  \$endif$\+  \"
+ lib/Hakyll/Web/Meta/TwitterCard.hs view
@@ -0,0 +1,63 @@+{- |++Twitter Card metadata, as described at+<https://developer.twitter.com/en/docs/twitter-for-websites/cards/guides/getting-started>.+This feature should be used alongside "Hakyll.Web.Meta.OpenGraph".+The following properties are supported:+++-------------------+----------------------------------------------------++| @twitter:card@    | __Hardcoded__ card type = @"summary"@.             |++-------------------+----------------------------------------------------++| @twitter:creator@ | __Optional__ author's Twitter user name.           |+|                   | Taken from @twitter-creator@ context field, if set.|++-------------------+----------------------------------------------------++| @twitter:site@    | __Optional__ publication's Twitter user name.      |+|                   | Taken from @twitter-site@ context field, if set.   |++-------------------+----------------------------------------------------+++To use, add 'openGraphField' and 'twitterCardField' to the template context:++@+let+  context = 'defaultContext' <> …+  postContext =+    context+    <> 'openGraphField' "opengraph" context+    <> 'twitterCardField' "twitter" context+@++and update the template:++@+\<head>+  \<title>$title$\</title>+  \<link rel="stylesheet" type="text\/css" href="\/css\/default.css" />+  $if(opengraph)$$opengraph$$endif$+  $if(twitter)$$twitter$$endif$+\</head>+@++-}+module Hakyll.Web.Meta.TwitterCard+  ( twitterCardField+  ) where++import Hakyll.Core.Compiler+import Hakyll.Core.Item+import Hakyll.Web.Template+import Hakyll.Web.Template.Context++twitterCardField :: String -> Context String -> Context String+twitterCardField k ctx = functionField k $ \_args i -> do+  template <- twitterCardTemplate+  itemBody <$> applyTemplate template ctx i++twitterCardTemplate :: Compiler Template+twitterCardTemplate = do+  makeItem twitterCardTemplateString >>= compileTemplateItem++twitterCardTemplateString :: String+twitterCardTemplateString =+  "<meta name=\"twitter:card\" content=\"summary\" />\+  \$if(twitter-creator)$<meta name=\"twitter:creator\" content=\"$twitter-creator$\" />$endif$\+  \$if(twitter-site)$<meta name=\"twitter:site\" content=\"$twitter-site$\" />$endif$"
+ lib/Hakyll/Web/Paginate.hs view
@@ -0,0 +1,154 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Web.Paginate+    ( PageNumber+    , Paginate (..)+    , buildPaginateWith+    , paginateEvery+    , paginateRules+    , paginateContext+    ) where+++--------------------------------------------------------------------------------+import           Control.Applicative            (empty)+import           Control.Monad                  (forM_, forM)+import qualified Data.Map                       as M+import qualified Data.Set                       as S+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Dependencies+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern+import           Hakyll.Core.Item+import           Hakyll.Core.Metadata+import           Hakyll.Core.Rules+import           Hakyll.Web.Html+import           Hakyll.Web.Template.Context+++--------------------------------------------------------------------------------+type PageNumber = Int+++--------------------------------------------------------------------------------+-- | Data about paginators+data Paginate = Paginate+    { paginateMap        :: M.Map PageNumber [Identifier]+    , paginateMakeId     :: PageNumber -> Identifier+    , paginateDependency :: Dependency+    }+++--------------------------------------------------------------------------------+paginateNumPages :: Paginate -> Int+paginateNumPages = M.size . paginateMap+++--------------------------------------------------------------------------------+paginateEvery :: Int -> [a] -> [[a]]+paginateEvery n = go+  where+    go [] = []+    go xs = let (y, ys) = splitAt n xs in y : go ys+++--------------------------------------------------------------------------------+buildPaginateWith+    :: MonadMetadata m+    => ([Identifier] -> m [[Identifier]])  -- ^ Group items into pages+    -> Pattern                             -- ^ Select items to paginate+    -> (PageNumber -> Identifier)          -- ^ Identifiers for the pages+    -> m Paginate+buildPaginateWith grouper pattern makeId = do+    ids      <- getMatches pattern+    idGroups <- grouper ids+    let idsSet = S.fromList ids+    return Paginate+        { paginateMap        = M.fromList (zip [1 ..] idGroups)+        , paginateMakeId     = makeId+        , paginateDependency = contentDependency $ PatternDependency pattern idsSet+        }+++--------------------------------------------------------------------------------+paginateRules :: Paginate -> (PageNumber -> Pattern -> Rules ()) -> Rules ()+paginateRules paginator rules =+    forM_ (M.toList $ paginateMap paginator) $ \(idx, identifiers) ->+        rulesExtraDependencies [paginateDependency paginator] $+            create [paginateMakeId paginator idx] $+                rules idx $ fromList identifiers+++--------------------------------------------------------------------------------+-- | Get the identifier for a certain page by passing in the page number.+paginatePage :: Paginate -> PageNumber -> Maybe Identifier+paginatePage pag pageNumber+    | pageNumber < 1                      = Nothing+    | pageNumber > (paginateNumPages pag) = Nothing+    | otherwise                           = Just $ paginateMakeId pag pageNumber+++--------------------------------------------------------------------------------+-- | A default paginate context which provides the following keys:+--+--+-- * @firstPageNum@+-- * @firstPageUrl@+-- * @previousPageNum@+-- * @previousPageUrl@+-- * @nextPageNum@+-- * @nextPageUrl@+-- * @lastPageNum@+-- * @lastPageUrl@+-- * @currentPageNum@+-- * @currentPageUrl@+-- * @numPages@+-- * @allPages@+paginateContext :: Paginate -> PageNumber -> Context a+paginateContext pag currentPage = mconcat+    [ field "firstPageNum"    $ \_ -> otherPage 1                 >>= num+    , field "firstPageUrl"    $ \_ -> otherPage 1                 >>= url+    , field "previousPageNum" $ \_ -> otherPage (currentPage - 1) >>= num+    , field "previousPageUrl" $ \_ -> otherPage (currentPage - 1) >>= url+    , field "nextPageNum"     $ \_ -> otherPage (currentPage + 1) >>= num+    , field "nextPageUrl"     $ \_ -> otherPage (currentPage + 1) >>= url+    , field "lastPageNum"     $ \_ -> otherPage lastPage          >>= num+    , field "lastPageUrl"     $ \_ -> otherPage lastPage          >>= url+    , field "currentPageNum"  $ \i -> thisPage i                  >>= num+    , field "currentPageUrl"  $ \i -> thisPage i                  >>= url+    , constField "numPages"   $ show $ paginateNumPages pag+    , Context $ \k _ i -> case k of+        "allPages" -> do+            let ctx =+                    field "isCurrent" (\n -> if fst (itemBody n) == currentPage then return "true" else empty) `mappend`+                    field "num" (num . itemBody) `mappend`+                    field "url" (url . itemBody)++            list <- forM [1 .. lastPage] $+                \n -> if n == currentPage then thisPage i else otherPage n+            items <- mapM makeItem list+            return $ ListField ctx items+        _          -> do+            empty++    ]+  where+    lastPage = paginateNumPages pag++    thisPage i = return (currentPage, itemIdentifier i)+    otherPage n+        | n == currentPage = fail $ "This is the current page: " ++ show n+        | otherwise        = case paginatePage pag n of+            Nothing -> fail $ "No such page: " ++ show n+            Just i  -> return (n, i)++    num :: (Int, Identifier) -> Compiler String+    num = return . show . fst++    url :: (Int, Identifier) -> Compiler String+    url (n, i) = getRoute i >>= \mbR -> case mbR of+        Just r  -> return $ toUrl r+        Nothing -> fail $ "No URL for page: " ++ show n
+ lib/Hakyll/Web/Pandoc.hs view
@@ -0,0 +1,253 @@+{-# LANGUAGE CPP #-}+--------------------------------------------------------------------------------+-- | Module exporting convenient pandoc bindings+module Hakyll.Web.Pandoc+    ( -- * The basic building blocks+      readPandoc+    , readPandocWith+    , writePandoc+    , writePandocWith+    , renderPandoc+    , renderPandocWith+    , renderPandocWithTransform+    , renderPandocWithTransformM+    , renderPandocItemWithTransformM++      -- * Derived compilers+    , pandocCompiler+    , pandocCompilerWith+    , pandocCompilerWithTransform+    , pandocCompilerWithTransformM+    , pandocItemCompilerWithTransformM++      -- * Default options+    , defaultHakyllReaderOptions+    , defaultHakyllWriterOptions+    ) where+++--------------------------------------------------------------------------------+import qualified Data.Text                  as T+import           Text.Pandoc+import           Text.Pandoc.Highlighting   (pygments)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Item+import           Hakyll.Web.Pandoc.FileType+++--------------------------------------------------------------------------------+-- | Read a string using pandoc, with the default options+readPandoc+    :: Item String             -- ^ String to read+    -> Compiler (Item Pandoc)  -- ^ Resulting document+readPandoc = readPandocWith defaultHakyllReaderOptions+++--------------------------------------------------------------------------------+-- | Read a string using pandoc, with the supplied options+readPandocWith+    :: ReaderOptions           -- ^ Parser options+    -> Item String             -- ^ String to read+    -> Compiler (Item Pandoc)  -- ^ Resulting document+readPandocWith ropt item =+    case runPure $ traverse (reader ropt (itemFileType item)) (fmap T.pack item) of+        Left err    -> fail $+            "Hakyll.Web.Pandoc.readPandocWith: parse failed: " ++ show err+        Right item' -> return item'+  where+    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+        MediaWiki          -> readMediaWiki ro+        OrgMode            -> readOrg ro+        Rst                -> readRST ro+#if MIN_VERSION_pandoc(3,8,3)+        AsciiDoc           -> readAsciiDoc ro+#endif+#if MIN_VERSION_pandoc(3,1,12)+        Djot               -> readDjot ro+#endif+-- This preprocessing instruction can be dropped+-- once the minimum supported GHC version is 8.10+#if MIN_VERSION_pandoc(3,1,3)+        Typst              -> readTypst ro+#endif+        Textile            -> readTextile ro+        _                  -> error $+            "Hakyll.Web.readPandocWith: I don't know how to read a file of " +++            "the type " ++ show t ++ " for: " ++ show (itemIdentifier item)++    addExt ro e = ro {readerExtensions = enableExtension e $ readerExtensions ro}+++--------------------------------------------------------------------------------+-- | Write a document (as HTML) using pandoc, with the default options+writePandoc :: Item Pandoc  -- ^ Document to write+            -> Item String  -- ^ Resulting HTML+writePandoc = writePandocWith defaultHakyllWriterOptions+++--------------------------------------------------------------------------------+-- | Write a document (as HTML) using pandoc, with the supplied options+writePandocWith :: WriterOptions  -- ^ Writer options for pandoc+                -> Item Pandoc    -- ^ Document to write+                -> Item String    -- ^ Resulting HTML+writePandocWith wopt (Item itemi doc) =+    case runPure $ writeHtml5String wopt doc of+        Left err    -> error $ "Hakyll.Web.Pandoc.writePandocWith: " ++ show err+        Right item' -> Item itemi $ T.unpack item'+++--------------------------------------------------------------------------------+-- | Render the resource using pandoc+renderPandoc :: Item String -> Compiler (Item String)+renderPandoc =+    renderPandocWith defaultHakyllReaderOptions defaultHakyllWriterOptions+++--------------------------------------------------------------------------------+-- | Render the resource using pandoc+renderPandocWith+    :: ReaderOptions -> WriterOptions -> Item String -> Compiler (Item String)+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.+--+-- @since 4.16.3.0+renderPandocWithTransformM :: ReaderOptions -> WriterOptions+                    -> (Pandoc -> Compiler Pandoc)+                    -> Item String+                    -> Compiler (Item String)+renderPandocWithTransformM ropt wopt f i =+    writePandocWith wopt <$> (traverse f =<< readPandocWith ropt i)+++--------------------------------------------------------------------------------+-- | Like 'renderPandocWithTransformM', but work on an @'Item' 'Pandoc'@ instead+-- of just a 'Pandoc'. This allows for more seamless composition of functions+-- that require the extra information that an 'Item' provides, like+-- bibliographic transformations with+-- 'Hakyll.Web.Pandoc.Biblio.processPandocBiblio'.+--+-- @since 4.16.3.0+renderPandocItemWithTransformM+  :: ReaderOptions -> WriterOptions+  -> (Item Pandoc -> Compiler (Item Pandoc))+  -> Item String+  -> Compiler (Item String)+renderPandocItemWithTransformM ropt wopt f i =+    writePandocWith wopt <$> (f =<< readPandocWith ropt i)+++--------------------------------------------------------------------------------+-- | Read a page render using pandoc+pandocCompiler :: Compiler (Item String)+pandocCompiler =+    pandocCompilerWith defaultHakyllReaderOptions defaultHakyllWriterOptions+++--------------------------------------------------------------------------------+-- | A version of 'pandocCompiler' which allows you to specify your own pandoc+-- options+pandocCompilerWith :: ReaderOptions -> WriterOptions -> Compiler (Item String)+pandocCompilerWith ropt wopt =+    cached "Hakyll.Web.Pandoc.pandocCompilerWith" $+        pandocCompilerWithTransform ropt wopt id+++--------------------------------------------------------------------------------+-- | An extension of 'pandocCompilerWith' which allows you to specify a custom+-- pandoc transformation for the content+pandocCompilerWithTransform :: ReaderOptions -> WriterOptions+                            -> (Pandoc -> Pandoc)+                            -> Compiler (Item String)+pandocCompilerWithTransform ropt wopt f =+    pandocCompilerWithTransformM ropt wopt (return . f)+++--------------------------------------------------------------------------------+-- | Similar to 'pandocCompilerWithTransform', but the transformation+-- function is monadic. This is useful when you want the pandoc+-- transformation to use the 'Compiler' information such as routes,+-- metadata, etc+pandocCompilerWithTransformM :: ReaderOptions -> WriterOptions+                    -> (Pandoc -> Compiler Pandoc)+                    -> Compiler (Item String)+pandocCompilerWithTransformM ropt wopt f =+    getResourceBody >>= renderPandocWithTransformM ropt wopt f+++--------------------------------------------------------------------------------+-- | Like 'pandocCompilerWithTransformM', but work on an 'Item' 'Pandoc'+-- instead of just a 'Pandoc'. This allows for more seamless composition of+-- functions that require the extra information that an 'Item' provides, like+-- bibliographic transformations with+-- 'Hakyll.Web.Pandoc.Biblio.processPandocBiblio'.+pandocItemCompilerWithTransformM+  :: ReaderOptions -> WriterOptions+  -> (Item Pandoc -> Compiler (Item Pandoc))+  -> Compiler (Item String)+pandocItemCompilerWithTransformM ropt wopt f =+    getResourceBody >>= renderPandocItemWithTransformM ropt wopt f+++--------------------------------------------------------------------------------+-- | The default reader options for pandoc parsing in hakyll+defaultHakyllReaderOptions :: ReaderOptions+defaultHakyllReaderOptions = def+    { -- The following option causes pandoc to read smart typography, a nice+      -- and free bonus.+      readerExtensions = enableExtension Ext_smart pandocExtensions+    }+++--------------------------------------------------------------------------------+-- | The default writer options for pandoc rendering in hakyll+defaultHakyllWriterOptions :: WriterOptions+defaultHakyllWriterOptions = def+    { -- This option causes literate haskell to be written using '>' marks in+      -- html, which I think is a good default.+      writerExtensions = enableExtension Ext_smart pandocExtensions+    , -- We want to have hightlighting by default, to be compatible with earlier+      -- Hakyll releases+#if MIN_VERSION_pandoc(3,8,0)+      -- Starting with pandoc 3.8, the highlighting+      -- system was overhauled to have more than just Skylighting+      -- styles+      writerHighlightMethod = Skylighting pygments+#else+      writerHighlightStyle = Just pygments+#endif+    , -- Do not word-wrap produced HTML, and do not undo any word-wrapping+      -- that's already present in the markup. This is how Pandoc operated+      -- prior to 2.17, but the behaviour was changed for consistency with+      -- other Pandoc writers. We retain the old behaviour because it spares us+      -- the trouble of updating our golden tests.+      writerWrapText = WrapPreserve+    }
+ lib/Hakyll/Web/Pandoc/Biblio.hs view
@@ -0,0 +1,240 @@+--------------------------------------------------------------------------------+-- | Wraps pandocs bibiliography handling+--+-- In order to add a bibliography, you will need a bibliography file (e.g.+-- @.bib@) and a CSL file (@.csl@). Both need to be compiled with their+-- 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. 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;+-- 'pandocBibliosCompiler' is similar but instead takes a glob pattern for bib files.+{-# LANGUAGE Arrows                     #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE OverloadedStrings          #-}+module Hakyll.Web.Pandoc.Biblio+    ( CSL (..)+    , cslCompiler+    , Biblio (..)+    , biblioCompiler+    , readPandocBiblio+    , readPandocBiblios+    , processPandocBiblio+    , processPandocBiblios+    , pandocBiblioCompiler+    , pandocBibliosCompiler+    ) where+++--------------------------------------------------------------------------------+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 qualified Data.Text                     as T (pack)+import           Data.Typeable                 (Typeable)+import           Hakyll.Core.Compiler+import           Hakyll.Core.Compiler.Internal+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern (fromGlob)+import           Hakyll.Core.Item+import           Hakyll.Core.Metadata          (getMetadataField)+import           Hakyll.Core.Writable+import           Hakyll.Web.Pandoc+import           Text.Pandoc                   (Extension (..), Pandoc,+                                                PandocPure, ReaderOptions (..),+                                                enableExtension)+import qualified Text.Pandoc                   as Pandoc+import           Text.Pandoc.Builder           (setMeta)+import qualified Text.Pandoc.Citeproc          as Pandoc (processCitations)+import           Text.Pandoc.Walk              (Walkable (query))+import           System.FilePath               (addExtension, takeExtension)+++--------------------------------------------------------------------------------+newtype CSL = CSL {unCSL :: B.ByteString}+    deriving (Binary, Show, Typeable)++++--------------------------------------------------------------------------------+instance Writable CSL where+    -- Shouldn't be written.+    write _ _ = return ()+++--------------------------------------------------------------------------------+cslCompiler :: Compiler (Item CSL)+cslCompiler = fmap (CSL . BL.toStrict) <$> getResourceLBS+++--------------------------------------------------------------------------------+newtype Biblio = Biblio {unBiblio :: B.ByteString}+    deriving (Binary, Show, Typeable)+++--------------------------------------------------------------------------------+instance Writable Biblio where+    -- Shouldn't be written.+    write _ _ = return ()+++--------------------------------------------------------------------------------+biblioCompiler :: Compiler (Item Biblio)+biblioCompiler = fmap (Biblio . BL.toStrict) <$> getResourceLBS+++--------------------------------------------------------------------------------+readPandocBiblio :: ReaderOptions+                 -> Item CSL+                 -> Item Biblio+                 -> (Item String)+                 -> Compiler (Item Pandoc)+readPandocBiblio ropt csl biblio = readPandocBiblios ropt csl [biblio]++readPandocBiblios :: ReaderOptions+                  -> Item CSL+                  -> [Item Biblio]+                  -> (Item String)+                  -> Compiler (Item Pandoc)+readPandocBiblios ropt csl biblios item = do+  pandoc <- readPandocWith ropt item+  processPandocBiblios csl biblios pandoc+++--------------------------------------------------------------------------------++-- | Process a bibliography file with the given style.+--+-- This function supports pandoc's+-- <https://pandoc.org/chunkedhtml-demo/9.6-including-uncited-items-in-the-bibliography.html nocite>+-- functionality when there is a @nocite@ metadata field present.+--+-- ==== __Example__+--+-- In your main function, first compile the respective files:+--+-- > main = hakyll $ do+-- >   …+-- >   match "style.csl" $ compile cslCompiler+-- >   match "bib.bib"   $ compile biblioCompiler+--+-- Then, create a function like the following:+--+-- > processBib :: Item Pandoc -> Compiler (Item Pandoc)+-- > processBib pandoc = do+-- >   csl <- load @CSL    "bib/style.csl"+-- >   bib <- load @Biblio "bib/bibliography.bib"+-- >   processPandocBiblio csl bib pandoc+--+-- Now, feed this function to your pandoc compiler:+--+-- > myCompiler :: Compiler (Item String)+-- > myCompiler = pandocItemCompilerWithTransformM myReader myWriter processBib+processPandocBiblio :: Item CSL+                    -> Item Biblio+                    -> (Item Pandoc)+                    -> Compiler (Item Pandoc)+processPandocBiblio csl biblio = processPandocBiblios csl [biblio]++-- | Like 'processPandocBiblio', which see, but support multiple bibliography+-- files.+processPandocBiblios :: Item CSL+                     -> [Item Biblio]+                     -> (Item Pandoc)+                     -> Compiler (Item Pandoc)+processPandocBiblios csl biblios 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.+    --+    -- 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.++    -- Honour nocite metadata fields+    item <- getUnderlying >>= (`getMetadataField` "nocite") >>= \case+        Nothing -> pure item'+        Just x  -> withItemBody (pure . setMeta "nocite" x) item'++    let Pandoc.Pandoc (Pandoc.Meta meta) blocks = itemBody item+        cslFile = Pandoc.FileInfo zeroTime . unCSL $ itemBody csl+        bibFiles = zipWith (\x y ->+            ( addExtension ("_hakyll/bibliography-" ++ show x)+                           (takeExtension $ toFilePath $ itemIdentifier y)+            , Pandoc.FileInfo zeroTime . unBiblio . itemBody $ y+            )+          )+          [0 :: Integer ..]+          biblios++        stFiles = foldr ((.) . uncurry Pandoc.insertInFileTree)+                    (Pandoc.insertInFileTree "_hakyll/style.csl" cslFile)+                    bibFiles++        addBiblioFiles = \st -> st { Pandoc.stFiles = stFiles $ Pandoc.stFiles st }++        biblioMeta = Pandoc.Meta .+            Map.insert "csl" (Pandoc.MetaString "_hakyll/style.csl") .+            Map.insert "bibliography"+              (Pandoc.MetaList $ map (Pandoc.MetaString . T.pack . fst) bibFiles) $+            meta++    pandoc <- do+        let p = Pandoc.Pandoc biblioMeta blocks+        p' <- case Pandoc.lookupMeta "nocite" biblioMeta of+            Just (Pandoc.MetaString nocite) -> do+                Pandoc.Pandoc _ b <- runPandoc $+                    Pandoc.readMarkdown defaultHakyllReaderOptions nocite+                let nocites = Pandoc.MetaInlines . flip query b $ \case+                        c@Pandoc.Cite{} -> [c]+                        _               -> []+                return $ setMeta "nocite" nocites p+            _ -> return p+        runPandoc $ do+            Pandoc.modifyPureState addBiblioFiles+            Pandoc.processCitations p'+    return $ fmap (const pandoc) item++  where+    zeroTime = Time.UTCTime (toEnum 0) 0++    runPandoc :: PandocPure a -> Compiler a+    runPandoc with = case Pandoc.runPure with of+        Left  e -> compilerThrow ["Error during processCitations: " ++ show e]+        Right x -> pure x++--------------------------------------------------------------------------------+-- | 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+    bib <- load $ fromFilePath bibFileName+    liftM writePandoc+        (getResourceBody >>= readPandocBiblio ropt csl bib)+    where ropt = defaultHakyllReaderOptions+            { -- The following option enables citation rendering+              readerExtensions = enableExtension Ext_citations $ readerExtensions defaultHakyllReaderOptions+            }++--------------------------------------------------------------------------------+-- | Compiles a markdown file via Pandoc. Requires the .csl and .bib files to be known to the compiler via match statements.+pandocBibliosCompiler :: String -> String -> Compiler (Item String)+pandocBibliosCompiler cslFileName bibFileName = do+    csl  <- load    $ fromFilePath cslFileName+    bibs <- loadAll $ fromGlob bibFileName+    liftM writePandoc+        (getResourceBody >>= readPandocBiblios ropt csl bibs)+    where ropt = defaultHakyllReaderOptions+            { -- The following option enables citation rendering+              readerExtensions = enableExtension Ext_citations $ readerExtensions defaultHakyllReaderOptions+            }
+ lib/Hakyll/Web/Pandoc/Binary.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE DeriveGeneric #-}+module Hakyll.Web.Pandoc.Binary where++import           Data.Binary        (Binary (..))++import           Text.Pandoc++--------------------------------------------------------------------------------+-- orphans++instance Binary Alignment+instance Binary Block+instance Binary Caption+instance Binary Cell+instance Binary ColSpan+instance Binary ColWidth+instance Binary Citation+instance Binary CitationMode+instance Binary Format+instance Binary Inline+instance Binary ListNumberDelim+instance Binary ListNumberStyle+instance Binary MathType+instance Binary QuoteType+instance Binary Row+instance Binary RowHeadColumns+instance Binary RowSpan+instance Binary TableBody+instance Binary TableFoot+instance Binary TableHead
+ lib/Hakyll/Web/Pandoc/FileType.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE CPP #-}+--------------------------------------------------------------------------------+-- | A module dealing with pandoc file extensions and associated file types+module Hakyll.Web.Pandoc.FileType+    ( FileType (..)+    , fileType+    , itemFileType+    ) where+++--------------------------------------------------------------------------------+import           System.FilePath        (splitExtension)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Identifier+import           Hakyll.Core.Item+++--------------------------------------------------------------------------------+-- | Datatype to represent the different file types Hakyll can deal with by+-- default+data FileType+    = Binary+    | Css+    | DocBook+    | Html+    | Jupyter+    | LaTeX+    | LiterateHaskell FileType+    | Markdown+    | MediaWiki+    | OrgMode+    | PlainText+    | Rst+    | Textile+#if MIN_VERSION_pandoc(3,8,3)+    | AsciiDoc+#endif+#if MIN_VERSION_pandoc(3,1,12)+    | Djot+#endif+-- This preprocessing instruction can be dropped+-- once the minimum supported GHC version is 8.10+#if MIN_VERSION_pandoc(3,1,3)+    | Typst+#endif+    deriving (Eq, Ord, Show, Read)+++--------------------------------------------------------------------------------+-- | Get the file type for a certain file. The type is determined by extension.+fileType :: FilePath -> FileType+fileType = uncurry fileType' . splitExtension+  where+    fileType' _ ".css"       = Css+    fileType' _ ".dbk"       = DocBook+    fileType' _ ".ipynb"     = Jupyter+    fileType' _ ".htm"       = Html+    fileType' _ ".html"      = Html+    fileType' f ".lhs"       = LiterateHaskell $ case fileType f of+        -- If no extension is given, default to Markdown + LiterateHaskell+        Binary -> Markdown+        -- Otherwise, LaTeX + LiterateHaskell or whatever the user specified+        x      -> x+    fileType' _ ".markdown"  = Markdown+    fileType' _ ".mediawiki" = MediaWiki+    fileType' _ ".md"        = Markdown+    fileType' _ ".mdn"       = Markdown+    fileType' _ ".mdown"     = Markdown+    fileType' _ ".mdwn"      = Markdown+    fileType' _ ".mkd"       = Markdown+    fileType' _ ".mkdwn"     = Markdown+    fileType' _ ".org"       = OrgMode+    fileType' _ ".page"      = Markdown+    fileType' _ ".rst"       = Rst+    fileType' _ ".tex"       = LaTeX+    fileType' _ ".text"      = PlainText+    fileType' _ ".textile"   = Textile+    fileType' _ ".txt"       = PlainText+#if MIN_VERSION_pandoc(3,8,3)+    fileType' _ ".asciidoc"  = AsciiDoc+    fileType' _ ".adoc"      = AsciiDoc+#endif+#if MIN_VERSION_pandoc(3,1,12)+    fileType' _ ".dj"        = Djot+    fileType' _ ".djot"      = Djot+#endif+-- This preprocessing instruction can be dropped+-- once the minimum supported GHC version is 8.10+#if MIN_VERSION_pandoc(3,1,3)+    fileType' _ ".typ"       = Typst+#endif+    fileType' _ ".wiki"      = MediaWiki+    fileType' _ _            = Binary  -- Treat unknown files as binary+++--------------------------------------------------------------------------------+-- | Get the file type for the current file+itemFileType :: Item a -> FileType+itemFileType = fileType . toFilePath . itemIdentifier
+ lib/Hakyll/Web/Redirect.hs view
@@ -0,0 +1,99 @@+-- | Module used for generating HTML redirect pages. This allows renaming pages+-- to avoid breaking existing links without requiring server-side support for+-- formal 301 Redirect error codes+module Hakyll.Web.Redirect+    ( Redirect (..)+    , createRedirects+    ) where++import           Control.Monad          (forM_, when)+import           Data.Binary            (Binary (..))+import           Data.List              (sort, group)+import           Hakyll.Core.Compiler+import           Hakyll.Core.Identifier+import           Hakyll.Core.Routes+import           Hakyll.Core.Rules+import           Hakyll.Core.Writable   (Writable (..))++-- | This function exposes a higher-level interface compared to using the+-- 'Redirect' type manually.+--+-- This creates, using a database mapping broken URLs to working ones, HTML+-- files which will do HTML META tag redirect pages (since, as a static site, we+-- can't use web-server-level 301 redirects, and using JS is gross).+--+-- This is useful for sending people using old URLs to renamed versions, dealing+-- with common typos etc, and will increase site traffic.  Such broken URLs can+-- be found by looking at server logs or by using Google Webmaster Tools.+-- Broken URLs must be valid Haskell strings, non-URL-escaped valid POSIX+-- filenames, and relative links, since they will be defined in a @hakyll.hs@+-- and during generation, written to disk with the filename corresponding to the+-- broken URLs.  (Target URLs can be absolute or relative, but should be+-- URL-escaped.) So broken incoming links like <http://www.gwern.net/foo/> which+-- should be <http://www.gwern.net/foobar> cannot be fixed (since you cannot+-- create a HTML file named @"foo/"@ on disk, as that would be a directory).+--+-- An example of a valid association list would be:+--+-- > brokenLinks =+-- >     [ ("projects.html", "http://github.com/gwern")+-- >     , ("/Black-market archive", "Black-market%20archives")+-- >     ]+--+-- In which case the functionality can then be used in `main` with a line like:+--+-- > version "redirects" $ createRedirects brokenLinks+--+-- The 'version' is recommended to separate these items from your other pages.+--+-- The on-disk files can then be uploaded with HTML mimetypes+-- (either explicitly by generating and uploading them separately, by+-- auto-detection of the filetype, or an upload tool defaulting to HTML+-- mimetype, such as calling @s3cmd@ with @--default-mime-type=text/html@) and+-- will redirect browsers and search engines going to the old/broken URLs.+--+-- See also <https://groups.google.com/d/msg/hakyll/sWc6zxfh-uM/fUpZPsFNDgAJ>.+createRedirects :: [(Identifier, String)] -> Rules ()+createRedirects redirects =+ do -- redirects are many-to-fewer; keys must be unique, and must point somewhere else:+    let gkeys = group $ sort $ map fst redirects+    forM_ gkeys $ \gkey -> case gkey of+        (k : _ : _) -> fail $+            "Duplicate 301 redirects; " ++ show k ++ " is ambiguous."+        _           -> return ()++    forM_ redirects $ \(r, t) ->+        when (toFilePath r == t) $ fail $+            "Self-redirect detected: " ++ show r ++ " points to itself."++    forM_ redirects $ \(ident, to) ->+        create [ident] $ do+            route idRoute+            compile $ makeItem $! Redirect to++-- | This datatype can be used directly if you want a lower-level interface to+-- generate redirects.  For example, if you want to redirect @foo.html@ to+-- @bar.jpg@, you can use:+--+-- > create ["foo.html"] $ do+-- >     route idRoute+-- >     compile $ makeItem $ Redirect "bar.jpg"+data Redirect = Redirect+    { redirectTo :: String+    } deriving (Eq, Ord, Show)++instance Binary Redirect where+    put (Redirect to) = put to+    get = Redirect <$> get++instance Writable Redirect where+    write path = write path . fmap redirectToHtml++redirectToHtml :: Redirect -> String+redirectToHtml (Redirect working) =+    "<!DOCTYPE html><html><head><meta charset=\"utf-8\"/><meta name=\"generator\" content=\"hakyll\"/>" +++    "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">" +++    "<meta http-equiv=\"refresh\" content=\"0; url=" ++ working +++    "\"><link rel=\"canonical\" href=\"" ++ working +++    "\"><title>Permanent Redirect</title></head><body><p>The page has moved to: <a href=\"" ++ working +++    "\">this page</a></p></body></html>"
+ lib/Hakyll/Web/Tags.hs view
@@ -0,0 +1,356 @@+--------------------------------------------------------------------------------+-- | This module containing some specialized functions to deal with tags. It+-- assumes you follow some conventions.+--+-- We support two types of tags: tags and categories.+--+-- To use default tags, use 'buildTags'. Tags are placed in a comma-separated+-- metadata field like this:+--+-- > ---+-- > author: Philip K. Dick+-- > title: Do androids dream of electric sheep?+-- > tags: future, science fiction, humanoid+-- > ---+-- > The novel is set in a post-apocalyptic near future, where the Earth and+-- > its populations have been damaged greatly by Nuclear...+--+-- To use categories, use the 'buildCategories' function. Categories are+-- determined by the directory a page is in, for example, the post+--+-- > posts/coding/2010-01-28-hakyll-categories.markdown+--+-- will receive the @coding@ category.+--+-- Advanced users may implement custom systems using 'buildTagsWith' if desired.+--+-- In the above example, we would want to create a page which lists all pages in+-- the @coding@ category, for example, with the 'Identifier':+--+-- > tags/coding.html+--+-- This is where the first parameter of 'buildTags' and 'buildCategories' comes+-- in. In the above case, we used the function:+--+-- > fromCapture "tags/*.html" :: String -> Identifier+--+-- The 'tagsRules' function lets you generate such a page for each tag in the+-- 'Rules' monad.+{-# LANGUAGE Arrows                     #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+module Hakyll.Web.Tags+    ( Tags (..)+    , getTags+    , getTagsByField+    , getCategory+    , buildTagsWith+    , buildTags+    , buildCategories+    , tagsRules+    , renderTags+    , renderTagCloud+    , renderTagCloudWith+    , tagCloudField+    , tagCloudFieldWith+    , renderTagList+    , tagsField+    , tagsFieldWith+    , categoryField+    , simpleRenderLink+    , sortTagsBy+    , caseInsensitiveTags+    ) where+++--------------------------------------------------------------------------------+import           Control.Arrow                   ((&&&))+import           Control.Monad                   (foldM, forM, forM_, mplus)+import           Data.Char                       (toLower)+import           Data.List                       (intercalate, intersperse,+                                                  sortBy)+import qualified Data.Map                        as M+import           Data.Maybe                      (catMaybes, fromMaybe)+import           Data.Ord                        (comparing)+import qualified Data.Set                        as S+import           System.FilePath                 (takeBaseName, takeDirectory)+import           Text.Blaze.Html                 (toHtml, toValue, (!))+import           Text.Blaze.Html.Renderer.String (renderHtml)+import qualified Text.Blaze.Html5                as H+import qualified Text.Blaze.Html5.Attributes     as A+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Dependencies+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern+import           Hakyll.Core.Item+import           Hakyll.Core.Metadata+import           Hakyll.Core.Rules+import           Hakyll.Core.Util.String+import           Hakyll.Web.Html+import           Hakyll.Web.Template.Context+++--------------------------------------------------------------------------------+-- | Data about tags+data Tags = Tags+    { tagsMap        :: [(String, [Identifier])]+    , tagsMakeId     :: String -> Identifier+    , tagsDependency :: Dependency+    }+++--------------------------------------------------------------------------------+-- | 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 = 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 fieldName metadata) `mplus`+        (map trim . splitAll "," <$> lookupString fieldName metadata)+++--------------------------------------------------------------------------------+-- | Obtain category from a page.+getCategory :: MonadMetadata m => Identifier -> m [String]+getCategory = return . return . takeBaseName . takeDirectory . toFilePath+++--------------------------------------------------------------------------------+-- | Higher-order function to read tags+buildTagsWith :: MonadMetadata m+              => (Identifier -> m [String])+              -> Pattern+              -> (String -> Identifier)+              -> m Tags+buildTagsWith f pattern makeId = do+    ids    <- getMatches pattern+    tagMap <- foldM addTags M.empty ids+    let set' = S.fromList ids+    return $ Tags (M.toList tagMap) makeId+        (metadataDependency $ PatternDependency pattern set')+  where+    -- Create a tag map for one page+    addTags tagMap id' = do+        tags <- f id'+        let tagMap' = M.fromList $ zip tags $ repeat [id']+        return $ M.unionWith (++) tagMap tagMap'+++--------------------------------------------------------------------------------+buildTags :: MonadMetadata m => Pattern -> (String -> Identifier) -> m Tags+buildTags = buildTagsWith getTags+++--------------------------------------------------------------------------------+buildCategories :: MonadMetadata m => Pattern -> (String -> Identifier)+                -> m Tags+buildCategories = buildTagsWith getCategory+++--------------------------------------------------------------------------------+tagsRules :: Tags -> (String -> Pattern -> Rules ()) -> Rules ()+tagsRules tags rules =+    forM_ (tagsMap tags) $ \(tag, identifiers) ->+        rulesExtraDependencies [tagsDependency tags] $+            create [tagsMakeId tags tag] $+                rules tag $ fromList identifiers+++--------------------------------------------------------------------------------+-- | Render tags in HTML (the flexible higher-order function)+renderTags :: (String -> String -> Int -> Int -> Int -> String)+           -- ^ Produce a tag item: tag, url, count, min count, max count+           -> ([String] -> String)+           -- ^ Join items+           -> Tags+           -- ^ Tag cloud renderer+           -> Compiler String+renderTags makeHtml concatHtml tags = do+    -- In tags' we create a list: [((tag, route), count)]+    tags' <- forM (tagsMap tags) $ \(tag, ids) -> do+        route' <- getRoute $ tagsMakeId tags tag+        return ((tag, route'), length ids)++    -- TODO: We actually need to tell a dependency here!++    let -- Absolute frequencies of the pages+        freqs = map snd tags'++        -- The minimum and maximum count found+        (min', max')+            | null freqs = (0, 1)+            | otherwise  = (minimum &&& maximum) freqs++        -- Create a link for one item+        makeHtml' ((tag, url), count) =+            makeHtml tag (toUrl $ fromMaybe "/" url) count min' max'++    -- Render and return the HTML+    return $ concatHtml $ map makeHtml' tags'+++--------------------------------------------------------------------------------+-- | Render a tag cloud in HTML+renderTagCloud :: Double+               -- ^ Smallest font size, in percent+               -> Double+               -- ^ Biggest font size, in percent+               -> Tags+               -- ^ Input tags+               -> Compiler String+               -- ^ Rendered cloud+renderTagCloud = renderTagCloudWith makeLink (intercalate " ")+  where+    makeLink minSize maxSize tag url count min' max' =+        -- Show the relative size of one 'count' in percent+        let diff     = 1 + fromIntegral max' - fromIntegral min'+            relative = (fromIntegral count - fromIntegral min') / diff+            size     = floor $ minSize + relative * (maxSize - minSize) :: Int+        in renderHtml $+            H.a ! A.style (toValue $ "font-size: " ++ show size ++ "%")+                ! A.href (toValue url)+                $ toHtml tag+++--------------------------------------------------------------------------------+-- | Render a tag cloud in HTML+renderTagCloudWith :: (Double -> Double ->+                       String -> String -> Int -> Int -> Int -> String)+                   -- ^ Render a single tag link+                   -> ([String] -> String)+                   -- ^ Concatenate links+                   -> Double+                   -- ^ Smallest font size, in percent+                   -> Double+                   -- ^ Biggest font size, in percent+                   -> Tags+                   -- ^ Input tags+                   -> Compiler String+                   -- ^ Rendered cloud+renderTagCloudWith makeLink cat minSize maxSize =+  renderTags (makeLink minSize maxSize) cat+++--------------------------------------------------------------------------------+-- | Render a tag cloud in HTML as a context+tagCloudField :: String+               -- ^ Destination key+               -> Double+               -- ^ Smallest font size, in percent+               -> Double+               -- ^ Biggest font size, in percent+               -> Tags+               -- ^ Input tags+               -> Context a+               -- ^ Context+tagCloudField key minSize maxSize tags =+  field key $ \_ -> renderTagCloud minSize maxSize tags+++--------------------------------------------------------------------------------+-- | Render a tag cloud in HTML as a context+tagCloudFieldWith :: String+                  -- ^ Destination key+                  -> (Double -> Double ->+                      String -> String -> Int -> Int -> Int -> String)+                  -- ^ Render a single tag link+                  -> ([String] -> String)+                  -- ^ Concatenate links+                  -> Double+                  -- ^ Smallest font size, in percent+                  -> Double+                  -- ^ Biggest font size, in percent+                  -> Tags+                  -- ^ Input tags+                  -> Context a+                  -- ^ Context+tagCloudFieldWith key makeLink cat minSize maxSize tags =+  field key $ \_ -> renderTagCloudWith makeLink cat minSize maxSize tags+++--------------------------------------------------------------------------------+-- | Render a simple tag list in HTML, with the tag count next to the item+-- TODO: Maybe produce a Context here+renderTagList :: Tags -> Compiler (String)+renderTagList = renderTags makeLink (intercalate ", ")+  where+    makeLink tag url count _ _ = renderHtml $+        H.a ! A.href (toValue url) ! A.rel "tag" $ toHtml (tag ++ " (" ++ show count ++ ")")+++--------------------------------------------------------------------------------+-- | Render tags with links with custom functions to get tags and to+-- render links+tagsFieldWith :: (Identifier -> Compiler [String])+              -- ^ Get the tags+              -> (String -> (Maybe FilePath) -> Maybe H.Html)+              -- ^ Render link for one tag+              -> ([H.Html] -> H.Html)+              -- ^ Concatenate tag links+              -> String+              -- ^ Destination field+              -> Tags+              -- ^ Tags structure+              -> Context a+              -- ^ Resulting context+tagsFieldWith getTags' renderLink cat key tags = field key $ \item -> do+    tags' <- getTags' $ itemIdentifier item+    links <- forM tags' $ \tag -> do+        route' <- getRoute $ tagsMakeId tags tag+        return $ renderLink tag route'++    return $ renderHtml $ cat $ catMaybes $ links+++--------------------------------------------------------------------------------+-- | Render tags with links+tagsField :: String     -- ^ Destination key+          -> Tags       -- ^ Tags+          -> Context a  -- ^ Context+tagsField =+  tagsFieldWith getTags simpleRenderLink (mconcat . intersperse ", ")+++--------------------------------------------------------------------------------+-- | Render the category in a link+categoryField :: String     -- ^ Destination key+              -> Tags       -- ^ Tags+              -> Context a  -- ^ Context+categoryField =+  tagsFieldWith getCategory simpleRenderLink (mconcat . intersperse ", ")+++--------------------------------------------------------------------------------+-- | Render one tag link+simpleRenderLink :: String -> (Maybe FilePath) -> Maybe H.Html+simpleRenderLink _   Nothing         = Nothing+simpleRenderLink tag (Just filePath) = Just $+    H.a ! A.title (H.stringValue ("All pages tagged '"++tag++"'."))+        ! A.href (toValue $ toUrl filePath)+        ! (A.rel "tag")+        $ toHtml tag+++--------------------------------------------------------------------------------+-- | Sort tags using supplied function. First element of the tuple passed to+-- the comparing function is the actual tag name.+sortTagsBy :: ((String, [Identifier]) -> (String, [Identifier]) -> Ordering)+           -> Tags -> Tags+sortTagsBy f t = t {tagsMap = sortBy f (tagsMap t)}+++--------------------------------------------------------------------------------+-- | Sample sorting function that compares tags case insensitively.+caseInsensitiveTags :: (String, [Identifier]) -> (String, [Identifier])+                    -> Ordering+caseInsensitiveTags = comparing $ map toLower . fst
+ lib/Hakyll/Web/Template.hs view
@@ -0,0 +1,178 @@+-- | This module provides means for reading and applying 'Template's.+--+-- Templates are tools to convert items into a string. They are perfectly suited+-- for laying out your site.+--+-- Let's look at an example template:+--+-- > <html>+-- >     <head>+-- >         <title>My crazy homepage - $title$</title>+-- >     </head>+-- >     <body>+-- >         <div id="header">+-- >             <h1>My crazy homepage - $title$</h1>+-- >         </div>+-- >         <div id="content">+-- >             $body$+-- >         </div>+-- >         <div id="footer">+-- >             By reading this you agree that I now own your soul+-- >         </div>+-- >     </body>+-- > </html>+--+-- As you can see, the format is very simple -- @$key$@ is used to render the+-- @$key$@ field from the page, everything else is literally copied. If you want+-- to literally insert @\"$key$\"@ into your page (for example, when you're+-- writing a Hakyll tutorial) you can use+--+-- > <p>+-- >     A literal $$key$$.+-- > </p>+--+-- Because of it's simplicity, these templates can be used for more than HTML:+-- you could make, for example, CSS or JS templates as well.+--+-- Apart from interpolating @$key$@s from the 'Context' you can also+-- use the following macros:+--+-- * @$if(key)$@+--+-- > $if(key)$+-- >  <b> Defined </b>+-- > $else$+-- >  <b> Non-defined </b>+-- > $endif$+--+-- This example will print @Defined@ if @key@ is defined in the+-- context and @Non-defined@ otherwise. The @$else$@ clause is+-- optional.+--+-- * @$for(key)$@+--+-- The @for@ macro is used for enumerating 'Context' elements that are+-- lists, i.e. constructed using the 'listField' function. Assume that+-- in a context we have an element @listField \"key\" c itms@. Then+-- the snippet+--+-- > $for(key)$+-- >   $x$+-- > $sep$,+-- > $endfor$+--+-- would, for each item @i@ in 'itms', lookup @$x$@ in the context @c@+-- with item @i@, interpolate it, and join the resulting list with+-- @,@.+--+-- Another concrete example one may consider is the following. Given the+-- context+--+-- > listField "things" (field "thing" (return . itemBody))+-- >    (sequence [makeItem "fruits", makeItem "vegetables"])+--+-- and a template+--+-- >  I like+-- >  $for(things)$+-- >    fresh $thing$$sep$, and+-- >  $endfor$+--+-- the resulting page would look like+--+-- > <p>+-- >  I like+-- >+-- >   fresh fruits, and+-- >+-- >   fresh vegetables+-- > </p>+--+-- The @$sep$@ part can be omitted. Usually, you can get by using the+-- 'applyListTemplate' and 'applyJoinListTemplate' functions.+--+-- * @$partial(path)$@+--+-- Loads a template located in a separate file and interpolates it+-- under the current context.+--+-- Assuming that the file @test.html@ contains+--+-- > <b>$key$</b>+--+-- The result of rendering+--+-- > <p>+-- >   $partial("test.html")$+-- > </p>+--+-- is the same as the result of rendering+--+-- > <p>+-- >   <b>$key$</b>+-- > </p>+--+-- That is, calling @$partial$@ is equivalent to just copying and pasting+-- template code.+--+-- In the examples above you can see that the outputs contain a lot of leftover+-- whitespace that you may wish to remove. Using @'$-'@ or @'-$'@ instead of+-- @'$'@ in a macro strips all whitespace to the left or right of that clause+-- respectively. Given the context+--+-- > listField "counts" (field "count" (return . itemBody))+-- >    (sequence [makeItem "3", makeItem "2", makeItem "1"])+--+-- and a template+--+-- > <p>+-- >     $for(counts)-$+-- >       $count$+-- >       $-sep$...+-- >     $-endfor$+-- > </p>+--+-- the resulting page would look like+--+-- > <p>+-- >     3...2...1+-- > </p>+--+{-# LANGUAGE TemplateHaskell #-}+module Hakyll.Web.Template+    ( Template+    , templateBodyCompiler+    , templateCompiler+    , applyTemplate+    , loadAndApplyTemplate+    , applyAsTemplate+    , readTemplate+    , compileTemplateItem+    , unsafeReadTemplateFile+    , embedTemplate+    ) where+++--------------------------------------------------------------------------------+import           Hakyll.Web.Template.Internal+++--------------------------------------------------------------------------------+import           Data.FileEmbed               (embedFile)+import qualified Data.Text                    as T+import qualified Data.Text.Encoding           as T+import           Language.Haskell.TH          (Exp, Q)+++--------------------------------------------------------------------------------+-- | Embed template allows you embed a template within the Haskell binary.+-- Example:+--+-- > myTemplate :: Template+-- > myTemplate = $(embedTemplate "test.html")+embedTemplate :: FilePath -> Q Exp+embedTemplate filePath = [|+    let source = T.unpack $ T.decodeUtf8 $(embedFile filePath) in+    case parseTemplateElemsFile filePath source of+        Left  err -> error err+        Right tpl -> template filePath tpl |]
+ lib/Hakyll/Web/Template/Context.hs view
@@ -0,0 +1,520 @@+-- | This module provides 'Context's which are used to expand expressions in+-- templates and allow for arbitrary customisation.+--+-- 'Template's define a small expression DSL which consists of strings,+-- identifiers and function application. There is no type system, every value is+-- a string and on the top level they get substituted verbatim into the page.+--+-- For example, you can build a context that contains+--+-- > … <> functionField "concat" (const . concat) <> …+--+-- which will allow you to use the @concat@ identifier as a function that takes+-- arbitrarily many strings and concatenates them to a new string:+--+-- > $partial(concat("templates/categories/", category))$+--+-- This will evaluate the @category@ field in the context, then prepend the path,+-- and include the referenced file as a template.+++--------------------------------------------------------------------------------+{-# LANGUAGE CPP                       #-}+{-# LANGUAGE ExistentialQuantification #-}+module Hakyll.Web.Template.Context+    ( ContextField (..)+    , Context (..)+    , field+    , boolField+    , boolFieldM+    , constField+    , listField+    , listFieldWith+    , functionField+    , mapContext+    , mapContextBy++    , defaultContext+    , bodyField+    , metadataField+    , urlField+    , pathField+    , titleField+    , snippetField+    , dateField+    , dateFieldWith+    , getItemUTC+    , getItemModificationTime+    , modificationTimeField+    , modificationTimeFieldWith+    , teaserField+    , teaserFieldWithSeparator+    , missingField+    ) where+++--------------------------------------------------------------------------------+import           Control.Applicative                  (Alternative (..))+import           Control.Monad                        (msum)+#if !MIN_VERSION_base(4,13,0)+import           Control.Monad.Fail                   (MonadFail)+#endif+import           Data.Functor.Contravariant           (Contravariant (..))+import           Data.Functor.Contravariant.Divisible (Divisible (..), Decidable (..))+import           Data.List                            (intercalate, tails)+import           Data.Time.Clock                      (UTCTime (..))+import           Data.Time.Format                     (formatTime, parseTimeM)+import           Data.Time.Locale.Compat              (TimeLocale, defaultTimeLocale)+import           Hakyll.Core.Compiler+import           Hakyll.Core.Compiler.Internal+import           Hakyll.Core.Identifier+import           Hakyll.Core.Item+import           Hakyll.Core.Metadata+import           Hakyll.Core.Provider+import           Hakyll.Core.Util.String              (needlePrefix, splitAll)+import           Hakyll.Web.Html+import           Prelude                              hiding (id)+import           System.FilePath                      (dropExtension, splitDirectories,+                                                       takeBaseName)++--------------------------------------------------------------------------------+-- | Mostly for internal usage+data ContextField+    = EmptyField+    | StringField String+    | forall a. ListField (Context a) [Item a]+++--------------------------------------------------------------------------------+-- | The 'Context' monoid. Please note that the order in which you+-- compose the items is important. For example in+--+-- > field "A" f1 <> field "A" f2+--+-- the first context will overwrite the second. This is especially+-- important when something is being composed with+-- 'metadataField' (or 'defaultContext'). If you want your context to be+-- overwritten by the metadata fields, compose it from the right:+--+-- @+-- 'metadataField' \<\> field \"date\" fDate+-- @+--+newtype Context a = Context+    { unContext :: String -> [String] -> Item a -> Compiler ContextField+    }+++--------------------------------------------------------------------------------+-- | Tries to find a key in the left context,+-- or when that fails in the right context.+instance Semigroup (Context a) where+    (<>) (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i++instance Monoid (Context a) where+    mempty  = missingField+    mappend = (<>)++instance Contravariant Context where+    contramap f ctx = Context (\s ss -> unContext ctx s ss . fmap f)++instance Divisible Context where+    divide f c1 c2 = contramap (fst . f) c1 <> contramap (snd . f) c2+    conquer = missingField++instance Decidable Context where+    choose f (Context c1) (Context c2) = Context (\s ss (Item i e) ->+        either (c1 s ss . Item i) (c2 s ss . Item i) (f e))+    lose f = contramap f missingField++--------------------------------------------------------------------------------+field' :: String -> (Item a -> Compiler ContextField) -> Context a+field' key value = Context $ \k _ i ->+    if k == key+        then value i+        else noResult $ "Tried field " ++ key+++--------------------------------------------------------------------------------+-- | Constructs a new field for a 'Context'.+-- If the key matches, the compiler is run and its result is substituted in the+-- template.+--+-- If the compiler fails, the field will be considered non-existent+-- in an @$if()$@ macro or ultimately break the template application+-- (unless the key is found in another context when using '<>').+-- Use 'empty' or 'noResult' for intentional failures of fields used in+-- @$if()$@, to distinguish them from exceptions thrown with 'fail'.+field+    :: String                      -- ^ Key+    -> (Item a -> Compiler String) -- ^ Function that constructs a value based+                                   -- on the item (e.g. accessing metadata)+    -> Context a+field key value = field' key (fmap StringField . value)+++--------------------------------------------------------------------------------+-- | Creates a 'field' to use with the @$if()$@ template macro.+-- Attempting to substitute the field into the template will cause an error.+boolField+    :: String           -- ^ Key+    -> (Item a -> Bool) -- ^ Extract value from an @'Item' a@+    -> Context a+boolField name f = boolFieldM name (pure . f)+++--------------------------------------------------------------------------------+-- | Creates a 'field' to use with the @$if()$@ template macro, in the+-- 'Compiler' monad. Attempting to substitute the field into the template+-- will cause an error.+--+-- @since 4.16.4.0+boolFieldM+    :: String                       -- ^ Key+    -> (Item a -> Compiler Bool)    -- ^ Extract value from an @'Item' a@+                                    --   from within the 'Compiler' monad+    -> Context a+boolFieldM name f = field' name (\i -> do+  b <- f i+  if b+    then return EmptyField+    else noResult $ "Field " ++ name ++ " is false")+++--------------------------------------------------------------------------------+-- | Creates a 'field' that does not depend on the 'Item' but always yields+-- the same string+constField :: String     -- ^ Key+           -> String     -- ^ Value+           -> Context a+constField key = field key . const . return+++--------------------------------------------------------------------------------+-- | Creates a list field to be consumed by a @$for(…)$@ expression.+-- The compiler returns multiple items which are rendered in the loop body+-- with the supplied context.+listField :: String -> Context a -> Compiler [Item a] -> Context b+listField key c xs = listFieldWith key c (const xs)+++--------------------------------------------------------------------------------+-- | Creates a list field like 'listField', but supplies the current page+-- to the compiler.+listFieldWith+    :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b+listFieldWith key c f = field' key $ fmap (ListField c) . f+++--------------------------------------------------------------------------------+-- | Creates a variadic function field.+--+-- The function will be called with the dynamically evaluated string arguments+-- from the template as well as the page that is currently rendered.+functionField :: String                                  -- ^ Key+              -> ([String] -> Item a -> Compiler String) -- ^ Function+              -> Context a+functionField name value = Context $ \k args i ->+    if k == name+        then StringField <$> value args i+        else noResult $ "Tried function field " ++ name+++--------------------------------------------------------------------------------+-- | Transform the respective string results of all fields in a context.+-- For example,+--+-- > mapContext (++"c") (constField "x" "a" <> constField "y" "b")+--+-- is equivalent to+--+-- > constField "x" "ac" <> constField "y" "bc"+--+mapContext :: (String -> String) -> Context a -> Context a+mapContext = mapContextBy (const True)+++--------------------------------------------------------------------------------+-- | Transform the respective string results of all fields in a context+-- satisfying a predicate. For example,+--+-- > mapContextBy (=="y") (++"c") (constField "x" "a" <> constField "y" "b")+--+-- is equivalent to+--+-- > constField "x" "a" <> constField "y" "bc"+--+mapContextBy :: (String -> Bool) -> (String -> String) -> Context a -> Context a+mapContextBy p f (Context c) = Context $ \k a i -> do+    fld <- c k a i+    case fld of+        EmptyField      -> wrongType "boolField"+        StringField str -> return $ StringField $+                             if p k then f str else str+        _               -> wrongType "ListField"+  where+    wrongType typ = fail $ "Hakyll.Web.Template.Context.mapContext: " +++        "can't map over a " ++ typ ++ "!"++--------------------------------------------------------------------------------+-- | A context that allows snippet inclusion. In processed file, use as:+--+-- > ...+-- > $snippet("path/to/snippet/")$+-- > ...+--+-- The contents of the included file will not be interpolated like @partial@+-- does it.+--+snippetField :: Context String+snippetField = functionField "snippet" f+  where+    f [contentsPath] _ = loadBody (fromFilePath contentsPath)+    f []             _ = fail "No argument to function 'snippet()'"+    f _              _ = fail "Too many arguments to function 'snippet()'"++--------------------------------------------------------------------------------+-- | A context that contains (in that order)+--+--     1. A @$body$@ 'bodyField'+--+--     2. Metadata fields+--+--     3. A @$url$@ 'urlField'+--+--     4. A @$path$@ 'pathField'+--+--     5. A @$title$@ 'titleField'+--+-- This order means that all of the fields, except @$body$@,+-- can have their values replaced by metadata fields of the same name.+-- For example, a context from a file at @posts/foo.markdown@ has a default title+-- @foo@.  However, with a metadata field:+--+-- > ---+-- > title: The Foo Story+-- > ---+--+-- The @$title$@ will be replaced with @The Foo Story@.+defaultContext :: Context String+defaultContext =+    bodyField     "body"     `mappend`+    metadataField            `mappend`+    urlField      "url"      `mappend`+    pathField     "path"     `mappend`+    titleField    "title"+++--------------------------------------------------------------------------------+teaserSeparator :: String+teaserSeparator = "<!--more-->"+++--------------------------------------------------------------------------------+-- | Body of the item, that is, the main content of the underlying file+bodyField :: String -> Context String+bodyField key = field key $ return . itemBody+++--------------------------------------------------------------------------------+-- | Map any field to its metadata value, if present+metadataField :: Context a+metadataField = Context $ \k _ i -> do+    let id = itemIdentifier i+        empty' = noResult $ "No '" ++ k ++ "' field in metadata " +++            "of item " ++ show id+    value <- getMetadataField id k+    maybe empty' (return . StringField) value+++--------------------------------------------------------------------------------+-- | Absolute url to the resulting item.  For an example item that produces a+-- file @posts/foo.html@, this field contains "posts/foo.html"+urlField :: String -> Context a+urlField key = field key $ \i -> do+    let id = itemIdentifier i+        empty' = fail $ "No route url found for item " ++ show id+    fmap (maybe empty' toUrl) $ getRoute id+++--------------------------------------------------------------------------------+-- | Filepath of the underlying file of the item.  For an example+-- underlying file @posts/foo.markdown@, this field contains+-- "posts/foo.markdown"+pathField :: String -> Context a+pathField key = field key $ return . toFilePath . itemIdentifier+++--------------------------------------------------------------------------------+-- | Basename of the underlying file of the item.  For an example+-- underlying file @posts/foo.markdown@, this field contains "foo"+titleField :: String -> Context a+titleField = mapContext takeBaseName . pathField+++--------------------------------------------------------------------------------+-- | When the metadata has a field called @published@ in one of the+-- following formats then this function can render the date.+--+--   * @Mon, 06 Sep 2010 00:01:00 +0000@+--+--   * @Mon, 06 Sep 2010 00:01:00 UTC@+--+--   * @Mon, 06 Sep 2010 00:01:00@+--+--   * @2010-09-06T00:01:00+0000@+--+--   * @2010-09-06T00:01:00Z@+--+--   * @2010-09-06T00:01:00@+--+--   * @2010-09-06 00:01:00+0000@+--+--   * @2010-09-06 00:01:00@+--+--   * @September 06, 2010 00:01 AM@+--+-- Following date-only formats are supported too (@00:00:00@ for time is+-- assumed)+--+--   * @2010-09-06@+--+--   * @06.09.2010@+--+--   * @September 06, 2010@+--+-- Alternatively, when the metadata has a field called @path@ in a+-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages)+-- and no @published@ metadata field set, this function can render+-- the date. This pattern matches the file name or directory names+-- that begins with @yyyy-mm-dd@ . For example:+-- @folder//yyyy-mm-dd-title//dist//main.extension@ .+-- In case of multiple matches, the rightmost one is used.+--+-- As another alternative, if none of the above matches, and the file has a+-- path which contains nested directories specifying a date, then that date+-- will be used. In other words, if the path is of the form+-- @**//yyyy//mm//dd//**//main.extension@ .+-- As above, in case of multiple matches, the rightmost one is used.++dateField :: String     -- ^ Key in which the rendered date should be placed+          -> String     -- ^ Format to use on the date+          -> Context a  -- ^ Resulting context+dateField = dateFieldWith defaultTimeLocale+++--------------------------------------------------------------------------------+-- | This is an extended version of 'dateField' that allows you to+-- specify a time locale that is used for outputting the date. For more+-- details, see 'dateField' and 'formatTime'.+dateFieldWith :: TimeLocale  -- ^ Output time locale+              -> String      -- ^ Destination key+              -> String      -- ^ Format to use on the date+              -> Context a   -- ^ Resulting context+dateFieldWith locale key format = field key $ \i -> do+    time <- getItemUTC locale $ itemIdentifier i+    return $ formatTime locale format time+++--------------------------------------------------------------------------------+-- | Parser to try to extract and parse the time from the @published@+-- field or from the filename. See 'dateField' for more information.+-- Exported for user convenience.+getItemUTC :: (MonadMetadata m, MonadFail m)+           => TimeLocale        -- ^ Output time locale+           -> Identifier        -- ^ Input page+           -> m UTCTime         -- ^ Parsed UTCTime+getItemUTC locale id' = do+    metadata <- getMetadata id'+    let tryField k fmt = lookupString k metadata >>= parseTime' fmt+        paths          = splitDirectories $ (dropExtension . toFilePath) id'++    maybe empty' return $ msum $+        [tryField "published" fmt | fmt <- formats] +++        [tryField "date"      fmt | fmt <- formats] +++        [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fnCand | fnCand <- reverse paths] +++        [parseTime' "%Y-%m-%d" $ intercalate "-" $ fnCand | fnCand <- map (take 3) $ reverse . tails $ paths]+  where+    empty'     = fail $ "Hakyll.Web.Template.Context.getItemUTC: " +++        "could not parse time for " ++ show id'+    parseTime' = parseTimeM True locale+    formats    =+        [ "%a, %d %b %Y %H:%M:%S %Z"+        , "%a, %d %b %Y %H:%M:%S"+        , "%Y-%m-%dT%H:%M:%S%Z"+        , "%Y-%m-%dT%H:%M:%S"+        , "%Y-%m-%d %H:%M:%S%Z"+        , "%Y-%m-%d %H:%M:%S"+        , "%Y-%m-%d"+        , "%d.%m.%Y"+        , "%B %e, %Y %l:%M %p"+        , "%B %e, %Y"+        , "%b %d, %Y"+        ]+++--------------------------------------------------------------------------------+-- | Get the time on which the actual file was last modified. This only works if+-- there actually is an underlying file, of couse.+getItemModificationTime+    :: Identifier+    -> Compiler UTCTime+getItemModificationTime identifier = do+    provider <- compilerProvider <$> compilerAsk+    return $ resourceModificationTime provider identifier+++--------------------------------------------------------------------------------+-- | Creates a field with the last modification date of the underlying item.+modificationTimeField :: String     -- ^ Key+                      -> String     -- ^ Format+                      -> Context  a -- ^ Resulting context+modificationTimeField = modificationTimeFieldWith defaultTimeLocale+++--------------------------------------------------------------------------------+-- | Creates a field with the last modification date of the underlying item+-- in a custom localisation format (see 'formatTime').+modificationTimeFieldWith :: TimeLocale  -- ^ Time output locale+                          -> String      -- ^ Key+                          -> String      -- ^ Format+                          -> Context a   -- ^ Resulting context+modificationTimeFieldWith locale key fmt = field key $ \i -> do+    mtime <- getItemModificationTime $ itemIdentifier i+    return $ formatTime locale fmt mtime+++--------------------------------------------------------------------------------+-- | A context with "teaser" key which contain a teaser of the item.+-- The item is loaded from the given snapshot (which should be saved+-- in the user code before any templates are applied).+teaserField :: String           -- ^ Key to use+            -> Snapshot         -- ^ Snapshot to load+            -> Context String   -- ^ Resulting context+teaserField = teaserFieldWithSeparator teaserSeparator+++--------------------------------------------------------------------------------+-- | A context with "teaser" key which contain a teaser of the item, defined as+-- the snapshot content before the teaser separator. The item is loaded from the+-- given snapshot (which should be saved in the user code before any templates+-- are applied).+teaserFieldWithSeparator :: String           -- ^ Separator to use+                         -> String           -- ^ Key to use+                         -> Snapshot         -- ^ Snapshot to load+                         -> Context String   -- ^ Resulting context+teaserFieldWithSeparator separator key snapshot = field key $ \item -> do+    body <- itemBody <$> loadSnapshot (itemIdentifier item) snapshot+    case needlePrefix separator body of+        Nothing -> fail $+            "Hakyll.Web.Template.Context: no teaser defined for " +++            show (itemIdentifier item)+        Just t -> return t+++--------------------------------------------------------------------------------+-- | Constantly reports any field as missing. Mostly for internal usage,+-- it is the last choice in every context used in a template application.+missingField :: Context a+missingField = Context $ \k _ _ -> noResult $+    "Missing field '" ++ k ++ "' in context"
+ lib/Hakyll/Web/Template/Internal.hs view
@@ -0,0 +1,260 @@+{-# LANGUAGE DeriveAnyClass             #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables        #-}++module Hakyll.Web.Template.Internal+    ( Template (..)+    , template+    , templateBodyCompiler+    , templateCompiler+    , applyTemplate+    , loadAndApplyTemplate+    , applyAsTemplate+    , readTemplate+    , compileTemplateItem+    , unsafeReadTemplateFile++    , module Hakyll.Web.Template.Internal.Element+    , module Hakyll.Web.Template.Internal.Trim+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad.Except                 (catchError)+import           Data.Binary                          (Binary)+import           Data.List                            (intercalate)+import qualified Data.List.NonEmpty                   as NonEmpty+import           Data.Typeable                        (Typeable)+import           GHC.Exts                             (IsString (..))+import           GHC.Generics                         (Generic)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Compiler.Internal+import           Hakyll.Core.Identifier+import           Hakyll.Core.Item+import           Hakyll.Core.Writable+import           Hakyll.Web.Template.Context+import           Hakyll.Web.Template.Internal.Element+import           Hakyll.Web.Template.Internal.Trim+++--------------------------------------------------------------------------------+-- | Datatype used for template substitutions.+data Template = Template+    { tplElements :: [TemplateElement]+    , tplOrigin   :: FilePath  -- Only for error messages.+    } deriving (Show, Eq, Generic, Binary, Typeable)+++--------------------------------------------------------------------------------+instance Writable Template where+    -- Writing a template is impossible+    write _ _ = return ()+++--------------------------------------------------------------------------------+instance IsString Template where+    fromString = readTemplate+++--------------------------------------------------------------------------------+-- | Wrap the constructor to ensure trim is called.+template :: FilePath -> [TemplateElement] -> Template+template p = flip Template p . trim+++--------------------------------------------------------------------------------+-- | Parse a string into a template.+-- You should prefer 'compileTemplateItem' over this.+readTemplate :: String -> Template+readTemplate = either error (template origin) . parseTemplateElemsFile origin+  where+    origin = "{literal}"+{-# DEPRECATED readTemplate "Use templateCompiler instead" #-}++--------------------------------------------------------------------------------+-- | Parse an item body into a template.+-- Provides useful error messages in the 'Compiler' monad.+compileTemplateItem :: Item String -> Compiler Template+compileTemplateItem item = let file = itemIdentifier item+                           in compileTemplateFile file (itemBody item)++--------------------------------------------------------------------------------+compileTemplateFile :: Identifier -> String -> Compiler Template+compileTemplateFile file = either fail (return . template origin)+                         . parseTemplateElemsFile origin+  where+    origin = show file++--------------------------------------------------------------------------------+-- | Read a template, without metadata header+templateBodyCompiler :: Compiler (Item Template)+templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do+    item <- getResourceBody+    file <- getUnderlying+    withItemBody (compileTemplateFile file) item++--------------------------------------------------------------------------------+-- | Read complete file contents as a template+templateCompiler :: Compiler (Item Template)+templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do+    item <- getResourceString+    file <- getUnderlying+    withItemBody (compileTemplateFile file) item+++--------------------------------------------------------------------------------+-- | Interpolate template expressions from context values in a page+applyTemplate :: Template                -- ^ Template+              -> Context a               -- ^ Context+              -> Item a                  -- ^ Page+              -> Compiler (Item String)  -- ^ Resulting item+applyTemplate tpl context item = do+    body <- applyTemplate' (tplElements tpl) context item `catchError` handler+    return $ itemSetBody body item+  where+    tplName = tplOrigin tpl+    itemName = show $ itemIdentifier item+    handler es = fail $ "Hakyll.Web.Template.applyTemplate: Failed to " +++        (if tplName == itemName+          then "interpolate template in item " ++ itemName+          else "apply template " ++ tplName ++ " to item " ++ itemName) +++        ":\n" ++ intercalate ",\n" es++++--------------------------------------------------------------------------------+applyTemplate'+    :: forall a.+       [TemplateElement] -- ^ Unwrapped Template+    -> Context a         -- ^ Context+    -> Item a            -- ^ Page+    -> Compiler String   -- ^ Resulting item+applyTemplate' tes context x = go tes+  where+    context' :: String -> [String] -> Item a -> Compiler ContextField+    context' = unContext (context `mappend` missingField)++    go = fmap concat . mapM applyElem++    ---------------------------------------------------------------------------++    applyElem :: TemplateElement -> Compiler String++    applyElem TrimL = trimError++    applyElem TrimR = trimError++    applyElem (Chunk c) = return c++    applyElem (Expr e) = withErrorMessage evalMsg (applyStringExpr typeMsg e)+      where+        evalMsg = "In expr '$" ++ show e ++ "$'"+        typeMsg = "expr '$" ++ show e ++ "$'"++    applyElem Escaped = return "$"++    applyElem (If e t mf) = compilerTry (applyExpr e) >>= handle+      where+        f = maybe (return "") go mf+        handle (Right _)                      = go t+        handle (Left (CompilationNoResult _)) = f+        handle (Left (CompilationFailure es)) = debug (NonEmpty.toList es) >> f+        debug = compilerDebugEntries ("Hakyll.Web.Template.applyTemplate: " +++            "[ERROR] in 'if' condition on expr '" ++ show e ++ "':")++    applyElem (For e b s) = withErrorMessage headMsg (applyExpr e) >>= \cf -> case cf of+        EmptyField     -> expected "list" "boolean" typeMsg+        StringField _  -> expected "list" "string" typeMsg+        ListField c xs -> withErrorMessage bodyMsg $ do+            sep <- maybe (return "") go s+            bs  <- mapM (applyTemplate' b c) xs+            return $ intercalate sep bs+      where+        headMsg = "In expr '$for(" ++ show e ++ ")$'"+        typeMsg = "loop expr '" ++ show e ++ "'"+        bodyMsg = "In loop context of '$for(" ++ show e ++ ")$'"++    applyElem (Partial e) = withErrorMessage headMsg $+        applyStringExpr typeMsg e >>= \p ->+        withErrorMessage inclMsg $ do+            tpl' <- loadBody (fromFilePath p)+            itemBody <$> applyTemplate tpl' context x+      where+        headMsg = "In expr '$partial(" ++ show e ++ ")$'"+        typeMsg = "partial expr '" ++ show e ++ "'"+        inclMsg = "In inclusion of '$partial(" ++ show e ++ ")$'"++    ---------------------------------------------------------------------------++    applyExpr :: TemplateExpr -> Compiler ContextField++    applyExpr (Ident (TemplateKey k)) = context' k [] x++    applyExpr (Call (TemplateKey k) args) = do+        args' <- mapM (\e -> applyStringExpr (typeMsg e) e) args+        context' k args' x+      where+        typeMsg e = "argument '" ++ show e ++ "'"++    applyExpr (StringLiteral s) = return (StringField s)++    ----------------------------------------------------------------------------++    applyStringExpr :: String -> TemplateExpr -> Compiler String+    applyStringExpr msg expr =+        applyExpr expr >>= getString+      where+        getString EmptyField      = expected "string" "boolean" msg+        getString (StringField s) = return s+        getString (ListField _ _) = expected "string" "list" msg++    expected typ act expr = fail $ unwords ["Hakyll.Web.Template.applyTemplate:",+        "expected", typ, "but got", act, "for", expr]++    -- expected to never happen with all templates constructed by 'template'+    trimError = fail $+        "Hakyll.Web.Template.applyTemplate: template not fully trimmed."+++--------------------------------------------------------------------------------+-- | The following pattern is so common:+--+-- > tpl <- loadBody "templates/foo.html"+-- > someCompiler+-- >     >>= applyTemplate tpl context+--+-- That we have a single function which does this:+--+-- > someCompiler+-- >     >>= loadAndApplyTemplate "templates/foo.html" context+loadAndApplyTemplate :: Identifier              -- ^ Template identifier+                     -> Context a               -- ^ Context+                     -> Item a                  -- ^ Page+                     -> Compiler (Item String)  -- ^ Resulting item+loadAndApplyTemplate identifier context item = do+    tpl <- loadBody identifier+    applyTemplate tpl context item+++--------------------------------------------------------------------------------+-- | It is also possible that you want to substitute @$key$@s within the body of+-- an item. This function does that by interpreting the item body as a template,+-- and then applying it to itself.+applyAsTemplate :: Context String          -- ^ Context+                -> Item String             -- ^ Item and template+                -> Compiler (Item String)  -- ^ Resulting item+applyAsTemplate context item = do+    tpl <- compileTemplateItem item+    applyTemplate tpl context item+++--------------------------------------------------------------------------------+unsafeReadTemplateFile :: FilePath -> Compiler Template+unsafeReadTemplateFile file = do+    tpl <- unsafeCompiler $ readFile file+    compileTemplateFile (fromFilePath file) tpl+{-# DEPRECATED unsafeReadTemplateFile "Use templateCompiler" #-}
+ lib/Hakyll/Web/Template/Internal/Element.hs view
@@ -0,0 +1,291 @@+--------------------------------------------------------------------------------+-- | Module containing the elements used in a template.  A template is generally+-- just a list of these elements.+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Hakyll.Web.Template.Internal.Element+    ( TemplateKey (..)+    , TemplateExpr (..)+    , TemplateElement (..)+    , templateElems+    , parseTemplateElemsFile+    ) where+++--------------------------------------------------------------------------------+import           Control.Applicative     ((<|>))+import           Control.Monad           (void)+import           Control.Arrow           (left)+import           Data.Binary             (Binary, get, getWord8, put, putWord8)+import           Data.List               (intercalate)+import           Data.Maybe              (isJust)+import           Data.Typeable           (Typeable)+import           GHC.Exts                (IsString (..))+import qualified Text.Parsec             as P+import qualified Text.Parsec.String      as P+++--------------------------------------------------------------------------------+import           Hakyll.Core.Util.Parser+++--------------------------------------------------------------------------------+newtype TemplateKey = TemplateKey String+    deriving (Binary, Show, Eq, Typeable)+++--------------------------------------------------------------------------------+instance IsString TemplateKey where+    fromString = TemplateKey+++--------------------------------------------------------------------------------+-- | Elements of a template.+data TemplateElement+    = Chunk String+    | Expr TemplateExpr+    | Escaped+      -- expr, then, else+    | If TemplateExpr [TemplateElement] (Maybe [TemplateElement])+      -- expr, body, separator+    | For TemplateExpr [TemplateElement] (Maybe [TemplateElement])+      -- filename+    | Partial TemplateExpr+    | TrimL+    | TrimR+    deriving (Show, Eq, Typeable)+++--------------------------------------------------------------------------------+instance Binary TemplateElement where+    put (Chunk string) = putWord8 0 >> put string+    put (Expr e)       = putWord8 1 >> put e+    put  Escaped       = putWord8 2+    put (If e t f)     = putWord8 3 >> put e >> put t >> put f+    put (For e b s)    = putWord8 4 >> put e >> put b >> put s+    put (Partial e)    = putWord8 5 >> put e+    put  TrimL         = putWord8 6+    put  TrimR         = putWord8 7++    get = getWord8 >>= \tag -> case tag of+        0 -> Chunk <$> get+        1 -> Expr <$> get+        2 -> pure Escaped+        3 -> If <$> get <*> get <*> get+        4 -> For <$> get <*> get <*> get+        5 -> Partial <$> get+        6 -> pure TrimL+        7 -> pure TrimR+        _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"+++--------------------------------------------------------------------------------+-- | Expression in a template+data TemplateExpr+    = Ident TemplateKey+    | Call TemplateKey [TemplateExpr]+    | StringLiteral String+    deriving (Eq, Typeable)+++--------------------------------------------------------------------------------+instance Show TemplateExpr where+    show (Ident (TemplateKey k))   = k+    show (Call (TemplateKey k) as) =+        k ++ "(" ++ intercalate ", " (map show as) ++ ")"+    show (StringLiteral s)         = show s+++--------------------------------------------------------------------------------+instance Binary TemplateExpr where+    put (Ident k)         = putWord8 0 >> put k+    put (Call k as)       = putWord8 1 >> put k >> put as+    put (StringLiteral s) = putWord8 2 >> put s++    get = getWord8 >>= \tag -> case tag of+        0 -> Ident         <$> get+        1 -> Call          <$> get <*> get+        2 -> StringLiteral <$> get+        _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"++--------------------------------------------------------------------------------+parseTemplateElemsFile :: FilePath -> String -> Either String [TemplateElement]+parseTemplateElemsFile file = left (\e -> "Cannot parse template " ++ show e)+                            . P.parse (templateElems <* P.eof) file+++--------------------------------------------------------------------------------+templateElems :: P.Parser [TemplateElement]+templateElems = mconcat <$> P.many (P.choice [ lift chunk+                                             , lift escaped+                                             , conditional+                                             , for+                                             , partial+                                             , expr+                                             ])+    where lift = fmap (:[])+++--------------------------------------------------------------------------------+chunk :: P.Parser TemplateElement+chunk = Chunk <$> P.many1 (P.noneOf "$")+++--------------------------------------------------------------------------------+expr :: P.Parser [TemplateElement]+expr = P.try $ do+    trimLExpr <- trimOpen+    e <- expr'+    trimRExpr <- trimClose+    return $ [TrimL | trimLExpr] ++ [Expr e] ++ [TrimR | trimRExpr]+++--------------------------------------------------------------------------------+expr' :: P.Parser TemplateExpr+expr' = stringLiteral <|> call <|> ident+++--------------------------------------------------------------------------------+escaped :: P.Parser TemplateElement+escaped = Escaped <$ P.try (P.string "$$")+++--------------------------------------------------------------------------------+trimOpen :: P.Parser Bool+trimOpen = do+    void $ P.char '$'+    trimLIf <- P.optionMaybe $ P.try (P.char '-')+    pure $ isJust trimLIf+++--------------------------------------------------------------------------------+trimClose :: P.Parser Bool+trimClose = do+    trimIfR <- P.optionMaybe $ (P.char '-')+    void $ P.char '$'+    pure $ isJust trimIfR+++--------------------------------------------------------------------------------+conditional :: P.Parser [TemplateElement]+conditional = P.try $ do+    -- if+    trimLIf <- trimOpen+    void $ P.string "if("+    e <- expr'+    void $ P.char ')'+    trimRIf <- trimClose+    -- then+    thenBranch <- templateElems+    -- else+    elseParse <- opt "else"+    -- endif+    trimLEnd <- trimOpen+    void $ P.string "endif"+    trimREnd <- trimClose++    -- As else is optional we need to sort out where any Trim_s need to go.+    let (thenBody, elseBody) = maybe (thenNoElse, Nothing) thenElse elseParse+            where thenNoElse =+                      [TrimR | trimRIf] ++ thenBranch ++ [TrimL | trimLEnd]++                  thenElse (trimLElse, elseBranch, trimRElse) = (thenB, elseB)+                      where thenB = [TrimR | trimRIf]+                                 ++ thenBranch+                                 ++ [TrimL | trimLElse]++                            elseB = Just $ [TrimR | trimRElse]+                                        ++ elseBranch+                                        ++ [TrimL | trimLEnd]++    pure $ [TrimL | trimLIf] ++ [If e thenBody elseBody] ++ [TrimR | trimREnd]+++--------------------------------------------------------------------------------+for :: P.Parser [TemplateElement]+for = P.try $ do+    -- for+    trimLFor <- trimOpen+    void $ P.string "for("+    e <- expr'+    void $ P.char ')'+    trimRFor <- trimClose+    -- body+    bodyBranch <- templateElems+    -- sep+    sepParse <- opt "sep"+    -- endfor+    trimLEnd <- trimOpen+    void $ P.string "endfor"+    trimREnd <- trimClose++    -- As sep is optional we need to sort out where any Trim_s need to go.+    let (forBody, sepBody) = maybe (forNoSep, Nothing) forSep sepParse+            where forNoSep =+                      [TrimR | trimRFor] ++ bodyBranch ++ [TrimL | trimLEnd]++                  forSep (trimLSep, sepBranch, trimRSep) = (forB, sepB)+                      where forB = [TrimR | trimRFor]+                                ++ bodyBranch+                                ++ [TrimL | trimLSep]++                            sepB = Just $ [TrimR | trimRSep]+                                       ++ sepBranch+                                       ++ [TrimL | trimLEnd]++    pure $ [TrimL | trimLFor] ++ [For e forBody sepBody] ++ [TrimR | trimREnd]+++--------------------------------------------------------------------------------+partial :: P.Parser [TemplateElement]+partial = P.try $ do+    trimLPart <- trimOpen+    void $ P.string "partial("+    e <- expr'+    void $ P.char ')'+    trimRPart <- trimClose++    pure $ [TrimL | trimLPart] ++ [Partial e] ++ [TrimR | trimRPart]+++--------------------------------------------------------------------------------+ident :: P.Parser TemplateExpr+ident = P.try $ Ident <$> key+++--------------------------------------------------------------------------------+call :: P.Parser TemplateExpr+call = P.try $ do+    f <- key+    void $ P.char '('+    P.spaces+    as <- P.sepBy expr' (P.spaces >> P.char ',' >> P.spaces)+    P.spaces+    void $ P.char ')'+    return $ Call f as+++--------------------------------------------------------------------------------+stringLiteral :: P.Parser TemplateExpr+stringLiteral = do+    void $ P.char '\"'+    str <- P.many $ do+        x <- P.noneOf "\""+        if x == '\\' then P.anyChar else return x+    void $ P.char '\"'+    return $ StringLiteral str+++--------------------------------------------------------------------------------+key :: P.Parser TemplateKey+key = TemplateKey <$> metadataKey+++--------------------------------------------------------------------------------+opt :: String -> P.Parser (Maybe (Bool, [TemplateElement], Bool))+opt clause = P.optionMaybe $ P.try $ do+    trimL <- trimOpen+    void $ P.string clause+    trimR <- trimClose+    branch <- templateElems+    pure (trimL, branch, trimR)+
+ lib/Hakyll/Web/Template/Internal/Trim.hs view
@@ -0,0 +1,95 @@+--------------------------------------------------------------------------------+-- | Module for trimming whitespace from tempaltes.+module Hakyll.Web.Template.Internal.Trim+    ( trim+    ) where+++--------------------------------------------------------------------------------+import           Data.Char                            (isSpace)+import           Data.List                            (dropWhileEnd)+++--------------------------------------------------------------------------------+import           Hakyll.Web.Template.Internal.Element+++--------------------------------------------------------------------------------+trim :: [TemplateElement] -> [TemplateElement]+trim = cleanse . canonicalize+++--------------------------------------------------------------------------------+-- | Apply the Trim nodes to the Chunks.+cleanse :: [TemplateElement] -> [TemplateElement]+cleanse = recurse cleanse . process+    where process [] = []+          process (TrimR:Chunk str:ts) = let str' = dropWhile isSpace str+                                         in if null str'+                                                then process ts+                                                -- Might need to TrimL.+                                                else process $ Chunk str':ts++          process (Chunk str:TrimL:ts) = let str' = dropWhileEnd isSpace str+                                         in if null str'+                                                then process ts+                                                else Chunk str':process ts++          process (t:ts) = t:process ts++--------------------------------------------------------------------------------+-- | Enforce the invariant that:+--+--     * Every 'TrimL' has a 'Chunk' to its left.+--     * Every 'TrimR' has a 'Chunk' to its right.+--+canonicalize :: [TemplateElement] -> [TemplateElement]+canonicalize = go+    where go t = let t' = redundant . swap $ dedupe t+                 in if t == t' then t else go t'+++--------------------------------------------------------------------------------+-- | Remove the 'TrimR' and 'TrimL's that are no-ops.+redundant :: [TemplateElement] -> [TemplateElement]+redundant = recurse redundant . process+    where -- Remove the leading 'TrimL's.+          process (TrimL:ts) = process ts+          -- Remove trailing 'TrimR's.+          process ts = foldr trailing [] ts+              where trailing TrimR [] = []+                    trailing x xs     = x:xs+++--------------------------------------------------------------------------------+-- >>> swap $ [TrimR, TrimL]+-- [TrimL, TrimR]+swap :: [TemplateElement] -> [TemplateElement]+swap = recurse swap . process+    where process []               = []+          process (TrimR:TrimL:ts) = TrimL:process (TrimR:ts)+          process (t:ts)           = t:process ts+++--------------------------------------------------------------------------------+-- | Remove 'TrimR' and 'TrimL' duplication.+dedupe :: [TemplateElement] -> [TemplateElement]+dedupe = recurse dedupe . process+    where process []               = []+          process (TrimR:TrimR:ts) = process (TrimR:ts)+          process (TrimL:TrimL:ts) = process (TrimL:ts)+          process (t:ts)           = t:process ts+++--------------------------------------------------------------------------------+-- | @'recurse' f t@ applies f to every '[TemplateElement]' in t.+recurse :: ([TemplateElement] -> [TemplateElement])+        -> [TemplateElement]+        -> [TemplateElement]+recurse _ []     = []+recurse f (x:xs) = process x:recurse f xs+    where process y = case y of+                          If e tb eb -> If e (f tb) (f <$> eb)+                          For e t s  -> For e (f t) (f <$> s)+                          _          -> y+
+ lib/Hakyll/Web/Template/List.hs view
@@ -0,0 +1,95 @@+--------------------------------------------------------------------------------+-- | Provides an easy way to combine several items in a list. The applications+-- are obvious:+--+-- * A post list on a blog+--+-- * An image list in a gallery+--+-- * A sitemap+{-# LANGUAGE CPP           #-}+{-# LANGUAGE TupleSections #-}+module Hakyll.Web.Template.List+    ( applyTemplateList+    , applyJoinTemplateList+    , chronological+    , recentFirst+    , sortChronological+    , sortRecentFirst+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad               (liftM)+#if !MIN_VERSION_base(4,13,0)+import           Control.Monad.Fail          (MonadFail)+#endif+import           Data.List                   (intersperse, sortBy)+import           Data.Ord                    (comparing)+import           Data.Time.Locale.Compat     (defaultTimeLocale)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Identifier+import           Hakyll.Core.Item+import           Hakyll.Core.Metadata+import           Hakyll.Web.Template+import           Hakyll.Web.Template.Context+++--------------------------------------------------------------------------------+-- | Generate a string of a listing of pages, after applying a template to each+-- page.+applyTemplateList :: Template+                  -> Context a+                  -> [Item a]+                  -> Compiler String+applyTemplateList = applyJoinTemplateList ""+++--------------------------------------------------------------------------------+-- | Join a listing of pages with a string in between, after applying a template+-- to each page.+applyJoinTemplateList :: String+                      -> Template+                      -> Context a+                      -> [Item a]+                      -> Compiler String+applyJoinTemplateList delimiter tpl context items = do+    items' <- mapM (applyTemplate tpl context) items+    return $ concat $ intersperse delimiter $ map itemBody items'+++--------------------------------------------------------------------------------+-- | Sort pages chronologically. Uses the same method as 'dateField' for+-- extracting the date.+chronological :: (MonadMetadata m, MonadFail m) => [Item a] -> m [Item a]+chronological =+    sortByM $ getItemUTC defaultTimeLocale . itemIdentifier+  where+    sortByM :: (Monad m, Ord k) => (a -> m k) -> [a] -> m [a]+    sortByM f xs = liftM (map fst . sortBy (comparing snd)) $+                   mapM (\x -> liftM (x,) (f x)) xs+++--------------------------------------------------------------------------------+-- | The reverse of 'chronological'+recentFirst :: (MonadMetadata m, MonadFail m) => [Item a] -> m [Item a]+recentFirst = liftM reverse . chronological+++--------------------------------------------------------------------------------+-- | Version of 'chronological' which doesn't need the actual items.+sortChronological+    :: (MonadMetadata m, MonadFail m) => [Identifier] -> m [Identifier]+sortChronological ids =+    liftM (map itemIdentifier) $ chronological [Item i () | i <- ids]+++--------------------------------------------------------------------------------+-- | Version of 'recentFirst' which doesn't need the actual items.+sortRecentFirst+    :: (MonadMetadata m, MonadFail m) => [Identifier] -> m [Identifier]+sortRecentFirst ids =+    liftM (map itemIdentifier) $ recentFirst [Item i () | i <- ids]
− src/Hakyll.hs 
@@ -1,70 +0,0 @@--- | Top-level module exporting all modules that are interesting for the user----{-# LANGUAGE CPP #-}-module Hakyll-    ( module Hakyll.Core.Compiler-    , module Hakyll.Core.Configuration-    , module Hakyll.Core.Identifier-    , module Hakyll.Core.Identifier.Pattern-    , module Hakyll.Core.Resource-    , module Hakyll.Core.Resource.Provider-    , module Hakyll.Core.Routes-    , module Hakyll.Core.Rules-    , module Hakyll.Core.UnixFilter-    , module Hakyll.Core.Util.Arrow-    , module Hakyll.Core.Util.File-    , module Hakyll.Core.Util.String-    , module Hakyll.Core.Writable-    , module Hakyll.Core.Writable.CopyFile-    , module Hakyll.Core.Writable.WritableTuple-    , module Hakyll.Main-    , module Hakyll.Web.Blaze-    , module Hakyll.Web.CompressCss-    , module Hakyll.Web.Feed-    , module Hakyll.Web.Page-    , module Hakyll.Web.Page.List-    , module Hakyll.Web.Page.Metadata-    , module Hakyll.Web.Page.Read-    , module Hakyll.Web.Pandoc-    , module Hakyll.Web.Pandoc.Biblio-    , module Hakyll.Web.Pandoc.FileType-    , module Hakyll.Web.Urls-    , module Hakyll.Web.Urls.Relativize-    , module Hakyll.Web.Tags-    , module Hakyll.Web.Template-    , module Hakyll.Web.Template.Read-    , module Hakyll.Web.Util.Html-    ) where--import Hakyll.Core.Compiler-import Hakyll.Core.Configuration-import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Routes-import Hakyll.Core.Rules-import Hakyll.Core.UnixFilter-import Hakyll.Core.Util.Arrow-import Hakyll.Core.Util.File-import Hakyll.Core.Util.String-import Hakyll.Core.Writable-import Hakyll.Core.Writable.CopyFile-import Hakyll.Core.Writable.WritableTuple-import Hakyll.Main-import Hakyll.Web.Blaze-import Hakyll.Web.CompressCss-import Hakyll.Web.Feed-import Hakyll.Web.Page-import Hakyll.Web.Page.List-import Hakyll.Web.Page.Metadata-import Hakyll.Web.Page.Read-import Hakyll.Web.Pandoc-import Hakyll.Web.Pandoc.Biblio-import Hakyll.Web.Pandoc.FileType-import Hakyll.Web.Urls-import Hakyll.Web.Urls.Relativize-import Hakyll.Web.Tags-import Hakyll.Web.Template-import Hakyll.Web.Template.Read-import Hakyll.Web.Util.Html
− src/Hakyll/Core/CompiledItem.hs 
@@ -1,47 +0,0 @@--- | A module containing a box datatype representing a compiled item. This--- item can be of any type, given that a few restrictions hold:------ * we need a 'Typeable' instance to perform type-safe casts;------ * we need a 'Binary' instance so we can serialize these items to the cache;------ * we need a 'Writable' instance so the results can be saved.----{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-}-module Hakyll.Core.CompiledItem-    ( CompiledItem (..)-    , compiledItem-    , unCompiledItem-    ) where--import Data.Binary (Binary)-import Data.Typeable (Typeable, cast, typeOf)-import Data.Maybe (fromMaybe)--import Hakyll.Core.Writable---- | Box type for a compiled item----data CompiledItem =  forall a.  (Binary a, Typeable a, Writable a)-                  => CompiledItem a-                  deriving (Typeable)--instance Writable CompiledItem where-    write p (CompiledItem x) = write p x---- | Box a value into a 'CompiledItem'----compiledItem :: (Binary a, Typeable a, Writable a)-             => a-             -> CompiledItem-compiledItem = CompiledItem---- | Unbox a value from a 'CompiledItem'----unCompiledItem :: (Binary a, Typeable a, Writable a)-               => CompiledItem-               -> a-unCompiledItem (CompiledItem x) = fromMaybe error' $ cast x-  where-    error' = error $  "Hakyll.Core.CompiledItem.unCompiledItem: "-                   ++ "unsupported type (got " ++ show (typeOf x) ++ ")"
− src/Hakyll/Core/Compiler.hs 
@@ -1,399 +0,0 @@--- | A Compiler manages targets and dependencies between targets------ The most distinguishing property of a 'Compiler' is that it is an Arrow. A--- compiler of the type @Compiler a b@ is simply a compilation phase which takes--- an @a@ as input, and produces a @b@ as output.------ Compilers are chained using the '>>>' arrow operation. If we have a compiler------ > getResourceString :: Compiler Resource String------ which reads the resource, and a compiler------ > readPage :: Compiler String (Page String)------ we can chain these two compilers to get a------ > (getResourceString >>> readPage) :: Compiler Resource (Page String)------ Most compilers can be created by combining smaller compilers using '>>>'.------ More advanced constructions are also possible using arrow, and sometimes--- these are needed. For a good introduction to arrow, you can refer to------ <http://en.wikibooks.org/wiki/Haskell/Understanding_arrows>------ A construction worth writing a few paragraphs about here are the 'require'--- functions. Different variants of this function are exported here, but they--- all serve more or less the same goal.------ When you use only '>>>' to chain your compilers, you get a linear pipeline ----- it is not possible to add extra items from other compilers along the way.--- This is where the 'require' functions come in.------ This function allows you to reference other items, which are then added to--- the pipeline. Let's look at this crappy ASCII illustration which represents--- a pretty common scenario:------ > read resource >>> pandoc render >>> layout >>> relativize URL's--- >--- > @templates/fancy.html@------ We want to construct a pipeline of compilers to go from our resource to a--- proper webpage. However, the @layout@ compiler takes more than just the--- rendered page as input: it needs the @templates/fancy.html@ template as well.------ This is an example of where we need the @require@ function. We can solve--- this using a construction that looks like:------ > ... >>> pandoc render >>> require >>> layout >>> ...--- >                              |--- > @templates/fancy.html@ ------/------ This illustration can help us understand the type signature of 'require'.------ > require :: (Binary a, Typeable a, Writable a)--- >         => Identifier a--- >         -> (b -> a -> c)--- >         -> Compiler b c------ Let's look at it in detail:------ > (Binary a, Typeable a, Writable a)------ These are constraints for the @a@ type. @a@ (the template) needs to have--- certain properties for it to be required.------ > Identifier a------ This is simply @templates/fancy.html@: the 'Identifier' of the item we want--- to 'require', in other words, the name of the item we want to add to the--- pipeline somehow.------ > (b -> a -> c)------ This is a function given by the user, specifying /how/ the two items shall be--- merged. @b@ is the output of the previous compiler, and @a@ is the item we--- just required -- the template. This means @c@ will be the final output of the--- 'require' combinator.------ > Compiler b c------ Indeed, we have now constructed a compiler which takes a @b@ and produces a--- @c@. This means that we have a linear pipeline again, thanks to the 'require'--- function. So, the 'require' function actually helps to reduce to complexity--- of Hakyll applications!------ Note that require will fetch a previously compiled item: in our example of--- the type @a@. It is /very/ important that the compiler which produced this--- value, produced the right type as well!----{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}-module Hakyll.Core.Compiler-    ( Compiler-    , runCompiler-    , getIdentifier-    , getResource-    , getRoute-    , getRouteFor-    , getResourceString-    , getResourceLBS-    , getResourceWith-    , fromDependency-    , require_-    , require-    , requireA-    , requireAll_-    , requireAll-    , requireAllA-    , cached-    , unsafeCompiler-    , traceShowCompiler-    , mapCompiler-    , timedCompiler-    , byPattern-    , byExtension-    ) where--import Prelude hiding ((.), id)-import Control.Arrow ((>>>), (&&&), arr, first)-import Control.Applicative ((<$>))-import Control.Exception (SomeException, handle)-import Control.Monad.Reader (ask)-import Control.Monad.Trans (liftIO)-import Control.Monad.Error (throwError)-import Control.Category (Category, (.), id)-import Data.List (find)-import System.Environment (getProgName)-import System.FilePath (takeExtension)--import Data.Binary (Binary)-import Data.Typeable (Typeable)-import Data.ByteString.Lazy (ByteString)--import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import Hakyll.Core.CompiledItem-import Hakyll.Core.Writable-import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Compiler.Internal-import Hakyll.Core.Store (Store)-import Hakyll.Core.Rules.Internal-import Hakyll.Core.Routes-import Hakyll.Core.Logger-import qualified Hakyll.Core.Store as Store---- | Run a compiler, yielding the resulting target and it's dependencies. This--- version of 'runCompilerJob' also stores the result----runCompiler :: Compiler () CompileRule    -- ^ Compiler to run-            -> Identifier ()              -- ^ Target identifier-            -> ResourceProvider           -- ^ Resource provider-            -> [Identifier ()]            -- ^ Universe-            -> Routes                     -- ^ Route-            -> Store                      -- ^ Store-            -> Bool                       -- ^ Was the resource modified?-            -> Logger                     -- ^ Logger-            -> IO (Throwing CompileRule)  -- ^ Resulting item-runCompiler compiler id' provider universe routes store modified logger = do-    -- Run the compiler job-    result <- handle (\(e :: SomeException) -> return $ Left $ show e) $-        runCompilerJob compiler id' provider universe routes store modified-            logger--    -- Inspect the result-    case result of-        -- In case we compiled an item, we will store a copy in the cache first,-        -- before we return control. This makes sure the compiled item can later-        -- be accessed by e.g. require.-        Right (CompileRule (CompiledItem x)) ->-            Store.set store ["Hakyll.Core.Compiler.runCompiler", show id'] x--        -- Otherwise, we do nothing here-        _ -> return ()--    return result---- | Get the identifier of the item that is currently being compiled----getIdentifier :: Compiler a (Identifier b)-getIdentifier = fromJob $ const $ CompilerM $-    castIdentifier . compilerIdentifier <$> ask---- | Get the resource that is currently being compiled----getResource :: Compiler a Resource-getResource = getIdentifier >>> arr fromIdentifier---- | Get the route we are using for this item----getRoute :: Compiler a (Maybe FilePath)-getRoute = getIdentifier >>> getRouteFor---- | Get the route for a specified item----getRouteFor :: Compiler (Identifier a) (Maybe FilePath)-getRouteFor = fromJob $ \identifier -> CompilerM $ do-    routes <- compilerRoutes <$> ask-    return $ runRoutes routes identifier---- | Get the resource we are compiling as a string----getResourceString :: Compiler Resource String-getResourceString = getResourceWith resourceString---- | Get the resource we are compiling as a lazy bytestring----getResourceLBS :: Compiler Resource ByteString-getResourceLBS = getResourceWith resourceLBS---- | Overloadable function for 'getResourceString' and 'getResourceLBS'----getResourceWith :: (ResourceProvider -> Resource -> IO a)-                -> Compiler Resource a-getResourceWith reader = fromJob $ \r -> CompilerM $ do-    let filePath = unResource r-    provider <- compilerResourceProvider <$> ask-    if resourceExists provider r-        then liftIO $ reader provider r-        else throwError $ error' filePath-  where-    error' id' =  "Hakyll.Core.Compiler.getResourceWith: resource "-               ++ show id' ++ " not found"---- | Auxiliary: get a dependency----getDependency :: (Binary a, Writable a, Typeable a)-              => Identifier a -> CompilerM a-getDependency id' = CompilerM $ do-    store  <- compilerStore <$> ask-    result <- liftIO $-        Store.get store ["Hakyll.Core.Compiler.runCompiler", show id']-    case result of-        Store.NotFound      -> throwError notFound-        Store.WrongType e r -> throwError $ wrongType e r-        Store.Found x       -> return x-  where-    notFound =-        "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " 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.getDependency: " ++ show id' ++ " was found " ++-        "in the cache, but does not have the right type: expected " ++ show e ++-        " but got " ++ show r---- | Variant of 'require' which drops the current value----require_ :: (Binary a, Typeable a, Writable a)-         => Identifier a-         -> Compiler b a-require_ identifier =-    fromDependency identifier >>> fromJob (const $ getDependency identifier)---- | Require another target. Using this function ensures automatic handling of--- dependencies----require :: (Binary a, Typeable a, Writable a)-        => Identifier a-        -> (b -> a -> c)-        -> Compiler b c-require identifier = requireA identifier . arr . uncurry---- | Arrow-based variant of 'require'----requireA :: (Binary a, Typeable a, Writable a)-         => Identifier a-         -> Compiler (b, a) c-         -> Compiler b c-requireA identifier = (id &&& require_ identifier >>>)---- | Variant of 'requireAll' which drops the current value----requireAll_ :: (Binary a, Typeable a, Writable a)-            => Pattern a-            -> Compiler b [a]-requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_'-  where-    getDeps = map castIdentifier . filterMatches pattern . map castIdentifier-    requireAll_' = const $ CompilerM $ do-        deps <- getDeps . compilerUniverse <$> ask-        mapM (unCompilerM . getDependency) deps---- | Require a number of targets. Using this function ensures automatic handling--- of dependencies----requireAll :: (Binary a, Typeable a, Writable a)-           => Pattern a-           -> (b -> [a] -> c)-           -> Compiler b c-requireAll pattern = requireAllA pattern . arr . uncurry---- | Arrow-based variant of 'requireAll'----requireAllA :: (Binary a, Typeable a, Writable a)-            => Pattern a-            -> Compiler (b, [a]) c-            -> Compiler b c-requireAllA pattern = (id &&& requireAll_ pattern >>>)--cached :: (Binary a, Typeable a, Writable a)-       => String-       -> Compiler Resource a-       -> Compiler Resource a-cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do-    logger <- compilerLogger <$> ask-    identifier <- castIdentifier . compilerIdentifier <$> ask-    store <- compilerStore <$> ask-    modified <- compilerResourceModified <$> ask-    progName <- liftIO getProgName-    report logger $ "Checking cache: " ++ if modified then "modified" else "OK"-    if modified-        then do v <- unCompilerM $ j $ fromIdentifier identifier-                liftIO $ Store.set store [name, show identifier] v-                return v-        else do v <- liftIO $ Store.get store [name, show identifier]-                case v of Store.Found v' -> return v'-                          _              -> throwError (error' progName)-  where-    error' progName =-        "Hakyll.Core.Compiler.cached: Cache corrupt! " ++-         "Try running: " ++ progName ++ " clean"---- | Create an unsafe compiler from a function in IO----unsafeCompiler :: (a -> IO b)   -- ^ Function to lift-               -> Compiler a b  -- ^ Resulting compiler-unsafeCompiler f = fromJob $ CompilerM . liftIO . f---- | Compiler for debugging purposes----traceShowCompiler :: Show a => Compiler a a-traceShowCompiler = fromJob $ \x -> CompilerM $ do-    logger <- compilerLogger <$> ask-    report logger $ show x-    return x---- | Map over a compiler----mapCompiler :: Compiler a b-            -> Compiler [a] [b]-mapCompiler (Compiler d j) = Compiler d $ mapM j---- | Log and time a compiler----timedCompiler :: String        -- ^ Message-              -> Compiler a b  -- ^ Compiler to time-              -> Compiler a b  -- ^ Resulting compiler-timedCompiler msg (Compiler d j) = Compiler d $ \x -> CompilerM $ do-    logger <- compilerLogger <$> ask-    timed logger msg $ unCompilerM $ j x---- | Choose a compiler by identifier------ For example, assume that most content files need to be compiled--- normally, but a select few need an extra step in the pipeline:------ > compile $ pageCompiler >>> byPattern id--- >     [ ("projects.md", addProjectListCompiler)--- >     , ("sitemap.md", addSiteMapCompiler)--- >     ]----byPattern :: Compiler a b                  -- ^ Default compiler-          -> [(Pattern (), Compiler a b)]  -- ^ Choices-          -> Compiler a b                  -- ^ Resulting compiler-byPattern defaultCompiler choices = Compiler deps job-  where-    -- Lookup the compiler, give an error when it is not found-    lookup' identifier = maybe defaultCompiler snd $-        find (\(p, _) -> matches p identifier) choices-    -- Collect the dependencies of the choice-    deps = do-        identifier <- castIdentifier . dependencyIdentifier <$> ask-        compilerDependencies $ lookup' identifier-    -- Collect the job of the choice-    job x = CompilerM $ do-        identifier <- castIdentifier . compilerIdentifier <$> ask-        unCompilerM $ compilerJob (lookup' identifier) x---- | Choose a compiler by extension------ Example:------ > match "css/*" $ do--- >   route $ setExtension "css"--- >   compile $ byExtension (error "Not a (S)CSS file")--- >             [ (".css",  compressCssCompiler)--- >             , (".scss", sass)--- >             ]------ This piece of code will select the @compressCssCompiler@ for @.css@ files,--- and the @sass@ compiler (defined elsewhere) for @.scss@ files.----byExtension :: Compiler a b              -- ^ Default compiler-            -> [(String, Compiler a b)]  -- ^ Choices-            -> Compiler a b              -- ^ Resulting compiler-byExtension defaultCompiler = byPattern defaultCompiler . map (first extPattern)-  where-    extPattern c = predicate $ (== c) . takeExtension . toFilePath
− src/Hakyll/Core/Compiler/Internal.hs 
@@ -1,156 +0,0 @@--- | Internally used compiler module----{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Hakyll.Core.Compiler.Internal-    ( Dependencies-    , DependencyEnvironment (..)-    , CompilerEnvironment (..)-    , Throwing-    , CompilerM (..)-    , Compiler (..)-    , runCompilerJob-    , runCompilerDependencies-    , fromJob-    , fromDependencies-    , fromDependency-    ) where--import Prelude hiding ((.), id)-import Control.Applicative (Applicative, pure, (<*>), (<$>))-import Control.Monad.Reader (ReaderT, Reader, ask, runReaderT, runReader)-import Control.Monad.Error (ErrorT, runErrorT)-import Control.Monad ((<=<), liftM2)-import Data.Set (Set)-import qualified Data.Set as S-import Control.Category (Category, (.), id)-import Control.Arrow (Arrow, ArrowChoice, arr, first, left)--import Hakyll.Core.Identifier-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Store-import Hakyll.Core.Routes-import Hakyll.Core.Logger---- | A set of dependencies----type Dependencies = Set (Identifier ())---- | Environment in which the dependency analyzer runs----data DependencyEnvironment = DependencyEnvironment-    { -- | Target identifier-      dependencyIdentifier :: Identifier ()-    , -- | List of available identifiers we can depend upon-      dependencyUniverse   :: [Identifier ()]-    }---- | Environment in which a compiler runs----data CompilerEnvironment = CompilerEnvironment-    { -- | Target identifier-      compilerIdentifier       :: Identifier ()-    , -- | Resource provider-      compilerResourceProvider :: ResourceProvider-    , -- | List of all known identifiers-      compilerUniverse         :: [Identifier ()]-    , -- | Site routes-      compilerRoutes           :: Routes-    , -- | Compiler store-      compilerStore            :: Store-    , -- | Flag indicating if the underlying resource was modified-      compilerResourceModified :: Bool-    , -- | Logger-      compilerLogger           :: Logger-    }---- | A calculation possibly throwing an error----type Throwing a = Either String a---- | The compiler monad----newtype CompilerM a = CompilerM-    { unCompilerM :: ErrorT String (ReaderT CompilerEnvironment IO) a-    } deriving (Monad, Functor, Applicative)---- | The compiler arrow----data Compiler a b = Compiler-    { compilerDependencies :: Reader DependencyEnvironment Dependencies-    , compilerJob          :: a -> CompilerM b-    }--instance Functor (Compiler a) where-    fmap f ~(Compiler d j) = Compiler d $ fmap f . j--instance Applicative (Compiler a) where-    pure = Compiler (return S.empty) . const . return-    ~(Compiler d1 f) <*> ~(Compiler d2 j) =-        Compiler (liftM2 S.union d1 d2) $ \x -> f x <*> j x--instance Category Compiler where-    id = Compiler (return S.empty) return-    ~(Compiler d1 j1) . ~(Compiler d2 j2) =-        Compiler (liftM2 S.union d1 d2) (j1 <=< j2)--instance Arrow Compiler where-    arr f = Compiler (return S.empty) (return . f)-    first ~(Compiler d j) = Compiler d $ \(x, y) -> do-        x' <- j x-        return (x', y)--instance ArrowChoice Compiler where-    left ~(Compiler d j) = Compiler d $ \e -> case e of-        Left l  -> Left  <$> j l-        Right r -> Right <$> return r---- | Run a compiler, yielding the resulting target----runCompilerJob :: Compiler () a     -- ^ Compiler to run-               -> Identifier ()     -- ^ Target identifier-               -> ResourceProvider  -- ^ Resource provider-               -> [Identifier ()]   -- ^ Universe-               -> Routes            -- ^ Route-               -> Store             -- ^ Store-               -> Bool              -- ^ Was the resource modified?-               -> Logger            -- ^ Logger-               -> IO (Throwing a)   -- ^ Result-runCompilerJob compiler id' provider universe route store modified logger =-    runReaderT (runErrorT $ unCompilerM $ compilerJob compiler ()) env-  where-    env = CompilerEnvironment-            { compilerIdentifier       = id'-            , compilerResourceProvider = provider-            , compilerUniverse         = universe-            , compilerRoutes           = route-            , compilerStore            = store-            , compilerResourceModified = modified-            , compilerLogger           = logger-            }--runCompilerDependencies :: Compiler () a-                        -> Identifier ()-                        -> [Identifier ()]-                        -> Dependencies-runCompilerDependencies compiler identifier universe =-    runReader (compilerDependencies compiler) env-  where-    env = DependencyEnvironment-            { dependencyIdentifier = identifier-            , dependencyUniverse   = universe-            }--fromJob :: (a -> CompilerM b)-        -> Compiler a b-fromJob = Compiler (return S.empty)--fromDependencies :: (Identifier () -> [Identifier ()] -> [Identifier ()])-                 -> Compiler b b-fromDependencies collectDeps = flip Compiler return $ do-    DependencyEnvironment identifier universe <- ask-    return $ S.fromList $ collectDeps identifier universe---- | Wait until another compiler has finished before running this compiler----fromDependency :: Identifier a -> Compiler b b-fromDependency = fromDependencies . const . const . return . castIdentifier
− src/Hakyll/Core/Configuration.hs 
@@ -1,76 +0,0 @@--- | Exports a datastructure for the top-level hakyll configuration----module Hakyll.Core.Configuration-    ( HakyllConfiguration (..)-    , shouldIgnoreFile-    , defaultHakyllConfiguration-    ) where--import System.FilePath (takeFileName)-import Data.List (isPrefixOf, isSuffixOf)--data HakyllConfiguration = HakyllConfiguration-    { -- | Directory in which the output written-      destinationDirectory :: FilePath-    , -- | Directory where hakyll's internal store is kept-      storeDirectory :: FilePath-    , -- | Function to determine ignored files-      ---      -- In 'defaultHakyllConfiguration', the following files are ignored:-      ---      -- * files starting with a @.@-      ---      -- * files starting with a @#@-      ---      -- * files ending with a @~@-      ---      -- * files ending with @.swp@-      ---      -- Note that the files in @destinationDirectory@ and @storeDirectory@ will-      -- also be ignored. Note that this is the configuration parameter, if you-      -- want to use the test, you should use @shouldIgnoreFile@.-      ---      ignoreFile :: FilePath -> Bool-    , -- | Here, you can plug in a system command to upload/deploy your site.-      ---      -- Example:-      ---      -- > rsync -ave 'ssh -p 2217' _site jaspervdj@jaspervdj.be:hakyll-      ---      -- You can execute this by using-      ---      -- > ./hakyll deploy-      ---      deployCommand :: String-    , -- | Use an in-memory cache for items. This is faster but uses more-      -- memory.-      inMemoryCache :: Bool-    }---- | Default configuration for a hakyll application----defaultHakyllConfiguration :: HakyllConfiguration-defaultHakyllConfiguration = HakyllConfiguration-    { destinationDirectory = "_site"-    , storeDirectory       = "_cache"-    , ignoreFile           = ignoreFile'-    , deployCommand        = "echo 'No deploy command specified'"-    , inMemoryCache        = True-    }-  where-    ignoreFile' path-        | "."    `isPrefixOf` fileName = True-        | "#"    `isPrefixOf` fileName = True-        | "~"    `isSuffixOf` fileName = True-        | ".swp" `isSuffixOf` fileName = True-        | otherwise = False-      where-        fileName = takeFileName path---- | Check if a file should be ignored----shouldIgnoreFile :: HakyllConfiguration -> FilePath -> Bool-shouldIgnoreFile conf path =-    destinationDirectory conf `isPrefixOf` path ||-    storeDirectory conf `isPrefixOf` path ||-    ignoreFile conf path
− src/Hakyll/Core/DependencyAnalyzer.hs 
@@ -1,156 +0,0 @@-module Hakyll.Core.DependencyAnalyzer-    ( DependencyAnalyzer (..)-    , Signal (..)-    , makeDependencyAnalyzer-    , step-    , stepAll-    ) where--import Prelude hiding (reverse)-import qualified Prelude as P (reverse)-import Control.Arrow (first)-import Data.Set (Set)-import qualified Data.Set as S-import Data.Monoid (Monoid, mappend, mempty)--import Hakyll.Core.DirectedGraph---- | This data structure represents the state of the dependency analyzer. It--- holds a complete graph in 'analyzerGraph', which always contains all items,--- whether they are to be compiled or not.------ The 'analyzerRemains' fields holds the items that still need to be compiled,--- and 'analyzerDone' holds the items which are already compiled. This means--- that initally, 'analyzerDone' is empty and 'analyzerRemains' contains the--- items which are out-of-date (or items which have out-of-date dependencies).------ We also hold the dependency graph from the previous run because we need it--- when we want to determine when an item is out-of-date. An item is out-of-date--- when:------ * the resource from which it compiles is out-of-date, or;------ * any of it's dependencies is out-of-date, or;------ * it's set of dependencies has changed since the previous run.----data DependencyAnalyzer a = DependencyAnalyzer-    { -- | The complete dependency graph-      analyzerGraph         :: DirectedGraph a-    , -- | A set of items yet to be compiled-      analyzerRemains       :: Set a-    , -- | A set of items already compiled-      analyzerDone          :: Set a-    , -- | The dependency graph from the previous run-      analyzerPreviousGraph :: DirectedGraph a-    } deriving (Show)--data Signal a = Build a-              | Cycle [a]-              | Done-              deriving (Show)--instance (Ord a, Show a) => Monoid (DependencyAnalyzer a) where-    mempty = DependencyAnalyzer mempty mempty mempty mempty-    mappend x y = growRemains $ DependencyAnalyzer-        (analyzerGraph x `mappend` analyzerGraph y)-        (analyzerRemains x `mappend` analyzerRemains y)-        (analyzerDone x `mappend` analyzerDone y)-        (analyzerPreviousGraph x `mappend` analyzerPreviousGraph y)---- | Construct a dependency analyzer----makeDependencyAnalyzer :: (Ord a, Show a)-                       => DirectedGraph a       -- ^ The dependency graph-                       -> (a -> Bool)           -- ^ Is an item out-of-date?-                       -> DirectedGraph a       -- ^ The old dependency graph-                       -> DependencyAnalyzer a  -- ^ Resulting analyzer-makeDependencyAnalyzer graph isOutOfDate prev =-    growRemains $ DependencyAnalyzer graph remains S.empty prev-  where-    -- Construct the remains set by filtering using the given predicate-    remains = S.fromList $ filter isOutOfDate $ map fst $ toList graph---- | The 'analyzerRemains' field of a 'DependencyAnalyzer' is supposed to--- contain all out-of-date items, including the items with out-of-date--- dependencies. However, it is easier to just set up the directly out-of-date--- items initially -- and then grow the remains fields.------ This function assumes the 'analyzerRemains' fields in incomplete, and tries--- to correct it. Running it when the field is complete has no effect -- but it--- is a pretty expensive function, and it should be used with care.----growRemains :: (Ord a, Show a) => DependencyAnalyzer a -> DependencyAnalyzer a-growRemains (DependencyAnalyzer graph remains done prev) =-    (DependencyAnalyzer graph remains' done prev)-  where-    -- Grow the remains set using the indirect and changedDeps values, then-    -- filter out the items already done-    remains' = S.filter (`S.notMember` done) indirect--    -- Select the nodes which are reachable from the remaining nodes in the-    -- reversed dependency graph: these are the indirectly out-of-date items-    indirect = reachableNodes (remains `S.union` changedDeps) $ reverse graph--    -- For all nodes in the graph, check which items have a different dependency-    -- set compared to the previous run-    changedDeps = S.fromList $ map fst $-        filter (uncurry (/=) . first (`neighbours` prev)) $ toList graph---- | Step a dependency analyzer----step :: (Ord a, Show a) => DependencyAnalyzer a -> (Signal a, DependencyAnalyzer a)-step analyzer@(DependencyAnalyzer graph remains done prev)-    -- No remaining items-    | S.null remains = (Done, analyzer)-    -- An item remains, let's find a ready item-    | otherwise =-        let item = S.findMin remains-        in case findReady analyzer item of-            Done        -> (Done, analyzer)-            Cycle c     -> (Cycle c, analyzer)-            -- A ready item was found, signal a build-            Build build ->-                let remains' = S.delete build remains-                    done'    = S.insert build done-                in (Build build, DependencyAnalyzer graph remains' done' prev)---- | Step until done, creating a set of items we need to build -- mostly used--- for debugging purposes----stepAll :: (Ord a, Show a) => DependencyAnalyzer a -> Maybe (Set a)-stepAll = stepAll' S.empty-  where-    stepAll' xs analyzer = case step analyzer of-        (Build x, analyzer') -> stepAll' (S.insert x xs) analyzer'-        (Done, _)            -> Just xs-        (Cycle _, _)         -> Nothing---- | Find an item ready to be compiled----findReady :: (Ord a, Show a) => DependencyAnalyzer a -> a -> Signal a-findReady analyzer = findReady' [] S.empty-  where-    -- The dependency graph-    graph = analyzerGraph analyzer--    -- Items to do-    todo = analyzerRemains analyzer `S.difference` analyzerDone analyzer--    -- Worker-    findReady' stack visited item-        -- We already visited this item, the cycle is the reversed stack-        | item `S.member` visited = Cycle $ P.reverse stack'-        -- Look at the neighbours we to do-        | otherwise = case filter (`S.member` todo) neighbours' of-            -- No neighbours available to be done: it's ready!-            []      -> Build item-            -- At least one neighbour is available, search for that one-            (x : _) -> findReady' stack' visited' x-      where-        -- Our neighbours-        neighbours' = S.toList $ neighbours item graph--        -- The new visited stack/set-        stack' = item : stack-        visited' = S.insert item visited
− src/Hakyll/Core/DirectedGraph.hs 
@@ -1,84 +0,0 @@--- | Representation of a directed graph. In Hakyll, this is used for dependency--- tracking.----module Hakyll.Core.DirectedGraph-    ( DirectedGraph-    , fromList-    , toList-    , member-    , nodes-    , neighbours-    , reverse-    , reachableNodes-    ) where--import Prelude hiding (reverse)-import Control.Arrow (second)-import Data.Monoid (mconcat)-import Data.Set (Set)-import Data.Maybe (fromMaybe)-import qualified Data.Map as M-import qualified Data.Set as S--import Hakyll.Core.DirectedGraph.Internal---- | Construction of directed graphs----fromList :: Ord a-         => [(a, Set a)]     -- ^ List of (node, reachable neighbours)-         -> DirectedGraph a  -- ^ Resulting directed graph-fromList = DirectedGraph . M.fromList . map (\(t, d) -> (t, Node t d))---- | Deconstruction of directed graphs----toList :: DirectedGraph a-       -> [(a, Set a)]-toList = map (second nodeNeighbours) . M.toList . unDirectedGraph---- | Check if a node lies in the given graph----member :: Ord a-       => a                -- ^ Node to check for-       -> DirectedGraph a  -- ^ Directed graph to check in-       -> Bool             -- ^ If the node lies in the graph-member n = M.member n . unDirectedGraph---- | Get all nodes in the graph----nodes :: Ord a-      => DirectedGraph a  -- ^ Graph to get the nodes from-      -> Set a            -- ^ All nodes in the graph-nodes = M.keysSet . unDirectedGraph---- | Get a set of reachable neighbours from a directed graph----neighbours :: Ord a-           => a                -- ^ Node to get the neighbours of-           -> DirectedGraph a  -- ^ Graph to search in-           -> Set a            -- ^ Set containing the neighbours-neighbours x = fromMaybe S.empty . fmap nodeNeighbours-             . M.lookup x . unDirectedGraph---- | Reverse a directed graph (i.e. flip all edges)----reverse :: Ord a-        => DirectedGraph a-        -> DirectedGraph a-reverse = mconcat . map reverse' . M.toList . unDirectedGraph-  where-    reverse' (id', Node _ neighbours') = fromList $-        zip (S.toList neighbours') $ repeat $ S.singleton id'---- | Find all reachable nodes from a given set of nodes in the directed graph----reachableNodes :: Ord a => Set a -> DirectedGraph a -> Set a-reachableNodes set graph = reachable (setNeighbours set) set-  where-    reachable next visited-        | S.null next = visited-        | otherwise = reachable (sanitize neighbours') (next `S.union` visited)-      where-        sanitize = S.filter (`S.notMember` visited)-        neighbours' = setNeighbours (sanitize next)--    setNeighbours = S.unions . map (`neighbours` graph) . S.toList
− src/Hakyll/Core/DirectedGraph/Dot.hs 
@@ -1,32 +0,0 @@--- | Dump a directed graph in dot format. Used for debugging purposes----module Hakyll.Core.DirectedGraph.Dot-    ( toDot-    , writeDot-    ) where--import Hakyll.Core.DirectedGraph-import qualified Data.Set as S---- | Convert a directed graph into dot format for debugging purposes----toDot :: Ord a-      => (a -> String)    -- ^ Convert nodes to dot names-      -> DirectedGraph a  -- ^ Graph to dump-      -> String           -- ^ Resulting string-toDot showTag graph = unlines $ concat-    [ return "digraph dependencies {"-    , map showNode (S.toList $ nodes graph)-    , concatMap showEdges (S.toList $ nodes graph)-    , return "}"-    ]-  where-    showNode node = "    \"" ++ showTag node ++ "\";"-    showEdges node = map (showEdge node) $ S.toList $ neighbours node graph-    showEdge x y = "    \"" ++ showTag x ++ "\" -> \"" ++ showTag y ++ "\";"---- | Write out the @.dot@ file to a given file path. See 'toDot' for more--- information.----writeDot :: Ord a => FilePath -> (a -> String) -> DirectedGraph a -> IO ()-writeDot path showTag = writeFile path . toDot showTag
− src/Hakyll/Core/DirectedGraph/Internal.hs 
@@ -1,52 +0,0 @@--- | Internal structure of the DirectedGraph type. Not exported outside of the--- library.----{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}-module Hakyll.Core.DirectedGraph.Internal-    ( Node (..)-    , DirectedGraph (..)-    ) where--import Prelude hiding (reverse, filter)-import Control.Applicative ((<$>), (<*>))-import Data.Monoid (Monoid, mempty, mappend)-import Data.Set (Set)-import Data.Map (Map)-import qualified Data.Map as M-import qualified Data.Set as S--import Data.Binary (Binary, put, get)-import Data.Typeable (Typeable)---- | A node in the directed graph----data Node a = Node-    { nodeTag        :: a      -- ^ Tag identifying the node-    , nodeNeighbours :: Set a  -- ^ Edges starting at this node-    } deriving (Show, Typeable)--instance (Binary a, Ord a) => Binary (Node a) where-    put (Node t n) = put t >> put n-    get = Node <$> get <*> get---- | Append two nodes. Useful for joining graphs.----appendNodes :: Ord a => Node a -> Node a -> Node a-appendNodes (Node t1 n1) (Node t2 n2)-    | t1 /= t2 = error'-    | otherwise = Node t1 (n1 `S.union` n2)-  where-    error' = error $  "Hakyll.Core.DirectedGraph.Internal.appendNodes: "-                   ++ "Appending differently tagged nodes"---- | Type used to represent a directed graph----newtype DirectedGraph a = DirectedGraph {unDirectedGraph :: Map a (Node a)}-                        deriving (Show, Binary, Typeable)---- | Allow users to concatenate different graphs----instance Ord a => Monoid (DirectedGraph a) where-    mempty = DirectedGraph M.empty-    mappend (DirectedGraph m1) (DirectedGraph m2) = DirectedGraph $-        M.unionWith appendNodes m1 m2
− src/Hakyll/Core/Identifier.hs 
@@ -1,96 +0,0 @@--- | An identifier is a type used to uniquely identify a resource, target...------ One can think of an identifier as something similar to a file path. An--- identifier is a path as well, with the different elements in the path--- separated by @/@ characters. Examples of identifiers are:------ * @posts/foo.markdown@------ * @index@------ * @error/404@------ The most important difference between an 'Identifier' and a file path is that--- the identifier for an item is not necesserily the file path.------ For example, we could have an @index@ identifier, generated by Hakyll. The--- actual file path would be @index.html@, but we identify it using @index@.------ @posts/foo.markdown@ could be an identifier of an item that is rendered to--- @posts/foo.html@. In this case, the identifier is the name of the source--- file of the page.------ An `Identifier` carries the type of the value it identifies. This basically--- means that an @Identifier (Page String)@ refers to a page.------ It is a phantom type parameter, meaning you can safely change this if you--- know what you are doing. You can change the type using the 'castIdentifier'--- function.------ If the @a@ type is not known, Hakyll traditionally uses @Identifier ()@.----{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}-module Hakyll.Core.Identifier-    ( Identifier (..)-    , castIdentifier-    , parseIdentifier-    , toFilePath-    , setGroup-    ) where--import Control.Applicative ((<$>), (<*>))-import Control.Monad (mplus)-import Data.Monoid (Monoid, mempty, mappend)-import Data.List (intercalate)-import System.FilePath (dropTrailingPathSeparator, splitPath)--import Data.Binary (Binary, get, put)-import GHC.Exts (IsString, fromString)-import Data.Typeable (Typeable)---- | An identifier used to uniquely identify a value----data Identifier a = Identifier-    { identifierGroup :: Maybe String-    , identifierPath  :: String-    } deriving (Eq, Ord, Typeable)--instance Monoid (Identifier a) where-    mempty = Identifier Nothing ""-    Identifier g1 p1 `mappend` Identifier g2 p2 =-        Identifier (g1 `mplus` g2) (p1 `mappend` p2)--instance Binary (Identifier a) where-    put (Identifier g p) = put g >> put p-    get = Identifier <$> get <*> get--instance Show (Identifier a) where-    show i@(Identifier Nothing _)  = toFilePath i-    show i@(Identifier (Just g) _) = toFilePath i ++ " (" ++ g ++ ")"--instance IsString (Identifier a) where-    fromString = parseIdentifier---- | Discard the phantom type parameter of an identifier----castIdentifier :: Identifier a -> Identifier b-castIdentifier (Identifier g p) = Identifier g p-{-# INLINE castIdentifier #-}---- | Parse an identifier from a string----parseIdentifier :: String -> Identifier a-parseIdentifier = Identifier Nothing-                . intercalate "/" . filter (not . null) . split'-  where-    split' = map dropTrailingPathSeparator . splitPath---- | Convert an identifier to a relative 'FilePath'----toFilePath :: Identifier a -> FilePath-toFilePath = identifierPath---- | Set the identifier group for some identifier----setGroup :: Maybe String -> Identifier a -> Identifier a-setGroup g (Identifier _ p) = Identifier g p
− src/Hakyll/Core/Identifier/Pattern.hs 
@@ -1,223 +0,0 @@--- | Module providing pattern matching and capturing on 'Identifier's.--- 'Pattern's come in two kinds:------ * Simple glob patterns, like @foo\/*@;------ * Custom, arbitrary predicates of the type @Identifier -> Bool@.------ They both have advantages and disadvantages. By default, globs are used,--- unless you construct your 'Pattern' using the 'predicate' function.------ A very simple pattern could be, for example, @foo\/bar@. This pattern will--- only match the exact @foo\/bar@ identifier.------ To match more than one identifier, there are different captures that one can--- use:------ * @*@: matches at most one element of an identifier;------ * @**@: matches one or more elements of an identifier.------ Some examples:------ * @foo\/*@ will match @foo\/bar@ and @foo\/foo@, but not @foo\/bar\/qux@;------ * @**@ will match any identifier;------ * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@;------ * @foo\/*.html@ will match all HTML files in the @foo\/@ directory.------ The 'capture' function allows the user to get access to the elements captured--- by the capture elements in the pattern.------ Like an 'Identifier', a 'Pattern' also has a type parameter. This is simply--- an extra layer of safety, and can be discarded using the 'castPattern'--- function.----module Hakyll.Core.Identifier.Pattern-    ( -- * The pattern type-      Pattern-    , castPattern--      -- * Creating patterns-    , parseGlob-    , predicate-    , list-    , regex-    , inGroup-    , complement--      -- * Applying patterns-    , matches-    , filterMatches-    , capture-    , fromCapture-    , fromCaptures-    ) where--import Data.List (isPrefixOf, inits, tails)-import Control.Arrow ((&&&), (>>>))-import Control.Monad (msum)-import Data.Maybe (isJust, fromMaybe)-import Data.Monoid (Monoid, mempty, mappend)--import GHC.Exts (IsString, fromString)-import Text.Regex.TDFA ((=~~))--import Hakyll.Core.Identifier---- | One base element of a pattern----data GlobComponent = Capture-                   | CaptureMany-                   | Literal String-                   deriving (Eq, Show)---- | Type that allows matching on identifiers----data Pattern a = Glob [GlobComponent]-               | Predicate (Identifier a -> Bool)-               | List [Identifier a]--instance IsString (Pattern a) where-    fromString = parseGlob--instance Monoid (Pattern a) where-    mempty = Predicate (const True)-    p1 `mappend` p2 = Predicate $ \i -> matches p1 i && matches p2 i---- | Discard the phantom type parameter----castPattern :: Pattern a -> Pattern b-castPattern (Glob g)      = Glob g-castPattern (Predicate p) = Predicate $ p . castIdentifier-castPattern (List l)      = List $ map castIdentifier l-{-# INLINE castPattern #-}---- | Parse a pattern from a string----parseGlob :: String -> Pattern a-parseGlob = Glob . parse'-  where-    parse' str =-        let (chunk, rest) = break (`elem` "\\*") str-        in case rest of-            ('\\' : x   : xs) -> Literal (chunk ++ [x]) : parse' xs-            ('*'  : '*' : xs) -> Literal chunk : CaptureMany : parse' xs-            ('*'  : xs)       -> Literal chunk : Capture : parse' xs-            xs                -> Literal chunk : Literal xs : []---- | Create a 'Pattern' from an arbitrary predicate------ Example:------ > predicate (\i -> matches "foo/*" i && not (matches "foo/bar" i))----predicate :: (Identifier a -> Bool) -> Pattern a-predicate = Predicate---- | Create a 'Pattern' from a list of 'Identifier's it should match----list :: [Identifier a] -> Pattern a-list = List---- | Create a 'Pattern' from a regex------ Example:------ > regex "^foo/[^x]*$----regex :: String -> Pattern a-regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath---- | Create a 'Pattern' which matches if the identifier is in a certain group--- (or in no group)----inGroup :: Maybe String -> Pattern a-inGroup group = predicate $ (== group) . identifierGroup---- | Inverts a pattern, e.g.------ > complement "foo/bar.html"------ will match /anything/ except @\"foo\/bar.html\"@----complement :: Pattern a -> Pattern a-complement p = predicate (not . matches p)---- | Check if an identifier matches a pattern----matches :: Pattern a -> Identifier a -> Bool-matches (Glob p)      = isJust . capture (Glob p)-matches (Predicate p) = (p $)-matches (List l)      = (`elem` l)---- | Given a list of identifiers, retain only those who match the given pattern----filterMatches :: Pattern a -> [Identifier a] -> [Identifier a]-filterMatches = filter . matches---- | Split a list at every possible point, generate a list of (init, tail)--- cases. The result is sorted with inits decreasing in length.----splits :: [a] -> [([a], [a])]-splits = inits &&& tails >>> uncurry zip >>> reverse---- | Match a glob against a pattern, generating a list of captures----capture :: Pattern a -> Identifier a -> Maybe [String]-capture (Glob p) (Identifier _ i) = capture' p i-capture _        _                = Nothing---- | Internal verion of 'capture'----capture' :: [GlobComponent] -> String -> Maybe [String]-capture' [] [] = Just []  -- An empty match-capture' [] _  = Nothing  -- No match-capture' (Literal l : ms) str-    -- Match the literal against the string-    | l `isPrefixOf` str = capture' ms $ drop (length l) str-    | otherwise          = Nothing-capture' (Capture : ms) str =-    -- Match until the next /-    let (chunk, rest) = break (== '/') str-    in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]-capture' (CaptureMany : ms) str =-    -- Match everything-    msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]-    --- | Create an identifier from a pattern by filling in the captures with a given--- string------ Example:------ > fromCapture (parseGlob "tags/*") "foo"------ Result:------ > "tags/foo"----fromCapture :: Pattern a -> String -> Identifier a-fromCapture pattern = fromCaptures pattern . repeat---- | Create an identifier from a pattern by filling in the captures with the--- given list of strings----fromCaptures :: Pattern a -> [String] -> Identifier a-fromCaptures (Glob p) = Identifier Nothing . fromCaptures' p-fromCaptures _        = error $-    "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++-    "on simple globs!"---- | Internally used version of 'fromCaptures'----fromCaptures' :: [GlobComponent] -> [String] -> String-fromCaptures' []        _ = mempty-fromCaptures' (m : ms) [] = case m of-    Literal l -> l `mappend` fromCaptures' ms []-    _         -> error $  "Hakyll.Core.Identifier.Pattern.fromCaptures': "-                       ++ "identifier list exhausted"-fromCaptures' (m : ms) ids@(i : is) = case m of-    Literal l -> l `mappend` fromCaptures' ms ids-    _         -> i `mappend` fromCaptures' ms is
− src/Hakyll/Core/Logger.hs 
@@ -1,100 +0,0 @@--- | Produce pretty, thread-safe logs----{-# LANGUAGE BangPatterns #-}-module Hakyll.Core.Logger-    ( Logger-    , makeLogger-    , flushLogger-    , section-    , timed-    , report-    , thrown-    ) where--import Control.Monad (forever)-import Control.Monad.Trans (MonadIO, liftIO)-import Control.Applicative (pure, (<$>), (<*>))-import Control.Concurrent (forkIO)-import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)-import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar)-import Text.Printf (printf)--import Data.Time (getCurrentTime, diffUTCTime)---- | Logger structure. Very complicated.----data Logger = Logger-    { loggerChan :: Chan (Maybe String)  -- ^ Nothing marks the end-    , loggerSync :: MVar ()              -- ^ Used for sync on quit-    , loggerSink :: String -> IO ()      -- ^ Out sink-    }---- | Create a new logger----makeLogger :: (String -> IO ()) -> IO Logger-makeLogger sink = do-    logger <- Logger <$> newChan <*> newEmptyMVar <*> pure sink-    _ <- forkIO $ loggerThread logger-    return logger-  where-    loggerThread logger = forever $ do-        msg <- readChan $ loggerChan logger-        case msg of-            -- Stop: sync-            Nothing -> putMVar (loggerSync logger) ()-            -- Print and continue-            Just m  -> loggerSink logger m---- | Flush the logger (blocks until flushed)----flushLogger :: Logger -> IO ()-flushLogger logger = do-    writeChan (loggerChan logger) Nothing-    () <- takeMVar $ loggerSync logger-    return ()---- | Send a raw message to the logger----message :: Logger -> String -> IO ()-message logger = writeChan (loggerChan logger) . Just---- | Start a section in the log----section :: MonadIO m-        => Logger  -- ^ Logger-        -> String  -- ^ Section name-        -> m ()    -- ^ No result-section logger = liftIO . message logger---- | Execute a monadic action and log the duration----timed :: MonadIO m-      => Logger  -- ^ Logger-      -> String  -- ^ Message-      -> m a     -- ^ Action-      -> m a     -- ^ Timed and logged action-timed logger msg action = do-    start <- liftIO getCurrentTime-    !result <- action-    stop <- liftIO getCurrentTime-    let diff = fromEnum $ diffUTCTime stop start-        ms = diff `div` 10 ^ (9 :: Int)-        formatted = printf "  [%4dms] %s" ms msg-    liftIO $ message logger formatted-    return result---- | Log something at the same level as 'timed', but without the timing----report :: MonadIO m-       => Logger  -- ^ Logger-       -> String  -- ^ Message-       -> m ()    -- ^ No result-report logger msg = liftIO $ message logger $ "  [      ] " ++ msg---- | Log an error that was thrown in the compilation phase----thrown :: MonadIO m-       => Logger  -- ^ Logger-       -> String  -- ^ Message-       -> m ()    -- ^ No result-thrown logger msg = liftIO $ message logger $ "  [ ERROR] " ++ msg
− src/Hakyll/Core/Resource.hs 
@@ -1,31 +0,0 @@--- | Module exporting the simple 'Resource' type----module Hakyll.Core.Resource-    ( Resource-    , unResource-    , resource-    , fromIdentifier-    , toIdentifier-    ) where--import Hakyll.Core.Identifier---- | A resource----newtype Resource = Resource {unResource :: FilePath}-    deriving (Eq, Show, Ord)---- | Smart constructor to ensure we have @/@ as path separator----resource :: FilePath -> Resource-resource = fromIdentifier . parseIdentifier---- | Create a resource from an identifier----fromIdentifier :: Identifier a -> Resource-fromIdentifier = Resource . toFilePath---- | Map the resource to an identifier. Note that the group will not be set!----toIdentifier :: Resource -> Identifier a-toIdentifier = parseIdentifier . unResource
− src/Hakyll/Core/Resource/Provider.hs 
@@ -1,125 +0,0 @@------------------------------------------------------------------------------------ | This module provides an API for resource providers. Resource providers--- allow Hakyll to get content from resources; the type of resource depends on--- the concrete instance.------ A resource is represented by the 'Resource' type. This is basically just a--- newtype wrapper around 'Identifier' -- but it has an important effect: it--- guarantees that a resource with this identifier can be provided by one or--- more resource providers.------ Therefore, it is not recommended to read files directly -- you should use the--- provided 'Resource' methods.----module Hakyll.Core.Resource.Provider-    ( ResourceProvider (..)-    , resourceList-    , makeResourceProvider-    , resourceExists-    , resourceDigest-    , resourceModified-    ) where------------------------------------------------------------------------------------import Control.Applicative ((<$>))-import Control.Concurrent (MVar, readMVar, modifyMVar_, newMVar)-import Data.Map (Map)-import qualified Data.Map as M-import qualified Data.Set as S------------------------------------------------------------------------------------import Data.Time (UTCTime)-import qualified Crypto.Hash.MD5 as MD5-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as LB------------------------------------------------------------------------------------import Hakyll.Core.Store (Store)-import Hakyll.Core.Resource-import qualified Hakyll.Core.Store as Store-------------------------------------------------------------------------------------- | A value responsible for retrieving and listing resources-data ResourceProvider = ResourceProvider-    { -- | A set of all resources this provider is able to provide-      resourceSet              :: S.Set Resource-    , -- | Retrieve a certain resource as string-      resourceString           :: Resource -> IO String-    , -- | Retrieve a certain resource as lazy bytestring-      resourceLBS              :: Resource -> IO LB.ByteString-    , -- | Check when a resource was last modified-      resourceModificationTime :: Resource -> IO UTCTime-    , -- | Cache keeping track of modified items-      resourceModifiedCache    :: MVar (Map Resource Bool)-    }-------------------------------------------------------------------------------------- | Create a resource provider-makeResourceProvider :: [Resource]                      -- ^ Resource list-                     -> (Resource -> IO String)         -- ^ String reader-                     -> (Resource -> IO LB.ByteString)  -- ^ ByteString reader-                     -> (Resource -> IO UTCTime)        -- ^ Time checker-                     -> IO ResourceProvider             -- ^ Resulting provider-makeResourceProvider l s b t =-    ResourceProvider (S.fromList l) s b t <$> newMVar M.empty-------------------------------------------------------------------------------------- | Get the list of all resources-resourceList :: ResourceProvider -> [Resource]-resourceList = S.toList . resourceSet-------------------------------------------------------------------------------------- | Check if a given identifier has a resource-resourceExists :: ResourceProvider -> Resource -> Bool-resourceExists provider = flip S.member $ resourceSet provider-------------------------------------------------------------------------------------- | Retrieve a digest for a given resource-resourceDigest :: ResourceProvider -> Resource -> IO B.ByteString-resourceDigest provider = fmap MD5.hashlazy . resourceLBS provider-------------------------------------------------------------------------------------- | Check if a resource was modified-resourceModified :: ResourceProvider -> Store -> Resource -> IO Bool-resourceModified provider store r = do-    cache <- readMVar mvar-    case M.lookup r cache of-        -- Already in the cache-        Just m  -> return m-        -- Not yet in the cache, check digests (if it exists)-        Nothing -> do-            m <- if resourceExists provider r-                        then digestModified provider store r-                        else return False-            modifyMVar_ mvar (return . M.insert r m)-            return m-  where-    mvar = resourceModifiedCache provider-------------------------------------------------------------------------------------- | Check if a resource digest was modified-digestModified :: ResourceProvider -> Store -> Resource -> IO Bool-digestModified provider store r = do-    -- Get the latest seen digest from the store-    lastDigest <- Store.get store key-    -- Calculate the digest for the resource-    newDigest <- resourceDigest provider r-    -- Check digests-    if Store.Found newDigest == lastDigest-        -- All is fine, not modified-        then return False-        -- Resource modified; store new digest-        else do Store.set store key newDigest-                return True-  where-    key = ["Hakyll.Core.ResourceProvider.digestModified", unResource r]
− src/Hakyll/Core/Resource/Provider/Dummy.hs 
@@ -1,25 +0,0 @@--- | Dummy resource provider for testing purposes----module Hakyll.Core.Resource.Provider.Dummy-    ( dummyResourceProvider-    ) where--import Data.Map (Map)-import qualified Data.Map as M--import Data.Time (getCurrentTime)-import Data.ByteString.Lazy (ByteString)-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL--import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider---- | Create a dummy 'ResourceProvider'----dummyResourceProvider :: Map String ByteString -> IO ResourceProvider-dummyResourceProvider vfs = makeResourceProvider-    (map resource (M.keys vfs))-    (return . TL.unpack . TL.decodeUtf8 . (vfs M.!) . unResource)-    (return . (vfs M.!) . unResource)-    (const getCurrentTime)
− src/Hakyll/Core/Resource/Provider/File.hs 
@@ -1,39 +0,0 @@--- | A concrete 'ResourceProvider' that gets it's resources from the filesystem----{-# LANGUAGE CPP #-}-module Hakyll.Core.Resource.Provider.File-    ( fileResourceProvider-    ) where--import Control.Applicative ((<$>))--import Data.Time (readTime)-import System.Directory (getModificationTime)-import System.Locale (defaultTimeLocale)-import System.Time (formatCalendarTime, toCalendarTime)-import qualified Data.ByteString.Lazy as LB--import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Util.File-import Hakyll.Core.Configuration---- | Create a filesystem-based 'ResourceProvider'----fileResourceProvider :: HakyllConfiguration -> IO ResourceProvider-fileResourceProvider configuration = do-    -- Retrieve a list of paths-    list <- map resource . filter (not . shouldIgnoreFile configuration) <$>-        getRecursiveContents False "."-    makeResourceProvider list (readFile . unResource)-                              (LB.readFile . unResource)-                              (mtime . unResource)-  where-    mtime r = do-#if MIN_VERSION_directory(1,2,0)-        getModificationTime r-#else-        ct <- toCalendarTime =<< getModificationTime r-        let str = formatCalendarTime defaultTimeLocale "%s" ct-        return $ readTime defaultTimeLocale "%s" str-#endif
− src/Hakyll/Core/Routes.hs 
@@ -1,143 +0,0 @@--- | Once a target is compiled, the user usually wants to save it to the disk.--- This is where the 'Routes' type comes in; it determines where a certain--- target should be written.------ Suppose we have an item @foo\/bar.markdown@. We can render this to--- @foo\/bar.html@ using:------ > route "foo/bar.markdown" (setExtension ".html")------ If we do not want to change the extension, we can use 'idRoute', the simplest--- route available:------ > route "foo/bar.markdown" idRoute------ That will route @foo\/bar.markdown@ to @foo\/bar.markdown@.------ Note that the extension says nothing about the content! If you set the--- extension to @.html@, it is your own responsibility to ensure that the--- content is indeed HTML.------ Finally, some special cases:------ * If there is no route for an item, this item will not be routed, so it will---   not appear in your site directory.------ * If an item matches multiple routes, the first rule will be chosen.----{-# LANGUAGE Rank2Types #-}-module Hakyll.Core.Routes-    ( Routes-    , runRoutes-    , idRoute-    , setExtension-    , matchRoute-    , customRoute-    , constRoute-    , gsubRoute-    , composeRoutes-    ) where--import Data.Monoid (Monoid, mempty, mappend)-import Control.Monad (mplus)-import System.FilePath (replaceExtension)--import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import Hakyll.Core.Util.String---- | Type used for a route----newtype Routes = Routes {unRoutes :: forall a. Identifier a -> Maybe FilePath}--instance Monoid Routes where-    mempty = Routes $ const Nothing-    mappend (Routes f) (Routes g) = Routes $ \id' -> f id' `mplus` g id'---- | Apply a route to an identifier----runRoutes :: Routes -> Identifier a -> Maybe FilePath-runRoutes = unRoutes---- | A route that uses the identifier as filepath. For example, the target with--- ID @foo\/bar@ will be written to the file @foo\/bar@.----idRoute :: Routes-idRoute = Routes $ Just . toFilePath---- | Set (or replace) the extension of a route.------ Example:------ > runRoutes (setExtension "html") "foo/bar"------ Result:------ > Just "foo/bar.html"------ Example:------ > runRoutes (setExtension "html") "posts/the-art-of-trolling.markdown"------ Result:------ > Just "posts/the-art-of-trolling.html"----setExtension :: String -> Routes-setExtension extension = Routes $ fmap (`replaceExtension` extension)-                                . unRoutes idRoute---- | Apply the route if the identifier matches the given pattern, fail--- otherwise----matchRoute :: Pattern a -> Routes -> Routes-matchRoute pattern (Routes route) = Routes $ \id' ->-    if matches pattern (castIdentifier id') then route id' else Nothing---- | Create a custom route. This should almost always be used with--- 'matchRoute'----customRoute :: (Identifier a -> FilePath) -> Routes-customRoute f = Routes $ Just . f . castIdentifier---- | A route that always gives the same result. Obviously, you should only use--- this for a single compilation rule.-constRoute :: FilePath -> Routes-constRoute = customRoute . const---- | Create a gsub route------ Example:------ > runRoutes (gsubRoute "rss/" (const "")) "tags/rss/bar.xml"------ Result:------ > Just "tags/bar.xml"----gsubRoute :: String              -- ^ Pattern-          -> (String -> String)  -- ^ Replacement-          -> Routes              -- ^ Resulting route-gsubRoute pattern replacement = customRoute $-    replaceAll pattern replacement . toFilePath---- | Compose routes so that @f `composeRoutes` g@ is more or less equivalent--- with @f >>> g@.------ Example:------ > let routes = gsubRoute "rss/" (const "") `composeRoutes` setExtension "xml"--- > in runRoutes routes "tags/rss/bar"------ Result:------ > Just "tags/bar.xml"------ If the first route given fails, Hakyll will not apply the second route.----composeRoutes :: Routes  -- ^ First route to apply-              -> Routes  -- ^ Second route to apply-              -> Routes  -- ^ Resulting route-composeRoutes (Routes f) (Routes g) = Routes $ \i -> do-    p <- f i-    g $ parseIdentifier p
− src/Hakyll/Core/Rules.hs 
@@ -1,250 +0,0 @@--- | This module provides a declarative DSL in which the user can specify the--- different rules used to run the compilers.------ The convention is to just list all items in the 'RulesM' monad, routes and--- compilation rules.------ A typical usage example would be:------ > main = hakyll $ do--- >     match "posts/*" $ do--- >         route   (setExtension "html")--- >         compile someCompiler--- >     match "css/*" $ do--- >         route   idRoute--- >         compile compressCssCompiler----{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}-module Hakyll.Core.Rules-    ( RulesM-    , Rules-    , match-    , group-    , compile-    , create-    , route-    , resources-    , metaCompile-    , metaCompileWith-    , freshIdentifier-    ) where--import Control.Applicative ((<$>))-import Control.Monad.Writer (tell)-import Control.Monad.Reader (ask, local)-import Control.Arrow ((>>>), arr, (>>^), (***))-import Control.Monad.State (get, put)-import Data.Monoid (mempty, mappend)-import qualified Data.Set as S--import Data.Typeable (Typeable)-import Data.Binary (Binary)--import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import Hakyll.Core.Compiler.Internal-import Hakyll.Core.Routes-import Hakyll.Core.CompiledItem-import Hakyll.Core.Writable-import Hakyll.Core.Rules.Internal-import Hakyll.Core.Util.Arrow---- | Add a route----tellRoute :: Routes -> Rules-tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty---- | Add a number of compilers----tellCompilers :: (Binary a, Typeable a, Writable a)-             => [(Identifier a, Compiler () a)]-             -> Rules-tellCompilers compilers = RulesM $ do-    -- We box the compilers so they have a more simple type-    let compilers' = map (castIdentifier *** boxCompiler) compilers-    tell $ RuleSet mempty compilers' mempty-  where-    boxCompiler = (>>> arr compiledItem >>> arr CompileRule)---- | Add resources----tellResources :: [Resource]-              -> Rules-tellResources resources' = RulesM $ tell $-    RuleSet mempty mempty $ S.fromList resources'---- | Only compile/route items satisfying the given predicate----match :: Pattern a -> RulesM b -> RulesM b-match pattern = RulesM . local addPredicate . unRulesM-  where-    addPredicate env = env-        { rulesPattern = rulesPattern env `mappend` castPattern pattern-        }---- | Greate a group of compilers------ Imagine you have a page that you want to render, but you also want the raw--- content available on your site.------ > match "test.markdown" $ do--- >     route $ setExtension "html"--- >     compile pageCompiler--- >--- > match "test.markdown" $ do--- >     route idRoute--- >     compile copyPageCompiler------ Will of course conflict! In this case, Hakyll will pick the first matching--- compiler (@pageCompiler@ in this case).------ In case you want to have them both, you can use the 'group' function to--- create a new group. For example,------ > match "test.markdown" $ do--- >     route $ setExtension "html"--- >     compile pageCompiler--- >--- > group "raw" $ do--- >     match "test.markdown" $ do--- >         route idRoute--- >         compile copyPageCompiler------ This will put the compiler for the raw content in a separate group--- (@\"raw\"@), which causes it to be compiled as well.----group :: String -> RulesM a -> RulesM a-group g = RulesM . local setGroup' . unRulesM-  where-    setGroup' env = env { rulesGroup = Just g }---- | Add a compilation rule to the rules.------ This instructs all resources to be compiled using the given compiler. When--- no resources match the current selection, nothing will happen. In this case,--- you might want to have a look at 'create'.----compile :: (Binary a, Typeable a, Writable a)-        => Compiler Resource a -> RulesM (Pattern a)-compile compiler = do-    ids <- resources-    tellCompilers $ flip map ids $ \identifier ->-        (identifier, constA (fromIdentifier identifier) >>> compiler)-    tellResources $ map fromIdentifier ids-    return $ list ids-                   --- | Add a compilation rule------ This sets a compiler for the given identifier. No resource is needed, since--- we are creating the item from scratch. This is useful if you want to create a--- page on your site that just takes content from other items -- but has no--- actual content itself. Note that the group of the given identifier is--- replaced by the group set via 'group' (or 'Nothing', if 'group' has not been--- used).----create :: (Binary a, Typeable a, Writable a)-       => Identifier a -> Compiler () a -> RulesM (Identifier a)-create id' compiler = RulesM $ do-    group' <- rulesGroup <$> ask-    let id'' = setGroup group' id'-    unRulesM $ tellCompilers [(id'', compiler)]-    return id''---- | Add a route.------ This adds a route for all items matching the current pattern.----route :: Routes -> Rules-route route' = RulesM $ do-    -- We want the route only to be applied if we match the current pattern and-    -- group-    pattern <- rulesPattern <$> ask-    group' <- rulesGroup <$> ask-    unRulesM $ tellRoute $ matchRoute (pattern `mappend` inGroup group') route'---- | Get a list of resources matching the current pattern. This will also set--- the correct group to the identifiers.----resources :: RulesM [Identifier a]-resources = RulesM $ do-    pattern <- rulesPattern <$> ask-    provider <- rulesResourceProvider <$> ask-    group' <- rulesGroup <$> ask-    -- Important: filter with pattern *before* setting the group-    return $ map (setGroup group') $ filterMatches pattern $-        map toIdentifier $ resourceList provider---- | Apart from regular compilers, one is also able to specify metacompilers.--- Metacompilers are a special class of compilers: they are compilers which--- produce other compilers.------ This is needed when the list of compilers depends on something we cannot know--- before actually running other compilers. The most typical example is if we--- have a blogpost using tags.------ Every post has a collection of tags. For example,------ > post1: code, haskell--- > post2: code, random------ Now, we want to create a list of posts for every tag. We cannot write this--- down in our 'Rules' DSL directly, since we don't know what tags the different--- posts will have -- we depend on information that will only be available when--- we are actually compiling the pages.------ The solution is simple, using 'metaCompile', we can add a compiler that will--- parse the pages and produce the compilers needed for the different tag pages.------ And indeed, we can see that the first argument to 'metaCompile' is a--- 'Compiler' which produces a list of ('Identifier', 'Compiler') pairs. The--- idea is simple: 'metaCompile' produces a list of compilers, and the--- corresponding identifiers.------ For simple hakyll systems, it is no need for this construction. More--- formally, it is only needed when the content of one or more items determines--- which items must be rendered.----metaCompile :: (Binary a, Typeable a, Writable a)-            => Compiler () [(Identifier a, Compiler () a)]   -            -- ^ Compiler generating the other compilers-            -> Rules-            -- ^ Resulting rules-metaCompile compiler = do-    id' <- freshIdentifier "Hakyll.Core.Rules.metaCompile"-    metaCompileWith id' compiler---- | Version of 'metaCompile' that allows you to specify a custom identifier for--- the metacompiler.----metaCompileWith :: (Binary a, Typeable a, Writable a)-                => Identifier ()-                -- ^ Identifier for this compiler-                -> Compiler () [(Identifier a, Compiler () a)]   -                -- ^ Compiler generating the other compilers-                -> Rules-                -- ^ Resulting rules-metaCompileWith identifier compiler = RulesM $ do-    group' <- rulesGroup <$> ask--    let -- Set the correct group on the identifier-        id' = setGroup group' identifier-        -- Function to box an item into a rule-        makeRule = MetaCompileRule . map (castIdentifier *** box)-        -- Entire boxing function-        box = (>>> fromDependency id' >>^ CompileRule . compiledItem)-        -- Resulting compiler list-        compilers = [(id', compiler >>> arr makeRule )]--    tell $ RuleSet mempty compilers mempty---- | Generate a fresh Identifier with a given prefix-freshIdentifier :: String                 -- ^ Prefix-                -> RulesM (Identifier a)  -- ^ Fresh identifier-freshIdentifier prefix = RulesM $ do-    state <- get-    let index = rulesNextIdentifier state-        id'   = parseIdentifier $ prefix ++ "/" ++ show index-    put $ state {rulesNextIdentifier = index + 1}-    return id'
− src/Hakyll/Core/Rules/Internal.hs 
@@ -1,99 +0,0 @@--- | Internal rules module for types which are not exposed to the user----{-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-}-module Hakyll.Core.Rules.Internal-    ( CompileRule (..)-    , RuleSet (..)-    , RuleState (..)-    , RuleEnvironment (..)-    , RulesM (..)-    , Rules-    , runRules-    ) where--import Control.Applicative (Applicative)-import Control.Monad.Writer (WriterT, execWriterT)-import Control.Monad.Reader (ReaderT, runReaderT)-import Control.Monad.State (State, evalState)-import Data.Monoid (Monoid, mempty, mappend)-import Data.Set (Set)-import qualified Data.Map as M--import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import Hakyll.Core.Compiler.Internal-import Hakyll.Core.Routes-import Hakyll.Core.CompiledItem---- | Output of a compiler rule------ * The compiler will produce a simple item. This is the most common case.------ * The compiler will produce more compilers. These new compilers need to be---   added to the runtime if possible, since other items might depend upon them.----data CompileRule = CompileRule CompiledItem-                 | MetaCompileRule [(Identifier (), Compiler () CompileRule)]---- | A collection of rules for the compilation process----data RuleSet = RuleSet-    { -- | Routes used in the compilation structure-      rulesRoutes    :: Routes-    , -- | Compilation rules-      rulesCompilers :: [(Identifier (), Compiler () CompileRule)]-    , -- | A list of the used resources-      rulesResources :: Set Resource-    }--instance Monoid RuleSet where-    mempty = RuleSet mempty mempty mempty-    mappend (RuleSet r1 c1 s1) (RuleSet r2 c2 s2) =-        RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2)---- | Rule state----data RuleState = RuleState-    { rulesNextIdentifier :: Int-    } deriving (Show)---- | Rule environment----data RuleEnvironment = RuleEnvironment-    { rulesResourceProvider :: ResourceProvider-    , rulesPattern          :: forall a. Pattern a-    , rulesGroup            :: Maybe String-    }---- | The monad used to compose rules----newtype RulesM a = RulesM-    { unRulesM :: ReaderT RuleEnvironment (WriterT RuleSet (State RuleState)) a-    } deriving (Monad, Functor, Applicative)---- | Simplification of the RulesM type; usually, it will not return any--- result.----type Rules = RulesM ()---- | Run a Rules monad, resulting in a 'RuleSet'----runRules :: RulesM a -> ResourceProvider -> RuleSet-runRules rules provider = nubCompilers $-    evalState (execWriterT $ runReaderT (unRulesM rules) env) state-  where-    state = RuleState {rulesNextIdentifier = 0}-    env = RuleEnvironment { rulesResourceProvider = provider-                          , rulesPattern          = mempty-                          , rulesGroup            = Nothing-                          }---- | Remove duplicate compilers from the 'RuleSet'. When two compilers match an--- item, we prefer the first one----nubCompilers :: RuleSet -> RuleSet-nubCompilers set = set { rulesCompilers = nubCompilers' (rulesCompilers set) }-  where-    nubCompilers' = M.toList . M.fromListWith (flip const)
− src/Hakyll/Core/Run.hs 
@@ -1,217 +0,0 @@--- | This is the module which binds it all together----{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}-module Hakyll.Core.Run-    ( run-    ) where--import Control.Applicative (Applicative, (<$>))-import Control.Monad (filterM, forM_)-import Control.Monad.Error (ErrorT, runErrorT, throwError)-import Control.Monad.Reader (ReaderT, runReaderT, ask)-import Control.Monad.State.Strict (StateT, runStateT, get, put)-import Control.Monad.Trans (liftIO)-import Data.Map (Map)-import Data.Monoid (mempty, mappend)-import Prelude hiding (reverse)-import System.Exit (ExitCode (..), exitWith)-import System.FilePath ((</>))-import qualified Data.Map as M-import qualified Data.Set as S--import Hakyll.Core.Compiler-import Hakyll.Core.Compiler.Internal-import Hakyll.Core.Configuration-import Hakyll.Core.DependencyAnalyzer-import Hakyll.Core.DirectedGraph-import Hakyll.Core.Identifier-import Hakyll.Core.Logger-import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Resource.Provider.File-import Hakyll.Core.Routes-import Hakyll.Core.Rules.Internal-import Hakyll.Core.Store (Store)-import Hakyll.Core.Util.File-import Hakyll.Core.Writable-import qualified Hakyll.Core.Store as Store---- | Run all rules needed, return the rule set used----run :: HakyllConfiguration -> RulesM a -> IO RuleSet-run configuration rules = do-    logger <- makeLogger putStrLn--    section logger "Initialising"-    store <- timed logger "Creating store" $-        Store.new (inMemoryCache configuration) $ storeDirectory configuration-    provider <- timed logger "Creating provider" $-        fileResourceProvider configuration--    -- Fetch the old graph from the store. If we don't find it, we consider this-    -- to be the first run-    graph <- Store.get store ["Hakyll.Core.Run.run", "dependencies"]-    let (firstRun, oldGraph) = case graph of Store.Found g -> (False, g)-                                             _             -> (True, mempty)--    let ruleSet = runRules rules provider-        compilers = rulesCompilers ruleSet--        -- Extract the reader/state-        reader = unRuntime $ addNewCompilers compilers-        stateT = runReaderT reader $ RuntimeEnvironment-                    { hakyllLogger           = logger-                    , hakyllConfiguration    = configuration-                    , hakyllRoutes           = rulesRoutes ruleSet-                    , hakyllResourceProvider = provider-                    , hakyllStore            = store-                    , hakyllFirstRun         = firstRun-                    }--    -- Run the program and fetch the resulting state-    result <- runErrorT $ runStateT stateT $ RuntimeState-        { hakyllAnalyzer  = makeDependencyAnalyzer mempty (const False) oldGraph-        , hakyllCompilers = M.empty-        }--    case result of-        Left e             -> do-            thrown logger e-            flushLogger logger-            exitWith $ ExitFailure 1-        Right ((), state') -> do-            -- We want to save the final dependency graph for the next run-            Store.set store ["Hakyll.Core.Run.run", "dependencies"] $-                analyzerGraph $ hakyllAnalyzer state'-            flushLogger logger-            return ruleSet--data RuntimeEnvironment = RuntimeEnvironment-    { hakyllLogger           :: Logger-    , hakyllConfiguration    :: HakyllConfiguration-    , hakyllRoutes           :: Routes-    , hakyllResourceProvider :: ResourceProvider-    , hakyllStore            :: Store-    , hakyllFirstRun         :: Bool-    }--data RuntimeState = RuntimeState-    { hakyllAnalyzer  :: DependencyAnalyzer (Identifier ())-    , hakyllCompilers :: Map (Identifier ()) (Compiler () CompileRule)-    }--newtype Runtime a = Runtime-    { unRuntime :: ReaderT RuntimeEnvironment-        (StateT RuntimeState (ErrorT String IO)) a-    } deriving (Functor, Applicative, Monad)---- | Add a number of compilers and continue using these compilers----addNewCompilers :: [(Identifier (), Compiler () CompileRule)]-                -- ^ Compilers to add-                -> Runtime ()-addNewCompilers newCompilers = Runtime $ do-    -- Get some information-    logger <- hakyllLogger <$> ask-    section logger "Adding new compilers"-    provider <- hakyllResourceProvider <$> ask-    store <- hakyllStore <$> ask-    firstRun <- hakyllFirstRun <$> ask--    -- Old state information-    oldCompilers <- hakyllCompilers <$> get-    oldAnalyzer <- hakyllAnalyzer <$> get--    let -- All known compilers-        universe = M.keys oldCompilers ++ map fst newCompilers--        -- Create a new partial dependency graph-        dependencies = flip map newCompilers $ \(id', compiler) ->-            let deps = runCompilerDependencies compiler id' universe-            in (id', deps)--        -- Create the dependency graph-        newGraph = fromList dependencies--    -- Check which items have been modified-    modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $-        liftIO . resourceModified provider store . fromIdentifier-    let checkModified = if firstRun then const True else (`S.member` modified)--    -- Create a new analyzer and append it to the currect one-    let newAnalyzer = makeDependencyAnalyzer newGraph checkModified $-            analyzerPreviousGraph oldAnalyzer-        analyzer = mappend oldAnalyzer newAnalyzer--    -- Update the state-    put $ RuntimeState-        { hakyllAnalyzer  = analyzer-        , hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)-        }--    -- Continue-    unRuntime stepAnalyzer--stepAnalyzer :: Runtime ()-stepAnalyzer = Runtime $ do-    -- Step the analyzer-    state <- get-    let (signal, analyzer') = step $ hakyllAnalyzer state-    put $ state { hakyllAnalyzer = analyzer' }--    case signal of Done      -> return ()-                   Cycle c   -> unRuntime $ dumpCycle c-                   Build id' -> unRuntime $ build id'---- | Dump cyclic error and quit----dumpCycle :: [Identifier ()] -> Runtime ()-dumpCycle cycle' = Runtime $ do-    logger <- hakyllLogger <$> ask-    section logger "Dependency cycle detected! Conflict:"-    forM_ (zip cycle' $ drop 1 cycle') $ \(x, y) ->-        report logger $ show x ++ " -> " ++ show y--build :: Identifier () -> Runtime ()-build id' = Runtime $ do-    logger <- hakyllLogger <$> ask-    routes <- hakyllRoutes <$> ask-    provider <- hakyllResourceProvider <$> ask-    store <- hakyllStore <$> ask-    compilers <- hakyllCompilers <$> get--    section logger $ "Compiling " ++ show id'--    -- Fetch the right compiler from the map-    let compiler = compilers M.! id'--    -- Check if the resource was modified-    isModified <- liftIO $ resourceModified provider store $ fromIdentifier id'--    -- Run the compiler-    result <- timed logger "Total compile time" $ liftIO $-        runCompiler compiler id' provider (M.keys compilers) routes-                    store isModified logger--    case result of-        -- Compile rule for one item, easy stuff-        Right (CompileRule compiled) -> do-            case runRoutes routes id' of-                Nothing  -> return ()-                Just url -> timed logger ("Routing to " ++ url) $ do-                    destination <--                        destinationDirectory . hakyllConfiguration <$> ask-                    let path = destination </> url-                    liftIO $ makeDirectories path-                    liftIO $ write path compiled--            -- Continue for the remaining compilers-            unRuntime stepAnalyzer--        -- Metacompiler, slightly more complicated-        Right (MetaCompileRule newCompilers) ->-            -- Actually I was just kidding, it's not hard at all-            unRuntime $ addNewCompilers newCompilers--        -- Some error happened, rethrow in Runtime monad-        Left err -> throwError err
− src/Hakyll/Core/Store.hs 
@@ -1,155 +0,0 @@------------------------------------------------------------------------------------ | A store for storing and retreiving items-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE ScopedTypeVariables       #-}-module Hakyll.Core.Store-    ( Store-    , Result (..)-    , new-    , set-    , get-    , delete-    ) where------------------------------------------------------------------------------------import           Control.Applicative ((<$>))-import           Control.Exception   (IOException, handle)-import qualified Crypto.Hash.MD5     as MD5-import           Data.Binary         (Binary, decodeFile, encodeFile)-import qualified Data.ByteString     as B-import qualified Data.Cache.LRU.IO   as Lru-import           Data.List           (intercalate)-import qualified Data.Text           as T-import qualified Data.Text.Encoding  as T-import           Data.Typeable       (TypeRep, Typeable, cast, typeOf)-import           System.Directory    (createDirectoryIfMissing)-import           System.Directory    (doesFileExist, removeFile)-import           System.FilePath     ((</>))-import           Text.Printf         (printf)-------------------------------------------------------------------------------------- | Simple wrapper type-data Box = forall a. Typeable a => Box a------------------------------------------------------------------------------------data Store = Store-    { -- | All items are stored on the filesystem-      storeDirectory :: FilePath-    , -- | Optionally, items are also kept in-memory-      storeMap       :: Maybe (Lru.AtomicLRU FilePath Box)-    }-------------------------------------------------------------------------------------- | Result of a store query-data Result a-    = Found a                    -- ^ Found, result-    | NotFound                   -- ^ Not found-    | WrongType TypeRep TypeRep  -- ^ Expected, true type-    deriving (Show, Eq)-------------------------------------------------------------------------------------- | Initialize the store-new :: Bool      -- ^ Use in-memory caching-    -> FilePath  -- ^ Directory to use for hard disk storage-    -> IO Store  -- ^ Store-new inMemory directory = do-    createDirectoryIfMissing True directory-    ref <- if inMemory then Just <$> Lru.newAtomicLRU csize else return Nothing-    return Store-        { storeDirectory = directory-        , storeMap       = ref-        }-  where-    csize = Just 500-------------------------------------------------------------------------------------- | Auxiliary: add an item to the in-memory cache-cacheInsert :: Typeable a => Store -> String -> a -> IO ()-cacheInsert (Store _ Nothing)    _   _     = return ()-cacheInsert (Store _ (Just lru)) key x =-    Lru.insert key (Box x) lru-------------------------------------------------------------------------------------- | Auxiliary: get an item from the in-memory cache-cacheLookup :: forall a. Typeable a => Store -> String -> IO (Result a)-cacheLookup (Store _ Nothing)    _   = return NotFound-cacheLookup (Store _ (Just lru)) key = do-    res <- Lru.lookup key lru-    return $ case res of-        Nothing      -> NotFound-        Just (Box x) -> case cast x of-            Just x' -> Found x'-            Nothing -> WrongType (typeOf (undefined :: a)) (typeOf x)-------------------------------------------------------------------------------------- | Auxiliary: delete an item from the in-memory cache-cacheDelete :: Store -> String -> IO ()-cacheDelete (Store _ Nothing)    _   = return ()-cacheDelete (Store _ (Just lru)) key = do-    _ <- Lru.delete key lru-    return ()-------------------------------------------------------------------------------------- | Store an item-set :: (Binary a, Typeable a) => Store -> [String] -> a -> IO ()-set store identifier value = do-    encodeFile (storeDirectory store </> key) value-    cacheInsert store key value-  where-    key = hash identifier-------------------------------------------------------------------------------------- | Load an item-get :: (Binary a, Typeable a) => Store -> [String] -> IO (Result a)-get store identifier = do-    -- First check the in-memory map-    ref <- cacheLookup store key-    case ref of-        -- Not found in the map, try the filesystem-        NotFound -> do-            exists <- doesFileExist path-            if not exists-                -- Not found in the filesystem either-                then return NotFound-                -- Found in the filesystem-                else do-                    v <- decodeFile path-                    cacheInsert store key v-                    return $ Found v-        -- Found in the in-memory map (or wrong type), just return-        s -> return s-  where-    key  = hash identifier-    path = storeDirectory store </> key-------------------------------------------------------------------------------------- | Delete an item-delete :: Store -> [String] -> IO ()-delete store identifier = do-    cacheDelete store key-    deleteFile $ storeDirectory store </> key-  where-    key  = hash identifier------------------------------------------------------------------------------------hash :: [String] -> String-hash = concatMap (printf "%02x") . B.unpack .-    MD5.hash . T.encodeUtf8 . T.pack . intercalate "/"-------------------------------------------------------------------------------------- | Delete a file unless it doesn't exist...-deleteFile :: FilePath -> IO ()-deleteFile = handle (\(_ :: IOException) -> return ()) . removeFile
− src/Hakyll/Core/UnixFilter.hs 
@@ -1,94 +0,0 @@--- | A Compiler that supports unix filters.----module Hakyll.Core.UnixFilter-    ( unixFilter-    , unixFilterLBS-    ) where--import Control.Concurrent (forkIO)-import System.Process-import System.IO ( Handle, hPutStr, hClose, hGetContents-                 , hSetEncoding, localeEncoding-                 )--import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString.Lazy as LB--import Hakyll.Core.Compiler---- | Use a unix filter as compiler. For example, we could use the 'rev' program--- as a compiler.------ > rev :: Compiler Resource String--- > rev = getResourceString >>> unixFilter "rev" []------ A more realistic example: one can use this to call, for example, the sass--- compiler on CSS files. More information about sass can be found here:------ <http://sass-lang.com/>------ The code is fairly straightforward, given that we use @.scss@ for sass:------ > match "style.scss" $ do--- >     route   $ setExtension "css"--- >     compile $ getResourceString >>> unixFilter "sass" ["-s", "--scss"]--- >                                 >>> arr compressCss----unixFilter :: String                  -- ^ Program name-           -> [String]                -- ^ Program args-           -> Compiler String String  -- ^ Resulting compiler-unixFilter = unixFilterWith writer reader-  where-    writer handle input = do-        hSetEncoding handle localeEncoding-        hPutStr handle input-    reader handle = do-        hSetEncoding handle localeEncoding-        hGetContents handle---- | Variant of 'unixFilter' that should be used for binary files------ > match "music.wav" $ do--- >     route   $ setExtension "ogg"--- >     compile $ getResourceLBS >>> unixFilter "oggenc" ["-"]----unixFilterLBS :: String                          -- ^ Program name-              -> [String]                        -- ^ Program args-              -> Compiler ByteString ByteString  -- ^ Resulting compiler-unixFilterLBS = unixFilterWith LB.hPutStr LB.hGetContents---- | Overloaded compiler----unixFilterWith :: (Handle -> i -> IO ())  -- ^ Writer-               -> (Handle -> IO o)        -- ^ Reader-               -> String                  -- ^ Program name-               -> [String]                -- ^ Program args-               -> Compiler i o            -- ^ Resulting compiler-unixFilterWith writer reader programName args =-    timedCompiler ("Executing external program " ++ programName) $-        unsafeCompiler $ unixFilterIO writer reader programName args---- | Internally used function----unixFilterIO :: (Handle -> i -> IO ())-             -> (Handle -> IO o)-             -> String-             -> [String]-             -> i-             -> IO o-unixFilterIO writer reader programName args input = do-    let process = (proc programName args)-                    { std_in = CreatePipe-                    , std_out = CreatePipe-                    , close_fds = True-                    }-    (Just stdinWriteHandle, Just stdoutReadHandle, _, _) <--        createProcess process--    -- Write the input to the child pipe-    _ <- forkIO $ do-        writer stdinWriteHandle input-        hClose stdinWriteHandle--    -- Receive the output from the child-    reader stdoutReadHandle
− src/Hakyll/Core/Util/Arrow.hs 
@@ -1,25 +0,0 @@--- | Various arrow utility functions----module Hakyll.Core.Util.Arrow-    ( constA-    , sequenceA-    , unitA-    ) where--import Control.Arrow (Arrow, (&&&), arr, (>>^))--constA :: Arrow a-       => c-       -> a b c-constA = arr . const--sequenceA :: Arrow a-          => [a b c]-          -> a b [c]-sequenceA = foldr reduce $ constA []-  where-    reduce xa la = xa &&& la >>^ arr (uncurry (:))--unitA :: Arrow a-      => a b ()-unitA = constA ()
− src/Hakyll/Core/Util/File.hs 
@@ -1,61 +0,0 @@--- | A module containing various file utility functions----module Hakyll.Core.Util.File-    ( makeDirectories-    , getRecursiveContents-    , isFileInternal-    ) where--import Control.Applicative ((<$>))-import Control.Monad (forM)-import Data.List (isPrefixOf)-import System.Directory ( createDirectoryIfMissing, doesDirectoryExist-                        , getDirectoryContents-                        )-import System.FilePath ( normalise, takeDirectory, splitPath-                       , dropTrailingPathSeparator, (</>)-                       )--import Hakyll.Core.Configuration---- | Given a path to a file, try to make the path writable by making---   all directories on the path.----makeDirectories :: FilePath -> IO ()-makeDirectories = createDirectoryIfMissing True . takeDirectory---- | Get all contents of a directory. Note that files starting with a dot (.)--- will be ignored.----getRecursiveContents :: Bool           -- ^ Include directories?-                     -> FilePath       -- ^ Directory to search-                     -> IO [FilePath]  -- ^ List of files found-getRecursiveContents includeDirs topdir = do-    topdirExists <- doesDirectoryExist topdir-    if not topdirExists-        then return []-        else do-            names <- filter isProper <$> getDirectoryContents topdir-            paths <- forM names $ \name -> do-                let path = normalise $ topdir </> name-                isDirectory <- doesDirectoryExist path-                if isDirectory then getRecursiveContents includeDirs path-                               else return [path]-            return $ if includeDirs then topdir : concat paths-                                    else concat paths-  where-    isProper = (`notElem` [".", ".."])---- | Check if a file is meant for Hakyll internal use, i.e. if it is located in--- the destination or store directory----isFileInternal :: HakyllConfiguration  -- ^ Configuration-               -> FilePath             -- ^ File to check-               -> Bool                 -- ^ If the given file is internal-isFileInternal configuration file =-    any (`isPrefixOf` split file) dirs-  where-    split = map dropTrailingPathSeparator . splitPath-    dirs = map (split . ($ configuration)) [ destinationDirectory-                                           , storeDirectory-                                           ]
− src/Hakyll/Core/Util/String.hs 
@@ -1,48 +0,0 @@--- | Miscellaneous string manipulation functions.----module Hakyll.Core.Util.String-    ( trim-    , replaceAll-    , splitAll-    ) where--import Data.Char (isSpace)-import Data.Maybe (listToMaybe)--import Text.Regex.TDFA ((=~~))---- | Trim a string (drop spaces, tabs and newlines at both sides).----trim :: String -> String-trim = reverse . trim' . reverse . trim'-  where-    trim' = dropWhile isSpace---- | A simple (but inefficient) regex replace funcion----replaceAll :: String              -- ^ Pattern-           -> (String -> String)  -- ^ Replacement (called on capture)-           -> String              -- ^ Source string-           -> String              -- ^ Result-replaceAll pattern f source = replaceAll' source-  where-    replaceAll' src = case listToMaybe (src =~~ pattern) of-        Nothing     -> src-        Just (o, l) ->-            let (before, tmp) = splitAt o src-                (capture, after) = splitAt l tmp-            in before ++ f capture ++ replaceAll' after---- | A simple regex split function. The resulting list will contain no empty--- strings.----splitAll :: String    -- ^ Pattern-         -> String    -- ^ String to split-         -> [String]  -- ^ Result-splitAll pattern = filter (not . null) . splitAll'-  where-    splitAll' src = case listToMaybe (src =~~ pattern) of-        Nothing     -> [src]-        Just (o, l) ->-            let (before, tmp) = splitAt o src-            in before : splitAll' (drop l tmp)
− src/Hakyll/Core/Writable.hs 
@@ -1,42 +0,0 @@--- | Describes writable items; items that can be saved to the disk----{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}-module Hakyll.Core.Writable-    ( Writable (..)-    ) where--import Data.Word (Word8)--import qualified Data.ByteString as SB-import qualified Data.ByteString.Lazy as LB-import Text.Blaze.Html (Html)-import Text.Blaze.Html.Renderer.String (renderHtml)--import Hakyll.Core.Identifier---- | Describes an item that can be saved to the disk----class Writable a where-    -- | Save an item to the given filepath-    write :: FilePath -> a -> IO ()--instance Writable () where-    write _ _ = return ()--instance Writable [Char] where-    write = writeFile--instance Writable SB.ByteString where-    write p = SB.writeFile p--instance Writable LB.ByteString where-    write p = LB.writeFile p--instance Writable [Word8] where-    write p = write p . SB.pack--instance Writable Html where-    write p html = write p $ renderHtml html--instance Writable (Identifier a) where-    write p = write p . show
− src/Hakyll/Core/Writable/CopyFile.hs 
@@ -1,29 +0,0 @@--- | Exports simple compilers to just copy files----{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}-module Hakyll.Core.Writable.CopyFile-    ( CopyFile (..)-    , copyFileCompiler-    ) where--import Control.Arrow ((>>^))-import System.Directory (copyFile)--import Data.Typeable (Typeable)-import Data.Binary (Binary)--import Hakyll.Core.Resource-import Hakyll.Core.Writable-import Hakyll.Core.Compiler-import Hakyll.Core.Identifier---- | Newtype construct around 'FilePath' which will copy the file directly----newtype CopyFile = CopyFile {unCopyFile :: FilePath}-                 deriving (Show, Eq, Ord, Binary, Typeable)--instance Writable CopyFile where-    write dst (CopyFile src) = copyFile src dst--copyFileCompiler :: Compiler Resource CopyFile-copyFileCompiler = getIdentifier >>^ CopyFile . toFilePath
− src/Hakyll/Core/Writable/WritableTuple.hs 
@@ -1,37 +0,0 @@--- | This module exposes a writable type 'WritableTuple' which is a simple--- newtype wrapper around a tuple.------ The idea is that, given a tuple @(a, b)@, @a@ is the value you actually want--- to save to the disk, and @b@ is some additional info that you /don't/ want to--- save, but that you need later, for example in a 'require' clause.----{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}-module Hakyll.Core.Writable.WritableTuple-    ( WritableTuple (..)-    , writableTupleFst-    , writableTupleSnd-    , writableTupleCompiler-    ) where--import Control.Arrow (arr)--import Data.Typeable (Typeable)-import Data.Binary (Binary)--import Hakyll.Core.Writable-import Hakyll.Core.Compiler--newtype WritableTuple a b = WritableTuple {unWritableTuple :: (a, b)}-                          deriving (Show, Eq, Ord, Binary, Typeable)--instance Writable a => Writable (WritableTuple a b) where-    write dst (WritableTuple (x, _)) = write dst x--writableTupleFst :: WritableTuple a b -> a-writableTupleFst = fst . unWritableTuple--writableTupleSnd :: WritableTuple a b -> b-writableTupleSnd = snd . unWritableTuple--writableTupleCompiler :: Compiler (a, b) (WritableTuple a b)-writableTupleCompiler = arr WritableTuple
− src/Hakyll/Main.hs 
@@ -1,153 +0,0 @@--- | Module providing the main hakyll function and command-line argument parsing----{-# LANGUAGE CPP #-}-module Hakyll.Main-    ( hakyll-    , hakyllWith-    ) where--import Control.Monad (when)-import System.Directory (doesDirectoryExist, removeDirectoryRecursive)-import System.Environment (getProgName, getArgs)-import System.Process (system)--import Hakyll.Core.Configuration-import Hakyll.Core.Run-import Hakyll.Core.Rules--#ifdef PREVIEW_SERVER-import Control.Applicative ((<$>))-import Control.Concurrent (forkIO)-import qualified Data.Set as S--import Hakyll.Core.Resource-import Hakyll.Core.Rules.Internal-import Hakyll.Web.Preview.Poll-import Hakyll.Web.Preview.Server-#endif---- | This usualy is the function with which the user runs the hakyll compiler----hakyll :: RulesM a -> IO ()-hakyll = hakyllWith defaultHakyllConfiguration---- | A variant of 'hakyll' which allows the user to specify a custom--- configuration----hakyllWith :: HakyllConfiguration -> RulesM a -> IO ()-hakyllWith conf rules = do-    args <- getArgs-    case args of-        ["build"]      -> build conf rules-        ["clean"]      -> clean conf-        ["help"]       -> help-        ["preview"]    -> preview conf rules 8000-        ["preview", p] -> preview conf rules (read p)-        ["rebuild"]    -> rebuild conf rules-        ["server"]     -> server conf 8000-        ["server", p]  -> server conf (read p)-        ["deploy"]     -> deploy conf-        _              -> help---- | Build the site----build :: HakyllConfiguration -> RulesM a -> IO ()-build conf rules = do-    _ <- run conf rules-    return ()---- | Remove the output directories----clean :: HakyllConfiguration -> IO ()-clean conf = do-    remove $ destinationDirectory conf-    remove $ storeDirectory conf-  where-    remove dir = do-        putStrLn $ "Removing " ++ dir ++ "..."-        exists <- doesDirectoryExist dir-        when exists $ removeDirectoryRecursive dir---- | Show usage information.----help :: IO ()-help = do-    name <- getProgName-    mapM_ putStrLn-        [ "ABOUT"-        , ""-        , "This is a Hakyll site generator program. You should always"-        , "run it from the project root directory."-        , ""-        , "USAGE"-        , ""-        , name ++ " build           Generate the site"-        , name ++ " clean           Clean up and remove cache"-        , name ++ " help            Show this message"-        , name ++ " preview [port]  Run a server and autocompile"-        , name ++ " rebuild         Clean up and build again"-        , name ++ " server [port]   Run a local test server"-        , name ++ " deploy          Upload/deploy your site"-        , ""-        ]--#ifndef PREVIEW_SERVER-    previewServerDisabled-#endif---- | Preview the site----preview :: HakyllConfiguration -> RulesM a -> Int -> IO ()-#ifdef PREVIEW_SERVER-preview conf rules port = do-    -- Fork a thread polling for changes-    _ <- forkIO $ previewPoll conf update-    -    -- Run the server in the main thread-    server conf port-  where-    update = map unResource . S.toList . rulesResources <$> run conf rules-#else-preview _ _ _ = previewServerDisabled-#endif---- | Rebuild the site----rebuild :: HakyllConfiguration -> RulesM a -> IO ()-rebuild conf rules = do-    clean conf-    build conf rules---- | Start a server----server :: HakyllConfiguration -> Int -> IO ()-#ifdef PREVIEW_SERVER-server conf port = do-    let destination = destinationDirectory conf-    staticServer destination preServeHook port-  where-    preServeHook _ = return ()-#else-server _ _ = previewServerDisabled-#endif---- | Upload the site----deploy :: HakyllConfiguration -> IO ()-deploy conf = do-    _ <- system $ deployCommand conf-    return ()---- | Print a warning message about the preview serving not being enabled----#ifndef PREVIEW_SERVER-previewServerDisabled :: IO ()-previewServerDisabled =-    mapM_ putStrLn-        [ "PREVIEW SERVER"-        , ""-        , "The preview server is not enabled in the version of Hakyll. To"-        , "enable it, set the flag to True and recompile Hakyll."-        , "Alternatively, use an external tool to serve your site directory."-        ]-#endif
− src/Hakyll/Web/Blaze.hs 
@@ -1,35 +0,0 @@--- | Module providing BlazeHtml support for hakyll----module Hakyll.Web.Blaze-    ( getFieldHtml-    , getFieldHtml'-    , getBodyHtml-    , getBodyHtml'-    ) where--import Text.Blaze.Html (Html, toHtml)-import Text.Blaze.Internal (preEscapedString)--import Hakyll.Web.Page-import Hakyll.Web.Page.Metadata---- | Get a field from a page and convert it to HTML. This version does not--- escape the given HTML----getFieldHtml :: String -> Page a -> Html-getFieldHtml key = preEscapedString . getField key---- | Version of 'getFieldHtml' that escapes the HTML content----getFieldHtml' :: String -> Page a -> Html-getFieldHtml' key = toHtml . getField key---- | Get the body as HTML----getBodyHtml :: Page String -> Html-getBodyHtml = preEscapedString . pageBody---- | Version of 'getBodyHtml' that escapes the HTML content----getBodyHtml' :: Page String -> Html-getBodyHtml' = toHtml . pageBody
− src/Hakyll/Web/CompressCss.hs 
@@ -1,51 +0,0 @@--- | Module used for CSS compression. The compression is currently in a simple--- state, but would typically reduce the number of bytes by about 25%.----module Hakyll.Web.CompressCss-    ( compressCssCompiler-    , compressCss-    ) where--import Data.Char (isSpace)-import Data.List (isPrefixOf)-import Control.Arrow ((>>^))--import Hakyll.Core.Compiler-import Hakyll.Core.Resource-import Hakyll.Core.Util.String---- | Compiler form of 'compressCss'----compressCssCompiler :: Compiler Resource String-compressCssCompiler = getResourceString >>^ compressCss---- | Compress CSS to speed up your site.----compressCss :: String -> String-compressCss = compressSeparators-            . stripComments-            . compressWhitespace---- | Compresses certain forms of separators.----compressSeparators :: String -> String-compressSeparators = replaceAll "; *}" (const "}")-                   . replaceAll " *([{};:]) *" (take 1 . dropWhile isSpace)-                   . replaceAll ";+" (const ";")---- | Compresses all whitespace.----compressWhitespace :: String -> String-compressWhitespace = replaceAll "[ \t\n\r]+" (const " ")---- | Function that strips CSS comments away.----stripComments :: String -> String-stripComments [] = []-stripComments str-    | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str-    | otherwise = head str : stripComments (drop 1 str)-  where-    eatComments str' | null str' = []-                     | isPrefixOf "*/" str' = drop 2 str'-                     | otherwise = eatComments $ drop 1 str'
− src/Hakyll/Web/Feed.hs 
@@ -1,133 +0,0 @@--- | A Module that allows easy rendering of RSS feeds.------ The main rendering functions (@renderRss@, @renderAtom@) all assume that--- you pass the list of items so that the most recent entry in the feed is the--- first item in the list.------ Also note that the pages should have (at least) the following fields to--- produce a correct feed:------ - @$title$@: Title of the item------ - @$description$@: Description to appear in the feed------ - @$url$@: URL to the item - this is usually set automatically.------ In addition, the posts should be named according to the rules for--- 'Hakyll.Page.Metadata.renderDateField'.----module Hakyll.Web.Feed-    ( FeedConfiguration (..)-    , renderRss-    , renderAtom-    ) where--import Prelude hiding (id)-import Control.Category (id)-import Control.Arrow ((>>>), arr, (&&&))-import Control.Monad ((<=<))-import Data.Maybe (fromMaybe, listToMaybe)--import Hakyll.Core.Compiler-import Hakyll.Web.Page-import Hakyll.Web.Page.Metadata-import Hakyll.Web.Template-import Hakyll.Web.Template.Read.Hakyll (readTemplate)-import Hakyll.Web.Urls--import Paths_hakyll---- | This is a data structure to keep the configuration of a feed.-data FeedConfiguration = FeedConfiguration-    { -- | Title of the feed.-      feedTitle       :: String-    , -- | Description of the feed.-      feedDescription :: String-    , -- | Name of the feed author.-      feedAuthorName  :: String-    , -- | Email of the feed author.-      feedAuthorEmail :: String-    , -- | Absolute root URL of the feed site (e.g. @http://jaspervdj.be@)-      feedRoot        :: String-    } deriving (Show, Eq)---- | This is an auxiliary function to create a listing that is, in fact, a feed.--- The items should be sorted on date. The @$updated@ field should be set for--- each item.----createFeed :: Template           -- ^ Feed template-           -> Template           -- ^ Item template-           -> String             -- ^ URL of the feed-           -> FeedConfiguration  -- ^ Feed configuration-           -> [Page String]      -- ^ Items to include-           -> String             -- ^ Resulting feed-createFeed feedTemplate itemTemplate url configuration items =-    pageBody $ applyTemplate feedTemplate-             $ trySetField "updated"     updated-             $ trySetField "title"       (feedTitle configuration)-             $ trySetField "description" (feedDescription configuration)-             $ trySetField "authorName"  (feedAuthorName configuration)-             $ trySetField "authorEmail" (feedAuthorEmail configuration)-             $ trySetField "root"        (feedRoot configuration)-             $ trySetField "url"         url-             $ fromBody body-  where-    -- Preprocess items-    items' = flip map items $ applyTemplate itemTemplate-                            . trySetField "root" (feedRoot configuration)--    -- Body: concatenated items-    body = concat $ map pageBody items'--    -- Take the first updated, which should be the most recent-    updated = fromMaybe "Unknown" $ do-        p <- listToMaybe items-        return $ getField "updated" p----- | Abstract function to render any feed.----renderFeed :: FilePath                       -- ^ Feed template-           -> FilePath                       -- ^ Item template-           -> FeedConfiguration              -- ^ Feed configuration-           -> Compiler [Page String] String  -- ^ Feed compiler-renderFeed feedTemplate itemTemplate configuration =-    id &&& getRoute >>> renderFeed'-  where-    -- Arrow rendering the feed from the items and the URL-    renderFeed' = unsafeCompiler $ \(items, url) -> do-        feedTemplate' <- loadTemplate feedTemplate-        itemTemplate' <- loadTemplate itemTemplate-        let url' = toUrl $ fromMaybe noUrl url-        return $ createFeed feedTemplate' itemTemplate' url' configuration items--    -- Auxiliary: load a template from a datafile-    loadTemplate = fmap readTemplate . readFile <=< getDataFileName--    -- URL is required to have a valid field-    noUrl = error "Hakyll.Web.Feed.renderFeed: no route specified"---- | Render an RSS feed with a number of items.----renderRss :: FeedConfiguration              -- ^ Feed configuration-          -> Compiler [Page String] String  -- ^ Feed compiler-renderRss configuration = arr (map (addUpdated . renderDate))-    >>> renderFeed "templates/rss.xml" "templates/rss-item.xml" configuration-  where-    renderDate = renderDateField "published" "%a, %d %b %Y %H:%M:%S UT"-                                 "No date found."---- | Render an Atom feed with a number of items.----renderAtom :: FeedConfiguration              -- ^ Feed configuration-           -> Compiler [Page String] String  -- ^ Feed compiler-renderAtom configuration = arr (map (addUpdated . renderDate))-    >>> renderFeed "templates/atom.xml" "templates/atom-item.xml" configuration-  where-    renderDate = renderDateField "published" "%Y-%m-%dT%H:%M:%SZ"-                                 "No date found."---- | Copies @$updated$@ from @$published$@ if it is not already set.----addUpdated :: Page a -> Page a-addUpdated page = trySetField "updated" (getField "published" page) page
− src/Hakyll/Web/Page.hs 
@@ -1,156 +0,0 @@--- | A page is a key-value mapping, representing a page on your site------ A page is an important concept in Hakyll. It is a key-value mapping, and has--- one field with an arbitrary type. A 'Page' thus consists of------ * metadata (of the type @Map String String@);------ * the actual value (of the type @a@).------ Usually, the value will be a 'String' as well, and the value will be the body--- of the page.------ However, this is certainly no restriction. For example, @Page ByteString@--- could be used to represent a binary item (e.g. an image) and some metadata.------ Pages can be constructed using Haskell, but they are usually parsed from a--- file. The file format for pages is pretty straightforward.------ > This is a simple page--- > consisting of two lines.------ This is a valid page with two lines. If we load this in Hakyll, there would--- be no metadata, and the body would be the given text. Let's look at a page--- with some metadata:------ > ------ > title: Alice's Adventures in Wonderland--- > author: Lewis Caroll--- > year: 1865--- > ------ >--- > Chapter I--- > =========--- >--- > Down the Rabbit-Hole--- > ----------------------- >--- > Alice was beginning to get very tired of sitting by her sister on the bank,--- > and of having nothing to do: once or twice she had peeped into the book her--- > sister was reading, but it had no pictures or conversations in it, "and--- > what is the use of a book," thought Alice "without pictures or--- > conversation?"--- >--- > ...------ As you can see, we construct a metadata header in Hakyll using @---@. Then,--- we simply list all @key: value@ pairs, and end with @---@ again. This page--- contains three metadata fields and a body. The body is given in markdown--- format, which can be easily rendered to HTML by Hakyll, using pandoc.----{-# LANGUAGE DeriveDataTypeable #-}-module Hakyll.Web.Page-    ( Page (..)-    , fromBody-    , fromMap-    , toMap-    , readPageCompiler-    , pageCompiler-    , pageCompilerWith-    , pageCompilerWithPandoc-    , pageCompilerWithFields-    , addDefaultFields-    ) where--import Prelude hiding (id)-import Control.Category (id)-import Control.Arrow (arr, (>>^), (&&&), (>>>))-import System.FilePath (takeBaseName, takeDirectory)-import qualified Data.Map as M--import Text.Pandoc (Pandoc, ParserState, WriterOptions)--import Hakyll.Core.Identifier-import Hakyll.Core.Compiler-import Hakyll.Core.Resource-import Hakyll.Web.Page.Internal-import Hakyll.Web.Page.Read-import Hakyll.Web.Page.Metadata-import Hakyll.Web.Pandoc-import Hakyll.Web.Template-import Hakyll.Web.Urls---- | Create a page from a body, without metadata----fromBody :: a -> Page a-fromBody = Page M.empty---- | Read a page (do not render it)----readPageCompiler :: Compiler Resource (Page String)-readPageCompiler = getResourceString >>^ readPage---- | Read a page, add default fields, substitute fields and render using pandoc----pageCompiler :: Compiler Resource (Page String)-pageCompiler =-    pageCompilerWith defaultHakyllParserState defaultHakyllWriterOptions---- | A version of 'pageCompiler' which allows you to specify your own pandoc--- options----pageCompilerWith :: ParserState -> WriterOptions-                 -> Compiler Resource (Page String)-pageCompilerWith state options = pageCompilerWithPandoc state options id---- | An extension of 'pageCompilerWith' which allows you to specify a custom--- pandoc transformer for the content----pageCompilerWithPandoc :: ParserState -> WriterOptions-                       -> (Pandoc -> Pandoc)-                       -> Compiler Resource (Page String)-pageCompilerWithPandoc state options f = cached cacheName $-    readPageCompiler >>> addDefaultFields >>> arr applySelf-                     >>> pageReadPandocWith state-                     >>> arr (fmap (writePandocWith options . f))-  where-    cacheName = "Hakyll.Web.Page.pageCompilerWithPandoc"---- | This is another, even more advanced version of 'pageCompilerWithPandoc'.--- This function allows you to provide an arrow which is applied before the--- fields in a page are rendered. This means you can use this extra customizable--- stage to add custom fields which are inserted in the page.----pageCompilerWithFields :: ParserState -> WriterOptions-                       -> (Pandoc -> Pandoc)-                       -> Compiler (Page String) (Page String)-                       -> Compiler Resource (Page String)-pageCompilerWithFields state options f g =-    readPageCompiler >>> addDefaultFields >>> g >>> arr applySelf-                     >>> pageReadPandocWith state-                     >>> arr (fmap (writePandocWith options . f))---- | Add a number of default metadata fields to a page. These fields include:------ * @$url$@------ * @$category$@------ * @$title$@------ * @$path$@----addDefaultFields :: Compiler (Page a) (Page a)-addDefaultFields =   (getRoute &&& id >>^ uncurry addRoute)-                 >>> (getIdentifier &&& id >>^ uncurry addIdentifier)-  where-    -- Add root and url, based on route-    addRoute Nothing  = id-    addRoute (Just r) = trySetField "url" (toUrl r)--    -- Add title and category, based on identifier-    addIdentifier i = trySetField "title" (takeBaseName p)-                    . trySetField "category" (takeBaseName $ takeDirectory p)-                    . trySetField "path" p-      where-        p = toFilePath i
− src/Hakyll/Web/Page/Internal.hs 
@@ -1,50 +0,0 @@--- | Internal representation of the page datatype----{-# LANGUAGE DeriveDataTypeable #-}-module Hakyll.Web.Page.Internal-    ( Page (..)-    , fromMap-    , toMap-    ) where--import Control.Applicative ((<$>), (<*>))-import Data.Monoid (Monoid, mempty, mappend)--import Data.Map (Map)-import Data.Binary (Binary, get, put)-import Data.Typeable (Typeable)-import qualified Data.Map as M--import Hakyll.Core.Writable---- | Type used to represent pages----data Page a = Page-    { pageMetadata :: Map String String-    , pageBody     :: a-    } deriving (Eq, Show, Typeable)--instance Monoid a => Monoid (Page a) where-    mempty = Page M.empty mempty-    mappend (Page m1 b1) (Page m2 b2) =-        Page (M.union m1 m2) (mappend b1 b2)--instance Functor Page where-    fmap f (Page m b) = Page m (f b)--instance Binary a => Binary (Page a) where-    put (Page m b) = put m >> put b-    get = Page <$> get <*> get--instance Writable a => Writable (Page a) where-    write p (Page _ b) = write p b---- | Create a metadata page, without a body----fromMap :: Monoid a => Map String String -> Page a-fromMap m = Page m mempty---- | Convert a page to a map. The body will be placed in the @body@ key.----toMap :: Page String -> Map String String-toMap (Page m b) = M.insert "body" b m
− src/Hakyll/Web/Page/List.hs 
@@ -1,82 +0,0 @@--- | Provides an easy way to combine several pages in a list. The applications--- are obvious:------ * A post list on a blog------ * An image list in a gallery------ * A sitemap----module Hakyll.Web.Page.List-    ( setFieldPageList-    , pageListCompiler-    , chronological-    , recentFirst-    , sortByBaseName-    ) where--import Control.Arrow ((>>>), arr)-import Data.List (sortBy)-import Data.Monoid (Monoid, mconcat)-import Data.Ord (comparing)-import System.FilePath (takeBaseName)--import Hakyll.Core.Compiler-import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import Hakyll.Web.Page-import Hakyll.Web.Page.Metadata-import Hakyll.Web.Template---- | Set a field of a page to a listing of pages----setFieldPageList :: ([Page String] -> [Page String])  -                 -- ^ Determines list order-                 -> Identifier Template               -                 -- ^ Applied to every page-                 -> String-                 -- ^ Key indicating which field should be set-                 -> Pattern (Page String)             -                 -- ^ Selects pages to include in the list-                 -> Compiler (Page String) (Page String)-                 -- ^ Compiler that sets the page list in a field-setFieldPageList sort template key pattern =-    requireAllA pattern $ setFieldA key $ pageListCompiler sort template---- | Create a list of pages----pageListCompiler :: ([Page String] -> [Page String])  -- ^ Determine list order-                 -> Identifier Template               -- ^ Applied to pages-                 -> Compiler [Page String] String     -- ^ Compiles page list-pageListCompiler sort template =-    arr sort >>> applyTemplateToList template >>> arr concatPages---- | Apply a template to every page in a list----applyTemplateToList :: Identifier Template-                    -> Compiler [Page String] [Page String]-applyTemplateToList identifier =-    require identifier $ \posts template -> map (applyTemplate template) posts---- | Concatenate the bodies of a page list----concatPages :: Monoid m => [Page m] -> m-concatPages = mconcat . map pageBody---- | Sort pages chronologically. This function assumes that the pages have a--- @year-month-day-title.extension@ naming scheme -- as is the convention in--- Hakyll.----chronological :: [Page a] -> [Page a]-chronological = sortBy $ comparing $ takeBaseName . getField "path"---- | The reverse of 'chronological'----recentFirst :: [Page a] -> [Page a]-recentFirst = reverse . chronological---- | Deprecated, see 'chronological'----sortByBaseName :: [Page a] -> [Page a]-sortByBaseName = chronological-{-# DEPRECATED sortByBaseName "Use chronological" #-}
− src/Hakyll/Web/Page/Metadata.hs 
@@ -1,235 +0,0 @@--- | Provides various functions to manipulate the metadata fields of a page----module Hakyll.Web.Page.Metadata-    ( getField-    , getFieldMaybe-    , setField-    , trySetField-    , setFieldA-    , setFieldPage-    , renderField-    , changeField-    , copyField-    , renderDateField-    , renderDateFieldWith-    , renderModificationTime-    , renderModificationTimeWith-    , copyBodyToField-    , copyBodyFromField-    , comparePagesByDate-    ) where--import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))-import Control.Category (id)-import Control.Monad (msum)-import Data.List (intercalate)-import Data.Maybe (fromMaybe)-import Data.Ord (comparing)-import Prelude hiding (id)-import System.FilePath (takeFileName)-import System.Locale (TimeLocale, defaultTimeLocale)-import qualified Data.Map as M--import Data.Time.Calendar (Day (..))-import Data.Time.Clock (UTCTime (..))-import Data.Time.Format (parseTime, formatTime)--import Hakyll.Web.Page.Internal-import Hakyll.Core.Util.String-import Hakyll.Core.Identifier-import Hakyll.Core.Compiler-import Hakyll.Core.Resource.Provider---- | Get a metadata field. If the field does not exist, the empty string is--- returned.----getField :: String  -- ^ Key-         -> Page a  -- ^ Page-         -> String  -- ^ Value-getField key = fromMaybe "" . getFieldMaybe key---- | Get a field in a 'Maybe' wrapper----getFieldMaybe :: String        -- ^ Key-              -> Page a        -- ^ Page-              -> Maybe String  -- ^ Value, if found-getFieldMaybe key = M.lookup key . pageMetadata---- | Version of 'trySetField' which overrides any previous value----setField :: String  -- ^ Key-         -> String  -- ^ Value-         -> Page a  -- ^ Page to add it to-         -> Page a  -- ^ Resulting page-setField k v (Page m b) = Page (M.insert k v m) b---- | Add a metadata field. If the field already exists, it is not overwritten.----trySetField :: String  -- ^ Key-            -> String  -- ^ Value-            -> Page a  -- ^ Page to add it to-            -> Page a  -- ^ Resulting page-trySetField k v (Page m b) = Page (M.insertWith (flip const) k v m) b---- | Arrow-based variant of 'setField'. Because of it's type, this function is--- very usable together with the different 'require' functions.----setFieldA :: Arrow a-          => String                  -- ^ Key-          -> a x String              -- ^ Value arrow-          -> a (Page b, x) (Page b)  -- ^ Resulting arrow-setFieldA k v = id *** v >>> arr (uncurry $ flip $ setField k)---- | Set a field of a page to the contents of another page----setFieldPage :: String                      -- ^ Key to add the page under-             -> Identifier (Page String)    -- ^ Page to add-             -> Compiler (Page a) (Page a)  -- ^ Page compiler-setFieldPage key page = id &&& require_ page >>> setFieldA key (arr pageBody)---- | Do something with a metadata value, but keep the old value as well. If the--- key given is not present in the metadata, nothing will happen. If the source--- and destination keys are the same, the value will be changed (but you should--- use 'changeField' for this purpose).----renderField :: String              -- ^ Key of which the value should be copied-            -> String              -- ^ Key the value should be copied to-            -> (String -> String)  -- ^ Function to apply on the value-            -> Page a              -- ^ Page on which this should be applied-            -> Page a              -- ^ Resulting page-renderField src dst f page = case M.lookup src (pageMetadata page) of-    Nothing    -> page-    Just value -> setField dst (f value) page---- | Change a metadata value.------ > import Data.Char (toUpper)--- > changeField "title" (map toUpper)------ Will put the title in UPPERCASE.----changeField :: String              -- ^ Key to change.-            -> (String -> String)  -- ^ Function to apply on the value.-            -> Page a              -- ^ Page to change-            -> Page a              -- ^ Resulting page-changeField key = renderField key key---- | Make a copy of a metadata field (put the value belonging to a certain key--- under some other key as well)----copyField :: String  -- ^ Key to copy-          -> String  -- ^ Destination to copy to-          -> Page a  -- ^ Page on which this should be applied-          -> Page a  -- ^ Resulting page-copyField src dst = renderField src dst id---- | When the metadata has a field called @published@ in one of the--- following formats then this function can render the date.------   * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)------   * @2000-02-01T13:00:00Z@ (Atom date format)------   * @February 1, 2000 1:00 PM@ (PM is usually uppercase)------   * @February 1, 2000@ (assumes 12:00 AM for the time)------ Alternatively, when the metadata has a field called @path@ in a--- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages)--- and no @published@ metadata field set, this function can render--- the date.------ > renderDateField "date" "%B %e, %Y" "Date unknown"------ Will render something like @January 32, 2010@.----renderDateField :: String  -- ^ Key in which the rendered date should be placed-                -> String  -- ^ Format to use on the date-                -> String  -- ^ Default value, in case the date cannot be parsed-                -> Page a  -- ^ Page on which this should be applied-                -> Page a  -- ^ Resulting page-renderDateField = renderDateFieldWith defaultTimeLocale---- | This is an extended version of 'renderDateField' that allows you to--- specify a time locale that is used for outputting the date. For more--- details, see 'renderDateField'.----renderDateFieldWith :: TimeLocale  -- ^ Output time locale-                    -> String      -- ^ Destination key-                    -> String      -- ^ Format to use on the date-                    -> String      -- ^ Default value-                    -> Page a      -- ^ Target page-                    -> Page a      -- ^ Resulting page-renderDateFieldWith locale key format defaultValue page =-    setField key renderTimeString page-  where-    renderTimeString = fromMaybe defaultValue $ do-        time <- getUTCMaybe locale page-        return $ formatTime locale format time---- | Parser to try to extract and parse the time from the @published@--- field or from the filename. See 'renderDateField' for more information.-getUTCMaybe :: TimeLocale     -- ^ Output time locale-            -> Page a         -- ^ Input page-            -> Maybe UTCTime  -- ^ Parsed UTCTime-getUTCMaybe locale page = msum $-    [fromField "published" fmt | fmt <- formats] ++-    [fromField "date"      fmt | fmt <- formats] ++-    [ getFieldMaybe "path" page >>= parseTime' "%Y-%m-%d" .-        intercalate "-" . take 3 . splitAll "-" . takeFileName-    ]-  where-    parseTime' f str = parseTime locale f str-    fromField k fmt  = getFieldMaybe k page >>= parseTime' fmt--    formats =-        [ "%a, %d %b %Y %H:%M:%S UT"-        , "%Y-%m-%dT%H:%M:%SZ"-        , "%Y-%m-%d %H:%M:%S"-        , "%Y-%m-%d"-        , "%B %e, %Y %l:%M %p"-        , "%B %e, %Y"-        ]---- | Set the modification time as a field in the page-renderModificationTime :: String-                       -- ^ Destination key-                       -> String-                       -- ^ Format to use on the time-                       -> Compiler (Page String) (Page String)-                       -- ^ Resulting compiler-renderModificationTime = renderModificationTimeWith defaultTimeLocale--renderModificationTimeWith :: TimeLocale-                           -- ^ Output time locale-                           -> String-                           -- ^ Destination key-                           -> String-                           -- ^ Format to use on the time-                           -> Compiler (Page String) (Page String)-                           -- ^ Resulting compiler-renderModificationTimeWith locale key format =-    id &&& (getResource >>> getResourceWith resourceModificationTime) >>>-    setFieldA key (arr (formatTime locale format))---- | Copy the body of a page to a metadata field----copyBodyToField :: String       -- ^ Destination key-                -> Page String  -- ^ Target page-                -> Page String  -- ^ Resulting page-copyBodyToField key page = setField key (pageBody page) page---- | Copy a metadata field to the page body----copyBodyFromField :: String       -- ^ Source key-                  -> Page String  -- ^ Target page-                  -> Page String  -- ^ Resulting page-copyBodyFromField key page = fmap (const $ getField key page) page---- | Compare pages by the date and time parsed as in 'renderDateField',--- where 'LT' implies earlier, and 'GT' implies later. For more details,--- see 'renderDateField'.-comparePagesByDate :: Page a -> Page a -> Ordering-comparePagesByDate = comparing $ fromMaybe zero . getUTCMaybe defaultTimeLocale-  where-    zero = UTCTime (ModifiedJulianDay 0) 0
− src/Hakyll/Web/Page/Read.hs 
@@ -1,61 +0,0 @@--- | Module providing a function to parse a page from a file----module Hakyll.Web.Page.Read-    ( readPage-    ) where--import Control.Applicative ((<$>), (<*>), (<*), (<|>))-import qualified Data.Map as M--import Text.Parsec.Char (alphaNum, anyChar, char, oneOf, string)-import Text.Parsec.Combinator (choice, many1, manyTill, option, skipMany1)-import Text.Parsec.Prim (many, parse, skipMany, (<?>))-import Text.Parsec.String (Parser)--import Hakyll.Core.Util.String-import Hakyll.Web.Page.Internal---- | Space or tab, no newline-inlineSpace :: Parser Char-inlineSpace = oneOf ['\t', ' '] <?> "space"---- | Parse Windows newlines as well (i.e. "\n" or "\r\n")-newline :: Parser String-newline = string "\n"   -- Unix-      <|> string "\r\n" -- DOS---- | Parse a single metadata field----metadataField :: Parser (String, String)-metadataField = do-    key <- manyTill alphaNum $ char ':'-    skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key-    value <- manyTill anyChar newline-    trailing' <- many trailing-    return (key, trim $ value ++ concat trailing')-  where-    trailing = (++) <$> many1 inlineSpace <*> manyTill anyChar newline---- | Parse a metadata block, including delimiters and trailing newlines----metadata :: Parser [(String, String)]-metadata = do-    open <- many1 (char '-') <* many inlineSpace <* newline-    metadata' <- many metadataField-    _ <- choice $ map (string . replicate (length open)) ['-', '.']-    skipMany inlineSpace-    skipMany1 newline-    return metadata'---- | Parse a Hakyll page----page :: Parser ([(String, String)], String)-page = do-    metadata' <- option [] metadata-    body <- many anyChar-    return (metadata', body)--readPage :: String -> Page String-readPage input = case parse page "page" input of-    Left err      -> error (show err)-    Right (md, b) -> Page (M.fromList md) b
− src/Hakyll/Web/Pandoc.hs 
@@ -1,125 +0,0 @@--- | Module exporting pandoc bindings----module Hakyll.Web.Pandoc-    ( -- * The basic building blocks-      readPandoc-    , readPandocWith-    , writePandoc-    , writePandocWith--      -- * Functions working on pages/compilers-    , pageReadPandoc-    , pageReadPandocWith-    , pageReadPandocWithA-    , pageRenderPandoc-    , pageRenderPandocWith--      -- * Default options-    , defaultHakyllParserState-    , defaultHakyllWriterOptions-    ) where--import Prelude hiding (id)-import Control.Applicative ((<$>))-import Control.Arrow ((>>>), (>>^), (&&&), (***))-import Control.Category (id)-import Data.Maybe (fromMaybe)--import Text.Pandoc--import Hakyll.Core.Compiler-import Hakyll.Core.Identifier-import Hakyll.Core.Util.Arrow-import Hakyll.Web.Pandoc.FileType-import Hakyll.Web.Page.Internal---- | Read a string using pandoc, with the default options----readPandoc :: FileType              -- ^ Determines how parsing happens-           -> Maybe (Identifier a)  -- ^ Optional, for better error messages-           -> String                -- ^ String to read-           -> Pandoc                -- ^ Resulting document-readPandoc = readPandocWith defaultHakyllParserState---- | Read a string using pandoc, with the supplied options----readPandocWith :: ParserState           -- ^ Parser options-               -> FileType              -- ^ Determines parsing method-               -> Maybe (Identifier a)  -- ^ Optional, for better error messages-               -> String                -- ^ String to read-               -> Pandoc                -- ^ Resulting document-readPandocWith state fileType' id' = case fileType' of-    Html              -> readHtml state-    LaTeX             -> readLaTeX state-    LiterateHaskell t ->-        readPandocWith state {stateLiterateHaskell = True} t id'-    Markdown          -> readMarkdown state-    Rst               -> readRST state-    Textile           -> readTextile state-    t                 -> error $-        "Hakyll.Web.readPandocWith: I don't know how to read a file of the " ++-        "type " ++ show t ++ fromMaybe "" (fmap ((" for: " ++) . show) id')---- | Write a document (as HTML) using pandoc, with the default options----writePandoc :: Pandoc  -- ^ Document to write-            -> String  -- ^ Resulting HTML-writePandoc = writePandocWith defaultHakyllWriterOptions---- | Write a document (as HTML) using pandoc, with the supplied options----writePandocWith :: WriterOptions  -- ^ Writer options for pandoc-                -> Pandoc         -- ^ Document to write-                -> String         -- ^ Resulting HTML-writePandocWith = writeHtmlString---- | Read the resource using pandoc----pageReadPandoc :: Compiler (Page String) (Page Pandoc)-pageReadPandoc = pageReadPandocWith defaultHakyllParserState---- | Read the resource using pandoc----pageReadPandocWith :: ParserState -> Compiler (Page String) (Page Pandoc)-pageReadPandocWith state = constA state &&& id >>> pageReadPandocWithA---- | Read the resource using pandoc. This is a (rarely needed) variant, which--- comes in very useful when the parser state is the result of some arrow.----pageReadPandocWithA :: Compiler (ParserState, Page String) (Page Pandoc)-pageReadPandocWithA =-    id *** id &&& getIdentifier &&& getFileType >>^ pageReadPandocWithA'-  where-    pageReadPandocWithA' (s, (p, (i, t))) = readPandocWith s t (Just i) <$> p---- | Render the resource using pandoc----pageRenderPandoc :: Compiler (Page String) (Page String)-pageRenderPandoc =-    pageRenderPandocWith defaultHakyllParserState defaultHakyllWriterOptions---- | Render the resource using pandoc----pageRenderPandocWith :: ParserState-                     -> WriterOptions-                     -> Compiler (Page String) (Page String)-pageRenderPandocWith state options =-    pageReadPandocWith state >>^ fmap (writePandocWith options)---- | The default reader options for pandoc parsing in hakyll----defaultHakyllParserState :: ParserState-defaultHakyllParserState = defaultParserState-    { -- The following option causes pandoc to read smart typography, a nice-      -- and free bonus.-      stateSmart = True-    }---- | The default writer options for pandoc rendering in hakyll----defaultHakyllWriterOptions :: WriterOptions-defaultHakyllWriterOptions = defaultWriterOptions-    { -- This option causes literate haskell to be written using '>' marks in-      -- html, which I think is a good default.-      writerLiterateHaskell = True-    }
− src/Hakyll/Web/Pandoc/Biblio.hs 
@@ -1,73 +0,0 @@--- | Wraps pandocs bibiliography handling------ In order to add a bibliography, you will need a bibliography file (e.g.--- @.bib@) and a CSL file (@.csl@). Both need to be compiled with their--- respective compilers ('biblioCompiler' and 'cslCompiler'). Then, you can--- refer to these files when you use 'pageReadPandocBiblio'. This function also--- takes a parser state for completeness -- you can use--- 'defaultHakyllParserState' if you're unsure.----{-# LANGUAGE Arrows, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}-module Hakyll.Web.Pandoc.Biblio-    ( CSL-    , cslCompiler-    , Biblio (..)-    , biblioCompiler-    , pageReadPandocBiblio-    ) where--import Control.Applicative ((<$>))-import Control.Arrow (arr, returnA)-import Data.Typeable (Typeable)--import Data.Binary (Binary (..))-import Text.Pandoc (Pandoc, ParserState (..))-import Text.Pandoc.Biblio (processBiblio)-import qualified Text.CSL as CSL--import Hakyll.Core.Compiler-import Hakyll.Core.Identifier-import Hakyll.Core.Resource-import Hakyll.Core.Writable-import Hakyll.Web.Page-import Hakyll.Web.Pandoc--newtype CSL = CSL FilePath-    deriving (Binary, Show, Typeable, Writable)--cslCompiler :: Compiler Resource CSL-cslCompiler = arr (CSL . unResource)--newtype Biblio = Biblio [CSL.Reference]-    deriving (Show, Typeable)--instance Binary Biblio where-    -- Ugly.-    get             = Biblio . read <$> get-    put (Biblio rs) = put $ show rs--instance Writable Biblio where-    write _ _ = return ()--biblioCompiler :: Compiler Resource Biblio-biblioCompiler = unsafeCompiler $-    fmap Biblio . CSL.readBiblioFile . unResource--pageReadPandocBiblio :: ParserState-                     -> Identifier CSL-                     -> Identifier Biblio-                     -> Compiler (Page String) (Page Pandoc)-pageReadPandocBiblio state csl refs = proc page -> do-    CSL csl' <- require_ csl -< ()-    Biblio refs' <- require_ refs -< ()-    -- 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 cits   = map CSL.refId refs'-        state' = state {stateCitations = stateCitations state ++ cits}-    pandocPage <- pageReadPandocWithA -< (state', page)-    let pandoc = pageBody pandocPage-    pandoc' <- unsafeCompiler processBiblio' -< (csl', refs', pandoc)-    returnA -< pandocPage {pageBody = pandoc'}-  where-    processBiblio' (c, r, p) = processBiblio c Nothing r p
− src/Hakyll/Web/Pandoc/FileType.hs 
@@ -1,59 +0,0 @@--- | A module dealing with pandoc file extensions and associated file types----module Hakyll.Web.Pandoc.FileType-    ( FileType (..)-    , fileType-    , getFileType-    ) where--import System.FilePath (takeExtension)-import Control.Arrow ((>>^))--import Hakyll.Core.Identifier-import Hakyll.Core.Compiler---- | Datatype to represent the different file types Hakyll can deal with by--- default----data FileType-    = Binary-    | Css-    | Html-    | LaTeX-    | LiterateHaskell FileType-    | Markdown-    | OrgMode-    | PlainText-    | Rst-    | Textile-    deriving (Eq, Ord, Show, Read)---- | Get the file type for a certain file. The type is determined by extension.----fileType :: FilePath -> FileType-fileType = fileType' . takeExtension-  where-    fileType' ".css"      = Css-    fileType' ".htm"      = Html-    fileType' ".html"     = Html-    fileType' ".lhs"      = LiterateHaskell Markdown-    fileType' ".markdown" = Markdown-    fileType' ".md"       = Markdown-    fileType' ".mdn"      = Markdown-    fileType' ".mdown"    = Markdown-    fileType' ".mdwn"     = Markdown-    fileType' ".mkd"      = Markdown-    fileType' ".mkdwn"    = Markdown-    fileType' ".org"      = OrgMode-    fileType' ".page"     = Markdown-    fileType' ".rst"      = Rst-    fileType' ".tex"      = LaTeX-    fileType' ".text"     = PlainText-    fileType' ".textile"  = Textile-    fileType' ".txt"      = PlainText-    fileType' _           = Binary  -- Treat unknown files as binary---- | Get the file type for the current file----getFileType :: Compiler a FileType-getFileType = getIdentifier >>^ fileType . toFilePath
− src/Hakyll/Web/Preview/Poll.hs 
@@ -1,43 +0,0 @@--- | Interval-based implementation of preview polling----{-# LANGUAGE CPP #-}-module Hakyll.Web.Preview.Poll-    ( previewPoll-    ) where--import Control.Applicative ((<$>))-import Control.Concurrent (threadDelay)-import Control.Monad (filterM)-#if MIN_VERSION_directory(1,2,0)-import Data.Time (getCurrentTime)-#else-import System.Time (getClockTime)-#endif-import System.Directory (getModificationTime, doesFileExist)--import Hakyll.Core.Configuration---- | A preview thread that periodically recompiles the site.----previewPoll :: HakyllConfiguration  -- ^ Configuration-            -> IO [FilePath]        -- ^ Updating action-            -> IO ()                -- ^ Can block forever-previewPoll _ update = do-#if MIN_VERSION_directory(1,2,0)-    time <- getCurrentTime-#else-    time <- getClockTime-#endif-    loop time =<< update-  where-    delay = 1000000-    loop time files = do-        threadDelay delay-        files' <- filterM doesFileExist files-        filesTime <- case files' of-            []  -> return time-            _   -> maximum <$> mapM getModificationTime files'--        if filesTime > time || files' /= files-            then loop filesTime =<< update-            else loop time files'
− src/Hakyll/Web/Preview/Server.hs 
@@ -1,40 +0,0 @@--- | Implements a basic static file server for previewing options----{-# LANGUAGE OverloadedStrings #-}-module Hakyll.Web.Preview.Server-    ( staticServer-    ) where--import Control.Monad.Trans (liftIO)--import qualified Snap.Core as Snap-import qualified Snap.Http.Server as Snap-import qualified Snap.Util.FileServe as Snap---- | Serve a given directory----static :: FilePath             -- ^ Directory to serve-       -> (FilePath -> IO ())  -- ^ Pre-serve hook-       -> Snap.Snap ()-static directory preServe =-    Snap.serveDirectoryWith directoryConfig directory-  where-    directoryConfig :: Snap.DirectoryConfig Snap.Snap-    directoryConfig = Snap.fancyDirectoryConfig-        { Snap.preServeHook = liftIO . preServe-        }---- | Main method, runs a static server in the given directory----staticServer :: FilePath             -- ^ Directory to serve-             -> (FilePath -> IO ())  -- ^ Pre-serve hook-             -> Int                  -- ^ Port to listen on-             -> IO ()                -- ^ Blocks forever-staticServer directory preServe port =-    Snap.httpServe config $ static directory preServe-  where-    -- Snap server config-    config = Snap.setPort      port-           $ Snap.setAccessLog Snap.ConfigNoLog-           $ Snap.setErrorLog  Snap.ConfigNoLog-           $ Snap.emptyConfig
− src/Hakyll/Web/Tags.hs 
@@ -1,231 +0,0 @@--- | Module containing some specialized functions to deal with tags.--- This Module follows certain conventions. My advice is to stick with them if--- possible.------ More concrete: all functions in this module assume that the tags are--- located in the @tags@ field, and separated by commas. An example file--- @foo.markdown@ could look like:------ > ------ > author: Philip K. Dick--- > title: Do androids dream of electric sheep?--- > tags: future, science fiction, humanoid--- > ------ > The novel is set in a post-apocalyptic near future, where the Earth and--- > its populations have been damaged greatly by Nuclear...------ All the following functions would work with such a format. In addition to--- tags, Hakyll also supports categories. The convention when using categories--- is to place pages in subdirectories.------ An example, the page @posts\/coding\/2010-01-28-hakyll-categories.markdown@--- Tags or categories are read using the @readTags@ and @readCategory@--- functions. This module only provides functions to work with tags:--- categories are represented as tags. This is perfectly possible: categories--- only have an additional restriction that a page can only have one category--- (instead of multiple tags).----{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, Arrows #-}-module Hakyll.Web.Tags-    ( Tags (..)-    , getTags-    , readTagsWith-    , readTags-    , readCategory-    , renderTagCloud-    , renderTagList-    , renderTagsField-    , renderTagsFieldWith-    , renderCategoryField-    , sortTagsBy-    , caseInsensitiveTags-    ) where--import Prelude hiding (id)-import Control.Category (id)-import Control.Applicative ((<$>))-import Data.Char (toLower)-import Data.Ord (comparing)-import qualified Data.Map as M-import Data.List (intersperse, intercalate, sortBy)-import Control.Arrow (arr, (&&&), (>>>), (***), (<<^), returnA)-import Data.Maybe (catMaybes, fromMaybe)-import Data.Monoid (mconcat)--import Data.Typeable (Typeable)-import Data.Binary (Binary, get, put)-import Text.Blaze.Html.Renderer.String (renderHtml)-import Text.Blaze.Html ((!), toHtml, toValue)-import qualified Text.Blaze.Html5 as H-import qualified Text.Blaze.Html5.Attributes as A--import Hakyll.Web.Page-import Hakyll.Web.Page.Metadata-import Hakyll.Web.Urls-import Hakyll.Core.Writable-import Hakyll.Core.Identifier-import Hakyll.Core.Compiler-import Hakyll.Core.Util.String---- | Data about tags----data Tags a = Tags-    { tagsMap :: [(String, [Page a])]-    } deriving (Show, Typeable)--instance Binary a => Binary (Tags a) where-    get = Tags <$> get-    put (Tags m) = put m--instance Writable (Tags a) where-    write _ _ = return ()---- | Obtain tags from a page in the default way: parse them from the @tags@--- metadata field.----getTags :: Page a -> [String]-getTags = map trim . splitAll "," . getField "tags"---- | Obtain categories from a page----getCategory :: Page a -> [String]-getCategory = return . getField "category"---- | Higher-level function to read tags----readTagsWith :: (Page a -> [String])  -- ^ Function extracting tags from a page-             -> [Page a]              -- ^ Pages-             -> Tags a                -- ^ Resulting tags-readTagsWith f pages = Tags-    { tagsMap = M.toList $-        foldl (M.unionWith (++)) M.empty (map readTagsWith' pages)-    }-  where-    -- Create a tag map for one page-    readTagsWith' page =-        let tags = f page-        in M.fromList $ zip tags $ repeat [page]---- | Read a tagmap using the @tags@ metadata field----readTags :: [Page a] -> Tags a-readTags = readTagsWith getTags---- | Read a tagmap using the @category@ metadata field----readCategory :: [Page a] -> Tags a-readCategory = readTagsWith getCategory---- | Render tags in HTML----renderTags :: (String -> Identifier (Page a))-           -- ^ Produce a link-           -> (String -> String -> Int -> Int -> Int -> String)-           -- ^ Produce a tag item: tag, url, count, min count, max count-           -> ([String] -> String)-           -- ^ Join items-           -> Compiler (Tags a) String-           -- ^ Tag cloud renderer-renderTags makeUrl makeItem concatItems = proc (Tags tags) -> do-    -- In tags' we create a list: [((tag, route), count)]-    tags' <- mapCompiler ((id &&& (getRouteFor <<^ makeUrl)) *** arr length)-                -< tags--    let -- Absolute frequencies of the pages-        freqs = map snd tags'--        -- The minimum and maximum count found-        (min', max')-            | null freqs = (0, 1)-            | otherwise = (minimum &&& maximum) freqs--        -- Create a link for one item-        makeItem' ((tag, url), count) =-            makeItem tag (toUrl $ fromMaybe "/" url) count min' max'--    -- Render and return the HTML-    returnA -< concatItems $ map makeItem' tags'---- | Render a tag cloud in HTML----renderTagCloud :: (String -> Identifier (Page a))-               -- ^ Produce a link for a tag-               -> Double-               -- ^ Smallest font size, in percent-               -> Double-               -- ^ Biggest font size, in percent-               -> Compiler (Tags a) String-               -- ^ Tag cloud renderer-renderTagCloud makeUrl minSize maxSize =-    renderTags makeUrl makeLink (intercalate " ")-  where-    makeLink tag url count min' max' = renderHtml $-        H.a ! A.style (toValue $ "font-size: " ++ size count min' max')-            ! A.href (toValue url)-            $ toHtml tag--    -- Show the relative size of one 'count' in percent-    size count min' max' =-        let diff = 1 + fromIntegral max' - fromIntegral min'-            relative = (fromIntegral count - fromIntegral min') / diff-            size' = floor $ minSize + relative * (maxSize - minSize)-        in show (size' :: Int) ++ "%"---- | Render a simple tag list in HTML, with the tag count next to the item----renderTagList :: (String -> Identifier (Page a)) -> Compiler (Tags a) (String)-renderTagList makeUrl = renderTags makeUrl makeLink (intercalate ", ")-  where-    makeLink tag url count _ _ = renderHtml $-        H.a ! A.href (toValue url) $ toHtml (tag ++ " (" ++ show count ++ ")")---- | Render tags with links with custom function to get tags. It is typically--- together with 'getTags' like this:--- --- > renderTagsFieldWith (customFunction . getTags)--- >     "tags" (fromCapture "tags/*")----renderTagsFieldWith :: (Page a -> [String])        -- ^ Function to get the tags-                    -> String                      -- ^ Destination key-                    -> (String -> Identifier a)    -- ^ Create a link for a tag-                    -> Compiler (Page a) (Page a)  -- ^ Resulting compiler-renderTagsFieldWith tags destination makeUrl =-    id &&& arr tags >>> setFieldA destination renderTags'-  where-    -- Compiler creating a comma-separated HTML string for a list of tags-    renderTags' :: Compiler [String] String-    renderTags' =   arr (map $ id &&& makeUrl)-                >>> mapCompiler (id *** getRouteFor)-                >>> arr (map $ uncurry renderLink)-                >>> arr (renderHtml . mconcat . intersperse ", " . catMaybes)--    -- Render one tag link-    renderLink _   Nothing         = Nothing-    renderLink tag (Just filePath) = Just $-        H.a ! A.href (toValue $ toUrl filePath) $ toHtml tag---- | Render tags with links----renderTagsField :: String                      -- ^ Destination key-                -> (String -> Identifier a)    -- ^ Create a link for a tag-                -> Compiler (Page a) (Page a)  -- ^ Resulting compiler-renderTagsField = renderTagsFieldWith getTags---- | Render the category in a link----renderCategoryField :: String                      -- ^ Destination key-                    -> (String -> Identifier a)    -- ^ Create a category link-                    -> Compiler (Page a) (Page a)  -- ^ Resulting compiler-renderCategoryField = renderTagsFieldWith getCategory---- | Sort tags using supplied function. First element of the tuple passed to--- the comparing function is the actual tag name.----sortTagsBy :: ((String, [Page a]) -> (String, [Page a]) -> Ordering)-           -> Compiler (Tags a) (Tags a)-sortTagsBy f = arr $ Tags . sortBy f . tagsMap---- | Sample sorting function that compares tags case insensitively.----caseInsensitiveTags :: (String, [Page a]) -> (String, [Page a]) -> Ordering-caseInsensitiveTags = comparing $ map toLower . fst
− src/Hakyll/Web/Template.hs 
@@ -1,150 +0,0 @@--- | This module provides means for reading and applying 'Template's.------ Templates are tools to convert data (pages) into a string. They are--- perfectly suited for laying out your site.------ Let's look at an example template:------ > <html>--- >     <head>--- >         <title>My crazy homepage - $title$</title>--- >     </head>--- >     <body>--- >         <div id="header">--- >             <h1>My crazy homepage - $title$</h1>--- >         </div>--- >         <div id="content">--- >             $body$--- >         </div>--- >         <div id="footer">--- >             By reading this you agree that I now own your soul--- >         </div>--- >     </body>--- > </html>------ We can use this template to render a 'Page' which has a body and a @$title$@--- metadata field.------ As you can see, the format is very simple -- @$key$@ is used to render the--- @$key$@ field from the page, everything else is literally copied. If you want--- to literally insert @\"$key$\"@ into your page (for example, when you're--- writing a Hakyll tutorial) you can use------ > <p>--- >     A literal $$key$$.--- > </p>------ Because of it's simplicity, these templates can be used for more than HTML:--- you could make, for example, CSS or JS templates as well.------ In addition to the native format, Hakyll also supports hamlet templates. For--- more information on hamlet templates, please refer to:--- <http://hackage.haskell.org/package/hamlet>. Internally, hamlet templates are--- converted to hakyll templates -- which means that you can only use variable--- insertion (and not all hamlet's features).------ This is an example of a valid hamlet template. You should place them in--- files with a @.hamlet@ extension:------ > !!!--- > <html>--- >     <head>--- >         <meta charset="UTF-8">--- >         <title> MyAweSomeCompany - #{title}--- >     <body>--- >         <h1> MyAweSomeCompany - #{title}--- >         <div id="navigation">--- >             <a href="/index.html"> Home--- >             <a href="/about.html"> About--- >             <a href="/code.html"> Code--- >         #{body}----module Hakyll.Web.Template-    ( Template-    , applyTemplate-    , applyTemplateWith-    , applySelf-    , templateCompiler-    , templateCompilerWith-    , applyTemplateCompiler-    , applyTemplateCompilerWith-    ) where--import Control.Arrow-import Data.Maybe (fromMaybe)-import System.FilePath (takeExtension)-import qualified Data.Map as M--import Text.Hamlet (HamletSettings, defaultHamletSettings)--import Hakyll.Core.Compiler-import Hakyll.Core.Identifier-import Hakyll.Core.Resource-import Hakyll.Web.Template.Internal-import Hakyll.Web.Template.Read-import Hakyll.Web.Page.Internal---- | Substitutes @$identifiers@ in the given @Template@ by values from the given--- "Page". When a key is not found, it is left as it is.----applyTemplate :: Template -> Page String -> Page String-applyTemplate = applyTemplateWith defaultMissingHandler---- | Default solution if a key is missing: render it again-defaultMissingHandler :: String -> String-defaultMissingHandler k = "$" ++ k ++ "$"---- | A version of 'applyTemplate' which allows you to give a fallback option,--- which can produce the value for a key if it is missing.----applyTemplateWith :: (String -> String)  -- ^ Fallback if key missing-                  -> Template            -- ^ Template to apply-                  -> Page String         -- ^ Input page-                  -> Page String         -- ^ Resulting page-applyTemplateWith missing template page =-    fmap (const $ substitute =<< unTemplate template) page-  where-    map' = toMap page-    substitute (Chunk chunk) = chunk-    substitute (Key key)     = fromMaybe (missing key) $ M.lookup key map'-    substitute (Escaped)     = "$"---- | Apply a page as it's own template. This is often very useful to fill in--- certain keys like @$root@ and @$url@.----applySelf :: Page String -> Page String-applySelf page = applyTemplate (readTemplate $ pageBody page) page---- | Read a template. If the extension of the file we're compiling is--- @.hml@ or @.hamlet@, it will be considered as a Hamlet template, and parsed--- as such.----templateCompiler :: Compiler Resource Template-templateCompiler = templateCompilerWith defaultHamletSettings---- | Version of 'templateCompiler' that enables custom settings.----templateCompilerWith :: HamletSettings -> Compiler Resource Template-templateCompilerWith settings =-    cached "Hakyll.Web.Template.templateCompilerWith" $-        getIdentifier &&& getResourceString >>^ uncurry read'-  where-    read' identifier string =-        if takeExtension (toFilePath identifier) `elem` [".hml", ".hamlet"]-            -- Hamlet template-            then readHamletTemplateWith settings string-            -- Hakyll template-            else readTemplate string--applyTemplateCompiler :: Identifier Template                   -- ^ Template-                      -> Compiler (Page String) (Page String)  -- ^ Compiler-applyTemplateCompiler = applyTemplateCompilerWith defaultMissingHandler---- | A version of 'applyTemplateCompiler' which allows you to pass a function--- which is called for a key when it is missing.----applyTemplateCompilerWith :: (String -> String)-                          -> Identifier Template-                          -> Compiler (Page String) (Page String)-applyTemplateCompilerWith missing identifier =-    require identifier (flip $ applyTemplateWith missing)
− src/Hakyll/Web/Template/Internal.hs 
@@ -1,45 +0,0 @@--- | Module containing the template data structure----{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}-module Hakyll.Web.Template.Internal-    ( Template (..)-    , TemplateElement (..)-    ) where--import Control.Applicative ((<$>))--import Data.Binary (Binary, get, getWord8, put, putWord8)-import Data.Typeable (Typeable)--import Hakyll.Core.Writable---- | Datatype used for template substitutions.----newtype Template = Template-    { unTemplate :: [TemplateElement]-    }-    deriving (Show, Eq, Binary, Typeable)--instance Writable Template where-    -- Writing a template is impossible-    write _ _ = return ()---- | Elements of a template.----data TemplateElement-    = Chunk String-    | Key String-    | Escaped-    deriving (Show, Eq, Typeable)--instance Binary TemplateElement where-    put (Chunk string)    = putWord8 0 >> put string-    put (Key key)  = putWord8 1 >> put key-    put (Escaped) = putWord8 2--    get = getWord8 >>= \tag -> case tag of-            0 -> Chunk <$> get-            1 -> Key   <$> get-            2 -> return Escaped-            _ -> error $  "Hakyll.Web.Template.Internal: "-                       ++ "Error reading cached template"
− src/Hakyll/Web/Template/Read.hs 
@@ -1,10 +0,0 @@--- | Re-exports all different template reading modules----module Hakyll.Web.Template.Read-    ( readTemplate-    , readHamletTemplate-    , readHamletTemplateWith-    ) where--import Hakyll.Web.Template.Read.Hakyll-import Hakyll.Web.Template.Read.Hamlet
− src/Hakyll/Web/Template/Read/Hakyll.hs 
@@ -1,35 +0,0 @@--- | Read templates in Hakyll's native format----module Hakyll.Web.Template.Read.Hakyll-    ( readTemplate-    ) where--import Data.List (isPrefixOf)-import Data.Char (isAlphaNum)--import Hakyll.Web.Template.Internal---- | Construct a @Template@ from a string.----readTemplate :: String -> Template-readTemplate = Template . readTemplate'-  where-    readTemplate' [] = []-    readTemplate' string-        | "$$" `isPrefixOf` string =-            Escaped : readTemplate' (drop 2 string)-        | "$" `isPrefixOf` string =-            case readKey (drop 1 string) of-                Just (key, rest) -> Key key : readTemplate' rest-                Nothing          -> Chunk "$" : readTemplate' (drop 1 string)-        | otherwise =-            let (chunk, rest) = break (== '$') string-            in Chunk chunk : readTemplate' rest--    -- Parse an key into (key, rest) if it's valid, and return-    -- Nothing otherwise-    readKey string =-        let (key, rest) = span isAlphaNum string-        in if not (null key) && "$" `isPrefixOf` rest-            then Just (key, drop 1 rest)-            else Nothing
− src/Hakyll/Web/Template/Read/Hamlet.hs 
@@ -1,46 +0,0 @@--- | Read templates in the hamlet format----{-# LANGUAGE MultiParamTypeClasses #-}-module Hakyll.Web.Template.Read.Hamlet-    ( readHamletTemplate-    , readHamletTemplateWith-    ) where--import Text.Hamlet (HamletSettings, defaultHamletSettings)-import Text.Hamlet.RT--import Hakyll.Web.Template.Internal---- | Read a hamlet template using the default settings----readHamletTemplate :: String -> Template-readHamletTemplate = readHamletTemplateWith defaultHamletSettings---- | Read a hamlet template using the specified settings----readHamletTemplateWith :: HamletSettings -> String -> Template-readHamletTemplateWith settings string =-    let result = parseHamletRT settings string-    in case result of-        Just hamlet -> fromHamletRT hamlet-        Nothing     -> error-            "Hakyll.Web.Template.Read.Hamlet.readHamletTemplateWith: \-            \Could not parse Hamlet file"---- | Convert a 'HamletRT' to a 'Template'----fromHamletRT :: HamletRT  -- ^ Hamlet runtime template-             -> Template  -- ^ Hakyll template-fromHamletRT (HamletRT sd) = Template $ map fromSimpleDoc sd-  where-    fromSimpleDoc :: SimpleDoc -> TemplateElement-    fromSimpleDoc (SDRaw chunk) = Chunk chunk-    fromSimpleDoc (SDVar [var]) = Key var-    fromSimpleDoc (SDVar _) = error-        "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \-        \Hakyll does not support '.' in identifier names when using \-        \hamlet templates."-    fromSimpleDoc _ = error-        "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \-        \Only simple $key$ identifiers are allowed when using hamlet \-        \templates."
− src/Hakyll/Web/Urls.hs 
@@ -1,66 +0,0 @@--- | Provides utilities to manipulate URL's----module Hakyll.Web.Urls-    ( withUrls-    , toUrl-    , toSiteRoot-    , isExternal-    ) where--import Data.List (isPrefixOf)-import Data.Char (toLower)-import System.FilePath (splitPath, takeDirectory, joinPath)-import qualified Data.Set as S--import qualified Text.HTML.TagSoup as TS---- | Apply a function to each URL on a webpage----withUrls :: (String -> String) -> String -> String-withUrls f = renderTags' . map tag . TS.parseTags-  where-    tag (TS.TagOpen s a) = TS.TagOpen s $ map attr a-    tag x                = x-    attr (k, v)          = (k, if k `S.member` refs then f v else v)-    refs                 = S.fromList ["src", "href"]---- | Customized TagSoup renderer. (The default TagSoup renderer escape CSS--- within style tags.)----renderTags' :: [TS.Tag String] -> String-renderTags' = TS.renderTagsOptions TS.renderOptions-    { TS.optRawTag   = (`elem` ["script", "style"]) . map toLower-    , TS.optMinimize = (`elem` ["br", "img"])-    }---- | Convert a filepath to an URL starting from the site root------ Example:------ > toUrl "foo/bar.html"------ Result:------ > "/foo/bar.html"----toUrl :: FilePath -> String-toUrl ('/' : xs) = '/' : xs-toUrl url        = '/' : url---- | Get the relative url to the site root, for a given (absolute) url----toSiteRoot :: String -> String-toSiteRoot = emptyException . joinPath . map parent-           . filter relevant . splitPath . takeDirectory-  where-    parent            = const ".."-    emptyException [] = "."-    emptyException x  = x-    relevant "."      = False-    relevant "/"      = False-    relevant _        = True---- | Check if an URL links to an external HTTP(S) source----isExternal :: String -> Bool-isExternal url = any (flip isPrefixOf url) ["http://", "https://"]
− src/Hakyll/Web/Urls/Relativize.hs 
@@ -1,48 +0,0 @@--- | This module exposes a function which can relativize URL's on a webpage.------ This means that one can deploy the resulting site on--- @http:\/\/example.com\/@, but also on @http:\/\/example.com\/some-folder\/@--- without having to change anything (simply copy over the files).------ To use it, you should use absolute URL's from the site root everywhere. For--- example, use------ > <img src="/images/lolcat.png" alt="Funny zomgroflcopter" />------ in a blogpost. When running this through the relativize URL's module, this--- will result in (suppose your blogpost is located at @\/posts\/foo.html@:------ > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" />----module Hakyll.Web.Urls.Relativize-    ( relativizeUrlsCompiler-    , relativizeUrls-    ) where--import Prelude hiding (id)-import Control.Category (id)-import Control.Arrow ((&&&), (>>^))-import Data.List (isPrefixOf)--import Hakyll.Core.Compiler-import Hakyll.Web.Page-import Hakyll.Web.Urls---- | Compiler form of 'relativizeUrls' which automatically picks the right root--- path----relativizeUrlsCompiler :: Compiler (Page String) (Page String)-relativizeUrlsCompiler = getRoute &&& id >>^ uncurry relativize-  where-    relativize Nothing  = id-    relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r)---- | Relativize URL's in HTML----relativizeUrls :: String  -- ^ Path to the site root-               -> String  -- ^ HTML to relativize-               -> String  -- ^ Resulting HTML-relativizeUrls root = withUrls rel-  where-    isRel x = "/" `isPrefixOf` x && not ("//" `isPrefixOf` x)-    rel x = if isRel x then root ++ x else x
− src/Hakyll/Web/Util/Html.hs 
@@ -1,47 +0,0 @@--- | Miscellaneous HTML manipulation functions----module Hakyll.Web.Util.Html-    ( stripTags-    , escapeHtml-    ) where--import Text.Blaze.Html (toHtml)-import Text.Blaze.Html.Renderer.String (renderHtml)---- | Strip all HTML tags from a string------ Example:------ > stripTags "<p>foo</p>"------ Result:------ > "foo"------ This also works for incomplete tags------ Example:------ > stripTags "<p>foo</p"------ Result:------ > "foo"----stripTags :: String -> String-stripTags []         = []-stripTags ('<' : xs) = stripTags $ drop 1 $ dropWhile (/= '>') xs-stripTags (x : xs)   = x : stripTags xs---- | HTML-escape a string------ Example:------ > escapeHtml "Me & Dean"------ Result:------ > "Me &amp; Dean"----escapeHtml :: String -> String-escapeHtml = renderHtml . toHtml
+ src/Init.hs view
@@ -0,0 +1,132 @@+--------------------------------------------------------------------------------+{-# LANGUAGE CPP #-}+module Main+    ( main+    ) where+++--------------------------------------------------------------------------------+import           Control.Arrow         (first)+import           Control.Monad         (forM, forM_)+import           Data.Char             (isAlphaNum, isNumber)+import           Data.List             (intercalate, isPrefixOf)+#if !(MIN_VERSION_base(4,20,0))+import           Data.List             (foldl')+#endif+import           Data.Version          (Version (..))+import           System.Directory      (canonicalizePath, copyFile,+                                        doesFileExist,+                                        setPermissions, getPermissions, writable)+import           System.Environment    (getArgs, getProgName)+import           System.Exit           (exitFailure)+import           System.FilePath       (splitDirectories, (</>))+++--------------------------------------------------------------------------------+import           Hakyll.Core.Util.File+import           Paths_hakyll+++--------------------------------------------------------------------------------+import           Prelude+++--------------------------------------------------------------------------------+main :: IO ()+main = do+    progName <- getProgName+    args     <- getArgs+    srcDir   <- getDataFileName "example"+    files    <- getRecursiveContents (const $ return False) srcDir++    case args of+        -- When the argument begins with hyphens, it's more likely that the user+        -- intends to attempt some arguments like ("--help", "-h", "--version", etc.)+        -- rather than create directory with that name.+        -- If dstDir begins with hyphens, the guard will prevent it from creating+        -- directory with that name so we can fall to the second alternative+        -- which prints a usage info for user.+        [dstDir] | not ("-" `isPrefixOf` dstDir) ->+            createFiles False srcDir files dstDir+        ["-f", dstDir] ->+            createFiles True srcDir files dstDir+        _ -> do+            putStrLn $ "Usage: " ++ progName ++ " [-f] <directory>"+            exitFailure++    where+        createFiles force srcDir files dstDir = do+            name <- makeName dstDir+            let cabalPath = dstDir </> name ++ ".cabal"++            diff <- if force then return []+                    else existingFiles dstDir (cabalPath : files)++            case diff of+                [] -> do+                    forM_ files $ \file -> do+                        let dst = dstDir </> file+                            src = srcDir </> file+                        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+                fs -> do+                    putStrLn $ "The following files will be overwritten:"+                    mapM_ putStrLn fs+                    putStrLn $ "Use -f to overwrite them"+                    exitFailure++existingFiles :: FilePath -> [FilePath] -> IO [FilePath]+existingFiles dstDir files = fmap concat $ forM files $ \file -> do+    let dst = dstDir </> file+    exists <- doesFileExist dst+    return $ if exists then [dst] else []++-- | Figure out a good cabal package name from the given (existing) directory+-- name+makeName :: FilePath -> IO String+makeName dstDir = do+    canonical <- canonicalizePath dstDir+    return $ case safeLast (splitDirectories canonical) of+        Nothing  -> fallbackName+        Just "/" -> fallbackName+        Just x   -> repair (fallbackName ++) id x+  where+    -- Package name repair code comes from+    -- cabal-install.Distribution.Client.Init.Heuristics+    repair invalid valid x = case dropWhile (not . isAlphaNum) x of+        "" -> repairComponent ""+        x' -> let (c, r) = first repairComponent $ break (not . isAlphaNum) x'+              in c ++ repairRest r+      where repairComponent c | all isNumber c = invalid c+                              | otherwise = valid c+    repairRest = repair id ('-' :)+    fallbackName = "site"++    safeLast = foldl' (\_ x -> Just x) Nothing++createCabal :: FilePath -> String -> IO ()+createCabal path name =+    writeFile path $ unlines [+        "name:               " ++ name+      , "version:            0.1.0.0"+      , "build-type:         Simple"+      , "cabal-version:      >= 1.10"+      , ""+      , "executable site"+      , "  main-is:          site.hs"+      , "  build-depends:    base == 4.*"+      , "                  , hakyll == " ++ version' ++ ".*"+      , "  ghc-options:      -threaded -rtsopts -with-rtsopts=-N"+      , "  default-language: Haskell2010"+      ]+  where+    -- Major hakyll version+    version' = intercalate "." . take 2 . map show $ versionBranch version
− tests/Hakyll/Core/Compiler/Tests.hs 
@@ -1,36 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Hakyll.Core.Compiler.Tests-    ( tests-    ) where--import qualified Data.Map as M--import Test.Framework (Test)-import Test.Framework.Providers.HUnit (testCase)-import qualified Test.HUnit as H--import Hakyll.Core.Compiler-import Hakyll.Core.Resource.Provider.Dummy-import Hakyll.Core.Util.Arrow-import TestSuite.Util--tests :: [Test]-tests =-    [ testCase "byExtension" byExtensionTest-    ]--byExtensionTest :: H.Assertion-byExtensionTest = do-    provider <- dummyResourceProvider $ M.empty-    txt      <- runCompilerJobTest compiler "foo.txt" provider uni-    css      <- runCompilerJobTest compiler "bar.css" provider uni-    html     <- runCompilerJobTest compiler "qux.html" provider uni-    H.assertEqual "byExtension" "txt" txt-    H.assertEqual "byExtension" "css" css-    H.assertEqual "byExtension" "unknown" html-  where-    uni      = ["foo.txt", "bar.css", "qux.html"]-    compiler = byExtension (constA ("unknown" :: String))-        [ (".txt", constA "txt")-        , (".css", constA "css")-        ]
+ tests/Hakyll/Core/Dependencies/Tests.hs view
@@ -0,0 +1,93 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Core.Dependencies.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Data.List                (delete)+import qualified Data.Map                 as M+import qualified Data.Set                 as S+import           Test.Tasty               (TestTree, testGroup)+import           Test.Tasty.HUnit         (Assertion, (@=?))+++--------------------------------------------------------------------------------+import           Hakyll.Core.Dependencies+import           Hakyll.Core.Identifier+import           TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Core.Dependencies.Tests" $+    fromAssertions "analyze" [case01, case02, case03, case04, case05]+++--------------------------------------------------------------------------------+oldUniverse :: [Identifier]+oldUniverse = M.keys oldFacts+++--------------------------------------------------------------------------------+oldFacts :: DependencyFacts+oldFacts = M.fromList+    [ ("posts/01.md",+        [])+    , ("posts/02.md",+        [])+    , ("index.md",+        [ contentDependency $ PatternDependency "posts/*"+            (S.fromList ["posts/01.md", "posts/02.md"])+        , contentDependency $ IdentifierDependency "posts/01.md"+        , contentDependency $ IdentifierDependency "posts/02.md"+        ])+    , ("sidebar",+        [ metadataDependency $ PatternDependency "posts/*"+            (S.fromList ["posts/01.md", "posts/02.md"])+        ])+    ]+++--------------------------------------------------------------------------------+-- | posts/02.md has changed+case01 :: Assertion+case01 = S.fromList ["posts/02.md", "index.md"] @=? ood+  where+    (ood, _, _) = outOfDate oldUniverse (S.singleton "posts/02.md") S.empty oldFacts+++--------------------------------------------------------------------------------+-- | about.md was added+case02 :: Assertion+case02 = S.singleton "about.md" @=? ood+  where+    (ood, _, _) = outOfDate ("about.md" : oldUniverse) S.empty S.empty oldFacts+++--------------------------------------------------------------------------------+-- | posts/01.md was removed+case03 :: Assertion+case03 = S.fromList ["index.md", "sidebar"] @=? ood+  where+    (ood, _, _) =+        outOfDate ("posts/01.md" `delete` oldUniverse) S.empty S.empty oldFacts+++--------------------------------------------------------------------------------+-- | metadata of posts/01.md was changed+case04 :: Assertion+case04 = S.singleton "sidebar" @=? ood+  where+    (ood, _, _) =+        outOfDate oldUniverse S.empty (S.singleton "posts/01.md") oldFacts+++--------------------------------------------------------------------------------+-- | content of posts/01.md was changed but metadata wasn't+case05 :: Assertion+case05 = S.fromList ["posts/01.md", "index.md"]  @=? ood+  where+    (ood, _, _) =+        outOfDate oldUniverse (S.singleton "posts/01.md") S.empty oldFacts
− tests/Hakyll/Core/DependencyAnalyzer/Tests.hs 
@@ -1,70 +0,0 @@-module Hakyll.Core.DependencyAnalyzer.Tests where--import Control.Arrow (second)-import qualified Data.Set as S-import Data.Monoid (mempty)--import Test.Framework-import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)--import Hakyll.Core.DirectedGraph-import Hakyll.Core.DependencyAnalyzer--tests :: [Test]-tests =-    [ testCase "step [1]" step1-    , testCase "step [2]" step2-    ]--step1 :: Assertion-step1 = Just (S.fromList [1, 2, 5, 6, 7, 8, 9]) @?=-    stepAll (makeDependencyAnalyzer graph isOutOfDate prev)-  where-    node = curry $ second S.fromList--    graph = fromList-        [ node (8 :: Int) [2, 4, 6]-        , node 2 [4, 3]-        , node 4 [3]-        , node 6 [4]-        , node 3 []-        , node 9 [5]-        , node 5 [7]-        , node 1 [7]-        , node 7 []-        ]--    prev = fromList-        [ node 8 [2, 4, 6]-        , node 2 [4, 3]-        , node 4 [3]-        , node 6 [4]-        , node 3 []-        , node 9 [5]-        , node 5 [7]-        , node 1 [7]-        , node 7 [8]-        ]--    isOutOfDate = (`elem` [5, 2, 6])--step2 :: Assertion-step2 = Nothing @?= stepAll (makeDependencyAnalyzer graph isOutOfDate mempty)-  where-    node = curry $ second S.fromList--    -- Cycle: 4 -> 7 -> 5 -> 9 -> 4-    graph = fromList-        [ node (1 :: Int) [6]-        , node 2 [3]-        , node 3 []-        , node 4 [1, 7, 8]-        , node 5 [9]-        , node 6 [3]-        , node 7 [5]-        , node 8 [2]-        , node 9 [4]-        ]--    isOutOfDate = const True
tests/Hakyll/Core/Identifier/Tests.hs view
@@ -1,46 +1,77 @@+-------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-} module Hakyll.Core.Identifier.Tests     ( tests     ) where -import Test.Framework-import Test.HUnit hiding (Test) -import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import TestSuite.Util+--------------------------------------------------------------------------------+import qualified Test.QuickCheck                as Q+import           Test.Tasty                     (TestTree, testGroup)+import           Test.Tasty.HUnit               ((@=?))+import           Test.Tasty.QuickCheck          (testProperty) -tests :: [Test]-tests = concat++--------------------------------------------------------------------------------+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern+import           System.FilePath                ((</>), isValid, equalFilePath, pathSeparators)+import           TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Core.Identifier.Tests" $ concat     [ captureTests     , matchesTests+    , [ testProperty "toFilePath . fromFilePath" filepathConversionProp ]     ] -captureTests :: [Test]++--------------------------------------------------------------------------------+captureTests :: [TestTree] captureTests = fromAssertions "capture"-    [ Just ["bar"]              @=? capture "foo/**" "foo/bar"-    , Just ["foo/bar"]          @=? capture "**" "foo/bar"-    , Nothing                   @=? capture "*" "foo/bar"-    , Just []                   @=? capture "foo" "foo"-    , Just ["foo"]              @=? capture "*/bar" "foo/bar"-    , Just ["foo/bar"]          @=? capture "**/qux" "foo/bar/qux"-    , Just ["foo/bar", "qux"]   @=? capture "**/*" "foo/bar/qux"-    , Just ["foo", "bar/qux"]   @=? capture "*/**" "foo/bar/qux"-    , Just ["foo"]              @=? capture "*.html" "foo.html"-    , Nothing                   @=? capture "*.html" "foo/bar.html"-    , Just ["foo/bar"]          @=? capture "**.html" "foo/bar.html"-    , Just ["foo/bar", "wut"]   @=? capture "**/qux/*" "foo/bar/qux/wut"-    , Just ["lol", "fun/large"] @=? capture "*cat/**.jpg" "lolcat/fun/large.jpg"-    , Just []                   @=? capture "\\*.jpg" "*.jpg"-    , Nothing                   @=? capture "\\*.jpg" "foo.jpg"+    [ Just ["bar"]                    @=? capture "foo/**" "foo/bar"+    , Just ["foo" </> "bar"]          @=? capture "**" "foo/bar"+    , Nothing                         @=? capture "*" "foo/bar"+    , Just []                         @=? capture "foo" "foo"+    , Just ["foo"]                    @=? capture "*/bar" "foo/bar"+    , Just ["foo" </> "bar"]          @=? capture "**/qux" "foo/bar/qux"+    , Just ["foo" </> "bar", "qux"]   @=? capture "**/*" "foo/bar/qux"+    , Just ["foo", "bar" </> "qux"]   @=? capture "*/**" "foo/bar/qux"+    , Just ["foo"]                    @=? capture "*.html" "foo.html"+    , Nothing                         @=? capture "*.html" "foo/bar.html"+    , Just ["foo" </> "bar"]          @=? capture "**.html" "foo/bar.html"+    , Just ["foo" </> "bar", "wut"]   @=? capture "**/qux/*" "foo/bar/qux/wut"+    , Just ["lol", "fun" </> "large"] @=? capture "*cat/**.jpg" "lolcat/fun/large.jpg"+    , Nothing                         @=? capture "\\*.jpg" "foo.jpg"+    , Just ["xyz","42"]               @=? capture (fromRegex "cat-([a-z]+)/foo([0-9]+).jpg") "cat-xyz/foo42.jpg"     ] -matchesTests :: [Test]++--------------------------------------------------------------------------------+matchesTests :: [TestTree] matchesTests = fromAssertions "matches"-    [ True  @=? matches (list ["foo.markdown"]) "foo.markdown"-    , False @=? matches (list ["foo"]) (Identifier (Just "foo") "foo")-    , True  @=? matches (regex "^foo/[^x]*$") "foo/bar"-    , False @=? matches (regex "^foo/[^x]*$") "foo/barx"+    [ True  @=? matches (fromList ["foo.markdown"]) "foo.markdown"+    , False @=? matches (fromList ["foo"]) (setVersion (Just "x") "foo")+    , True  @=? matches (fromVersion (Just "xz")) (setVersion (Just "xz") "bar")+    , True  @=? matches (fromRegex "^foo/[^x]*$") "foo/bar"+    , False @=? matches (fromRegex "^foo/[^x]*$") "foo/barx"     , True  @=? matches (complement "foo.markdown") "bar.markdown"     , False @=? matches (complement "foo.markdown") "foo.markdown"+    , True  @=? matches ("foo" .||. "bar") "bar"+    , False @=? matches ("bar" .&&. hasNoVersion) (setVersion (Just "xz") "bar")     ]+++--------------------------------------------------------------------------------+-- Ensure that `fromFilePath` and `toFilePath` are inverses of each other (#791)+filepathConversionProp :: Q.Property+filepathConversionProp +    = Q.forAll genFilePath +    $ \fp -> toFilePath (fromFilePath fp) `equalFilePath` fp+    where+        genFilePath +            = Q.listOf1 (Q.elements $ ['a'..'z'] <> pathSeparators) +                `Q.suchThat` +                isValid
+ tests/Hakyll/Core/Provider/Metadata/Tests.hs view
@@ -0,0 +1,66 @@+--------------------------------------------------------------------------------+{-# LANGUAGE CPP #-}+module Hakyll.Core.Provider.Metadata.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap             as KeyMap+import qualified Data.Aeson.Key                as AK+#else+import qualified Data.HashMap.Strict           as KeyMap+import qualified Data.Text                     as T+#endif+import qualified Data.Yaml                     as Yaml+import           Hakyll.Core.Metadata+import           Hakyll.Core.Provider.Metadata+import           Test.Tasty                    (TestTree, testGroup)+import           Test.Tasty.HUnit              (Assertion, assertFailure, (@=?))+import           TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Core.Provider.Metadata.Tests" $+    fromAssertions "page" [testPage01, testPage02]++++--------------------------------------------------------------------------------+testPage01 :: Assertion+testPage01 =+    (meta [("foo", "bar")], "qux\n") `expectRight` parsePage+    "---\nfoo: bar\n---\nqux\n"+++--------------------------------------------------------------------------------+testPage02 :: Assertion+testPage02 =+    (meta [("description", descr)], "Hello I am dog\n") `expectRight`+    parsePage+    "---\ndescription: A long description that would look better if it\n             spanned multiple lines and was indented\n---\nHello I am dog\n"+  where+    descr :: String+    descr =+        "A long description that would look better if it spanned multiple lines and was indented"+++--------------------------------------------------------------------------------+meta :: Yaml.ToJSON a => [(String, a)] -> Metadata+meta pairs = KeyMap.fromList [(keyFromString k, Yaml.toJSON v) | (k, v) <- pairs]+  where+#if MIN_VERSION_aeson(2,0,0)+  keyFromString = AK.fromString+#else+  keyFromString = T.pack+#endif+++--------------------------------------------------------------------------------+-- | This is useful when the 'Left' side of 'Either' doesn't have an 'Eq'+-- instance.+expectRight :: (Eq b, Show a, Show b) => b -> Either a b -> Assertion+expectRight _        (Left  err) = assertFailure (show err)+expectRight expected (Right res) = expected @=? res
+ tests/Hakyll/Core/Provider/Tests.hs view
@@ -0,0 +1,36 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Core.Provider.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Hakyll.Core.Metadata+import           Hakyll.Core.Provider+import           Test.Tasty           (TestTree, testGroup)+import           Test.Tasty.HUnit     (Assertion, testCase, (@=?))+import           TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Core.Provider.Tests"+    [ testCase "case01" case01+    ]+++--------------------------------------------------------------------------------+case01 :: Assertion+case01 = do+    store    <- newTestStore+    provider <- newTestProvider store+    True @=? resourceExists provider "example.md"++    metadata <- resourceMetadata provider "example.md"+    Just "An example"    @=? lookupString "title"    metadata+    Just "External data" @=? lookupString "external" metadata++    doesntExist <- resourceMetadata provider "doesntexist.md"+    mempty @=? doesntExist+    cleanTestEnv
tests/Hakyll/Core/Routes/Tests.hs view
@@ -1,30 +1,50 @@+-------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-} module Hakyll.Core.Routes.Tests     ( tests     ) where -import Test.Framework-import Test.HUnit hiding (Test) -import Hakyll.Core.Identifier-import Hakyll.Core.Routes-import TestSuite.Util+--------------------------------------------------------------------------------+import           Data.Maybe             (fromMaybe)+import           Hakyll.Core.Identifier+import           Hakyll.Core.Metadata+import           Hakyll.Core.Routes+import           System.FilePath        ((</>), normalise)+import           Test.Tasty             (TestTree, testGroup)+import           Test.Tasty.HUnit       (Assertion, (@=?))+import           TestSuite.Util -tests :: [Test]-tests = fromAssertions "runRoutes"-    [ Just "foo.html" @=? runRoutes (setExtension "html") "foo"-    , Just "foo.html" @=? runRoutes (setExtension ".html") "foo"-    , Just "foo.html" @=? runRoutes (setExtension "html") "foo.markdown"-    , Just "foo.html" @=? runRoutes (setExtension ".html") "foo.markdown" -    , Just "neve ro ddo reven" @=?-        runRoutes (customRoute (reverse . toFilePath  )) "never odd or even"+--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Core.Routes.Tests" $ fromAssertions "runRoutes"+    [ testRoutes "foo.html" (setExtension "html") "foo"+    , testRoutes "foo.html" (setExtension ".html") "foo"+    , testRoutes "foo.html" (setExtension "html") "foo.markdown"+    , testRoutes "foo.html" (setExtension ".html") "foo.markdown" -    , Just "foo" @=? runRoutes (constRoute "foo") "bar"+    , testRoutes "neve ro ddo reven"+        (customRoute (reverse . toFilePath  )) "never odd or even" -    , Just "tags/bar.xml" @=?-        runRoutes (gsubRoute "rss/" (const "")) "tags/rss/bar.xml"-    , Just "tags/bar.xml" @=?-        runRoutes (gsubRoute "rss/" (const "") `composeRoutes`-            setExtension "xml") "tags/rss/bar"+    , testRoutes "foo" (constRoute "foo") "bar"++    , testRoutes "tags/bar.xml" (gsubRoute "rss/" (const "")) "tags/rss/bar.xml"+    , testRoutes "tags/bar.xml"+        (gsubRoute "rss/" (const "") `composeRoutes` setExtension "xml")+        "tags/rss/bar"++    , testRoutes "food/example.md" (metadataRoute $ \md -> customRoute $ \id' ->+        fromMaybe "?" (lookupString "subblog" md) </> toFilePath id')+        "example.md"     ]+++--------------------------------------------------------------------------------+testRoutes :: FilePath -> Routes -> Identifier -> Assertion+testRoutes expected r id' = do+    store      <- newTestStore+    provider   <- newTestProvider store+    (route, _) <- runRoutes r provider id'+    Just (normalise expected) @=? route+    cleanTestEnv
tests/Hakyll/Core/Rules/Tests.hs view
@@ -1,78 +1,104 @@+-------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} module Hakyll.Core.Rules.Tests     ( tests     ) where -import qualified Data.Map as M-import qualified Data.Set as S -import Test.Framework-import Test.HUnit hiding (Test)+--------------------------------------------------------------------------------+import           Data.IORef                     (IORef, newIORef, readIORef,+                                                 writeIORef)+import qualified Data.Set                       as S+import           Hakyll.Core.Compiler+import           Hakyll.Core.File+import           Hakyll.Core.Identifier+import           Hakyll.Core.Identifier.Pattern+import           Hakyll.Core.Metadata+import           Hakyll.Core.Routes+import           Hakyll.Core.Rules+import           Hakyll.Core.Rules.Internal+import           System.FilePath                ((</>), normalise)+import           Test.Tasty                     (TestTree, testGroup)+import           Test.Tasty.HUnit               (Assertion, (@=?))+import           TestSuite.Util -import Hakyll.Core.Rules-import Hakyll.Core.Rules.Internal-import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import Hakyll.Core.Routes-import Hakyll.Core.Compiler-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Resource.Provider.Dummy-import Hakyll.Core.Writable.CopyFile-import Hakyll.Web.Page-import TestSuite.Util -tests :: [Test]-tests = fromAssertions "runRules" [case01]+--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Core.Rules.Tests" $ fromAssertions "runRules"+    [case01] --- | Dummy resource provider----provider :: IO ResourceProvider-provider = dummyResourceProvider $ M.fromList $ map (flip (,) "No content")-    [ "posts/a-post.markdown"-    , "posts/some-other-post.markdown"-    ] --- | Main test---+-------------------------------------------------------------------------------- case01 :: Assertion case01 = do-    p <- provider-    let ruleSet     = runRules rules p-        identifiers = map fst $ rulesCompilers ruleSet-        routes      = rulesRoutes ruleSet-    expected @=? S.fromList identifiers-    Just "posts/a-post.markdown" @=?-        runRoutes routes (Identifier (Just "nav") "posts/a-post.markdown")+    ioref    <- newIORef False+    store    <- newTestStore+    provider <- newTestProvider store+    ruleSet  <- runRules (rules01 ioref) provider+    let identifiers     = S.fromList $ map fst $ rulesCompilers ruleSet+        routes          = rulesRoutes ruleSet+        checkRoute ex i =+            runRoutes routes provider i >>= \(r, _) -> Just (normalise ex) @=? r++    -- Test that we have some identifiers and that the routes work out+    S.fromList expected @=? identifiers+    checkRoute "example.html"    "example.md"+    checkRoute "example.md"      (sv "raw" "example.md")+    checkRoute "example.md"      (sv "nav" "example.md")+    checkRoute "example.mv1"     (sv "mv1" "example.md")+    checkRoute "example.mv2"     (sv "mv2" "example.md")+    checkRoute "food/example.md" (sv "metadataMatch" "example.md")+    readIORef ioref >>= (True @=?)+    cleanTestEnv   where-    expected = S.fromList-        [ Identifier Nothing "posts/a-post.markdown"-        , Identifier Nothing "posts/some-other-post.markdown"-        , Identifier (Just "raw") "posts/a-post.markdown"-        , Identifier (Just "raw") "posts/some-other-post.markdown"-        , Identifier (Just "nav") "posts/a-post.markdown"+    sv g     = setVersion (Just g)+    expected =+        [                    "example.md"+        , sv "raw"           "example.md"+        , sv "metadataMatch" "example.md"+        , sv "nav"           "example.md"+        , sv "mv1"           "example.md"+        , sv "mv2"           "example.md"++        ,          "russian.md"+        , sv "raw" "russian.md"+        , sv "mv1" "russian.md"+        , sv "mv2" "russian.md"         ] --- | Example rules----rules :: Rules-rules = do++--------------------------------------------------------------------------------+rules01 :: IORef Bool -> Rules ()+rules01 ioref = do     -- Compile some posts-    match "posts/*" $ do+    match "*.md" $ do         route $ setExtension "html"-        compile pageCompiler+        compile copyFileCompiler +    -- Yeah. I don't know how else to test this stuff?+    preprocess $ writeIORef ioref True+     -- Compile them, raw-    group "raw" $ do+    match "*.md" $ version "raw" $ do         route idRoute-        match "posts/*" $ do-            route $ setExtension "html"+        compile getResourceString++    version "metadataMatch" $+        matchMetadata "*.md" (\md -> lookupString "subblog" md == Just "food") $ do+            route $ customRoute $ \id' -> "food" </> toFilePath id'             compile getResourceString      -- Regression test-    group "nav" $ do-        match (list ["posts/a-post.markdown"]) $ do-            route idRoute-            compile copyFileCompiler+    version "nav" $ match (fromList ["example.md"]) $ do+        route idRoute+        compile copyFileCompiler -    return ()+    -- Another edge case: different versions in one match+    match "*.md" $ do+        version "mv1" $ do+            route $ setExtension "mv1"+            compile getResourceString+        version "mv2" $ do+            route $ setExtension "mv2"+            compile getResourceString
+ tests/Hakyll/Core/Runtime/Tests.hs view
@@ -0,0 +1,290 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Core.Runtime.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad       (void)+import qualified Data.ByteString     as B+import           Data.List           (isInfixOf)+import           System.Exit         (ExitCode (..))+import           System.FilePath     ((</>))+import           Test.Tasty          (TestTree, testGroup)+import           Test.Tasty.HUnit    (Assertion, assertBool, (@?=))+++--------------------------------------------------------------------------------+import           Hakyll+import qualified Hakyll.Core.Logger  as Logger+import           Hakyll.Core.Runtime+import           TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Core.Runtime.Tests" $ fromAssertions "run"+    [ case01+    , case02+    , case03+    , case04+    , case05+    , case06+    , issue1000+    , issue1014+    ]+++--------------------------------------------------------------------------------+case01 :: Assertion+case01 = do+    logger <- Logger.new Logger.Error+    _      <- run RunModeNormal testConfiguration logger $ do+        match "images/*" $ do+            route idRoute+            compile copyFileCompiler++        match "*.md" $ do+            route   $ setExtension "html"+            compile $ do+                getResourceBody+                    >>= saveSnapshot "raw"+                    >>= renderParagraphs++        match (fromList ["partial.html", "partial-helper.html"]) $+            compile templateCompiler+        create ["partial.html.out"] $ do+            route idRoute+            compile $ do+                example <- loadSnapshotBody "example.md" "raw"+                makeItem example+                    >>= loadAndApplyTemplate "partial.html" defaultContext++        create ["bodies.txt"] $ do+            route idRoute+            compile $ do+                items <- loadAllSnapshots "*.md" "raw"+                makeItem $ concat $ map itemBody (items :: [Item String])++    favicon <- B.readFile $+        providerDirectory testConfiguration </> "images/favicon.ico"+    favicon' <- B.readFile $+        destinationDirectory testConfiguration </> "images/favicon.ico"+    favicon @?= favicon'++    example <- readFile $+        destinationDirectory testConfiguration </> "example.html"+    lines example @?=  ["<p>This is an example.</p>"]++    bodies <- readFile $ destinationDirectory testConfiguration </> "bodies.txt"+    head' (lines bodies) @?=  "This is an example."++    partial  <- readFile $ providerDirectory    testConfiguration </> "partial.html.out"+    partial' <- readFile $ destinationDirectory testConfiguration </> "partial.html.out"+    partial @?= partial'++    cleanTestEnv++  where+    head' (x:_) = x+    head' []    = error "Hakyll.Core.Runtime.Tests.case01: impossible"+++--------------------------------------------------------------------------------+case02 :: Assertion+case02 = do+    logger <- Logger.new Logger.Error+    _      <- run RunModeNormal testConfiguration logger $ do+        match "images/favicon.ico" $ do+            route   $ gsubRoute "images/" (const "")+            compile $ makeItem ("Test" :: String)++        match "images/**" $ do+            route   idRoute+            compile copyFileCompiler++    favicon <- readFile $+        destinationDirectory testConfiguration </> "favicon.ico"+    favicon @?= "Test"++    cleanTestEnv+++--------------------------------------------------------------------------------+-- Test that dependency cycles are correctly identified+case03 :: Assertion+case03 = do+    (logger, inMemLog) <- Logger.newInMem+    (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+    msgs <- inMemLog+    length+        [ msg+        | (Logger.Error, msg) <- msgs, "Dependency cycles:" `isInfixOf` msg+        ] @?= 1++    cleanTestEnv+++--------------------------------------------------------------------------------+-- Test that dependency cycles are correctly identified when snapshots+-- are also involved. See issue #878.+case04 :: Assertion+case04 = do+    (logger, inMemLog) <- Logger.newInMem+    (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++        create ["partial.html.out2"] $ do+            route idRoute+            compile $ do+                example <- loadSnapshotBody "partial.html.out1" "raw"+                makeItem example+                    >>= loadAndApplyTemplate "partial.html" defaultContext++    ec @?= ExitFailure 1+    msgs <- inMemLog+    length+        [ msg+        | (Logger.Error, msg) <- msgs, "Dependency cycles:" `isInfixOf` msg+        ] @?= 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+++--------------------------------------------------------------------------------+issue1000 :: Assertion+issue1000 = do+    (logger, inMemLog) <- Logger.newInMem+    (ec, _)            <- run RunModeNormal testConfiguration logger $ do+        match "*.md" $ do+            route $ setExtension "html"+            compile getResourceBody+        match "*.md" $ version "nav" $ do+            route $ setExtension "html"+            compile $ getResourceBody >>= traverse (pure . reverse)++    ec @?= ExitFailure 1+    msgs <- inMemLog+    assertBool "missing 'multiple writes' errors" $ not $ null $+        [ msg+        | (Logger.Error, msg) <- msgs, "multiple writes" `isInfixOf` msg+        ]++    cleanTestEnv+++--------------------------------------------------------------------------------+issue1014 :: Assertion+issue1014 = do+    (logger, inMemLog) <- Logger.newInMem+    (ec, _)            <- run RunModeNormal testConfiguration logger $ do+        match "*.md" $ do+            route $ setExtension "html"+            -- This compiler will succeed due to laziness, but writing the+            -- result will throw an exception.+            compile $ makeItem ("hello" ++ error "lazyworld")++    ec @?= ExitFailure 1+    msgs <- inMemLog+    assertBool "missing 'lazyworld' error" $ not $ null $+        [ msg+        | (Logger.Error, msg) <- msgs, "lazyworld" `isInfixOf` msg+        ]+    assertBool "unwanted 'Success' message" $ not $+        (Logger.Message, "Success") `elem` msgs+    cleanTestEnv
tests/Hakyll/Core/Store/Tests.hs view
@@ -6,63 +6,78 @@   ---------------------------------------------------------------------------------import           Data.Typeable                        (typeOf)-import           Test.Framework-import           Test.Framework.Providers.HUnit-import           Test.Framework.Providers.QuickCheck2-import qualified Test.HUnit                           as H-import           Test.QuickCheck-import           Test.QuickCheck.Monadic+import           Data.Typeable           (typeOf)+import qualified Test.QuickCheck         as Q+import qualified Test.QuickCheck.Monadic as Q+import           Test.Tasty              (TestTree, testGroup)+import           Test.Tasty.HUnit        (testCase)+import qualified Test.Tasty.HUnit        as H+import           Test.Tasty.QuickCheck   (testProperty)   ---------------------------------------------------------------------------------import qualified Hakyll.Core.Store                    as Store+import qualified Hakyll.Core.Store       as Store import           TestSuite.Util   ---------------------------------------------------------------------------------tests :: [Test]-tests =+tests :: TestTree+tests = testGroup "Hakyll.Core.Store.Tests"     [ testProperty "simple get . set"     simpleSetGet     , testProperty "persistent get . set" persistentSetGet     , testCase     "WrongType get . set"  wrongType+    , testCase     "isMembertest . set"   isMembertest     ]   ---------------------------------------------------------------------------------simpleSetGet :: Property-simpleSetGet = monadicIO $ do-    key   <- pick arbitrary-    value <- pick arbitrary-    store <- run $ makeStoreTest-    run $ Store.set store key (value :: String)-    value' <- run $ Store.get store key-    assert $ Store.Found value == value'+simpleSetGet :: Q.Property+simpleSetGet = Q.monadicIO $ do+    key   <- Q.pick Q.arbitrary+    value <- Q.pick Q.arbitrary+    store <- Q.run newTestStore+    Q.run $ Store.set store key (value :: String)+    value' <- Q.run $ Store.get store key+    Q.assert $ Store.Found value == value'+    Q.run cleanTestEnv   ---------------------------------------------------------------------------------persistentSetGet :: Property-persistentSetGet = monadicIO $ do-    key    <- pick arbitrary-    value  <- pick arbitrary-    store1 <- run $ makeStoreTest-    run $ Store.set store1 key (value :: String)+persistentSetGet :: Q.Property+persistentSetGet = Q.monadicIO $ do+    key    <- Q.pick Q.arbitrary+    value  <- Q.pick Q.arbitrary+    store1 <- Q.run newTestStore+    Q.run $ Store.set store1 key (value :: String)     -- Now Create another store from the same dir to test persistence-    store2 <- run $ makeStoreTest-    value' <- run $ Store.get store2 key-    assert $ Store.Found value == value'+    store2 <- Q.run newTestStore+    value' <- Q.run $ Store.get store2 key+    Q.assert $ Store.Found value == value'+    Q.run cleanTestEnv   -------------------------------------------------------------------------------- wrongType :: H.Assertion wrongType = do-    store <- makeStoreTest+    store <- newTestStore     -- Store a string and try to fetch an int     Store.set store ["foo", "bar"] ("qux" :: String)     value <- Store.get store ["foo", "bar"] :: IO (Store.Result Int)-    print value-    H.assert $ case value of-        Store.WrongType e t ->-            e == typeOf (undefined :: Int) &&-            t == typeOf (undefined :: String)-        _                   -> False+    case value of+        Store.WrongType e t -> do+            typeOf (undefined :: Int)    H.@=? e+            typeOf (undefined :: String) H.@=? t+        _ -> H.assertFailure "Expecting WrongType"+    cleanTestEnv+++--------------------------------------------------------------------------------+isMembertest :: H.Assertion+isMembertest = do+    store <- newTestStore+    Store.set store ["foo", "bar"] ("qux" :: String)+    good <- Store.isMember store ["foo", "bar"]+    bad  <- Store.isMember store ["foo", "baz"]+    True  H.@=? good+    False H.@=? bad+    cleanTestEnv
tests/Hakyll/Core/UnixFilter/Tests.hs view
@@ -1,50 +1,74 @@+-------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP               #-} module Hakyll.Core.UnixFilter.Tests-    where+    ( tests+    ) where -import Control.Arrow ((>>>))-import qualified Data.Map as M -import Test.Framework (Test)-import Test.Framework.Providers.HUnit (testCase)-import qualified Test.HUnit as H-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL+--------------------------------------------------------------------------------+import           Test.Tasty             (TestTree, testGroup)+import           Test.Tasty.HUnit       (testCase)+import qualified Test.Tasty.HUnit       as H -import Hakyll.Core.Compiler-import Hakyll.Core.Resource.Provider.Dummy-import Hakyll.Core.UnixFilter-import TestSuite.Util -tests :: [Test]-tests =-    [ testCase "unixFilter rev" unixFilterRev+--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Identifier+import           Hakyll.Core.Item+import           Hakyll.Core.UnixFilter+import           TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Core.UnixFilter.Tests" $+#ifdef mingw32_HOST_OS+    [] -- The `rev` utility is not present by default on Windows+#else+    [ testCase "unixFilter rev"   unixFilterRev ]+#endif+    +++    [ testCase "unixFilter false" unixFilterFalse+    , testCase "unixFilter error" unixFilterError     ] +testMarkdown :: Identifier+testMarkdown = "russian.md"++--------------------------------------------------------------------------------+#ifndef mingw32_HOST_OS unixFilterRev :: H.Assertion unixFilterRev = do-    provider <- dummyResourceProvider $ M.singleton "foo" $-        TL.encodeUtf8 $ TL.pack text-    output <- runCompilerJobTest compiler "foo" provider ["foo"]-    H.assert $ rev text == lines output+    store    <- newTestStore+    provider <- newTestProvider store+    output   <- testCompilerDone store provider testMarkdown compiler+    expected <- testCompilerDone store provider testMarkdown getResourceString+    rev (itemBody expected) H.@=? lines (itemBody output)+    cleanTestEnv   where-    compiler = getResource >>> getResourceString >>> unixFilter "rev" []-    rev = map reverse . lines+    compiler = getResourceString >>= withItemBody (unixFilter "rev" [])+    rev      = map reverse . lines+#endif -text :: String-text = unlines-    [ "Статья 18"-    , ""-    , "Каждый человек имеет право на свободу мысли, совести и религии; это"-    , "право включает свободу менять свою религию или убеждения и свободу"-    , "исповедовать свою религию или убеждения как единолично, так и сообща с"-    , "другими, публичным или частным порядком в учении, богослужении и"-    , "выполнении религиозных и ритуальных обрядов."-    , ""-    , "Статья 19"-    , ""-    , "Каждый человек имеет право на свободу убеждений и на свободное выражение"-    , "их; это право включает свободу беспрепятственно придерживаться своих"-    , "убеждений и свободу искать, получать и распространять информацию и идеи"-    , "любыми средствами и независимо от государственных границ."-    ]++--------------------------------------------------------------------------------+unixFilterFalse :: H.Assertion+unixFilterFalse = do+    store    <- newTestStore+    provider <- newTestProvider store+    testCompilerError store provider testMarkdown compiler "exit code"+    cleanTestEnv+  where+    compiler = getResourceString >>= withItemBody (unixFilter "false" [])+++--------------------------------------------------------------------------------+unixFilterError :: H.Assertion+unixFilterError = do+    store    <- newTestStore+    provider <- newTestProvider store+    testCompilerError store provider testMarkdown compiler "option"+    cleanTestEnv+  where+    compiler = getResourceString >>= withItemBody (unixFilter "head" ["-#"])
− tests/Hakyll/Core/Util/Arrow/Tests.hs 
@@ -1,14 +0,0 @@-module Hakyll.Core.Util.Arrow.Tests-    ( tests-    ) where--import Test.Framework (Test)-import Test.HUnit ((@=?))--import Hakyll.Core.Util.Arrow-import TestSuite.Util--tests :: [Test]-tests = fromAssertions "sequenceA"-    [ [8, 20, 1] @=? sequenceA [(+ 4), (* 5), signum] (4 :: Int)-    ]
tests/Hakyll/Core/Util/String/Tests.hs view
@@ -1,25 +1,54 @@+-------------------------------------------------------------------------------- module Hakyll.Core.Util.String.Tests     ( tests     ) where -import Test.Framework (Test)-import Test.HUnit ((@=?)) -import Hakyll.Core.Util.String-import TestSuite.Util+--------------------------------------------------------------------------------+import           Test.Tasty              (TestTree, testGroup)+import           Test.Tasty.HUnit        ((@=?)) -tests :: [Test]-tests = concat++--------------------------------------------------------------------------------+import           Hakyll.Core.Util.String+import           TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Core.Util.String.Tests" $ concat     [ fromAssertions "trim"         [ "foo" @=? trim " foo\n\t "         ]      , fromAssertions "replaceAll"-        [ "32 & 131" @=? replaceAll "0x[0-9]+" (show . readInt) "0x20 & 0x83"+        [ "foo-end"       @=? replaceAll "begin"       (const "foo")    "begin-end"+        , "begin-foo"     @=? replaceAll "end"         (const "foo")    "begin-end"+        , "no match"      @=? replaceAll "abc"         (const "foo")    "no match"+        , "foo"           @=? replaceAll ".*"          (const "foo")    "full match"+        , "empty pattern" @=? replaceAll ""            (const "foo")    "empty pattern"+        , ""              @=? replaceAll "empty input" (const "foo")    ""+        , "32 & 131"      @=? replaceAll "0x[0-9]+"    (show . readInt) "0x20 & 0x83"         ]      , fromAssertions "splitAll"-        [ ["λ", "∀x.x", "hi"] @=? splitAll ", *" "λ, ∀x.x,  hi"+        [ ["a", "b", "c"]     @=? splitAll ","           "a,,b,,,c,,"+        , ["abc", "def"]      @=? splitAll "[0-9]+"      "abc123def456"+        , ["no match"]        @=? splitAll ","           "no match"+        , []                  @=? splitAll ".*"          "full match"+        , ["empty pattern"]   @=? splitAll ""            "empty pattern"+        , []                  @=? splitAll "empty input" ""+        , ["λ", "∀x.x", "hi"] @=? splitAll ", *"         "λ, ∀x.x,  hi"+        ]++    , fromAssertions "needlePrefix"+        [ Just "ab" @=? needlePrefix "cd" "abcde"+        , Just "xx" @=? needlePrefix "ab" "xxab"+        , Nothing   @=? needlePrefix "a" "xx"+        , Just "x"  @=? needlePrefix "ab" "xabxab"+        , Just ""   @=? needlePrefix "ab" "abc"+        , Just ""   @=? needlePrefix "ab" "abab"+        , Nothing   @=? needlePrefix "" ""         ]     ]
+ tests/Hakyll/Web/CompressCss/Tests.hs view
@@ -0,0 +1,66 @@+--------------------------------------------------------------------------------+module Hakyll.Web.CompressCss.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Tasty             (TestTree, testGroup)+import           Test.Tasty.HUnit       ((@=?))+++--------------------------------------------------------------------------------+import           Hakyll.Web.CompressCss+import           TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Web.CompressCss.Tests" $ concat+    [ fromAssertions "compressCss"+        [+          -- compress whitespace+          "something something" @=?+            compressCss " something  \n\t\r  something "+          -- do not compress whitespace in string tokens+        , "abc \"  \t\n\r  \" xyz" @=?+            compressCss "abc \"  \t\n\r  \" xyz"+        , "abc '  \t\n\r  ' xyz" @=?+            compressCss "abc '  \t\n\r  ' xyz"++          -- strip comments+        , "before after"  @=? compressCss "before /* abc { } ;; \n\t\r */ after"+          -- don't strip comments inside string tokens+        , "before \"/* abc { } ;; \n\t\r */\" after"+                          @=? compressCss "before \"/* abc { } ;; \n\t\r */\" after"++          -- compress separators+        , "}"             @=? compressCss ";   }"+        , ";{};"          @=? compressCss " ;  {  }  ;  "+        , "text,"         @=? compressCss "text  ,  "+        , "a>b"           @=? compressCss "a > b"+        , "a+b"           @=? compressCss "a + b"+        , "a!b"           @=? compressCss "a ! b"+          -- compress calc()+        , "calc(1px + 100%/(5 + 3) - (3px + 2px)*5)" @=? compressCss "calc( 1px + 100% / ( 5 +  3) - calc( 3px + 2px ) * 5 )"+          -- compress clamp() (issue #1021)+        , "clamp(2.25rem, 2vw + 1.5rem, 3.25rem)" @=? compressCss "clamp(2.25rem,  2vw  +     1.5rem, 3.25rem)"+          -- compress whitespace even after this curly brace+        , "}"             @=? compressCss ";   }  "+          -- but do not compress separators inside string tokens+        , "\"  { } ; , \"" @=? compressCss "\"  { } ; , \""+          -- don't compress separators at the start or end of string tokens+        , "\" }\""        @=? compressCss "\" }\""+        , "\"{ \""        @=? compressCss "\"{ \""+          -- don't get irritated by the wrong token delimiter+        , "\"   '   \""   @=? compressCss "\"   '   \""+        , "'   \"   '"    @=? compressCss "'   \"   '"+          -- don't compress whitespace in the middle of a string+        , "abc '{ '"      @=? compressCss "abc '{ '"+        , "abc \"{ \""    @=? compressCss "abc \"{ \""+          -- compress whitespace after colons (but not before)+        , "abc :xyz"       @=? compressCss "abc : xyz"+          -- compress multiple semicolons+        , ";"             @=? compressCss ";;;;;;;"+        ]+    ]
+ tests/Hakyll/Web/Feed/Tests.hs view
@@ -0,0 +1,68 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Web.Feed.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Tasty       (TestTree, testGroup)+import           Test.Tasty.HUnit (Assertion, testCase)+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Provider+import           Hakyll.Web.Feed+import           Hakyll.Web.Template.Context+import           TestSuite.Util+--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Web.Feed.Tests"+    [ testCase "validateSucceeds" validateSucceeds+    , testCase "validateFails" validateFails+    ]++validateFails :: Assertion+validateFails = do+    store <- newTestStore+    provider <- newTestProvider store++    item <- testCompilerDone store provider "example.md"+      $ makeItem (resourceFilePath provider "example.md")++    testCompilerError store provider "feed.xml"+      (renderRss feedConfiguration ctx [item])+      "Generated feed contains invalid XML (perhaps you id not escape a metadata field?)"+    cleanTestEnv+  where+    title = "invalid & not xml"+    ctx = constField "title" title `mappend`+      constField "description" "" `mappend`+      defaultContext++validateSucceeds :: Assertion+validateSucceeds = do+    store <- newTestStore+    provider <- newTestProvider store++    item <- testCompilerDone store provider "example.md"+      $ makeItem (resourceFilePath provider "example.md")++    _ <- testCompilerDone store provider "feed.xml"+      $ renderRss feedConfiguration ctx [item]+    cleanTestEnv+  where+    title = "valid xml"+    ctx = constField "title" title `mappend`+      constField "description" "" `mappend`+      defaultContext++feedConfiguration :: FeedConfiguration+feedConfiguration = FeedConfiguration+  { feedTitle = "test"+  , feedDescription = "test"+  , feedAuthorName = "test"+  , feedAuthorEmail = ""+  , feedRoot = "example.org"+  }
+ tests/Hakyll/Web/Html/RelativizeUrls/Tests.hs view
@@ -0,0 +1,40 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Web.Html.RelativizeUrls.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Tasty                     (TestTree, testGroup)+import           Test.Tasty.HUnit               ((@=?))+++--------------------------------------------------------------------------------+import           Hakyll.Web.Html.RelativizeUrls+import           TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Web.Html.RelativizeUrls.Tests" $+    fromAssertions "relativizeUrls"+        [ "<a href=\"../foo\">bar</a>" @=?+            relativizeUrlsWith ".." "<a href=\"/foo\">bar</a>"+        , "<img src=\"../../images/lolcat.png\" />" @=?+            relativizeUrlsWith "../.." "<img src=\"/images/lolcat.png\" />"+        , "<video poster=\"../../images/lolcat.png\"></video>" @=?+            relativizeUrlsWith "../.."+                "<video poster=\"/images/lolcat.png\"></video>"+        , "<a href=\"http://haskell.org\">Haskell</a>" @=?+            relativizeUrlsWith "../.."+                "<a href=\"http://haskell.org\">Haskell</a>"+        , "<a href=\"http://haskell.org\">Haskell</a>" @=?+            relativizeUrlsWith "../.."+                "<a href=\"http://haskell.org\">Haskell</a>"+        , "<script src=\"//ajax.googleapis.com/jquery.min.js\"></script>" @=?+            relativizeUrlsWith "../.."+                "<script src=\"//ajax.googleapis.com/jquery.min.js\"></script>"+        , "<img srcset=\"./image.png 200w, ./image2.png 400w\" />"  @=?+            relativizeUrlsWith "." "<img srcset=\"/image.png 200w, /image2.png 400w\" />"+        ]
+ tests/Hakyll/Web/Html/Tests.hs view
@@ -0,0 +1,124 @@+--------------------------------------------------------------------------------+module Hakyll.Web.Html.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Data.Char        (toUpper)+import           Test.Tasty       (TestTree, testGroup)+import           Test.Tasty.HUnit ((@=?))+import qualified Text.HTML.TagSoup               as TS+++--------------------------------------------------------------------------------+import           Hakyll.Web.Html+import           TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Web.Html.Tests" $ concat+    [ fromAssertions "demoteHeaders"+        [ "<h2>A h1 title</h2>" @=?+            demoteHeaders "<h1>A h1 title</h1>" -- Assert single-step demotion+        , "<h6>A h6 title</h6>" @=?+            demoteHeaders "<h6>A h6 title</h6>" -- Assert maximum demotion is h6+        ]++    , fromAssertions "demoteHeadersBy"+        [ "<h3>A h1 title</h3>" @=?+            demoteHeadersBy 2 "<h1>A h1 title</h1>"+        , "<h6>A h5 title</h6>" @=?+            demoteHeadersBy 2 "<h5>A h5 title</h5>" -- Assert that h6 is the lowest possible demoted header.+        , "<h4>A h4 title</h4>" @=?+            demoteHeadersBy 0 "<h4>A h4 title</h4>" -- Assert that a demotion of @N < 1@ is a no-op.+        ]++    , fromAssertions "getUrls"+        [ ["/image1.png", "/image2.jpeg", "https://example.com", "/game.swf", "/poster.jpeg"] @=?+            getUrls [+                TS.TagOpen "img" [("src", "/image1.png")]+              , TS.TagOpen "img" [("src", "/image2.jpeg")]+              , TS.TagOpen "a" [("href", "https://example.com")]+              , TS.TagOpen "object" [("data", "/game.swf")]+              , TS.TagOpen "video" [("poster", "/poster.jpeg")]+              ]+        , ["/image1.png", "/image2.jpeg", "/image3.bmp"] @=?+            getUrls [ TS.TagOpen "img" [("srcset", "/image1.png 10w, /image2.jpeg, /image3.bmp 1.3x")] ]++        -- Invalid srcset specification means no URLs are extracted+        , [] @=?+            getUrls [ TS.TagOpen "img" [("srcset", "/image1.png 10wide, /image2.jpeg, /image3.bmp 1.3px")] ]+        ]++    , fromAssertions "withUrls"+        [ "<a href=\"FOO\">bar</a>" @=?+            withUrls (map toUpper) "<a href=\"foo\">bar</a>"+        , "<img src=\"OH BAR\" />" @=?+            withUrls (map toUpper) "<img src=\"oh bar\" />"++        -- Test escaping+        , "<script>\"sup\"</script>" @=?+            withUrls id "<script>\"sup\"</script>"+        , "<code>&lt;stdio&gt;</code>" @=?+            withUrls id "<code>&lt;stdio&gt;</code>"+        , "<style>body > p { line-height: 1.3 }</style>" @=?+            withUrls id "<style>body > p { line-height: 1.3 }</style>"++        -- Test minimizing elements+        , "<meta bar=\"foo\" />" @=?+            withUrls id "<meta bar=\"foo\" />"++        -- Test that URLs are extracted from img's srcset+        , "<img srcset=\"foo 200w\" />" @=?+            withUrls (const "foo") "<img srcset=\"/path/to/image.png 200w\" />"+        , "<img srcset=\"bar 200w, bar 400w\" />" @=?+            withUrls (const "bar") "<img srcset=\"/small.jpeg 200w, /img/large.jpeg 400w\" />"++        -- Invalid srcsets are left unchanged+        , "<img srcset=\"/image1.png 200px\" />" @=?+            withUrls (const "bar") "<img srcset=\"/image1.png 200px\" />"+        ]++    , fromAssertions "toUrl"+        [ "/foo/bar.html"                     @=? toUrl "foo/bar.html"+        , "/foo/bar.html"                     @=? toUrl "foo\\bar.html" -- Windows-specific+        , "/"                                 @=? toUrl "/"+        , "/funny-pics.html"                  @=? toUrl "/funny-pics.html"+        , "/funny%20pics.html"                @=? toUrl "funny pics.html"+        -- Test various reserved characters (RFC 3986, section 2.2)+        , "/%21%2A%27%28%29%3B%3A%40%26.html" @=? toUrl "/!*'();:@&.html"+        , "/%3D%2B%24%2C/%3F%23%5B%5D.html"   @=? toUrl "=+$,/?#[].html"+        -- Test various characters that are nor reserved, nor unreserved.+        , "/%E3%81%82%F0%9D%90%87%E2%88%80"   @=? toUrl "\12354\119815\8704"+        ]++    , fromAssertions "toSiteRoot"+        [ ".."    @=? toSiteRoot "/foo/bar.html"+        , "."     @=? toSiteRoot "index.html"+        , "."     @=? toSiteRoot "/index.html"+        , "../.." @=? toSiteRoot "foo/bar/qux"+        , ".."    @=? toSiteRoot "./foo/bar.html"+        , ".."    @=? toSiteRoot "/foo/./bar.html"+        ]++    , fromAssertions "isExternal"+        [ True  @=? isExternal "http://reddit.com"+        , True  @=? isExternal "https://mail.google.com"+        , True  @=? isExternal "//ajax.googleapis.com"+        , False @=? isExternal "../header.png"+        , False @=? isExternal "/foo/index.html"+        ]++    , fromAssertions "stripTags"+        [ "foo"     @=? stripTags "<p>foo</p>"+        , "foo bar" @=? stripTags "<p>foo</p> bar"+        , "foo"     @=? stripTags "<p>foo</p"+        ]++    , fromAssertions "escapeHtml"+        [ "Me &amp; Dean" @=? escapeHtml "Me & Dean"+        , "&lt;img&gt;"   @=? escapeHtml "<img>"+        ]+    ]
− tests/Hakyll/Web/Page/Metadata/Tests.hs 
@@ -1,77 +0,0 @@-module Hakyll.Web.Page.Metadata.Tests-    ( tests-    ) where--import Test.Framework-import Test.HUnit hiding (Test)--import qualified Data.Map as M-import Data.Monoid (mempty)-import Data.Char (toLower)--import Hakyll.Web.Page-import Hakyll.Web.Page.Metadata-import TestSuite.Util--tests :: [Test]-tests = concat $-    [ fromAssertions "getField"-        [ "bar" @=? getField "foo" (Page (M.singleton "foo" "bar") "body\n")-        , ""    @=? getField "foo" (Page M.empty "body")-        ]--    , fromAssertions "getFieldMaybe"-        [ Just "bar" @=? getFieldMaybe "foo" (Page (M.singleton "foo" "bar") "")-        , Nothing    @=? getFieldMaybe "foo" (Page M.empty "body")-        ]--    , fromAssertions "setField"-        [ (Page (M.singleton "bar" "foo") "") @=? setField "bar" "foo" mempty-        , (Page (M.singleton "bar" "foo") "") @=?-            setField "bar" "foo" (Page (M.singleton "bar" "qux") "")-        ]--    , fromAssertions "trySetField"-        [ (Page (M.singleton "bar" "foo") "") @=? trySetField "bar" "foo" mempty-        , (Page (M.singleton "bar" "qux") "") @=?-            trySetField "bar" "foo" (Page (M.singleton "bar" "qux") "")-        ]--    , fromAssertions "setFieldA"-        [ (Page (M.singleton "bar" "foo") "") @=?-            setFieldA "bar" (map toLower) (mempty, "FOO")-        ]--    , fromAssertions "renderDateField"-        [ (@=?) "January 31, 2010" $ getField "date" $ renderDateField-            "date" "%B %e, %Y" "Date unknown" $ Page-                (M.singleton "path" "/posts/2010-01-31-a-post.mkdwn") ""-        , (@=?) "Date unknown" $ getField "date" $ renderDateField-            "date" "%B %e, %Y" "Date unknown" $ Page-                (M.singleton "path" "/posts/a-post.mkdwn") ""-        , (@=?) "February 20, 2000" $ getField "date" $ renderDateField-            "date" "%B %e, %Y" "Date unknown" $ flip Page "" $ M.fromList-                [ ("path",      "/posts/2010-01-31-a-post.mkdwn")-                , ("published", "February 20, 2000 1:00 PM")-                ]-        , (@=?) "October 22, 2012" $ getField "date" $ renderDateField-            "date" "%B %e, %Y" "Date unknown" $ Page-                (M.singleton "date" "2012-10-22 14:35:24") ""-        ]--    , fromAssertions "copyBodyToField"-        [ (Page (M.singleton "bar" "foo") "foo") @=?-            copyBodyToField "bar" (Page M.empty "foo")-        ]--    , fromAssertions "copyBodyFromField"-        [ (Page (M.singleton "bar" "foo") "foo") @=?-            copyBodyFromField "bar" (Page (M.singleton "bar" "foo") "qux")-        ]--    , fromAssertions "comparePagesByDate"-        [ GT @=? comparePagesByDate-            (Page (M.singleton "path" "/posts/1990-08-26-foo.mkdwn") "")-            (Page (M.singleton "path" "/posts/1990-06-18-qux.mkdwn") "")-        ]-    ]
− tests/Hakyll/Web/Page/Tests.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Hakyll.Web.Page.Tests-    ( tests-    ) where--import Test.Framework-import Test.HUnit hiding (Test)--import qualified Data.Map as M--import Hakyll.Web.Page-import Hakyll.Web.Page.Read-import TestSuite.Util--tests :: [Test]-tests = fromAssertions "readPage"-    [ Page (M.singleton "foo" "bar") "body" @=? readPage-        "---        \n\-        \foo: bar   \n\-        \---        \n\-        \body"--    , Page M.empty "line one\nlijn twee" @=? readPage-        "line one\n\-        \lijn twee"--    , Page (M.fromList [("field1", "unos"), ("veld02", "deux")]) "" @=? readPage-        "---\n\-        \veld02: deux\n\-        \field1: unos\n\-        \---\n"--    , Page (M.fromList [("author", "jasper"), ("title", "lol")]) "O hai\n"-        @=? readPage-        "---\n\-        \author: jasper\n\-        \title: lol\n\-        \...\n\-        \O hai\n"-    ]
+ tests/Hakyll/Web/Pandoc/Biblio/Tests.hs view
@@ -0,0 +1,164 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP               #-}+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 qualified Hakyll.Core.Logger         as Logger+import           TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Web.Pandoc.Biblio.Tests" $+    [ goldenTest01+    , goldenTest02+    , goldenTest03+    ]++--------------------------------------------------------------------------------+goldenTestsDataDir :: FilePath+goldenTestsDataDir = "tests/data/biblio"++--------------------------------------------------------------------------------+goldenTest01 :: TestTree+goldenTest01 =+    goldenVsString+        "biblio01"+        (goldenTestsDataDir </> goldenTest)+        (do+            -- Code lifted from https://github.com/jaspervdj/hakyll-citeproc-example.+            logger <- Logger.new Logger.Error+            let config = testConfiguration { providerDirectory = goldenTestsDataDir }+            _ <- run RunModeNormal 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)++    where+        goldenTest =+#if MIN_VERSION_pandoc(3,1,8)+          "cites-meijer-pandoc-3.1.8plus.golden"+#elif MIN_VERSION_pandoc(3,0,0)+          "cites-meijer-pandoc-3.0.0plus.golden"+#else+          "cites-meijer-pandoc-2.0.0plus.golden"+#endif++goldenTest02 :: TestTree+goldenTest02 =+    goldenVsString+        "biblio02"+        (goldenTestsDataDir </> goldenTest)+        (do+            -- Code lifted from https://github.com/jaspervdj/hakyll-citeproc-example.+            logger <- Logger.new Logger.Error+            let config = testConfiguration { providerDirectory = goldenTestsDataDir }+            _ <- run RunModeNormal config logger $ do+                let myPandocBiblioCompiler = do+                        csl <- load "chicago.csl"+                        bib <- load "refs.yaml"+                        getResourceBody >>=+                            readPandocBiblio defaultHakyllReaderOptions csl bib >>=+                            return . writePandoc++                match "default.html" $ compile templateCompiler+                match "chicago.csl" $ compile cslCompiler+                match "refs.yaml"    $ 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)+    where+        goldenTest =+#if MIN_VERSION_pandoc(3,1,8)+          "cites-meijer-pandoc-3.1.8plus.golden"+#elif MIN_VERSION_pandoc(3,0,0)+          "cites-meijer-pandoc-3.0.0plus.golden"+#else+          "cites-meijer-pandoc-2.0.0plus.golden"+#endif++goldenTest03 :: TestTree+goldenTest03 =+    goldenVsString+        "biblio03"+        (goldenTestsDataDir </> goldenTest)+        (do+            -- Code lifted from https://github.com/jaspervdj/hakyll-citeproc-example.+            logger <- Logger.new Logger.Error+            let config = testConfiguration { providerDirectory = goldenTestsDataDir }+            _ <- run RunModeNormal config logger $ do+                let myPandocBiblioCompiler = do+                        csl <- load "chicago.csl"+                        bib1 <- load "refs.bib"+                        bib2 <- load "refs2.yaml"+                        getResourceBody >>=+                            readPandocBiblios defaultHakyllReaderOptions csl [bib1, bib2] >>=+                            return . writePandoc++                match "default.html" $ compile templateCompiler+                match "chicago.csl" $ compile cslCompiler+                match "refs.bib"    $ compile biblioCompiler+                match "refs2.yaml"    $ compile biblioCompiler+                match "cites-multiple.markdown" $ do+                    route $ setExtension "html"+                    compile $+                        myPandocBiblioCompiler >>=+                        loadAndApplyTemplate "default.html" defaultContext++            output <- fmap LBS.fromStrict $ B.readFile $+                    destinationDirectory testConfiguration </> "cites-multiple.html"++            cleanTestEnv++            return output)+    where+        goldenTest =+#if MIN_VERSION_pandoc(3,1,8)+          "cites-multiple-pandoc-3.1.8plus.golden"+#elif MIN_VERSION_pandoc(3,0,0)+          "cites-multiple-pandoc-3.0.0plus.golden"+#else+          "cites-multiple-pandoc-2.0.0plus.golden"+#endif
+ tests/Hakyll/Web/Pandoc/FileType/Tests.hs view
@@ -0,0 +1,27 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Web.Pandoc.FileType.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Tasty                 (TestTree, testGroup)+import           Test.Tasty.HUnit           ((@=?))+++--------------------------------------------------------------------------------+import           Hakyll.Web.Pandoc.FileType+import           TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Web.Pandoc.FileType.Tests" $+    fromAssertions "fileType"+        [ 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"+        ]
+ tests/Hakyll/Web/Tags/Tests.hs view
@@ -0,0 +1,42 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Web.Tags.Tests+    ( tests+    ) where++--------------------------------------------------------------------------------+import           Test.Tasty                  (TestTree, testGroup)+import           Test.Tasty.HUnit            (Assertion, testCase, (@?=))++--------------------------------------------------------------------------------+import           Hakyll.Core.Identifier+import           Hakyll.Core.Provider+import           Hakyll.Core.Store           (Store)+import           Hakyll.Web.Tags+import           TestSuite.Util++tests :: TestTree+tests = testGroup "Hakyll.Web.Tags"+    [ testCase "testGetCategory" testGetCategory+    ]++testGetCategory :: Assertion+testGetCategory = do+    store    <- newTestStore+    provider <- newTestProvider store++    noCategory <- testCategoryDone store provider "example.md"+    noCategory @?= [""]++    oneCategory1 <- testCategoryDone store provider "posts/2010-08-26-birthday.md"+    oneCategory1 @?= ["posts"]++    oneCategory2 <- testCategoryDone store provider "posts/2019/05/10/tomorrow.md"+    oneCategory2 @?= ["10"]++    cleanTestEnv++--------------------------------------------------------------------------------+testCategoryDone :: Store -> Provider -> Identifier -> IO [String]+testCategoryDone store provider identifier =+    testCompilerDone store provider identifier $ getCategory identifier
+ tests/Hakyll/Web/Template/Context/Tests.hs view
@@ -0,0 +1,67 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Web.Template.Context.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Tasty                  (TestTree, testGroup)+import           Test.Tasty.HUnit            (Assertion, testCase, (@=?))+++--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Identifier+import           Hakyll.Core.Provider+import           Hakyll.Core.Store           (Store)+import           Hakyll.Web.Template.Context+import           TestSuite.Util+++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Web.Template.Context.Tests"+    [ testCase "testDateField" testDateField+    ]+++--------------------------------------------------------------------------------+testDateField :: Assertion+testDateField = do+    store    <- newTestStore+    provider <- newTestProvider store++    date1 <- testContextDone store provider "example.md" "date" $+        dateField "date" "%B %e, %Y"+    date1 @=? "October 22, 2012"++    date2 <- testContextDone store provider+        "posts/2010-08-26-birthday.md" "date" $+            dateField "date" "%B %e, %Y"+    date2 @=? "August 26, 2010"++    date3 <- testContextDone store provider+        "posts/2018-09-26.md" "date" $+            dateField "date" "%B %e, %Y"+    date3 @=? "September 26, 2018"++    date4 <- testContextDone store provider+        "posts/2019/05/10/tomorrow.md" "date" $+            dateField "date" "%B %e, %Y"+    date4 @=? "May 10, 2019"+    cleanTestEnv+++--------------------------------------------------------------------------------+testContextDone :: Store -> Provider -> Identifier -> String+                -> Context String -> IO String+testContextDone store provider identifier key context =+    testCompilerDone store provider identifier $ do+        item <- getResourceBody+        cf   <- unContext context key [] item+        case cf of+            StringField str -> return str+            _               -> error $+                "Hakyll.Web.Template.Context.Tests.testContextDone: " +++                "expected StringField"
tests/Hakyll/Web/Template/Tests.hs view
@@ -1,55 +1,160 @@+-------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-} module Hakyll.Web.Template.Tests     ( tests     ) where -import Test.Framework-import Test.HUnit hiding (Test) -import qualified Data.Map as M+--------------------------------------------------------------------------------+import           Test.Tasty                   (TestTree, testGroup)+import           Test.Tasty.HUnit             (Assertion, assertBool, testCase,+                                               (@=?), (@?=)) -import Hakyll.Web.Page-import Hakyll.Web.Template-import Hakyll.Web.Template.Read-import TestSuite.Util+import           Data.Either                  (isLeft)+import           System.IO                    (nativeNewline, Newline(..)) -tests :: [Test]-tests = fromAssertions "applyTemplate"-    -- Hakyll templates-    [ applyTemplateAssertion readTemplate applyTemplate-        ("bar" @=?) "$foo$" [("foo", "bar")]+--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler+import           Hakyll.Core.Identifier+import           Hakyll.Core.Item+import           Hakyll.Core.Provider+import           Hakyll.Web.Template+import           Hakyll.Web.Template.Context+import           Hakyll.Web.Template.Internal+import           Hakyll.Web.Template.List+import           TestSuite.Util -    , applyTemplateAssertion readTemplate applyTemplate-        ("$ barqux" @=?) "$$ $foo$$bar$" [("foo", "bar"), ("bar", "qux")] -    , applyTemplateAssertion readTemplate applyTemplate-        ("$foo$" @=?) "$foo$" []+--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Hakyll.Web.Template.Tests" $ concat+    [ [ testCase "case01" $ test ("template.html.out", "template.html", "example.md")+      , testCase "case02" $ test ("strip.html.out", "strip.html", "example.md")+      , testCase "case03" $ test ("just-meta.html.out", "just-meta.html", "example.md")+      , testCase "applyJoinTemplateList" testApplyJoinTemplateList+      ] -    -- Hamlet templates-    , applyTemplateAssertion readHamletTemplate applyTemplate-        (("<head><title>notice</title></head><body>A paragraph</body>" @=?) .-            filter (/= '\n'))-        "<head>\n\-        \    <title>#{title}\n\-        \<body>\n\-        \    A paragraph\n"-        [("title", "notice")]+    , fromAssertions "parseTemplate"+        [ Right [Chunk "Hello ", Expr (Call "guest" [])]+            @=? parse "Hello $guest()$"+        , Right [If (Call "a" [StringLiteral "bar"]) [Chunk "foo"] Nothing]+            @=? parse "$if(a(\"bar\"))$foo$endif$"+        -- 'If' trim check.+        , Right [ TrimL+          , If (Ident (TemplateKey "body"))+               [ TrimR+               , Chunk "\n"+               , Expr (Ident (TemplateKey "body"))+               , Chunk "\n"+               , TrimL+               ]+               (Just [ TrimR+                     , Chunk "\n"+                     , Expr (Ident (TemplateKey "body"))+                     , Chunk "\n"+                     , TrimL+                     ])+          , TrimR+          ]+          @=? parse "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"+        -- 'For' trim check.+        , Right [ TrimL+          , For (Ident (TemplateKey "authors"))+                [TrimR, Chunk "\n   body   \n", TrimL]+                Nothing+          , TrimR+          ]+          @=? parse "$-for(authors)-$\n   body   \n$-endfor-$"+        -- 'Partial' trim check.+        , Right [ TrimL+          , Partial (StringLiteral "path")+          , TrimR+          ]+          @=? parse "$-partial(\"path\")-$"+        -- 'Expr' trim check.+        , Right [ TrimL+          , Expr (Ident (TemplateKey "foo"))+          , TrimR+          ]+          @=? parse "$-foo-$"+        -- fail on incomplete template.+        , assertBool "did not yield error" $ isLeft $+          parse "a$b"+        -- fail on mismatched template syntax.+        , assertBool "did not fail to parse" $ isLeft $+          parse "$for(xs)$\n  <p>foo</p>\n$endif$"+        ] -    -- Missing keys-    , let missing "foo" = "bar"-          missing "bar" = "qux"-          missing x     = reverse x-      in applyTemplateAssertion readTemplate (applyTemplateWith missing)-        ("bar foo ver" @=?) "$foo$ $bar$ $rev$" [("bar", "foo")]+    , [testCase "embeddedTemplate" testEmbeddedTemplate]     ]+  where+    parse = parseTemplateElemsFile "" --- | Utility function to create quick template tests----applyTemplateAssertion :: (String -> Template)-                       -> (Template -> Page String -> Page String)-                       -> (String -> Assertion)-                       -> String-                       -> [(String, String)]-                       -> Assertion-applyTemplateAssertion parser apply correct template page =-    correct $ pageBody (apply (parser template) (fromMap $ M.fromList page))++--------------------------------------------------------------------------------+test :: (Identifier, Identifier, Identifier) -> Assertion+test (outf, tplf, itemf) = do+    store    <- newTestStore+    provider <- newTestProvider store++    out  <- resourceString provider outf+    tpl  <- testCompilerDone store provider tplf templateBodyCompiler+    item <- testCompilerDone store provider itemf $+        getResourceBody+        >>= renderParagraphs+        >>= applyTemplate (itemBody tpl) testContext++    out @=? itemBody item+    cleanTestEnv+++--------------------------------------------------------------------------------+testContext :: Context String+testContext = mconcat+    [ defaultContext+    , listField "authors" (bodyField "name") $ do+        n1 <- makeItem "Jan"+        n2 <- makeItem "Piet"+        return [n1, n2]+    , functionField "rev" $ \args _ -> return $ unwords $ map reverse args+    ]+++--------------------------------------------------------------------------------+testApplyJoinTemplateList :: Assertion+testApplyJoinTemplateList = do+    store    <- newTestStore+    provider <- newTestProvider store+    tpl      <- testCompilerDone store provider "tpl" $+        compileTemplateItem (Item "tpl" "<b>$body$</b>")+    str      <- testCompilerDone store provider "item3" $+        applyJoinTemplateList ", " tpl defaultContext [i1, i2]++    str @?= "<b>Hello</b>, <b>World</b>"+    cleanTestEnv+  where+    i1  = Item "item1" "Hello"+    i2  = Item "item2" "World"+++--------------------------------------------------------------------------------+embeddedTemplate :: Template+embeddedTemplate = $(embedTemplate "tests/data/embed.html")++--------------------------------------------------------------------------------+testEmbeddedTemplate :: Assertion+testEmbeddedTemplate = do+    store    <- newTestStore+    provider <- newTestProvider store+    str      <- testCompilerDone store provider "item3" $+        applyTemplate embeddedTemplate defaultContext item++    itemBody str @?= ("<p>Hello, world</p>" ++ (newline nativeNewline))+    cleanTestEnv+  where+    item = Item "item1" "Hello, world"+    +    newline LF   = "\n"+    newline CRLF = "\r\n"+
− tests/Hakyll/Web/Urls/Relativize/Tests.hs 
@@ -1,25 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Hakyll.Web.Urls.Relativize.Tests-    ( tests-    ) where--import Test.Framework-import Test.HUnit hiding (Test)--import Hakyll.Web.Urls.Relativize-import TestSuite.Util--tests :: [Test]-tests = fromAssertions "relativizeUrls"-    [ "<a href=\"../foo\">bar</a>" @=?-        relativizeUrls ".." "<a href=\"/foo\">bar</a>"-    , "<img src=\"../../images/lolcat.png\" />" @=?-        relativizeUrls "../.." "<img src=\"/images/lolcat.png\" />"-    , "<a href=\"http://haskell.org\">Haskell</a>" @=?-        relativizeUrls "../.." "<a href=\"http://haskell.org\">Haskell</a>"-    , "<a href=\"http://haskell.org\">Haskell</a>" @=?-        relativizeUrls "../.." "<a href=\"http://haskell.org\">Haskell</a>"-    , "<script src=\"//ajax.googleapis.com/jquery.min.js\"></script>" @=?-        relativizeUrls "../.."-            "<script src=\"//ajax.googleapis.com/jquery.min.js\"></script>"-    ]
− tests/Hakyll/Web/Urls/Tests.hs 
@@ -1,46 +0,0 @@-module Hakyll.Web.Urls.Tests-    ( tests-    ) where--import Data.Char (toUpper)--import Test.Framework-import Test.HUnit hiding (Test)--import Hakyll.Web.Urls-import TestSuite.Util--tests :: [Test]-tests = concat-    [ fromAssertions "withUrls"-        [ "<a href=\"FOO\">bar</a>" @=?-            withUrls (map toUpper) "<a href=\"foo\">bar</a>"-        , "<img src=\"OH BAR\" />" @=?-            withUrls (map toUpper) "<img src=\"oh bar\" />"--        -- Test escaping-        , "<script>\"sup\"</script>" @=?-            withUrls id "<script>\"sup\"</script>"-        , "<code>&lt;stdio&gt;</code>" @=?-            withUrls id "<code>&lt;stdio&gt;</code>"-        , "<style>body > p { line-height: 1.3 }</style>" @=?-            withUrls id "<style>body > p { line-height: 1.3 }</style>"-        ]-    , fromAssertions "toUrl"-        [ "/foo/bar.html"    @=? toUrl "foo/bar.html"-        , "/"                @=? toUrl "/"-        , "/funny-pics.html" @=? toUrl "/funny-pics.html"-        ]-    , fromAssertions "toSiteRoot"-        [ ".."    @=? toSiteRoot "/foo/bar.html"-        , "."     @=? toSiteRoot "index.html"-        , "."     @=? toSiteRoot "/index.html"-        , "../.." @=? toSiteRoot "foo/bar/qux"-        ]-    , fromAssertions "isExternal"-        [ assert (isExternal "http://reddit.com")-        , assert (isExternal "https://mail.google.com")-        , assert (not (isExternal "../header.png"))-        , assert (not (isExternal "/foo/index.html"))-        ]-    ]
− tests/Hakyll/Web/Util/Html/Tests.hs 
@@ -1,22 +0,0 @@-module Hakyll.Web.Util.Html.Tests-    ( tests-    ) where--import Test.Framework-import Test.HUnit hiding (Test)--import Hakyll.Web.Util.Html-import TestSuite.Util--tests :: [Test]-tests = concat-    [ fromAssertions "stripTags"-        [ "foo"     @=? stripTags "<p>foo</p>"-        , "foo bar" @=? stripTags "<p>foo</p> bar"-        , "foo"     @=? stripTags "<p>foo</p"-        ]-    , fromAssertions "escapeHtml"-        [ "Me &amp; Dean" @=? escapeHtml "Me & Dean"-        , "&lt;img&gt;"   @=? escapeHtml "<img>"-        ]-    ]
tests/TestSuite.hs view
@@ -1,53 +1,60 @@-module Main where+--------------------------------------------------------------------------------+{-# LANGUAGE CPP #-}+module Main+    ( main+    ) where -import Test.Framework (defaultMain, testGroup) -import qualified Hakyll.Core.Compiler.Tests-import qualified Hakyll.Core.DependencyAnalyzer.Tests+--------------------------------------------------------------------------------+import           Test.Tasty                           (defaultMain, testGroup)+++--------------------------------------------------------------------------------+import qualified Hakyll.Core.Dependencies.Tests import qualified Hakyll.Core.Identifier.Tests+import qualified Hakyll.Core.Provider.Metadata.Tests+import qualified Hakyll.Core.Provider.Tests import qualified Hakyll.Core.Routes.Tests import qualified Hakyll.Core.Rules.Tests+import qualified Hakyll.Core.Runtime.Tests import qualified Hakyll.Core.Store.Tests import qualified Hakyll.Core.UnixFilter.Tests-import qualified Hakyll.Core.Util.Arrow.Tests import qualified Hakyll.Core.Util.String.Tests-import qualified Hakyll.Web.Page.Tests-import qualified Hakyll.Web.Page.Metadata.Tests+import qualified Hakyll.Web.CompressCss.Tests+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 import qualified Hakyll.Web.Template.Tests-import qualified Hakyll.Web.Urls.Tests-import qualified Hakyll.Web.Urls.Relativize.Tests-import qualified Hakyll.Web.Util.Html.Tests+import qualified Hakyll.Web.Tags.Tests+import qualified Hakyll.Web.Feed.Tests ++-------------------------------------------------------------------------------- main :: IO ()-main = defaultMain-    [ testGroup "Hakyll.Core.Compiler.Tests"-        Hakyll.Core.Compiler.Tests.tests-    , testGroup "Hakyll.Core.DependencyAnalyzer.Tests"-        Hakyll.Core.DependencyAnalyzer.Tests.tests-    , testGroup "Hakyll.Core.Identifier.Tests"-        Hakyll.Core.Identifier.Tests.tests-    , testGroup "Hakyll.Core.Routes.Tests"-        Hakyll.Core.Routes.Tests.tests-    , testGroup "Hakyll.Core.Rules.Tests"-        Hakyll.Core.Rules.Tests.tests-    , testGroup "Hakyll.Core.Store.Tests"-        Hakyll.Core.Store.Tests.tests-    , testGroup "Hakyll.Core.UnixFilter.Tests"-        Hakyll.Core.UnixFilter.Tests.tests-    , testGroup "Hakyll.Core.Util.Arrow.Tests"-        Hakyll.Core.Util.Arrow.Tests.tests-    , testGroup "Hakyll.Core.Util.String.Tests"-        Hakyll.Core.Util.String.Tests.tests-    , testGroup "Hakyll.Web.Page.Tests"-        Hakyll.Web.Page.Tests.tests-    , testGroup "Hakyll.Web.Page.Metadata.Tests"-        Hakyll.Web.Page.Metadata.Tests.tests-    , testGroup "Hakyll.Web.Template.Tests"-        Hakyll.Web.Template.Tests.tests-    , testGroup "Hakyll.Web.Urls.Tests"-        Hakyll.Web.Urls.Tests.tests-    , testGroup "Hakyll.Web.Urls.Relativize.Tests"-        Hakyll.Web.Urls.Relativize.Tests.tests-    , testGroup "Hakyll.Web.Util.Html.Tests"-        Hakyll.Web.Util.Html.Tests.tests+main = defaultMain $ testGroup "Hakyll"+    [ Hakyll.Core.Dependencies.Tests.tests+    , Hakyll.Core.Identifier.Tests.tests+    , Hakyll.Core.Provider.Metadata.Tests.tests+    , Hakyll.Core.Provider.Tests.tests+    , Hakyll.Core.Routes.Tests.tests+    , Hakyll.Core.Rules.Tests.tests+    , Hakyll.Core.Runtime.Tests.tests+    , Hakyll.Core.Store.Tests.tests+    , Hakyll.Core.UnixFilter.Tests.tests+    , Hakyll.Core.Util.String.Tests.tests+    , Hakyll.Web.CompressCss.Tests.tests+    , 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+    , Hakyll.Web.Template.Context.Tests.tests+    , Hakyll.Web.Template.Tests.tests+    , Hakyll.Web.Feed.Tests.tests     ]
tests/TestSuite/Util.hs view
@@ -1,45 +1,126 @@+-------------------------------------------------------------------------------- -- | Test utilities--- module TestSuite.Util     ( fromAssertions-    , makeStoreTest-    , runCompilerJobTest+    , newTestStore+    , newTestProvider+    , testCompiler+    , testCompilerDone+    , testCompilerError+    , testConfiguration+    , cleanTestEnv+    , renderParagraphs     ) where -import Data.Monoid (mempty) -import Test.Framework-import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)+--------------------------------------------------------------------------------+import           Data.List                     (intercalate, isInfixOf)+import qualified Data.Set                      as S+import           Test.Tasty+import           Test.Tasty.HUnit+import           Text.Printf                   (printf) -import Hakyll.Core.Compiler.Internal-import Hakyll.Core.Identifier-import Hakyll.Core.Logger-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Store (Store)-import qualified Hakyll.Core.Store as Store +--------------------------------------------------------------------------------+import           Hakyll.Core.Compiler.Internal+import           Hakyll.Core.Configuration+import           Hakyll.Core.Identifier+import qualified Hakyll.Core.Logger            as Logger+import           Hakyll.Core.Provider+import           Hakyll.Core.Store             (Store)+import qualified Hakyll.Core.Store             as Store+import           Hakyll.Core.Util.File+import           Hakyll.Core.Item+++-------------------------------------------------------------------------------- fromAssertions :: String       -- ^ Name                -> [Assertion]  -- ^ Cases-               -> [Test]       -- ^ Result tests-fromAssertions name = zipWith testCase names-  where-    names = map (\n -> name ++ " [" ++ show n ++ "]") [1 :: Int ..]+               -> [TestTree]   -- ^ Result tests+fromAssertions name =+    zipWith testCase [printf "%02d_%s" n name | n <- [1 :: Int ..]] --- | Create a store for testing----makeStoreTest :: IO Store-makeStoreTest = Store.new True "_store" --- | Testing for 'runCompilerJob'----runCompilerJobTest :: Compiler () a-                   -> Identifier ()-                   -> ResourceProvider-                   -> [Identifier ()]-                   -> IO a-runCompilerJobTest compiler id' provider uni = do-    store <- makeStoreTest-    logger <- makeLogger $ const $ return ()-    Right x <- runCompilerJob compiler id' provider uni mempty store True logger-    return x+--------------------------------------------------------------------------------+newTestStore :: IO Store+newTestStore = Store.new True $ storeDirectory testConfiguration+++--------------------------------------------------------------------------------+newTestProvider :: Store -> IO Provider+newTestProvider store = do+  let dir = providerDirectory testConfiguration+  (p, _) <- newProvider store (const $ return False) dir+  pure p+++--------------------------------------------------------------------------------+testCompiler :: Store -> Provider -> Identifier -> Compiler a+             -> IO (CompilerResult a)+testCompiler store provider underlying compiler = do+    logger <- Logger.new Logger.Error+    let read' = CompilerRead+            { compilerConfig     = testConfiguration+            , compilerUnderlying = underlying+            , compilerProvider   = provider+            , compilerUniverse   = S.empty+            , compilerRoutes     = mempty+            , compilerStore      = store+            , compilerLogger     = logger+            }++    result <- runCompiler compiler read'+    Logger.flush logger+    return result+++--------------------------------------------------------------------------------+testCompilerDone :: Store -> Provider -> Identifier -> Compiler a -> IO a+testCompilerDone store provider underlying compiler = do+    result <- testCompiler store provider underlying compiler+    case result of+        CompilerDone x _    -> return x+        CompilerError e     -> fail $+            "TestSuite.Util.testCompilerDone: compiler " ++ show underlying +++            " threw: " ++ intercalate "; " (compilerErrorMessages e)+        CompilerRequire i _ -> fail $+            "TestSuite.Util.testCompilerDone: compiler " ++ show underlying +++            " requires: " ++ show i+        CompilerSnapshot _ _ -> fail+            "TestSuite.Util.testCompilerDone: unexpected CompilerSnapshot"++testCompilerError :: Store -> Provider -> Identifier -> Compiler a -> String -> IO ()+testCompilerError store provider underlying compiler expectedMessage = do+    result   <- testCompiler store provider underlying compiler+    case result of+        CompilerError e ->+            any (expectedMessage `isInfixOf`) (compilerErrorMessages e) @?+           "Expecting '" ++ expectedMessage ++ "' error"+        _               -> assertFailure "Expecting CompilerError"++--------------------------------------------------------------------------------+testConfiguration :: Configuration+testConfiguration = defaultConfiguration+    { destinationDirectory = "_testsite"+    , storeDirectory       = "_teststore"+    , tmpDirectory         = "_testtmp"+    , providerDirectory    = "tests/data"+    }+++--------------------------------------------------------------------------------+cleanTestEnv :: IO ()+cleanTestEnv = do+    removeDirectory $ destinationDirectory testConfiguration+    removeDirectory $ storeDirectory testConfiguration+    removeDirectory $ tmpDirectory testConfiguration+++--------------------------------------------------------------------------------+-- | like 'Hakyll.Web.Pandoc.renderPandoc'+-- | but allowing to test without the @usePandoc@ flag+renderParagraphs :: Item String -> Compiler (Item String)+renderParagraphs = withItemBody (return+                       . intercalate "\n" -- no trailing line+                       . map (("<p>"++) . (++"</p>"))+                       . lines)
+ tests/data/biblio/chicago.csl view
@@ -0,0 +1,648 @@+<?xml version="1.0" encoding="utf-8"?>+<style xmlns="http://purl.org/net/xbiblio/csl" class="in-text" version="1.0" demote-non-dropping-particle="display-and-sort" page-range-format="chicago">+  <info>+    <title>Chicago Manual of Style 17th edition (author-date)</title>+    <id>http://www.zotero.org/styles/chicago-author-date</id>+    <link href="http://www.zotero.org/styles/chicago-author-date" rel="self"/>+    <link href="http://www.chicagomanualofstyle.org/tools_citationguide.html" rel="documentation"/>+    <author>+      <name>Julian Onions</name>+      <email>julian.onions@gmail.com</email>+    </author>+    <contributor>+      <name>Sebastian Karcher</name>+    </contributor>+    <contributor>+      <name>Richard Karnesky</name>+      <email>karnesky+zotero@gmail.com</email>+      <uri>http://arc.nucapt.northwestern.edu/Richard_Karnesky</uri>+    </contributor>+    <contributor>+      <name>Andrew Dunning</name>+      <email>andrew.dunning@utoronto.ca</email>+      <uri>https://orcid.org/0000-0003-0464-5036</uri>+    </contributor>+    <contributor>+      <name>Matthew Roth</name>+      <email>matthew.g.roth@yale.edu</email>+      <uri> https://orcid.org/0000-0001-7902-6331</uri>+    </contributor>+    <category citation-format="author-date"/>+    <category field="generic-base"/>+    <summary>The author-date variant of the Chicago style</summary>+    <updated>2018-01-24T12:00:00+00:00</updated>+    <rights license="http://creativecommons.org/licenses/by-sa/3.0/">This work is licensed under a Creative Commons Attribution-ShareAlike 3.0 License</rights>+  </info>+  <locale xml:lang="en">+    <terms>+      <term name="editor" form="verb-short">ed.</term>+      <term name="container-author" form="verb">by</term>+      <term name="translator" form="verb-short">trans.</term>+      <term name="editortranslator" form="verb">edited and translated by</term>+      <term name="translator" form="short">trans.</term>+    </terms>+  </locale>+  <macro name="secondary-contributors">+    <choose>+      <if type="chapter entry-dictionary entry-encyclopedia paper-conference" match="none">+        <group delimiter=". ">+          <names variable="editor translator" delimiter=". ">+            <label form="verb" text-case="capitalize-first" suffix=" "/>+            <name and="text" delimiter=", "/>+          </names>+          <names variable="director" delimiter=". ">+            <label form="verb" text-case="capitalize-first" suffix=" "/>+            <name and="text" delimiter=", "/>+          </names>+        </group>+      </if>+    </choose>+  </macro>+  <macro name="container-contributors">+    <choose>+      <if type="chapter entry-dictionary entry-encyclopedia paper-conference" match="any">+        <group prefix=", " delimiter=", ">+          <names variable="container-author" delimiter=", ">+            <label form="verb" suffix=" "/>+            <name and="text" delimiter=", "/>+          </names>+          <names variable="editor translator" delimiter=", ">+            <label form="verb" suffix=" "/>+            <name and="text" delimiter=", "/>+          </names>+        </group>+      </if>+    </choose>+  </macro>+  <macro name="editor">+    <names variable="editor">+      <name name-as-sort-order="first" and="text" sort-separator=", " delimiter=", " delimiter-precedes-last="always"/>+      <label form="short" prefix=", "/>+    </names>+  </macro>+  <macro name="translator">+    <names variable="translator">+      <name name-as-sort-order="first" and="text" sort-separator=", " delimiter=", " delimiter-precedes-last="always"/>+      <label form="short" prefix=", "/>+    </names>+  </macro>+  <macro name="recipient">+    <choose>+      <if type="personal_communication">+        <choose>+          <if variable="genre">+            <text variable="genre" text-case="capitalize-first"/>+          </if>+          <else>+            <text term="letter" text-case="capitalize-first"/>+          </else>+        </choose>+      </if>+    </choose>+    <names variable="recipient" delimiter=", ">+      <label form="verb" prefix=" " text-case="lowercase" suffix=" "/>+      <name and="text" delimiter=", "/>+    </names>+  </macro>+  <macro name="substitute-title">+    <choose>+      <if type="article-magazine article-newspaper review review-book" match="any">+        <text macro="container-title"/>+      </if>+    </choose>+  </macro>+  <macro name="contributors">+    <group delimiter=". ">+      <names variable="author">+        <name and="text" name-as-sort-order="first" sort-separator=", " delimiter=", " delimiter-precedes-last="always"/>+        <label form="short" prefix=", "/>+        <substitute>+          <names variable="editor"/>+          <names variable="translator"/>+          <names variable="director"/>+          <text macro="substitute-title"/>+          <text macro="title"/>+        </substitute>+      </names>+      <text macro="recipient"/>+    </group>+  </macro>+  <macro name="contributors-short">+    <names variable="author">+      <name form="short" and="text" delimiter=", " initialize-with=". "/>+      <substitute>+        <names variable="editor"/>+        <names variable="translator"/>+        <names variable="director"/>+        <text macro="substitute-title"/>+        <text macro="title"/>+      </substitute>+    </names>+  </macro>+  <macro name="interviewer">+    <names variable="interviewer" delimiter=", ">+      <label form="verb" prefix=" " text-case="capitalize-first" suffix=" "/>+      <name and="text" delimiter=", "/>+    </names>+  </macro>+  <macro name="archive">+    <group delimiter=". ">+      <text variable="archive_location" text-case="capitalize-first"/>+      <text variable="archive"/>+      <text variable="archive-place"/>+    </group>+  </macro>+  <macro name="access">+    <group delimiter=". ">+      <choose>+        <if type="graphic report" match="any">+          <text macro="archive"/>+        </if>+        <else-if type="article-journal bill book chapter legal_case legislation motion_picture paper-conference" match="none">+          <text macro="archive"/>+        </else-if>+      </choose>+      <choose>+        <if type="webpage post-weblog" match="any">+          <date variable="issued" form="text"/>+        </if>+      </choose>+      <choose>+        <if variable="issued" match="none">+          <group delimiter=" ">+            <text term="accessed" text-case="capitalize-first"/>+            <date variable="accessed" form="text"/>+          </group>+        </if>+      </choose>+      <choose>+        <if type="legal_case" match="none">+          <choose>+            <if variable="DOI">+              <text variable="DOI" prefix="https://doi.org/"/>+            </if>+            <else>+              <text variable="URL"/>+            </else>+          </choose>+        </if>+      </choose>+    </group>+  </macro>+  <macro name="title">+    <choose>+      <if variable="title" match="none">+        <choose>+          <if type="personal_communication" match="none">+            <text variable="genre" text-case="capitalize-first"/>+          </if>+        </choose>+      </if>+      <else-if type="bill book graphic legislation motion_picture song" match="any">+        <text variable="title" text-case="title" font-style="italic"/>+        <group prefix=" (" suffix=")" delimiter=" ">+          <text term="version"/>+          <text variable="version"/>+        </group>+      </else-if>+      <else-if variable="reviewed-author">+        <choose>+          <if variable="reviewed-title">+            <group delimiter=". ">+              <text variable="title" text-case="title" quotes="true"/>+              <group delimiter=", ">+                <text variable="reviewed-title" text-case="title" font-style="italic" prefix="Review of "/>+                <names variable="reviewed-author">+                  <label form="verb-short" text-case="lowercase" suffix=" "/>+                  <name and="text" delimiter=", "/>+                </names>+              </group>+            </group>+          </if>+          <else>+            <group delimiter=", ">+              <text variable="title" text-case="title" font-style="italic" prefix="Review of "/>+              <names variable="reviewed-author">+                <label form="verb-short" text-case="lowercase" suffix=" "/>+                <name and="text" delimiter=", "/>+              </names>+            </group>+          </else>+        </choose>+      </else-if>+      <else-if type="legal_case interview patent" match="any">+        <text variable="title"/>+      </else-if>+      <else>+        <text variable="title" text-case="title" quotes="true"/>+      </else>+    </choose>+  </macro>+  <macro name="edition">+    <choose>+      <if type="bill book graphic legal_case legislation motion_picture report song" match="any">+        <choose>+          <if is-numeric="edition">+            <group delimiter=" " prefix=". ">+              <number variable="edition" form="ordinal"/>+              <text term="edition" form="short" strip-periods="true"/>+            </group>+          </if>+          <else>+            <text variable="edition" text-case="capitalize-first" prefix=". "/>+          </else>+        </choose>+      </if>+      <else-if type="chapter entry-dictionary entry-encyclopedia paper-conference" match="any">+        <choose>+          <if is-numeric="edition">+            <group delimiter=" " prefix=", ">+              <number variable="edition" form="ordinal"/>+              <text term="edition" form="short"/>+            </group>+          </if>+          <else>+            <text variable="edition" prefix=", "/>+          </else>+        </choose>+      </else-if>+    </choose>+  </macro>+  <macro name="locators">+    <choose>+      <if type="article-journal">+        <choose>+          <if variable="volume">+            <text variable="volume" prefix=" "/>+            <group prefix=" (" suffix=")">+              <choose>+                <if variable="issue">+                  <text variable="issue"/>+                </if>+                <else>+                  <date variable="issued">+                    <date-part name="month"/>+                  </date>+                </else>+              </choose>+            </group>+          </if>+          <else-if variable="issue">+            <group delimiter=" " prefix=", ">+              <text term="issue" form="short"/>+              <text variable="issue"/>+              <date variable="issued" prefix="(" suffix=")">+                <date-part name="month"/>+              </date>+            </group>+          </else-if>+          <else>+            <date variable="issued" prefix=", ">+              <date-part name="month"/>+            </date>+          </else>+        </choose>+      </if>+      <else-if type="legal_case">+        <text variable="volume" prefix=", "/>+        <text variable="container-title" prefix=" "/>+        <text variable="page" prefix=" "/>+      </else-if>+      <else-if type="bill book graphic legal_case legislation motion_picture report song" match="any">+        <group prefix=". " delimiter=". ">+          <group>+            <text term="volume" form="short" text-case="capitalize-first" suffix=" "/>+            <number variable="volume" form="numeric"/>+          </group>+          <group>+            <number variable="number-of-volumes" form="numeric"/>+            <text term="volume" form="short" prefix=" " plural="true"/>+          </group>+        </group>+      </else-if>+      <else-if type="chapter entry-dictionary entry-encyclopedia paper-conference" match="any">+        <choose>+          <if variable="page" match="none">+            <group prefix=". ">+              <text term="volume" form="short" text-case="capitalize-first" suffix=" "/>+              <number variable="volume" form="numeric"/>+            </group>+          </if>+        </choose>+      </else-if>+    </choose>+  </macro>+  <macro name="locators-chapter">+    <choose>+      <if type="chapter entry-dictionary entry-encyclopedia paper-conference" match="any">+        <choose>+          <if variable="page">+            <group prefix=", ">+              <text variable="volume" suffix=":"/>+              <text variable="page"/>+            </group>+          </if>+        </choose>+      </if>+    </choose>+  </macro>+  <macro name="locators-article">+    <choose>+      <if type="article-newspaper">+        <group prefix=", " delimiter=", ">+          <group delimiter=" ">+            <text variable="edition"/>+            <text term="edition"/>+          </group>+          <group>+            <text term="section" form="short" suffix=" "/>+            <text variable="section"/>+          </group>+        </group>+      </if>+      <else-if type="article-journal">+        <choose>+          <if variable="volume issue" match="any">+            <text variable="page" prefix=": "/>+          </if>+          <else>+            <text variable="page" prefix=", "/>+          </else>+        </choose>+      </else-if>+    </choose>+  </macro>+  <macro name="point-locators">+    <choose>+      <if variable="locator">+        <choose>+          <if locator="page" match="none">+            <choose>+              <if type="bill book graphic legal_case legislation motion_picture report song" match="any">+                <choose>+                  <if variable="volume">+                    <group>+                      <text term="volume" form="short" suffix=" "/>+                      <number variable="volume" form="numeric"/>+                      <label variable="locator" form="short" prefix=", " suffix=" "/>+                    </group>+                  </if>+                  <else>+                    <label variable="locator" form="short" suffix=" "/>+                  </else>+                </choose>+              </if>+              <else>+                <label variable="locator" form="short" suffix=" "/>+              </else>+            </choose>+          </if>+          <else-if type="bill book graphic legal_case legislation motion_picture report song" match="any">+            <number variable="volume" form="numeric" suffix=":"/>+          </else-if>+        </choose>+        <text variable="locator"/>+      </if>+    </choose>+  </macro>+  <macro name="container-prefix">+    <text term="in" text-case="capitalize-first"/>+  </macro>+  <macro name="container-title">+    <choose>+      <if type="chapter entry-dictionary entry-encyclopedia paper-conference" match="any">+        <text macro="container-prefix" suffix=" "/>+      </if>+    </choose>+    <choose>+      <if type="webpage">+        <text variable="container-title" text-case="title"/>+      </if>+      <else-if type="legal_case" match="none">+        <group delimiter=" ">+          <text variable="container-title" text-case="title" font-style="italic"/>+          <choose>+            <if type="post-weblog">+              <text value="(blog)"/>+            </if>+          </choose>+        </group>+      </else-if>+    </choose>+  </macro>+  <macro name="publisher">+    <group delimiter=": ">+      <text variable="publisher-place"/>+      <text variable="publisher"/>+    </group>+  </macro>+  <macro name="date">+    <choose>+      <if variable="issued">+        <group delimiter=" ">+          <date variable="original-date" form="text" date-parts="year" prefix="(" suffix=")"/>+          <date variable="issued">+            <date-part name="year"/>+          </date>+        </group>+      </if>+      <else-if variable="status">+        <text variable="status" text-case="capitalize-first"/>+      </else-if>+      <else>+        <text term="no date" form="short"/>+      </else>+    </choose>+  </macro>+  <macro name="date-in-text">+    <choose>+      <if variable="issued">+        <group delimiter=" ">+          <date variable="original-date" form="text" date-parts="year" prefix="[" suffix="]"/>+          <date variable="issued">+            <date-part name="year"/>+          </date>+        </group>+      </if>+      <else-if variable="status">+        <text variable="status"/>+      </else-if>+      <else>+        <text term="no date" form="short"/>+      </else>+    </choose>+  </macro>+  <macro name="day-month">+    <date variable="issued">+      <date-part name="month"/>+      <date-part name="day" prefix=" "/>+    </date>+  </macro>+  <macro name="collection-title">+    <choose>+      <if match="none" type="article-journal">+        <choose>+          <if match="none" is-numeric="collection-number">+            <group delimiter=", ">+              <text variable="collection-title" text-case="title"/>+              <text variable="collection-number"/>+            </group>+          </if>+          <else>+            <group delimiter=" ">+              <text variable="collection-title" text-case="title"/>+              <text variable="collection-number"/>+            </group>+          </else>+        </choose>+      </if>+    </choose>+  </macro>+  <macro name="collection-title-journal">+    <choose>+      <if type="article-journal">+        <group delimiter=" ">+          <text variable="collection-title"/>+          <text variable="collection-number"/>+        </group>+      </if>+    </choose>+  </macro>+  <macro name="event">+    <group>+      <text term="presented at" suffix=" "/>+      <text variable="event"/>+    </group>+  </macro>+  <macro name="description">+    <choose>+      <if type="interview">+        <group delimiter=". ">+          <text macro="interviewer"/>+          <text variable="medium" text-case="capitalize-first"/>+        </group>+      </if>+      <else-if type="patent">+        <group delimiter=" " prefix=". ">+          <text variable="authority"/>+          <text variable="number"/>+        </group>+      </else-if>+      <else>+        <text variable="medium" text-case="capitalize-first" prefix=". "/>+      </else>+    </choose>+    <choose>+      <if variable="title" match="none"/>+      <else-if type="thesis personal_communication speech" match="any"/>+      <else>+        <group delimiter=" " prefix=". ">+          <text variable="genre" text-case="capitalize-first"/>+          <choose>+            <if type="report">+              <text variable="number"/>+            </if>+          </choose>+        </group>+      </else>+    </choose>+  </macro>+  <macro name="issue">+    <choose>+      <if type="legal_case">+        <text variable="authority" prefix=". "/>+      </if>+      <else-if type="speech">+        <group prefix=". " delimiter=", ">+          <group delimiter=" ">+            <text variable="genre" text-case="capitalize-first"/>+            <text macro="event"/>+          </group>+          <text variable="event-place"/>+          <text macro="day-month"/>+        </group>+      </else-if>+      <else-if type="article-newspaper article-magazine personal_communication" match="any">+        <date variable="issued" form="text" prefix=", "/>+      </else-if>+      <else-if type="patent">+        <group delimiter=", " prefix=", ">+          <group delimiter=" ">+            <!--Needs Localization-->+            <text value="filed"/>+            <date variable="submitted" form="text"/>+          </group>+          <group delimiter=" ">+            <choose>+              <if variable="issued submitted" match="all">+                <text term="and"/>+              </if>+            </choose>+            <!--Needs Localization-->+            <text value="issued"/>+            <date variable="issued" form="text"/>+          </group>+        </group>+      </else-if>+      <else-if type="article-journal" match="any"/>+      <else>+        <group prefix=". " delimiter=", ">+          <choose>+            <if type="thesis">+              <text variable="genre" text-case="capitalize-first"/>+            </if>+          </choose>+          <text macro="publisher"/>+        </group>+      </else>+    </choose>+  </macro>+  <citation et-al-min="4" et-al-use-first="1" disambiguate-add-year-suffix="true" disambiguate-add-names="true" disambiguate-add-givenname="true" givenname-disambiguation-rule="primary-name" collapse="year">+    <layout prefix="(" suffix=")" delimiter="; ">+      <group delimiter=", ">+        <choose>+          <if variable="issued accessed" match="any">+            <group delimiter=" ">+              <text macro="contributors-short"/>+              <text macro="date-in-text"/>+            </group>+          </if>+          <!---comma before forthcoming and n.d.-->+          <else>+            <group delimiter=", ">+              <text macro="contributors-short"/>+              <text macro="date-in-text"/>+            </group>+          </else>+        </choose>+        <text macro="point-locators"/>+      </group>+    </layout>+  </citation>+  <bibliography hanging-indent="true" et-al-min="11" et-al-use-first="7" subsequent-author-substitute="&#8212;&#8212;&#8212;" entry-spacing="0">+    <sort>+      <key macro="contributors"/>+      <key variable="issued"/>+      <key variable="title"/>+    </sort>+    <layout suffix=".">+      <group delimiter=". ">+        <text macro="contributors"/>+        <text macro="date"/>+        <text macro="title"/>+      </group>+      <text macro="description"/>+      <text macro="secondary-contributors" prefix=". "/>+      <text macro="container-title" prefix=". "/>+      <text macro="container-contributors"/>+      <text macro="edition"/>+      <text macro="locators-chapter"/>+      <text macro="collection-title-journal" prefix=", " suffix=", "/>+      <text macro="locators"/>+      <text macro="collection-title" prefix=". "/>+      <text macro="issue"/>+      <text macro="locators-article"/>+      <text macro="access" prefix=". "/>+    </layout>+  </bibliography>+</style>
+ tests/data/biblio/cites-meijer-pandoc-2.0.0plus.golden view
@@ -0,0 +1,16 @@+<!doctype html>+<html lang="en">+    <head>+        <meta charset="utf-8">+        <title>This page cites a paper.</title>+    </head>+    <body>+        <h1>This page cites a paper.</h1>+        <p>I would like to cite one of my favourite papers <span class="citation" data-cites="meijer1991functional">(Meijer, Fokkinga, and Paterson 1991)</span> here.</p>+<div id="refs" class="references csl-bib-body hanging-indent" role="doc-bibliography">+<div id="ref-meijer1991functional" class="csl-entry" role="doc-biblioentry">+Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. <span>“Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.”</span> In <em>Conference on Functional Programming Languages and Computer Architecture</em>, 124–44. Springer.+</div>+</div>+    </body>+</html>
+ tests/data/biblio/cites-meijer-pandoc-3.0.0plus.golden view
@@ -0,0 +1,16 @@+<!doctype html>+<html lang="en">+    <head>+        <meta charset="utf-8">+        <title>This page cites a paper.</title>+    </head>+    <body>+        <h1>This page cites a paper.</h1>+        <p>I would like to cite one of my favourite papers <span class="citation" data-cites="meijer1991functional">(Meijer, Fokkinga, and Paterson 1991)</span> here.</p>+<div id="refs" class="references csl-bib-body hanging-indent" role="list">+<div id="ref-meijer1991functional" class="csl-entry" role="listitem">+Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. <span>“Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.”</span> In <em>Conference on Functional Programming Languages and Computer Architecture</em>, 124–44. Springer.+</div>+</div>+    </body>+</html>
+ tests/data/biblio/cites-meijer-pandoc-3.1.8plus.golden view
@@ -0,0 +1,16 @@+<!doctype html>+<html lang="en">+    <head>+        <meta charset="utf-8">+        <title>This page cites a paper.</title>+    </head>+    <body>+        <h1>This page cites a paper.</h1>+        <p>I would like to cite one of my favourite papers <span class="citation" data-cites="meijer1991functional">(Meijer, Fokkinga, and Paterson 1991)</span> here.</p>+<div id="refs" class="references csl-bib-body hanging-indent" data-entry-spacing="0" role="list">+<div id="ref-meijer1991functional" class="csl-entry" role="listitem">+Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. <span>“Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.”</span> In <em>Conference on Functional Programming Languages and Computer Architecture</em>, 124–44. Springer.+</div>+</div>+    </body>+</html>
+ tests/data/biblio/cites-multiple-pandoc-2.0.0plus.golden view
@@ -0,0 +1,20 @@+<!doctype html>+<html lang="en">+    <head>+        <meta charset="utf-8">+        <title>This page cites a paper and a book.</title>+    </head>+    <body>+        <h1>This page cites a paper and a book.</h1>+        <p>I would like to cite one of my favourite papers <span class="citation" data-cites="meijer1991functional">(Meijer, Fokkinga, and Paterson 1991)</span> here.</p>+<p>And also a book <span class="citation" data-cites="lipovaca2012">(Lipovača 2012)</span>.</p>+<div id="refs" class="references csl-bib-body hanging-indent" role="doc-bibliography">+<div id="ref-lipovaca2012" class="csl-entry" role="doc-biblioentry">+Lipovača, Miran. 2012. <em>Learn You a Haskell for Great Good! A Beginner’s Guide</em>. San Francisco, CA: No Starch Press.+</div>+<div id="ref-meijer1991functional" class="csl-entry" role="doc-biblioentry">+Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. <span>“Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.”</span> In <em>Conference on Functional Programming Languages and Computer Architecture</em>, 124–44. Springer.+</div>+</div>+    </body>+</html>
+ tests/data/biblio/cites-multiple-pandoc-3.0.0plus.golden view
@@ -0,0 +1,20 @@+<!doctype html>+<html lang="en">+    <head>+        <meta charset="utf-8">+        <title>This page cites a paper and a book.</title>+    </head>+    <body>+        <h1>This page cites a paper and a book.</h1>+        <p>I would like to cite one of my favourite papers <span class="citation" data-cites="meijer1991functional">(Meijer, Fokkinga, and Paterson 1991)</span> here.</p>+<p>And also a book <span class="citation" data-cites="lipovaca2012">(Lipovača 2012)</span>.</p>+<div id="refs" class="references csl-bib-body hanging-indent" role="list">+<div id="ref-lipovaca2012" class="csl-entry" role="listitem">+Lipovača, Miran. 2012. <em>Learn You a Haskell for Great Good! A Beginner’s Guide</em>. San Francisco, CA: No Starch Press.+</div>+<div id="ref-meijer1991functional" class="csl-entry" role="listitem">+Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. <span>“Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.”</span> In <em>Conference on Functional Programming Languages and Computer Architecture</em>, 124–44. Springer.+</div>+</div>+    </body>+</html>
+ tests/data/biblio/cites-multiple-pandoc-3.1.8plus.golden view
@@ -0,0 +1,20 @@+<!doctype html>+<html lang="en">+    <head>+        <meta charset="utf-8">+        <title>This page cites a paper and a book.</title>+    </head>+    <body>+        <h1>This page cites a paper and a book.</h1>+        <p>I would like to cite one of my favourite papers <span class="citation" data-cites="meijer1991functional">(Meijer, Fokkinga, and Paterson 1991)</span> here.</p>+<p>And also a book <span class="citation" data-cites="lipovaca2012">(Lipovača 2012)</span>.</p>+<div id="refs" class="references csl-bib-body hanging-indent" data-entry-spacing="0" role="list">+<div id="ref-lipovaca2012" class="csl-entry" role="listitem">+Lipovača, Miran. 2012. <em>Learn You a Haskell for Great Good! A Beginner’s Guide</em>. San Francisco, CA: No Starch Press.+</div>+<div id="ref-meijer1991functional" class="csl-entry" role="listitem">+Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. <span>“Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.”</span> In <em>Conference on Functional Programming Languages and Computer Architecture</em>, 124–44. Springer.+</div>+</div>+    </body>+</html>
+ tests/data/biblio/cites-multiple.markdown view
@@ -0,0 +1,7 @@+---+title: This page cites a paper and a book.+---++I would like to cite one of my favourite papers [@meijer1991functional] here.++And also a book [@lipovaca2012].
+ tests/data/biblio/default.html view
@@ -0,0 +1,11 @@+<!doctype html>+<html lang="en">+    <head>+        <meta charset="utf-8">+        <title>$title$</title>+    </head>+    <body>+        <h1>$title$</h1>+        $body$+    </body>+</html>
+ tests/data/biblio/page.markdown view
@@ -0,0 +1,5 @@+---+title: This page cites a paper.+---++I would like to cite one of my favourite papers [@meijer1991functional] here.
+ tests/data/biblio/refs.bib view
@@ -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}+}
+ tests/data/biblio/refs.yaml view
@@ -0,0 +1,18 @@+---+references:+- id: meijer1991functional+  author:+    - family: Meijer+      given: Erik+    - family: Fokkinga+      given: Maarten+    - family: Paterson+      given: Ross+  container-title: Conference on functional programming languages and computer architecture+  issued:+    - year: 1991+  page: 124–144+  publisher: Springer+  title: Functional programming with bananas, lenses, envelopes and barbed wire+  type: paper-conference+...
+ tests/data/biblio/refs2.yaml view
@@ -0,0 +1,18 @@+---+references:+- id: lipovaca2012+  author:+    - family: Lipovača+      given: Miran+  call-number: QA76.73.H37 L69 2012+  event-place: San Francisco, CA+  ISBN: 978-1-59327-283-8+  issued:+    - year: 2012+  number-of-pages: '375'+  publisher: No Starch Press+  publisher-place: San Francisco, CA+  source: Library of Congress ISBN+  title: Learn you a Haskell for great good! a beginner's guide+  type: book+...
+ tests/data/embed.html view
@@ -0,0 +1,1 @@+<p>$body$</p>
+ tests/data/example.md view
@@ -0,0 +1,5 @@+---+title: An example+---++This is an example.
+ tests/data/example.md.metadata view
@@ -0,0 +1,5 @@+external: External data+date: 2012-10-22 14:35:24+subblog: food+intfield: 42+numfield: 3.14
+ tests/data/images/favicon.ico view

binary file changed (absent → 1150 bytes)

+ tests/data/just-meta.html view
@@ -0,0 +1,7 @@+<pre>+external: {$external$}+date: {$date$}+subblog: {$subblog$}+intfield: {$intfield$}+numfield: {$numfield$}+</pre>
+ tests/data/just-meta.html.out view
@@ -0,0 +1,7 @@+<pre>+external: {External data}+date: {2012-10-22 14:35:24}+subblog: {food}+intfield: {42}+numfield: {3.14}+</pre>
+ tests/data/partial-helper.html view
@@ -0,0 +1,3 @@+<p>This is an included partial.</p>++$body$
+ tests/data/partial.html view
@@ -0,0 +1,3 @@+<p>This is a file that includes a partial.</p>++$partial("partial-helper.html")$
+ tests/data/partial.html.out view
@@ -0,0 +1,7 @@+<p>This is a file that includes a partial.</p>++<p>This is an included partial.</p>++This is an example.++
+ tests/data/posts/2010-08-26-birthday.md view
@@ -0,0 +1,1 @@+It's my birthday today.
+ tests/data/posts/2018-09-26.md view
@@ -0,0 +1,1 @@+Something happened today.
+ tests/data/posts/2019/05/10/tomorrow.md view
@@ -0,0 +1,1 @@+This day hasn't happened yet (as of writing this).
+ tests/data/russian.md view
@@ -0,0 +1,14 @@+Статья 18++Каждый человек имеет право на свободу мысли, совести и религии; это+право включает свободу менять свою религию или убеждения и свободу+исповедовать свою религию или убеждения как единолично, так и сообща с+другими, публичным или частным порядком в учении, богослужении и+выполнении религиозных и ритуальных обрядов.++Статья 19++Каждый человек имеет право на свободу убеждений и на свободное выражение+их; это право включает свободу беспрепятственно придерживаться своих+убеждений и свободу искать, получать и распространять информацию и идеи+любыми средствами и независимо от государственных границ.
+ tests/data/strip.html view
@@ -0,0 +1,34 @@+<div>+    I'm so rich I have $$3.++    $rev("foo")$+    $-rev(rev("foo"))$++    $if(body)-$+    I have body+    $else-$+    or no+    $-endif-$++    $if(unbound)$+    should not be printed+    $endif$++    $-if(body)-$+    should be printed+    $-endif$++    <ul>+    $for(authors)-$+        <li>$name$</li>+    $endfor-$+    </ul>++    $for(authors)-$+        $name-$+        $sep$,+    $-endfor$++    $body$+</div>+
+ tests/data/strip.html.out view
@@ -0,0 +1,18 @@+<div>+    I'm so rich I have $3.++    ooffoo++    I have body+    should be printed++    <ul>+    <li>Jan</li>+    <li>Piet</li>+    </ul>++    Jan,Piet++    <p>This is an example.</p>+</div>+
+ tests/data/template-empty.html view
+ tests/data/template.html view
@@ -0,0 +1,30 @@+<div>+    I'm so rich I have $$3.++    $rev("foo")$+    $rev(rev("foo"))$++    $if(body)$+    I have body+    $else$+    or no+    $endif$++    $if(unbound)$+    should not be printed+    $endif$++    $if(body)$+    should be printed+    $endif$++    <ul>+    $for(authors)$+        <li>$name$</li>+    $endfor$+    </ul>++    $for(authors)$$name$$sep$, $endfor$++    $body$+</div>
+ tests/data/template.html.out view
@@ -0,0 +1,28 @@+<div>+    I'm so rich I have $3.++    oof+    foo++    +    I have body+    ++    ++    +    should be printed+    ++    <ul>+    +        <li>Jan</li>+    +        <li>Piet</li>+    +    </ul>++    Jan, Piet++    <p>This is an example.</p>+</div>
+ web/site.hs view
@@ -0,0 +1,89 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+import           Control.Monad    (filterM, forM_)+import           Data.List        (sortBy)+import           Data.Ord         (comparing)+import           Hakyll+import           System.Directory (copyFile)+import qualified Text.Pandoc      as Pandoc+++--------------------------------------------------------------------------------+main :: IO ()+main = hakyllWith config $ do+    -- Copy CHANGELOG.md here.+    preprocess $ copyFile "../CHANGELOG.md" "releases.markdown"++    -- CSS+    match "css/*" $ do+        route   idRoute+        compile compressCssCompiler++    -- Static directories+    forM_ ["images/*", "examples/*"] $ \f -> match f $ do+        route   idRoute+        compile copyFileCompiler++    -- Pages+    match "*.markdown" $ do+        route   $ setExtension "html"+        compile $ pandocCompiler+            >>= loadAndApplyTemplate "templates/default.html" defaultContext+            >>= relativizeUrls++    -- Tutorials+    match "tutorials/*" $ do+        route   $ setExtension "html"+        compile $ pandocCompilerWith defaultHakyllReaderOptions withToc+            >>= loadAndApplyTemplate "templates/tutorial.html" defaultContext+            >>= loadAndApplyTemplate "templates/default.html" defaultContext+            >>= relativizeUrls++    -- Tutorial list+    create ["tutorials.html"] $ do+        route idRoute+        compile $ do+            ctx <- tutorialsCtx <$>+                sortBy (comparing itemIdentifier) <$> loadAll "tutorials/*"+            makeItem ""+                >>= loadAndApplyTemplate "templates/tutorials.html" ctx+                >>= loadAndApplyTemplate "templates/default.html"   ctx+                >>= relativizeUrls++    -- Templates+    match "templates/*" $ compile templateCompiler+  where+    withToc = defaultHakyllWriterOptions+        { Pandoc.writerTableOfContents = True+        , Pandoc.writerTemplate        = Just tocTemplate+        }++    -- When did it get so hard to compile a string to a Pandoc template?+    tocTemplate =+        either error id $ either (error . show) id $+        Pandoc.runPure $ Pandoc.runWithDefaultPartials $+        Pandoc.compileTemplate "" "$toc$\n$body$"+++--------------------------------------------------------------------------------+config :: Configuration+config = defaultConfiguration+    { deployCommand =+        "rsync --checksum -av _site/* anmitsu:jaspervdj.be/hakyll/"+    }+++--------------------------------------------------------------------------------+-- | Partition tutorials into tutorial series, other articles, external articles+tutorialsCtx :: [Item String] -> Context String+tutorialsCtx tuts =+    constField "title" "Tutorials"                                    <>+    listField "main"          defaultContext (ofType "main")          <>+    listField "articles"      defaultContext (ofType "article")       <>+    listField "externals"     defaultContext (ofType "external")      <>+    listField "robertwpearce" defaultContext (ofType "robertwpearce") <>+    defaultContext+  where+    ofType ty = filterM (\item -> do+        mbType <- getMetadataField (itemIdentifier item) "type"+        return $ Just ty == mbType) tuts