hakyll-4.16.2.0/ 0000755 0000000 0000000 00000000000 07346545000 011417 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/CHANGELOG.md 0000644 0000000 0000000 00000063372 07346545000 013243 0 ustar 00 0000000 0000000 ---
title: Releases
---
# Releases
## 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 `` 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.
)
- 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 `` to
``
## 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.
hakyll-4.16.2.0/LICENSE 0000644 0000000 0000000 00000003105 07346545000 012423 0 ustar 00 0000000 0000000 Copyright (c) 2009 - 2017, Jasper Van der Jeugt
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Jasper Van der Jeugt nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
hakyll-4.16.2.0/Setup.hs 0000644 0000000 0000000 00000000056 07346545000 013054 0 ustar 00 0000000 0000000 import Distribution.Simple
main = defaultMain
hakyll-4.16.2.0/data/example/ 0000755 0000000 0000000 00000000000 07346545000 013763 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/data/example/about.rst 0000644 0000000 0000000 00000001324 07346545000 015627 0 ustar 00 0000000 0000000 ---
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.
hakyll-4.16.2.0/data/example/contact.markdown 0000644 0000000 0000000 00000000201 07346545000 017153 0 ustar 00 0000000 0000000 ---
title: Contact
---
I live in a small hut in the mountains of Kumano Kodō on Kii Hantō and would not
like to be contacted.
hakyll-4.16.2.0/data/example/css/ 0000755 0000000 0000000 00000000000 07346545000 014553 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/data/example/css/default.css 0000644 0000000 0000000 00000003416 07346545000 016715 0 ustar 00 0000000 0000000 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;
}
}
hakyll-4.16.2.0/data/example/images/ 0000755 0000000 0000000 00000000000 07346545000 015230 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/data/example/images/haskell-logo.png 0000644 0000000 0000000 00000013052 07346545000 020320 0 ustar 00 0000000 0000000 PNG
IHDR 5A sBIT|d pHYs QW tEXtSoftware www.inkscape.org< IDATxi e.ـEҍ33}ˌ,Fܐts[kwGQBH Mw m6 uƅEAG I q Iߥ|Ltw֩N>pRn=Rc VB#^[캮GDEBpR꒸CDK^ ڶ}nq>
rqH^"* df.[uNmoo`:.̼R w 8wXa `neY_Sp!R#3 ,IzRrAjE+ )pA\'I(j{ѶT L@*_EZ)i@!Tض}nqZ4GTju1bfgNmZbZj%g5 xwϵ9tV\ypN!Rfϔ
!̫BBjw "evL Tku;DXb+ XlZ w
q6e9gtttܨ[lYHjSJ 36 y1r˲ޢ[\Ũ3\.' ) c[m3]mȣîZbttN뺯' ùth4VJ=qI 8NU+]h5pD4% +-T蓪VRIR!jU*Uo < fTtt HћsKP
ZD0h4> !uw XXu!{3+vgCCCUb^ kZU +R25A uLYfKWV-7Yʭ 羱)U @Z .mf# `0\._wbMVd%Y jEHZBS GTK\.;)V+J>;|>bOj"&L|mO x7 xEf ZJ h&U6Ӗ\. "D.E!Ajwㅶ($IVJr߂ +tUP(0> o8
J[Hݪ|{wwxwRJ)e]jy%mSI$[TFZ 3/i{
Utp__):Jg2L/ p,-hkRyNXU fS/ ncSpz^ X(RZ'_-.l0ϼ#Z&fm_[LDWCjS.{u:Ml
2::zqf ,TZ3 z D0rEl
|vƙ(@[R}aB3& 6 _ @ʭ*.->x `0 X1y7HZZCuW iu
jH
LѸs q 0wjэ& jF e-ZrY fހT R&IU+2~ J_+~t7-<;pZ.~NX>D"V- 7 ,X@jè?!o Z SyhŚD)f"z0 uUuWw!d; /IUK xeAujղ,!GNHU+ uiRtjwܹV=
Ecb) @gYV
l$$A ydV ?S,MK_ D:6}"TC3`2PNh6R>G$A * ZNKl۾Tc `0<1oJk˲qZJ2NNj )4i3̩
p>~=\Mp8- _9Wӟ]8!D5R ¬6ɾL&S-dXBDj EbbRJ{tZCD/3(.87S9 Vm@r 8mۿ)&hHb7)j?-0F(ģD(r]1"Zo8S,oPE@Iw֭[w9BD+뮮M 6) Ç @0a;]C~HFa͕J:
L<-f4T m#HQrJ$OZYqZbIJY
0j̣aU 2H>b
ajɒ%`jQ-"ZyZ"Ķs0& - b`13@S l AZ#5i< TK
!jEDcܩ[xk0j
BMjjԹx2Z9s&5H`6l$i˲N̼Zk[n]dZ{ dIt+3Lywjg#Ic6yZ"Ķ G
V
_ZYfU!{,ef`f.Q+L +1Zju3Z N1js!j#/jE[ƚj-6m Ч[ Հ8 j1sT+ JԊV-cٮjX 8 扔pGGǍ u nbf$
"yޟԎ5 PXIJ <}O|^ XT"~"L +Tq@QY
@j۟֩/ct4kR7 "
ڦXFCjj%9?9 Q ;vHQ9іIZjTVR? O;4,j4S-oRL aVD$@3]Çy#M U.x4͛ tޏ&q]D BԊhY֭3/FycUhضV G4Pj
SZm 3GEfstڵ"cK2fvMm?,DdW*:vb" Lj!D +eAVDiqխ?t& ZqFGZ .P- ]M #
{Ml{i4gr|6 @єScQ,[4KHU+ʉz%ZyjihRjl}V[ gF T$UȸX,6
D3SH$j8k H DY˲~?I`a&IT+Bd"3bf+Ze21/Zlٲ j{sJS`"k\.w3Qmo|/ :th3ZrZ&Y9uMRT+mm(lX~(a"SV
C 6,Hj9`P8%MNmVbV<Zlٲu 300˗/97H69ju8?3[ h=
|Oʕ+kX(BhC\495eYxwDYl6 hQVR7aJ`!3VY+
'HZ
- fjkJҞvoҥ!D RjͺA:=,s!Ze8Ԫ+W|߿ j Y5HV6jŶG0X yD
R+fV!JԊکVS +ĽW>tj51j̷zE\.%҇-3R* 8s ņ hB5R""z0!UժRm0OuYl~ւl6+j "6& l Щ Z
~wWtww0h7H^!j0j篃 RJ}& G+E3ZZ
b i8.ju3s,)VG\wLFTNaf1j@Q+"JJ ; %1$P!{nqV3' V(
D1y_ęaVO$Xd2"ժ˲~hf ;qA,:UZZ IP(<w]vڵ#q &TZƦZ3}Q+"8Ηt(,Capp@Z ťZS6R 9t<1>>} B\~ ʛQV
O1q+ j=A,: d:ª3WLg%ijݻp9Z^>AV FC' DU+
L@ euJomv' UY= OgY) c,E:}oTHS+1jEuSәt!$U+{لT4HVk`tcypwXl!xV N~j!H|ߟjՊR1 mjez{{OVDJHԊl~* ؽ{f ŝ !yIj58zzj6
DEDk]}} BHWelcome
Welcome to my blog!
I've reproduced a list of recent posts here for your reading pleasure:
hakyll-4.16.2.0/data/example/posts/ 0000755 0000000 0000000 00000000000 07346545000 015133 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/data/example/posts/2015-08-12-spqr.markdown 0000644 0000000 0000000 00000007241 07346545000 020722 0 ustar 00 0000000 0000000 ---
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.
hakyll-4.16.2.0/data/example/posts/2015-10-07-rosa-rosa-rosam.markdown 0000644 0000000 0000000 00000005275 07346545000 022764 0 ustar 00 0000000 0000000 ---
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.
hakyll-4.16.2.0/data/example/posts/2015-11-28-carpe-diem.markdown 0000644 0000000 0000000 00000006142 07346545000 021743 0 ustar 00 0000000 0000000 ---
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.
hakyll-4.16.2.0/data/example/posts/2015-12-07-tu-quoque.markdown 0000644 0000000 0000000 00000007203 07346545000 021677 0 ustar 00 0000000 0000000 ---
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.
hakyll-4.16.2.0/data/example/site.hs 0000644 0000000 0000000 00000004232 07346545000 015264 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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
hakyll-4.16.2.0/data/example/templates/ 0000755 0000000 0000000 00000000000 07346545000 015761 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/data/example/templates/archive.html 0000644 0000000 0000000 00000000117 07346545000 020267 0 ustar 00 0000000 0000000 Here you can find all my previous posts:
$partial("templates/post-list.html")$
hakyll-4.16.2.0/data/example/templates/default.html 0000644 0000000 0000000 00000001663 07346545000 020301 0 ustar 00 0000000 0000000
My Hakyll Blog - $title$
hakyll-4.16.2.0/data/example/templates/post.html 0000644 0000000 0000000 00000000303 07346545000 017630 0 ustar 00 0000000 0000000
Posted on $date$
$if(author)$
by $author$
$endif$
$body$
hakyll-4.16.2.0/data/templates/ 0000755 0000000 0000000 00000000000 07346545000 014326 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/data/templates/atom-item.xml 0000644 0000000 0000000 00000000352 07346545000 016744 0 ustar 00 0000000 0000000 $title$$root$$url$$published$$updated$
hakyll-4.16.2.0/data/templates/atom.xml 0000644 0000000 0000000 00000000614 07346545000 016011 0 ustar 00 0000000 0000000
$title$$root$$url$$authorName$
$if(authorEmail)$
$authorEmail$
$endif$
$updated$
$body$
hakyll-4.16.2.0/data/templates/feed-item.json 0000644 0000000 0000000 00000000272 07346545000 017061 0 ustar 00 0000000 0000000 {
"id": "$root$$url$",
"url": "$root$$url$",
"content_html": "$description$",
"title": "$title$",
"date_published": "$published$",
"date_modified": "$updated$"
}
hakyll-4.16.2.0/data/templates/feed.json 0000644 0000000 0000000 00000000567 07346545000 016134 0 ustar 00 0000000 0000000 {
"version": "https://www.jsonfeed.org/version/1.1",
"title": "$title$",
"home_page_url": "$root$",
"feed_url": "$root$$url$",
$if(authorName)$
"authors": [
{
"name": "$authorName$"
$if(authorEmail)$
, "url": "mailto:$authorEmail$"
$endif$
}
],
$endif$
"items": [ $body$ ]
}
hakyll-4.16.2.0/data/templates/rss-item.xml 0000644 0000000 0000000 00000000352 07346545000 016613 0 ustar 00 0000000 0000000 $title$
$root$$url$
$published$$root$$url$$authorName$
hakyll-4.16.2.0/data/templates/rss.xml 0000644 0000000 0000000 00000000722 07346545000 015660 0 ustar 00 0000000 0000000
$title$
$root$
$updated$
$body$
hakyll-4.16.2.0/hakyll.cabal 0000644 0000000 0000000 00000023415 07346545000 013674 0 ustar 00 0000000 0000000 Name: hakyll
Version: 4.16.2.0
Synopsis: A static website compiler library
Description:
Hakyll is a static website compiler library. It provides you with the tools to
create a simple or advanced static website using a Haskell DSL and formats
such as markdown or RST. You can find more information, including a tutorial,
on the website:
.
*
.
If you seek assistance, there's:
.
* A google group:
.
* An IRC channel, @#hakyll@ on irc.libera.chat (we *do not* have a channel on Freenode anymore)
.
Additionally, there's the Haddock documentation in the different modules,
meant as a reference.
Author: Jasper Van der Jeugt
Maintainer: Jasper Van der Jeugt
Homepage: http://jaspervdj.be/hakyll
Bug-Reports: http://github.com/jaspervdj/Hakyll/issues
License: BSD3
License-File: LICENSE
Category: Web
Cabal-Version: >= 1.10
Build-Type: Simple
Data-Dir: data
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
Flag previewServer
Description: Include the preview server
Default: True
Flag watchServer
Description: Include the watch server
Default: True
Flag checkExternal
Description: Include external link checking
Default: 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.Commands
Hakyll.Core.Compiler
Hakyll.Core.Compiler.Internal
Hakyll.Core.Configuration
Hakyll.Core.Dependencies
Hakyll.Core.File
Hakyll.Core.Identifier
Hakyll.Core.Identifier.Pattern
Hakyll.Core.Item
Hakyll.Core.Logger
Hakyll.Core.Metadata
Hakyll.Core.Provider
Hakyll.Core.Provider.Metadata
Hakyll.Core.Routes
Hakyll.Core.Rules
Hakyll.Core.Rules.Internal
Hakyll.Core.Runtime
Hakyll.Core.Store
Hakyll.Core.UnixFilter
Hakyll.Core.Util.File
Hakyll.Core.Util.String
Hakyll.Core.Writable
Hakyll.Main
Hakyll.Web.CompressCss
Hakyll.Web.Feed
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.Context
Hakyll.Web.Template.Internal
Hakyll.Web.Template.Internal.Element
Hakyll.Web.Template.Internal.Trim
Hakyll.Web.Template.List
Other-Modules:
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,
blaze-markup >= 0.5.1 && < 0.9,
bytestring >= 0.9 && < 0.12,
containers >= 0.3 && < 0.7,
data-default >= 0.4 && < 0.8,
deepseq >= 1.3 && < 1.5,
directory >= 1.2.7.0 && < 1.4,
file-embed >= 0.0.10.1 && < 0.0.16,
filepath >= 1.0 && < 1.5,
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.19,
parsec >= 3.0 && < 3.2,
process >= 1.6 && < 1.7,
random >= 1.0 && < 1.3,
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.21,
text >= 0.11 && < 1.3 || >= 2.0 && < 2.1,
time >= 1.8 && < 1.13,
time-locale-compat >= 0.1 && < 0.2,
unordered-containers >= 0.2 && < 0.3,
vector >= 0.11 && < 0.14,
wai-app-static >= 3.1 && < 3.2,
yaml >= 0.8.11 && < 0.12
If flag(previewServer)
Build-depends:
wai >= 3.2 && < 3.3,
warp >= 3.2 && < 3.4,
http-types >= 0.9 && < 0.13,
fsnotify >= 0.2 && < 0.5
Cpp-options:
-DPREVIEW_SERVER
Other-modules:
Hakyll.Preview.Poll
Hakyll.Preview.Server
If flag(watchServer)
Build-depends:
fsnotify >= 0.2 && < 0.5
Cpp-options:
-DWATCH_SERVER
Other-modules:
Hakyll.Preview.Poll
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.2
Cpp-options:
-DUSE_PANDOC
Test-suite hakyll-tests
Type: exitcode-stdio-1.0
Hs-source-dirs: tests
Main-is: TestSuite.hs
Ghc-options: -Wall -threaded
Default-language: Haskell2010
Other-modules:
Hakyll.Core.Dependencies.Tests
Hakyll.Core.Identifier.Tests
Hakyll.Core.Provider.Metadata.Tests
Hakyll.Core.Provider.Tests
Hakyll.Core.Routes.Tests
Hakyll.Core.Rules.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
TestSuite.Util
Build-Depends:
hakyll,
QuickCheck >= 2.8 && < 2.15,
tasty >= 0.11 && < 1.6,
tasty-golden >= 2.3 && < 2.4,
tasty-hunit >= 0.9 && < 0.11,
tasty-quickcheck >= 0.8 && < 0.11,
-- Copy pasted from hakyll dependencies:
aeson >= 1.0 && < 1.6 || >= 2.0 && < 2.3,
base >= 4.12 && < 5,
bytestring >= 0.9 && < 0.12,
containers >= 0.3 && < 0.7,
filepath >= 1.0 && < 1.5,
tagsoup >= 0.13.1 && < 0.15,
text >= 0.11 && < 1.3 || >= 2.0 && < 2.1,
unordered-containers >= 0.2 && < 0.3,
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.2
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.5
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.5,
pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.2
hakyll-4.16.2.0/lib/Data/List/ 0000755 0000000 0000000 00000000000 07346545000 013751 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Data/List/Extended.hs 0000644 0000000 0000000 00000000646 07346545000 016053 0 ustar 00 0000000 0000000 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
hakyll-4.16.2.0/lib/Data/Yaml/ 0000755 0000000 0000000 00000000000 07346545000 013740 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Data/Yaml/Extended.hs 0000644 0000000 0000000 00000001362 07346545000 016036 0 ustar 00 0000000 0000000 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
hakyll-4.16.2.0/lib/ 0000755 0000000 0000000 00000000000 07346545000 012165 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll.hs 0000644 0000000 0000000 00000004771 07346545000 013756 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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
hakyll-4.16.2.0/lib/Hakyll/ 0000755 0000000 0000000 00000000000 07346545000 013411 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Check.hs 0000644 0000000 0000000 00000025220 07346545000 014763 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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'
_ -> head $ words $ show e
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)
return $ code >= 200 && code < 300
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 ['?', '#'])
hakyll-4.16.2.0/lib/Hakyll/Commands.hs 0000644 0000000 0000000 00000012476 07346545000 015520 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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 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
#ifndef WATCH_SERVER
watchServerDisabled :: IO ()
watchServerDisabled =
mapM_ putStrLn
[ "WATCH SERVER"
, ""
, "The watch 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
hakyll-4.16.2.0/lib/Hakyll/Core/ 0000755 0000000 0000000 00000000000 07346545000 014301 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Core/Compiler.hs 0000644 0000000 0000000 00000021620 07346545000 016410 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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 [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
hakyll-4.16.2.0/lib/Hakyll/Core/Compiler/ 0000755 0000000 0000000 00000000000 07346545000 016053 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Core/Compiler/Internal.hs 0000644 0000000 0000000 00000032541 07346545000 020170 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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_)
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
--------------------------------------------------------------------------------
-- | 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 [IdentifierDependency identifier]
compilerUnsafeIO $ resourceMetadata provider identifier
--------------------------------------------------------------------------------
compilerGetMatches :: Pattern -> Compiler [Identifier]
compilerGetMatches pattern = do
universe <- compilerUniverse <$> compilerAsk
let matching = S.filter (matches pattern) universe
compilerTellDependencies [PatternDependency pattern matching]
pure $ S.toList matching
hakyll-4.16.2.0/lib/Hakyll/Core/Compiler/Require.hs 0000644 0000000 0000000 00000012720 07346545000 020025 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
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 $ 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"
hakyll-4.16.2.0/lib/Hakyll/Core/Configuration.hs 0000644 0000000 0000000 00000014576 07346545000 017461 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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 (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)
hakyll-4.16.2.0/lib/Hakyll/Core/Dependencies.hs 0000644 0000000 0000000 00000014502 07346545000 017225 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# LANGUAGE DeriveDataTypeable #-}
module Hakyll.Core.Dependencies
( Dependency (..)
, DependencyFacts
, outOfDate
) 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.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 Dependency
= PatternDependency Pattern (Set Identifier)
| IdentifierDependency Identifier
| AlwaysOutOfDate
deriving (Show, Typeable)
--------------------------------------------------------------------------------
instance Binary Dependency where
put (PatternDependency p is) = putWord8 0 >> put p >> put is
put (IdentifierDependency i) = putWord8 1 >> put i
put AlwaysOutOfDate = putWord8 2
get = getWord8 >>= \t -> case t of
0 -> PatternDependency <$> get <*> get
1 -> IdentifierDependency <$> get
2 -> pure AlwaysOutOfDate
_ -> error "Data.Binary.get: Invalid Dependency"
--------------------------------------------------------------------------------
type DependencyFacts = Map Identifier [Dependency]
--------------------------------------------------------------------------------
outOfDate
:: [Identifier] -- ^ All known identifiers
-> Set Identifier -- ^ Initially out-of-date resources
-> DependencyFacts -- ^ Old dependency facts
-> (Set Identifier, DependencyFacts, [String])
outOfDate universe ood oldFacts =
let (_, state, logs) = runRWS rws universe (DependencyState oldFacts ood)
in (dependencyOod state, dependencyFacts state, logs)
where
rws = do
checkNew
checkChangedPatterns
bruteForce
--------------------------------------------------------------------------------
data DependencyState = DependencyState
{ dependencyFacts :: DependencyFacts
, dependencyOod :: 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}
--------------------------------------------------------------------------------
-- | Collection of dependencies that should be checked to determine
-- if an identifier needs rebuilding.
data Dependencies
= DependsOn [Identifier]
| MustRebuild
deriving (Show)
instance Semigroup Dependencies where
DependsOn ids <> DependsOn moreIds = DependsOn (ids <> moreIds)
MustRebuild <> _ = MustRebuild
_ <> MustRebuild = MustRebuild
instance Monoid Dependencies where
mempty = DependsOn []
--------------------------------------------------------------------------------
dependenciesFor :: Identifier -> DependencyM Dependencies
dependenciesFor id' = do
facts <- dependencyFacts <$> State.get
return $ foldMap dependenciesFor' $ fromMaybe [] $ M.lookup id' facts
where
dependenciesFor' (IdentifierDependency i) = DependsOn [i]
dependenciesFor' (PatternDependency _ is) = DependsOn $ S.toList is
dependenciesFor' AlwaysOutOfDate = MustRebuild
--------------------------------------------------------------------------------
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 _ ds (IdentifierDependency i) = return $ IdentifierDependency i : ds
go _ ds AlwaysOutOfDate = return $ AlwaysOutOfDate : ds
go id' ds (PatternDependency p ls) = do
universe <- ask
let ls' = S.fromList $ filterMatches p universe
if ls == ls'
then return $ PatternDependency p ls : ds
else do
tell [show id' ++ " is out-of-date because a pattern changed"]
markOod id'
return $ PatternDependency p ls' : ds
--------------------------------------------------------------------------------
bruteForce :: DependencyM ()
bruteForce = do
todo <- ask
go todo
where
go todo = do
(todo', changed) <- foldM check ([], False) todo
when changed (go todo')
check (todo, changed) id' = do
deps <- dependenciesFor id'
case deps of
DependsOn depList -> do
ood <- dependencyOod <$> State.get
case find (`S.member` ood) depList of
Nothing -> return (id' : todo, changed)
Just d -> do
tell [show id' ++ " is out-of-date because " ++
show d ++ " is out-of-date"]
markOod id'
return (todo, True)
MustRebuild -> do
tell [show id' ++ " will be forcibly rebuilt"]
markOod id'
return (todo, True)
hakyll-4.16.2.0/lib/Hakyll/Core/File.hs 0000644 0000000 0000000 00000006707 07346545000 015526 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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
hakyll-4.16.2.0/lib/Hakyll/Core/Identifier.hs 0000644 0000000 0000000 00000014252 07346545000 016723 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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}
hakyll-4.16.2.0/lib/Hakyll/Core/Identifier/ 0000755 0000000 0000000 00000000000 07346545000 016363 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Core/Identifier/Pattern.hs 0000644 0000000 0000000 00000022447 07346545000 020345 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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
hakyll-4.16.2.0/lib/Hakyll/Core/Identifier/Pattern/ 0000755 0000000 0000000 00000000000 07346545000 020000 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Core/Identifier/Pattern/Internal.hs 0000644 0000000 0000000 00000004464 07346545000 022120 0 ustar 00 0000000 0000000 -- | 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 = (<>)
hakyll-4.16.2.0/lib/Hakyll/Core/Item.hs 0000644 0000000 0000000 00000003262 07346545000 015536 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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
hakyll-4.16.2.0/lib/Hakyll/Core/Item/ 0000755 0000000 0000000 00000000000 07346545000 015177 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Core/Item/SomeItem.hs 0000644 0000000 0000000 00000001454 07346545000 017261 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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)
hakyll-4.16.2.0/lib/Hakyll/Core/Logger.hs 0000644 0000000 0000000 00000006431 07346545000 016060 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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
)
hakyll-4.16.2.0/lib/Hakyll/Core/Metadata.hs 0000644 0000000 0000000 00000013241 07346545000 016356 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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 => Pattern -> m Dependency
makePatternDependency pattern = do
matches' <- getMatches pattern
return $ 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
hakyll-4.16.2.0/lib/Hakyll/Core/Provider.hs 0000644 0000000 0000000 00000003133 07346545000 016427 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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 qualified Hakyll.Core.Provider.Internal as Internal
import qualified Hakyll.Core.Provider.MetadataCache as Internal
import Hakyll.Core.Store (Store)
--------------------------------------------------------------------------------
-- | Create a resource provider
newProvider :: Store -- ^ Store to use
-> (FilePath -> IO Bool) -- ^ Should we ignore this file?
-> FilePath -- ^ Search directory
-> IO Internal.Provider -- ^ Resulting provider
newProvider store ignore directory = do
-- Delete metadata cache where necessary
p <- Internal.newProvider store ignore directory
mapM_ (Internal.resourceInvalidateMetadataCache p) $
filter (Internal.resourceModified p) $ Internal.resourceList p
return p
hakyll-4.16.2.0/lib/Hakyll/Core/Provider/ 0000755 0000000 0000000 00000000000 07346545000 016073 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Core/Provider/Internal.hs 0000644 0000000 0000000 00000017341 07346545000 020211 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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
hakyll-4.16.2.0/lib/Hakyll/Core/Provider/Metadata.hs 0000644 0000000 0000000 00000013777 07346545000 020166 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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."
_ -> ""
hakyll-4.16.2.0/lib/Hakyll/Core/Provider/MetadataCache.hs 0000644 0000000 0000000 00000004261 07346545000 021076 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
module Hakyll.Core.Provider.MetadataCache
( resourceMetadata
, resourceBody
, resourceInvalidateMetadataCache
) where
--------------------------------------------------------------------------------
import Control.Monad (unless)
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
Store.Found (BinaryMetadata md) <- Store.get (providerStore p)
[name, toFilePath r, "metadata"]
return md
--------------------------------------------------------------------------------
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
--------------------------------------------------------------------------------
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"
hakyll-4.16.2.0/lib/Hakyll/Core/Routes.hs 0000644 0000000 0000000 00000032041 07346545000 016116 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{- | '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: '/posts/hakyll.md'
> match "posts/*" $ do
> -- compilation result is written to '/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 '/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: '/posts/hakyll.md'
>
> -- 'hakyll.md' source file implicitly gets filepath as identifier:
> -- 'posts/hakyll.md'
> match "posts/*" $ do
>
> -- compilation result is written to '/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: '/posts/hakyll.md'
>
> -- 'hakyll.md' source file implicitly gets filepath as identifier:
> -- 'posts/hakyll.md'
> match "posts/*" $ do
>
> -- compilation result is written to '/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 '/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: '/posts/hakyll.md'
>
> -- 'hakyll.md' source file implicitly gets filepath as identifier:
> -- 'posts/hakyll.md'
> match "posts/*" $ do
>
> -- compilation result is written to '/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 '/index.html'
> route $ constRoute "index.html"
>
> compile $ makeItem ("
Hello World
" :: 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: '/posts/hakyll.md'
>
> -- 'hakyll.md' source file implicitly gets filepath as identifier:
> -- 'posts/hakyll.md'
> match "posts/*" $ do
>
> -- compilation result is written to '/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 '/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
exists__.
=== __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 '/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: '/posts/hakyll.md'
>
> -- 'hakyll.md' source file implicitly gets filepath as identifier:
> -- 'posts/hakyll.md'
> match "posts/*" $ do
>
> -- compilation result is written to '/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')
hakyll-4.16.2.0/lib/Hakyll/Core/Rules.hs 0000644 0000000 0000000 00000047511 07346545000 015737 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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 '/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. '/posts/hakyll.md'
> -- but NOT '/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. '/posts/hakyll.md'
> -- and '/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 '/index.html'
> route idRoute
>
> -- create content without a source file from disk
> compile $ makeItem ("
Hello World
" :: 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:
>
$title$
> $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
]
}
hakyll-4.16.2.0/lib/Hakyll/Core/Rules/ 0000755 0000000 0000000 00000000000 07346545000 015373 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Core/Rules/Internal.hs 0000644 0000000 0000000 00000007500 07346545000 017505 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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
}
hakyll-4.16.2.0/lib/Hakyll/Core/Runtime.hs 0000644 0000000 0000000 00000051516 07346545000 016270 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# LANGUAGE RecordWildCards #-}
module Hakyll.Core.Runtime
( run
, RunMode(..)
) where
--------------------------------------------------------------------------------
import Control.Concurrent (forkIO, getNumCapabilities,
rtsSupportsBoundThreads)
import qualified Control.Concurrent.MVar as MVar
import Control.Monad (replicateM_, unless, void)
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 (foldl', intercalate)
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 <- 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
, 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
, 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
-> Scheduler
-> (Scheduler, [String])
schedulerMarkOutOfDate universe modified 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) modified 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
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
universe <- runtimeUniverse <$> ask
schedulerRef <- runtimeScheduler <$> ask
let modified = Set.filter (resourceModified provider) (Map.keysSet universe)
msgs <- liftIO . IORef.atomicModifyIORef' schedulerRef $
schedulerMarkOutOfDate universe modified
-- 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
(mroute, _) <- liftIO $ runRoutes routes provider id'
case mroute of
Nothing -> return ()
Just route -> do
liftIO . IORef.atomicModifyIORef' scheduler $
schedulerRoute id' route
let path = destinationDirectory config route
liftIO $ makeDirectories path
liftIO $ write path item
Logger.debug logger $ "Routed to " ++ path
liftIO $ save store item
liftIO . IORef.atomicModifyIORef' scheduler $
schedulerWrite id' facts
CompilerRequire reqs c ->
liftIO . IORef.atomicModifyIORef' scheduler $
schedulerBlock id' reqs c
hakyll-4.16.2.0/lib/Hakyll/Core/Store.hs 0000644 0000000 0000000 00000021377 07346545000 015743 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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 _ = ""
--------------------------------------------------------------------------------
-- | 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 "/"
hakyll-4.16.2.0/lib/Hakyll/Core/UnixFilter.hs 0000644 0000000 0000000 00000013614 07346545000 016733 0 ustar 00 0000000 0000000 {-# 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:
--
--
--
-- 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)
hakyll-4.16.2.0/lib/Hakyll/Core/Util/ 0000755 0000000 0000000 00000000000 07346545000 015216 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Core/Util/File.hs 0000644 0000000 0000000 00000006772 07346545000 016445 0 ustar 00 0000000 0000000 {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
--------------------------------------------------------------------------------
-- | A module containing various file utility functions
module Hakyll.Core.Util.File
( makeDirectories
, getRecursiveContents
, removeDirectory
) where
--------------------------------------------------------------------------------
import Control.Monad (filterM, forM)
import System.Directory (createDirectoryIfMissing,
doesDirectoryExist, getDirectoryContents)
import System.FilePath (takeDirectory, ())
#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.
getRecursiveContents :: (FilePath -> IO Bool) -- ^ Ignore this file/directory
-> FilePath -- ^ Directory to search
-> IO [FilePath] -- ^ List of files found
getRecursiveContents ignore top = go ""
where
isProper x
| x `elem` [".", ".."] = return False
| otherwise = not <$> ignore x
go dir = do
dirExists <- doesDirectoryExist (top dir)
if not dirExists
then return []
else do
names <- filterM isProper =<< getDirectoryContents (top dir)
paths <- forM names $ \name -> do
let rel = dir name
isDirectory <- doesDirectoryExist (top rel)
if isDirectory
then go rel
else return [rel]
return $ concat paths
--------------------------------------------------------------------------------
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
hakyll-4.16.2.0/lib/Hakyll/Core/Util/Parser.hs 0000644 0000000 0000000 00000002071 07346545000 017006 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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"]
hakyll-4.16.2.0/lib/Hakyll/Core/Util/String.hs 0000644 0000000 0000000 00000005534 07346545000 017027 0 ustar 00 0000000 0000000 {-# LANGUAGE FlexibleContexts #-}
--------------------------------------------------------------------------------
-- | Miscellaneous string manipulation functions.
module Hakyll.Core.Util.String
( trim
, replaceAll
, splitAll
, needlePrefix
, removeWinPathSeparator
) where
--------------------------------------------------------------------------------
import Data.Char (isSpace)
import Data.List (isPrefixOf)
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 match)
-> 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)
--------------------------------------------------------------------------------
-- | 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]) hakyll-4.16.2.0/lib/Hakyll/Core/Writable.hs 0000644 0000000 0000000 00000003606 07346545000 016413 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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
hakyll-4.16.2.0/lib/Hakyll/Main.hs 0000644 0000000 0000000 00000020017 07346545000 014631 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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 #-}
hakyll-4.16.2.0/lib/Hakyll/Preview/ 0000755 0000000 0000000 00000000000 07346545000 015032 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Preview/Poll.hs 0000644 0000000 0000000 00000011146 07346545000 016277 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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
hakyll-4.16.2.0/lib/Hakyll/Preview/Server.hs 0000644 0000000 0000000 00000002774 07346545000 016646 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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 ()
hakyll-4.16.2.0/lib/Hakyll/Web/ 0000755 0000000 0000000 00000000000 07346545000 014126 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Web/CompressCss.hs 0000644 0000000 0000000 00000010574 07346545000 016735 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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 `compressCalcExpression` on all parenthesised calc 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 compressCalcExpression (drop 4 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() expressions
compressCalcExpression :: String -> String
compressCalcExpression =
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 hakyll-4.16.2.0/lib/Hakyll/Web/Feed.hs 0000644 0000000 0000000 00000024255 07346545000 015335 0 ustar 00 0000000 0000000 {-# 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'
module Hakyll.Web.Feed
( FeedConfiguration (..)
, renderRss
, renderAtom
, renderJson
, renderRssWithTemplates
, renderAtomWithTemplates
, renderJsonWithTemplates
) where
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler
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)
--------------------------------------------------------------------------------
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 "]]>")
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
--------------------------------------------------------------------------------
-- | Render an RSS feed using given templates with a number of items.
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 = renderFeed
XmlFeed feedTemplate itemTemplate config
(makeItemContext "%a, %d %b %Y %H:%M:%S UT" context)
--------------------------------------------------------------------------------
-- | Render an Atom feed using given templates with a number of items.
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 = renderFeed
XmlFeed feedTemplate itemTemplate config
(makeItemContext "%Y-%m-%dT%H:%M:%SZ" context)
--------------------------------------------------------------------------------
-- | 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.
renderRss :: FeedConfiguration -- ^ Feed configuration
-> Context String -- ^ Item context
-> [Item String] -- ^ Feed items
-> Compiler (Item String) -- ^ Resulting feed
renderRss = renderRssWithTemplates rssTemplate rssItemTemplate
--------------------------------------------------------------------------------
-- | Render an Atom feed with a number of items.
renderAtom :: FeedConfiguration -- ^ Feed configuration
-> Context String -- ^ Item context
-> [Item String] -- ^ Feed items
-> Compiler (Item String) -- ^ Resulting feed
renderAtom = renderAtomWithTemplates atomTemplate atomItemTemplate
--------------------------------------------------------------------------------
-- | 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"
hakyll-4.16.2.0/lib/Hakyll/Web/Html.hs 0000644 0000000 0000000 00000024346 07346545000 015377 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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 "
foo
"
--
-- Result:
--
-- > "foo"
--
-- This also works for incomplete tags
--
-- Example:
--
-- > stripTags "
foo "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 & 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 ""
hakyll-4.16.2.0/lib/Hakyll/Web/Html/ 0000755 0000000 0000000 00000000000 07346545000 015032 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Web/Html/RelativizeUrls.hs 0000644 0000000 0000000 00000003740 07346545000 020356 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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
--
-- >
--
-- 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@:
--
-- >
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
hakyll-4.16.2.0/lib/Hakyll/Web/Meta/ 0000755 0000000 0000000 00000000000 07346545000 015014 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Web/Meta/JSONLD.hs 0000644 0000000 0000000 00000007576 07346545000 016360 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
{- |
JSON-LD metadata, using 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:
@
\
\$title$\
\
$if(jsonld)$$jsonld("embed")$$endif$
\
@
The @"embed"@ argument generates a @\"
>>= compileTemplateItem
hakyll-4.16.2.0/lib/Hakyll/Web/Meta/OpenGraph.hs 0000644 0000000 0000000 00000004643 07346545000 017242 0 ustar 00 0000000 0000000 {- |
Open Graph metadata, as described at . 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:
@
\
\$title$
\
$if(opengraph)$$opengraph$$endif$
\
@
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 =
"\
\\
\\
\$if(og-description)$\
\\
\$endif$\
\$if(og-image)$\
\\
\$endif$\
\"
hakyll-4.16.2.0/lib/Hakyll/Web/Meta/TwitterCard.hs 0000644 0000000 0000000 00000004215 07346545000 017606 0 ustar 00 0000000 0000000 {- |
Twitter Card metadata, as described at
.
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:
@
\
\$title$\
\
$if(opengraph)$$opengraph$$endif$
$if(twitter)$$twitter$$endif$
\
@
-}
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 =
"\
\$if(twitter-creator)$$endif$\
\$if(twitter-site)$$endif$"
hakyll-4.16.2.0/lib/Hakyll/Web/Paginate.hs 0000644 0000000 0000000 00000013212 07346545000 016211 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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.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 = 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
hakyll-4.16.2.0/lib/Hakyll/Web/Pandoc.hs 0000644 0000000 0000000 00000020407 07346545000 015671 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | Module exporting convenient pandoc bindings
module Hakyll.Web.Pandoc
( -- * The basic building blocks
readPandoc
, readPandocWith
, writePandoc
, writePandocWith
, renderPandoc
, renderPandocWith
, renderPandocWithTransform
, renderPandocWithTransformM
-- * Derived compilers
, pandocCompiler
, pandocCompilerWith
, pandocCompilerWithTransform
, pandocCompilerWithTransformM
-- * 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
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.
renderPandocWithTransformM :: ReaderOptions -> WriterOptions
-> (Pandoc -> Compiler Pandoc)
-> Item String
-> Compiler (Item String)
renderPandocWithTransformM ropt wopt f i =
writePandocWith wopt <$> (traverse f =<< readPandocWith ropt i)
--------------------------------------------------------------------------------
-- | Read a page render using pandoc
pandocCompiler :: Compiler (Item String)
pandocCompiler =
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
--------------------------------------------------------------------------------
-- | 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
writerHighlightStyle = Just pygments
, -- 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
}
hakyll-4.16.2.0/lib/Hakyll/Web/Pandoc/ 0000755 0000000 0000000 00000000000 07346545000 015332 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Web/Pandoc/Biblio.hs 0000644 0000000 0000000 00000017526 07346545000 017101 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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 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.Writable
import Hakyll.Web.Pandoc
import Text.Pandoc (Extension (..), Pandoc,
ReaderOptions (..),
enableExtension)
import qualified Text.Pandoc as Pandoc
import qualified Text.Pandoc.Citeproc as Pandoc (processCitations)
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
--------------------------------------------------------------------------------
processPandocBiblio :: Item CSL
-> Item Biblio
-> (Item Pandoc)
-> Compiler (Item Pandoc)
processPandocBiblio csl biblio = processPandocBiblios csl [biblio]
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.
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
errOrPandoc = Pandoc.runPure $ do
Pandoc.modifyPureState addBiblioFiles
Pandoc.processCitations $ Pandoc.Pandoc biblioMeta blocks
pandoc <- case errOrPandoc of
Left e -> compilerThrow ["Error during processCitations: " ++ show e]
Right x -> return x
return $ fmap (const pandoc) item
where
zeroTime = Time.UTCTime (toEnum 0) 0
--------------------------------------------------------------------------------
-- | 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
}
hakyll-4.16.2.0/lib/Hakyll/Web/Pandoc/Binary.hs 0000644 0000000 0000000 00000001430 07346545000 017110 0 ustar 00 0000000 0000000 {-# 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
hakyll-4.16.2.0/lib/Hakyll/Web/Pandoc/FileType.hs 0000644 0000000 0000000 00000005033 07346545000 017410 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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
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
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
hakyll-4.16.2.0/lib/Hakyll/Web/Redirect.hs 0000644 0000000 0000000 00000010442 07346545000 016224 0 ustar 00 0000000 0000000 -- | 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 which
-- should be 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 .
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) =
"" ++
"" ++
"Permanent Redirect
"
hakyll-4.16.2.0/lib/Hakyll/Web/Tags.hs 0000644 0000000 0000000 00000032466 07346545000 015373 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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 (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
hakyll-4.16.2.0/lib/Hakyll/Web/Template.hs 0000644 0000000 0000000 00000011356 07346545000 016243 0 ustar 00 0000000 0000000 -- | 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:
--
-- >
-- >
-- > My crazy homepage - $title$
-- >
-- >
-- >
-- >
My crazy homepage - $title$
-- >
-- >
-- > $body$
-- >
-- >
-- >
-- >
--
-- 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
--
-- >
-- > A literal $$key$$.
-- >
--
-- 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)$
-- > Defined
-- > $else$
-- > Non-defined
-- > $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
--
-- >
-- > I like
-- >
-- > fresh fruits, and
-- >
-- > fresh vegetables
-- >
--
-- 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
--
-- > $key$
--
-- The result of rendering
--
-- >
-- > $partial("test.html")$
-- >
--
-- is the same as the result of rendering
--
-- >
-- > $key$
-- >
--
-- 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
--
-- >
--
{-# 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 |]
hakyll-4.16.2.0/lib/Hakyll/Web/Template/ 0000755 0000000 0000000 00000000000 07346545000 015701 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Web/Template/Context.hs 0000644 0000000 0000000 00000043305 07346545000 017666 0 ustar 00 0000000 0000000 -- | 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
, 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.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 = (<>)
--------------------------------------------------------------------------------
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
-> (Item a -> Bool)
-> Context a
boolField name f = field' name (\i -> if f i
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$@ field
--
-- 2. Metadata fields
--
-- 3. A @$url$@ 'urlField'
--
-- 4. A @$path$@ 'pathField'
--
-- 5. A @$title$@ 'titleField'
defaultContext :: Context String
defaultContext =
bodyField "body" `mappend`
metadataField `mappend`
urlField "url" `mappend`
pathField "path" `mappend`
titleField "title"
--------------------------------------------------------------------------------
teaserSeparator :: String
teaserSeparator = ""
--------------------------------------------------------------------------------
-- | Constructs a 'field' that contains the body of the item.
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
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
pathField :: String -> Context a
pathField key = field key $ return . toFilePath . itemIdentifier
--------------------------------------------------------------------------------
-- | This title 'field' takes the basename of the underlying file by default
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"
hakyll-4.16.2.0/lib/Hakyll/Web/Template/Internal.hs 0000644 0000000 0000000 00000023767 07346545000 020030 0 ustar 00 0000000 0000000 {-# 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" #-}
hakyll-4.16.2.0/lib/Hakyll/Web/Template/Internal/ 0000755 0000000 0000000 00000000000 07346545000 017455 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Web/Template/Internal/Element.hs 0000644 0000000 0000000 00000023147 07346545000 021411 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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)
hakyll-4.16.2.0/lib/Hakyll/Web/Template/Internal/Trim.hs 0000644 0000000 0000000 00000007306 07346545000 020732 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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
hakyll-4.16.2.0/lib/Hakyll/Web/Template/List.hs 0000644 0000000 0000000 00000006704 07346545000 017157 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
-- | 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]
hakyll-4.16.2.0/src/ 0000755 0000000 0000000 00000000000 07346545000 012206 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/src/Init.hs 0000644 0000000 0000000 00000012010 07346545000 013437 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
module Main
( main
) where
--------------------------------------------------------------------------------
import Control.Arrow (first)
import Control.Monad (forM, forM_)
import Data.Char (isAlphaNum, isNumber)
import Data.List (foldl', intercalate, isPrefixOf)
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] "
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
hakyll-4.16.2.0/tests/Hakyll/Core/Dependencies/ 0000755 0000000 0000000 00000000000 07346545000 017263 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/Hakyll/Core/Dependencies/Tests.hs 0000644 0000000 0000000 00000004360 07346545000 020724 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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]
--------------------------------------------------------------------------------
oldUniverse :: [Identifier]
oldUniverse = M.keys oldFacts
--------------------------------------------------------------------------------
oldFacts :: DependencyFacts
oldFacts = M.fromList
[ ("posts/01.md",
[])
, ("posts/02.md",
[])
, ("index.md",
[ PatternDependency "posts/*"
(S.fromList ["posts/01.md", "posts/02.md"])
, IdentifierDependency "posts/01.md"
, IdentifierDependency "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") oldFacts
--------------------------------------------------------------------------------
-- | about.md was added
case02 :: Assertion
case02 = S.singleton "about.md" @=? ood
where
(ood, _, _) = outOfDate ("about.md" : oldUniverse) S.empty oldFacts
--------------------------------------------------------------------------------
-- | posts/01.md was removed
case03 :: Assertion
case03 = S.singleton "index.md" @=? ood
where
(ood, _, _) =
outOfDate ("posts/01.md" `delete` oldUniverse) S.empty oldFacts
hakyll-4.16.2.0/tests/Hakyll/Core/Identifier/ 0000755 0000000 0000000 00000000000 07346545000 016757 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/Hakyll/Core/Identifier/Tests.hs 0000644 0000000 0000000 00000005474 07346545000 020427 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
module Hakyll.Core.Identifier.Tests
( tests
) where
--------------------------------------------------------------------------------
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit ((@=?))
--------------------------------------------------------------------------------
import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
import System.FilePath (())
import TestSuite.Util
--------------------------------------------------------------------------------
tests :: TestTree
tests = testGroup "Hakyll.Core.Identifier.Tests" $ concat
[ captureTests
, matchesTests
]
--------------------------------------------------------------------------------
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"
, Nothing @=? capture "\\*.jpg" "foo.jpg"
, Just ["xyz","42"] @=? capture (fromRegex "cat-([a-z]+)/foo([0-9]+).jpg") "cat-xyz/foo42.jpg"
]
--------------------------------------------------------------------------------
matchesTests :: [TestTree]
matchesTests = fromAssertions "matches"
[ 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")
]
hakyll-4.16.2.0/tests/Hakyll/Core/Provider/Metadata/ 0000755 0000000 0000000 00000000000 07346545000 020207 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/Hakyll/Core/Provider/Metadata/Tests.hs 0000644 0000000 0000000 00000004571 07346545000 021654 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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
hakyll-4.16.2.0/tests/Hakyll/Core/Provider/ 0000755 0000000 0000000 00000000000 07346545000 016467 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/Hakyll/Core/Provider/Tests.hs 0000644 0000000 0000000 00000002254 07346545000 020130 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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
hakyll-4.16.2.0/tests/Hakyll/Core/Routes/ 0000755 0000000 0000000 00000000000 07346545000 016156 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/Hakyll/Core/Routes/Tests.hs 0000644 0000000 0000000 00000003624 07346545000 017621 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
module Hakyll.Core.Routes.Tests
( tests
) where
--------------------------------------------------------------------------------
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 :: 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"
, testRoutes "neve ro ddo reven"
(customRoute (reverse . toFilePath )) "never odd or even"
, 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
hakyll-4.16.2.0/tests/Hakyll/Core/Rules/ 0000755 0000000 0000000 00000000000 07346545000 015767 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/Hakyll/Core/Rules/Tests.hs 0000644 0000000 0000000 00000007230 07346545000 017427 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
module Hakyll.Core.Rules.Tests
( tests
) where
--------------------------------------------------------------------------------
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
--------------------------------------------------------------------------------
tests :: TestTree
tests = testGroup "Hakyll.Core.Rules.Tests" $ fromAssertions "runRules"
[case01]
--------------------------------------------------------------------------------
case01 :: Assertion
case01 = do
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
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"
]
--------------------------------------------------------------------------------
rules01 :: IORef Bool -> Rules ()
rules01 ioref = do
-- Compile some posts
match "*.md" $ do
route $ setExtension "html"
compile copyFileCompiler
-- Yeah. I don't know how else to test this stuff?
preprocess $ writeIORef ioref True
-- Compile them, raw
match "*.md" $ version "raw" $ do
route idRoute
compile getResourceString
version "metadataMatch" $
matchMetadata "*.md" (\md -> lookupString "subblog" md == Just "food") $ do
route $ customRoute $ \id' -> "food" toFilePath id'
compile getResourceString
-- Regression test
version "nav" $ match (fromList ["example.md"]) $ do
route idRoute
compile copyFileCompiler
-- 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
hakyll-4.16.2.0/tests/Hakyll/Core/Runtime/ 0000755 0000000 0000000 00000000000 07346545000 016320 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/Hakyll/Core/Runtime/Tests.hs 0000644 0000000 0000000 00000021560 07346545000 017762 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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
]
--------------------------------------------------------------------------------
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 @?= ["
This is an example.
"]
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
--------------------------------------------------------------------------------
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
hakyll-4.16.2.0/tests/Hakyll/Core/Store/ 0000755 0000000 0000000 00000000000 07346545000 015771 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/Hakyll/Core/Store/Tests.hs 0000644 0000000 0000000 00000005613 07346545000 017434 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
module Hakyll.Core.Store.Tests
( tests
) where
--------------------------------------------------------------------------------
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 TestSuite.Util
--------------------------------------------------------------------------------
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 :: 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 :: 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 <- 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 <- 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)
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
hakyll-4.16.2.0/tests/Hakyll/Core/UnixFilter/ 0000755 0000000 0000000 00000000000 07346545000 016766 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/Hakyll/Core/UnixFilter/Tests.hs 0000644 0000000 0000000 00000004706 07346545000 020433 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Hakyll.Core.UnixFilter.Tests
( tests
) where
--------------------------------------------------------------------------------
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)
import qualified Test.Tasty.HUnit as H
--------------------------------------------------------------------------------
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
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 = getResourceString >>= withItemBody (unixFilter "rev" [])
rev = map reverse . lines
#endif
--------------------------------------------------------------------------------
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" ["-#"])
hakyll-4.16.2.0/tests/Hakyll/Core/Util/String/ 0000755 0000000 0000000 00000000000 07346545000 017060 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/Hakyll/Core/Util/String/Tests.hs 0000644 0000000 0000000 00000002602 07346545000 020516 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
module Hakyll.Core.Util.String.Tests
( tests
) where
--------------------------------------------------------------------------------
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit ((@=?))
--------------------------------------------------------------------------------
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"
]
, fromAssertions "splitAll"
[ ["λ", "∀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 "" ""
]
]
where
readInt :: String -> Int
readInt = read
hakyll-4.16.2.0/tests/Hakyll/Web/CompressCss/ 0000755 0000000 0000000 00000000000 07346545000 016766 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/Hakyll/Web/CompressCss/Tests.hs 0000644 0000000 0000000 00000005432 07346545000 020430 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
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 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 ";;;;;;;"
]
]
hakyll-4.16.2.0/tests/Hakyll/Web/Html/RelativizeUrls/ 0000755 0000000 0000000 00000000000 07346545000 020412 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/Hakyll/Web/Html/RelativizeUrls/Tests.hs 0000644 0000000 0000000 00000003467 07346545000 022062 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
{-# 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"
[ "bar" @=?
relativizeUrlsWith ".." "bar"
, "" @=?
relativizeUrlsWith "../.." ""
, "" @=?
relativizeUrlsWith "../.."
""
, "Haskell" @=?
relativizeUrlsWith "../.."
"Haskell"
, "Haskell" @=?
relativizeUrlsWith "../.."
"Haskell"
, "" @=?
relativizeUrlsWith "../.."
""
, "" @=?
relativizeUrlsWith "." ""
]
hakyll-4.16.2.0/tests/Hakyll/Web/Html/ 0000755 0000000 0000000 00000000000 07346545000 015426 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/Hakyll/Web/Html/Tests.hs 0000644 0000000 0000000 00000012160 07346545000 017064 0 ustar 00 0000000 0000000 --------------------------------------------------------------------------------
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"
[ "
A h1 title
" @=?
demoteHeaders "
A h1 title
" -- Assert single-step demotion
, "
A h6 title
" @=?
demoteHeaders "
A h6 title
" -- Assert maximum demotion is h6
]
, fromAssertions "demoteHeadersBy"
[ "
A h1 title
" @=?
demoteHeadersBy 2 "
A h1 title
"
, "
A h5 title
" @=?
demoteHeadersBy 2 "
A h5 title
" -- Assert that h6 is the lowest possible demoted header.
, "
I would like to cite one of my favourite papers (Meijer, Fokkinga, and Paterson 1991) here.
Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. “Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.” In Conference on Functional Programming Languages and Computer Architecture, 124–44. Springer.
hakyll-4.16.2.0/tests/data/biblio/cites-meijer-pandoc-3.0.0plus.golden 0000644 0000000 0000000 00000001430 07346545000 023304 0 ustar 00 0000000 0000000
This page cites a paper.
This page cites a paper.
I would like to cite one of my favourite papers (Meijer, Fokkinga, and Paterson 1991) here.
Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. “Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.” In Conference on Functional Programming Languages and Computer Architecture, 124–44. Springer.
hakyll-4.16.2.0/tests/data/biblio/cites-meijer-pandoc-3.1.8plus.golden 0000644 0000000 0000000 00000001457 07346545000 023326 0 ustar 00 0000000 0000000
This page cites a paper.
This page cites a paper.
I would like to cite one of my favourite papers (Meijer, Fokkinga, and Paterson 1991) here.
Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. “Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.” In Conference on Functional Programming Languages and Computer Architecture, 124–44. Springer.
hakyll-4.16.2.0/tests/data/biblio/cites-multiple-pandoc-2.0.0plus.golden 0000644 0000000 0000000 00000002155 07346545000 023670 0 ustar 00 0000000 0000000
This page cites a paper and a book.
This page cites a paper and a book.
I would like to cite one of my favourite papers (Meijer, Fokkinga, and Paterson 1991) here.
And also a book (Lipovača 2012).
Lipovača, Miran. 2012. Learn You a Haskell for Great Good! A Beginner’s Guide. San Francisco, CA: No Starch Press.
Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. “Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.” In Conference on Functional Programming Languages and Computer Architecture, 124–44. Springer.
hakyll-4.16.2.0/tests/data/biblio/cites-multiple-pandoc-3.0.0plus.golden 0000644 0000000 0000000 00000002123 07346545000 023664 0 ustar 00 0000000 0000000
This page cites a paper and a book.
This page cites a paper and a book.
I would like to cite one of my favourite papers (Meijer, Fokkinga, and Paterson 1991) here.
And also a book (Lipovača 2012).
Lipovača, Miran. 2012. Learn You a Haskell for Great Good! A Beginner’s Guide. San Francisco, CA: No Starch Press.
Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. “Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.” In Conference on Functional Programming Languages and Computer Architecture, 124–44. Springer.
hakyll-4.16.2.0/tests/data/biblio/cites-multiple-pandoc-3.1.8plus.golden 0000644 0000000 0000000 00000002152 07346545000 023677 0 ustar 00 0000000 0000000
This page cites a paper and a book.
This page cites a paper and a book.
I would like to cite one of my favourite papers (Meijer, Fokkinga, and Paterson 1991) here.
And also a book (Lipovača 2012).
Lipovača, Miran. 2012. Learn You a Haskell for Great Good! A Beginner’s Guide. San Francisco, CA: No Starch Press.
Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. “Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.” In Conference on Functional Programming Languages and Computer Architecture, 124–44. Springer.
hakyll-4.16.2.0/tests/data/biblio/cites-multiple.markdown 0000644 0000000 0000000 00000000244 07346545000 021436 0 ustar 00 0000000 0000000 ---
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].
hakyll-4.16.2.0/tests/data/biblio/default.html 0000644 0000000 0000000 00000000275 07346545000 017250 0 ustar 00 0000000 0000000
$title$
$title$
$body$
hakyll-4.16.2.0/tests/data/biblio/page.markdown 0000644 0000000 0000000 00000000167 07346545000 017416 0 ustar 00 0000000 0000000 ---
title: This page cites a paper.
---
I would like to cite one of my favourite papers [@meijer1991functional] here.
hakyll-4.16.2.0/tests/data/biblio/refs.bib 0000644 0000000 0000000 00000000520 07346545000 016344 0 ustar 00 0000000 0000000 @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}
}
hakyll-4.16.2.0/tests/data/biblio/refs.yaml 0000644 0000000 0000000 00000000675 07346545000 016565 0 ustar 00 0000000 0000000 ---
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
...
hakyll-4.16.2.0/tests/data/biblio/refs2.yaml 0000644 0000000 0000000 00000000641 07346545000 016640 0 ustar 00 0000000 0000000 ---
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
...
hakyll-4.16.2.0/tests/data/ 0000755 0000000 0000000 00000000000 07346545000 013472 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/data/embed.html 0000644 0000000 0000000 00000000016 07346545000 015431 0 ustar 00 0000000 0000000
This is an example.
hakyll-4.16.2.0/tests/data/posts/ 0000755 0000000 0000000 00000000000 07346545000 014642 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/data/posts/2010-08-26-birthday.md 0000644 0000000 0000000 00000000030 07346545000 020015 0 ustar 00 0000000 0000000 It's my birthday today.
hakyll-4.16.2.0/tests/data/posts/2018-09-26.md 0000644 0000000 0000000 00000000032 07346545000 016224 0 ustar 00 0000000 0000000 Something happened today.
hakyll-4.16.2.0/tests/data/posts/2019/05/10/ 0000755 0000000 0000000 00000000000 07346545000 015701 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/tests/data/posts/2019/05/10/tomorrow.md 0000644 0000000 0000000 00000000063 07346545000 020112 0 ustar 00 0000000 0000000 This day hasn't happened yet (as of writing this).
hakyll-4.16.2.0/tests/data/russian.md 0000644 0000000 0000000 00000002140 07346545000 015475 0 ustar 00 0000000 0000000 Статья 18
Каждый человек имеет право на свободу мысли, совести и религии; это
право включает свободу менять свою религию или убеждения и свободу
исповедовать свою религию или убеждения как единолично, так и сообща с
другими, публичным или частным порядком в учении, богослужении и
выполнении религиозных и ритуальных обрядов.
Статья 19
Каждый человек имеет право на свободу убеждений и на свободное выражение
их; это право включает свободу беспрепятственно придерживаться своих
убеждений и свободу искать, получать и распространять информацию и идеи
любыми средствами и независимо от государственных границ.
hakyll-4.16.2.0/tests/data/strip.html 0000644 0000000 0000000 00000000642 07346545000 015523 0 ustar 00 0000000 0000000
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$
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$
--
-- 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@:
--
-- > 
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
hakyll-4.16.2.0/lib/Hakyll/Web/Meta/ 0000755 0000000 0000000 00000000000 07346545000 015014 5 ustar 00 0000000 0000000 hakyll-4.16.2.0/lib/Hakyll/Web/Meta/JSONLD.hs 0000644 0000000 0000000 00000007576 07346545000 016360 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
{- |
JSON-LD metadata, using
-- >
-- > ![](\"../../images/lolcat.png\")
" @=?
relativizeUrlsWith "../.." "![](\"/images/lolcat.png\")
"
, "" @=?
relativizeUrlsWith "../.."
""
, "Haskell" @=?
relativizeUrlsWith "../.."
"Haskell"
, "Haskell" @=?
relativizeUrlsWith "../.."
"Haskell"
, "" @=?
relativizeUrlsWith "../.."
""
, "![](\"./image.png)
![](\"/image.png)
![](\"/path/to/image.png)
![](\"/small.jpeg)
![](\"/image1.png)