git.iko.soy/hakyll
on master help sign in
swap
6782404167 ahead, 0 behind
121 files changed+2407−1031
since splitsnapshots
unifiedsplit
.circleci/config.yml+19 .circleci/tickle.sh+24 .gitignore+3 .travis.yml−20 web/releases.markdown → CHANGELOG.md+165 CODE_OF_CONDUCT.md+45 LICENSE+1−1 Makefile+6−6 README.markdown+1−1 data/example/css/default.css+122−37 data/example/templates/default.html+9−9 data/example/templates/post.html+11−8 hakyll.cabal+134−127 src/Data/List/Extended.hs → lib/Data/List/Extended.hs src/Data/Yaml/Extended.hs → lib/Data/Yaml/Extended.hs+5−1 src/Hakyll.hs → lib/Hakyll.hs+7−1 src/Hakyll/Check.hs → lib/Hakyll/Check.hs+118−77 src/Hakyll/Commands.hs → lib/Hakyll/Commands.hs+8−4 src/Hakyll/Core/Compiler.hs → lib/Hakyll/Core/Compiler.hs+44−2 src/Hakyll/Core/Compiler/Internal.hs → lib/Hakyll/Core/Compiler/Internal.hs+140−41 src/Hakyll/Core/Compiler/Require.hs → lib/Hakyll/Core/Compiler/Require.hs+2 src/Hakyll/Core/Configuration.hs → lib/Hakyll/Core/Configuration.hs src/Hakyll/Core/Dependencies.hs → lib/Hakyll/Core/Dependencies.hs src/Hakyll/Core/File.hs → lib/Hakyll/Core/File.hs+11−3 src/Hakyll/Core/Identifier.hs → lib/Hakyll/Core/Identifier.hs+1−1 src/Hakyll/Core/Identifier/Pattern.hs → lib/Hakyll/Core/Identifier/Pattern.hs+14−72 lib/Hakyll/Core/Identifier/Pattern/Internal.hs+92 src/Hakyll/Core/Item.hs → lib/Hakyll/Core/Item.hs src/Hakyll/Core/Item/SomeItem.hs → lib/Hakyll/Core/Item/SomeItem.hs src/Hakyll/Core/Logger.hs → lib/Hakyll/Core/Logger.hs+9−3 src/Hakyll/Core/Metadata.hs → lib/Hakyll/Core/Metadata.hs src/Hakyll/Core/Provider.hs → lib/Hakyll/Core/Provider.hs src/Hakyll/Core/Provider/Internal.hs → lib/Hakyll/Core/Provider/Internal.hs src/Hakyll/Core/Provider/Metadata.hs → lib/Hakyll/Core/Provider/Metadata.hs+3−2 src/Hakyll/Core/Provider/MetadataCache.hs → lib/Hakyll/Core/Provider/MetadataCache.hs src/Hakyll/Core/Routes.hs → lib/Hakyll/Core/Routes.hs+17 src/Hakyll/Core/Rules.hs → lib/Hakyll/Core/Rules.hs src/Hakyll/Core/Rules/Internal.hs → lib/Hakyll/Core/Rules/Internal.hs+14 src/Hakyll/Core/Runtime.hs → lib/Hakyll/Core/Runtime.hs+3−3 src/Hakyll/Core/Store.hs → lib/Hakyll/Core/Store.hs+26−23 src/Hakyll/Core/UnixFilter.hs → lib/Hakyll/Core/UnixFilter.hs+2−1 src/Hakyll/Core/Util/File.hs → lib/Hakyll/Core/Util/File.hs src/Hakyll/Core/Util/Parser.hs → lib/Hakyll/Core/Util/Parser.hs−1 src/Hakyll/Core/Util/String.hs → lib/Hakyll/Core/Util/String.hs+1−1 src/Hakyll/Core/Writable.hs → lib/Hakyll/Core/Writable.hs lib/Hakyll/Main.hs+180 src/Hakyll/Preview/Poll.hs → lib/Hakyll/Preview/Poll.hs+8−18 src/Hakyll/Preview/Server.hs → lib/Hakyll/Preview/Server.hs lib/Hakyll/Web/CompressCss.hs+101 src/Hakyll/Web/Feed.hs → lib/Hakyll/Web/Feed.hs+59−21 src/Hakyll/Web/Html.hs → lib/Hakyll/Web/Html.hs+6−2 src/Hakyll/Web/Html/RelativizeUrls.hs → lib/Hakyll/Web/Html/RelativizeUrls.hs src/Hakyll/Web/Paginate.hs → lib/Hakyll/Web/Paginate.hs+28−1 src/Hakyll/Web/Pandoc.hs → lib/Hakyll/Web/Pandoc.hs+13−12 src/Hakyll/Web/Pandoc/Biblio.hs → lib/Hakyll/Web/Pandoc/Biblio.hs+17−6 src/Hakyll/Web/Pandoc/Binary.hs → lib/Hakyll/Web/Pandoc/Binary.hs+19−17 src/Hakyll/Web/Pandoc/FileType.hs → lib/Hakyll/Web/Pandoc/FileType.hs lib/Hakyll/Web/Redirect.hs+100 src/Hakyll/Web/Tags.hs → lib/Hakyll/Web/Tags.hs+2−1 src/Hakyll/Web/Template.hs → lib/Hakyll/Web/Template.hs+24 src/Hakyll/Web/Template/Context.hs → lib/Hakyll/Web/Template/Context.hs+135−33 src/Hakyll/Web/Template/Internal.hs → lib/Hakyll/Web/Template/Internal.hs+103−45 src/Hakyll/Web/Template/Internal/Element.hs → lib/Hakyll/Web/Template/Internal/Element.hs+7−14 src/Hakyll/Web/Template/Internal/Trim.hs → lib/Hakyll/Web/Template/Internal/Trim.hs src/Hakyll/Web/Template/List.hs → lib/Hakyll/Web/Template/List.hs src/Hakyll/Main.hs−110 src/Hakyll/Web/CompressCss.hs−85 src/Hakyll/Init.hs → src/Init.hs+44−17 stack.yaml+27−7 test.hs+30 tests/Hakyll/Core/Identifier/Tests.hs+1 tests/Hakyll/Core/Provider/Tests.hs+2−2 tests/Hakyll/Core/Rules/Tests.hs+3−4 tests/Hakyll/Core/Runtime/Tests.hs+1−1 tests/Hakyll/Core/Store/Tests.hs+7−7 tests/Hakyll/Core/UnixFilter/Tests.hs+22−12 tests/Hakyll/Web/CompressCss/Tests.hs+18−13 tests/Hakyll/Web/Html/Tests.hs+6−6 tests/Hakyll/Web/Template/Context/Tests.hs+40−3 tests/Hakyll/Web/Template/Tests.hs+53−19 tests/TestSuite.hs+7 tests/TestSuite/Util.hs+27−5 tests/data/embed.html+1 tests/data/example.md.metadata+2 tests/data/just-meta.html+7 tests/data/just-meta.html.out+7 tests/data/posts/2018-09-26.md+1 tests/data/posts/2019/05/10/tomorrow.md+1 web/css/syntax.css+61−18 web/examples.markdown+48−28 web/libraries.markdown+1 web/site.hs+25−39 web/templates/default.html+1−6 web/templates/tutorials.html+24−18 web/tutorials/01-installation.markdown+4−1 web/tutorials/02-basics.markdown+1 web/tutorials/03-rules-routes-compilers.markdown+1 web/tutorials/04-compilers.markdown+18−3 web/tutorials/05-snapshots-feeds.markdown+1 web/tutorials/06-versions.markdown+1 web/tutorials/a-guide-to-the-hakyll-module-zoo.markdown+1 web/tutorials/external-add-tags-to-your-hakyll-blog.md+1−1 web/tutorials/external-blogger-port.md+6 web/tutorials/external-cassius-template.md+6 web/tutorials/external-clean-urls-with-hakyll.md+1−1 web/tutorials/external-deploying-with-widely.md+1−1 web/tutorials/external-external-code-inclusion.md+6 web/tutorials/external-functionfield.md+1−1 web/tutorials/external-github-pages-circle-ci.md+1−1 web/tutorials/external-inlining-and-compressing-css.md+1−1 web/tutorials/external-live-reload.md−6 web/tutorials/faq.markdown+1 web/tutorials/github-pages-tutorial.md+1 web/tutorials/hakyll-3-to-hakyll4-migration-guide.markdown+1 web/tutorials/robertwpearce-01-setup-and-initial-customization.html+5 web/tutorials/robertwpearce-02-generating-a-sitemap-xml-file.html+5 web/tutorials/robertwpearce-03-generating-rss-and-atom-xml-feeds.html+5 web/tutorials/robertwpearce-04-copying-static-files-for-your-build.html+5 web/tutorials/robertwpearce-05-generating-custom-post-filenames-from-a-title-slug.html+5 web/tutorials/using-clay-with-hakyll.markdown+1 web/tutorials/using-teasers-in-hakyll.markdown+1
.circleci/config.ymlnew file+19
@@ -0,0 +1,19 @@
1+version: 2
2+jobs:
3+ build:
4+ docker:
5+ - image: 'fpco/stack-build:latest'
6+ steps:
7+ - checkout
8+ - restore_cache:
9+ key: 'v3-hakyll-{{ arch }}-{{ .Branch }}'
10+ - run:
11+ # We set jobs to 1 here because that prevents Out-Of-Memory exceptions
12+ # while compiling dependencies.
13+ name: 'Install dependencies'
14+ command: '.circleci/tickle.sh stack build --test --copy-bins --jobs=1'
15+ - save_cache:
16+ key: 'v3-hakyll-{{ arch }}-{{ .Branch }}-{{ .Revision }}'
17+ paths:
18+ - '~/.stack-work'
19+ - '~/.stack'
.circleci/tickle.shnew file+24
@@ -0,0 +1,24 @@
1+#!/bin/bash
2+set -o nounset -o errexit -o pipefail
3+
4+function tickle() {
5+ while [ true ]; do
6+ echo "[$(date +%H:%M:%S)] Tickling..."
7+ sleep 60
8+ done
9+}
10+
11+echo "Forking tickle process..."
12+tickle &
13+TICKLE_PID=$!
14+
15+echo "Forking build process..."
16+eval $@ &
17+BUILD_PID=$!
18+
19+echo "Waiting for build thread ($BUILD_PID)..."
20+wait $BUILD_PID
21+
22+echo "Killing tickle thread ($TICKLE_PID)..."
23+kill $TICKLE_PID
24+echo "All done!"
.gitignore+3
@@ -23,3 +23,6 @@ web/_cache
2323web/_site
2424web/site
2525web/reference
26+
27+# This is generated from the CHANGELOG
28+web/releases.markdown
.travis.ymldeleted−20
@@ -1,20 +0,0 @@
1−language: haskell
2−ghc: '7.10'
3−branches:
4− only:
5− - master
6−cache:
7− directories:
8− - $HOME/.stack
9−before_install:
10− - echo "override before_install"
11−install:
12− - wget https://github.com/commercialhaskell/stack/releases/download/v1.0.0/stack-1.0.0-linux-x86_64.tar.gz -O stack.gz
13− - tar xvf stack.gz
14− - chmod +x stack-1.0.0-linux-x86_64/stack
15− - stack-1.0.0-linux-x86_64/stack setup
16− - stack-1.0.0-linux-x86_64/stack build
17−before_script:
18− - echo "override before_script"
19−script:
20− - stack-1.0.0-linux-x86_64/stack test
web/releases.markdown → CHANGELOG.mdrenamed+165
@@ -4,6 +4,171 @@ title: Releases
44
55# Releases
66
7+## Hakyll 4.13.0.0 (2019-08-30)
8+
9+- Improved documentation in many places (contribution by Bergi)
10+- Significantly improve error messages when reading and applying templates
11+ (contribution by Bergi)
12+ * `empty` and `fail` for `Compiler` now fail without or with a message,
13+ allowing for much better debug output
14+ * `renderFeed`, `renderRssWithTemplates` and `renderAtomWithTemplates` now
15+ take `Template` rather than `String` arguments
16+- Add option to specify date in directory structure,e.g.
17+ `posts/2019/05/10/tomorrow.md` (contribution by Taeer Bar-Ya)
18+- Bump QuickCheck to 2.13
19+
20+## Hakyll 4.12.5.2 (2019-05-09)
21+
22+- Bump pandoc to 2.7
23+- Add `srcset` to the list of URL attributes (contribution by c50a326)
24+- Expose `getCategory` in `Hakyll.Web.Tags` (contribution by Ng Wei En)
25+- Fix issue where `published` overwrites the user's context (contribution by
26+ ncaq)
27+
28+## Hakyll 4.12.5.1 (2019-02-03)
29+
30+- Bump pandoc to 2.6
31+- Bump pandoc-citeproc to 0.16
32+
33+## Hakyll 4.12.5.0 (2019-01-12)
34+
35+- Update dependencies (contribution by Hexirp):
36+ * Bump containers to 0.6
37+ * Bump yaml to 0.11
38+ * Bump pandoc to 2.5
39+ * Bump pandoc-citeproc to 0.15
40+ * Bump tasty to 1.2
41+- Correct assertion in unixFilterError test
42+ (contribution by Jim McStanton)
43+- Add renderRssWithTemplates, renderAtomWithTemplates
44+ (contribution by Abhinav Sarkar)
45+- Speed up hashing in cache (contribution by 0xd34df00d)
46+- Update type of fromFilePath to use FilePath instead of String
47+ (contribution by Jim McStanton)
48+- Drop extension when parsing dates in filepaths (contribution by
49+ Gabriel Aumala)
50+
51+## Hakyll 4.12.4.0 (2018-08-13)
52+
53+- Bump yaml to 0.10
54+- Bump file-embed to 0.0.11
55+- Bump QuickCheck to 2.12
56+- Use makeRelativeToProject with embedFile for stack ghci (contribution by
57+ Michael Sloan)
58+
59+## Hakyll 4.12.3.0 (2018-05-29)
60+
61+- Bump tasty to 1.1
62+- Bump fsnotify to 0.3
63+
64+## Hakyll 4.12.2.0
65+
66+- Bump pandoc to 2.2
67+- Fix path resolution in Pandoc.Biblio (contribution by knih)
68+
69+## Hakyll 4.12.1.0
70+
71+- Fix hakyll-init on older GHC versions
72+- Make the Pandoc dependency optional
73+
74+## Hakyll 4.12.0.1
75+
76+- Bump resourcet to 1.2 in test section
77+
78+## Hakyll 4.12.0.0
79+
80+- Add Semigroup instances for existing Monoids (contribution by
81+ Christian Barcenas)
82+- Fix issue with CPP and comment containing `/*`
83+- Add `withTagList` (contribution by Oleg Grenrus)
84+- Improve CSS compression (contribution by Bergi)
85+- Bump pandoc-citeproc to 0.14
86+- Bump resourcet to 1.2
87+- Bump time to 1.9
88+- Bump http-types to 0.12
89+- Bump http-conduit to 2.3
90+- Bump tasty-quickcheck to 0.10
91+
92+## Hakyll 4.11.0.0
93+
94+- Bump binary to 0.9
95+- Bump pandoc to 2.1
96+- Bump pandoc-citeproc to 0.13
97+- Bump http-types to 0.11
98+- Bump QuickCheck to 2.11
99+- Bump tasty to 1.0
100+- Bump tasty-hunit to 0.10
101+- Remove system-filepath dependency
102+- Embed feed templates rather than using data-files (contribution by Roman
103+ Kuznetsov)
104+- Fix pthread link error on GHC-8.2.2 (contribution by Shinya Yamaguchi)
105+- Extend capture with Regex handling (contribution by frederik-h)
106+
107+## Hakyll 4.10.0.0
108+
109+- Bump Pandoc to 2.0 (contribution by Vaibhav Sagar)
110+- Fix compression of calc() in CSS (contribution by Krzysztof Jurewicz)
111+- Make unixFilter output stderr when failing (contribution by Nick Boultbee)
112+- Export Check type from `Hakyll.Commands` (contribution by Futtetennista)
113+- Add overwritten files check to `hakyll-init` (contribution by Ilya Murzinov)
114+- Expose & document `hakyllWithExitCodeAndArgs`, `Options`, and `Command`
115+ (contribution by Michael Walker)
116+- Add check for non-overlapping redirects (contribution by gwern)
117+- Fix early exit when calling check as a library
118+
119+## Hakyll 4.9.8.0
120+
121+- Bump pandoc-citeproc to 0.10.5
122+- Bump optparse-applicative to 0.14
123+- Bump QuickCheck to 2.10
124+- Bump tasty-quickcheck to 0.9
125+- Restructure .cabal to avoid redundant compilation (contribution by
126+ Christopher League)
127+
128+## Hakyll 4.9.7.0
129+
130+- Fix compilation trouble with `Options.Applicative`
131+- Some small CSS compression improvements (contribution by Nicole Rauch)
132+
133+## Hakyll 4.9.6.0
134+
135+- Tighten dependency on `pandoc-citeproc` (contribution by Mikhail Glushenkov)
136+- Enable using a custom parser for command line arguments (contribution by
137+ Alberto)
138+- Update examples to semantic HTML (contribution by Elie Génard)
139+- Better error for `cached` on non-existing file
140+- Provide an `$allPages$` key when doing pagination
141+- Preserve file metadata in `copyFileCompiler` (contribution by frederik-h)
142+
143+## Hakyll 4.9.5.1
144+
145+- Bump blaze-html dependency to 0.9
146+- Bump blaze-markup dependency to 0.8
147+- Bump process dependency to 1.5
148+
149+## Hakyll 4.9.5.0
150+
151+- Fix compilation issue with `Hakyll.Check` if `checkExternal` is disabled
152+ (Fix by Magnus Therning)
153+
154+## Hakyll 4.9.4.0
155+
156+- Make `./site check` concurrent
157+- Bump directory dependency to 1.3
158+- Bump time dependency to 1.7
159+- Bump vector dependency to 0.12
160+
161+## Hakyll 4.9.3.0
162+
163+- Add a `Hakyll.Web.Redirect` module (contribution by gwern)
164+- Expose `Hakyll.Commands`
165+- Fix the exit code behaviour of `./site check`
166+
167+## Hakyll 4.9.2.0
168+
169+- Fix integer fields in YAML metadata (Fix by Nikolaos S. Papaspyrou)
170+- Bump pandoc dependency to 1.19
171+
7172## Hakyll 4.9.1.0
8173
9174- Allow optparse-applicative 0.13, QuickCheck 2.9, and pandoc 1.18
CODE_OF_CONDUCT.mdnew file+45
@@ -0,0 +1,45 @@
1+# Contributor Covenant Code of Conduct
2+
3+## Our Pledge
4+
5+In the interest of fostering an open and welcoming environment, we as contributors and maintainers pledge to making participation in our project and our community a harassment-free experience for everyone, regardless of age, body size, disability, ethnicity, gender identity and expression, level of experience, nationality, personal appearance, race, religion, or sexual identity and orientation.
6+
7+## Our Standards
8+
9+Examples of behavior that contributes to creating a positive environment include:
10+* Using welcoming and inclusive language
11+* Being respectful of differing viewpoints and experiences
12+* Gracefully accepting constructive criticism
13+* Focusing on what is best for the community
14+* Showing empathy towards other community members
15+
16+Examples of unacceptable behavior by participants include:
17+
18+* The use of sexualized language or imagery and unwelcome sexual attention or advances
19+* Trolling, insulting/derogatory comments, and personal or political attacks
20+* Public or private harassment
21+* Publishing others' private information, such as a physical or electronic address, without explicit permission
22+* Other conduct which could reasonably be considered inappropriate in a professional setting
23+
24+## Our Responsibilities
25+
26+Project maintainers are responsible for clarifying the standards of acceptable behavior and are expected to take appropriate and fair corrective action in response to any instances of unacceptable behavior.
27+
28+Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, or to ban temporarily or permanently any contributor for other behaviors that they deem inappropriate, threatening, offensive, or harmful.
29+
30+## Scope
31+
32+This Code of Conduct applies both within project spaces and in public spaces when an individual is representing the project or its community. Examples of representing a project or community include using an official project e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. Representation of a project may be further defined and clarified by project maintainers.
33+
34+## Enforcement
35+
36+Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by [contacting the project team at m@jaspervdj.be](mailto:m@jaspervdj.be). All complaints will be reviewed and investigated and will result in a response that is deemed necessary and appropriate to the circumstances. The project team is obligated to maintain confidentiality with regard to the reporter of an incident. Further details of specific enforcement policies may be posted separately.
37+
38+Project maintainers who do not follow or enforce the Code of Conduct in good faith may face temporary or permanent repercussions as determined by other members of the project's leadership.
39+
40+## Attribution
41+
42+This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, available at [http://contributor-covenant.org/version/1/4][version]
43+
44+[homepage]: http://contributor-covenant.org
45+[version]: http://contributor-covenant.org/version/1/4/
LICENSE+1−1
@@ -1,4 +1,4 @@
1−Copyright (c) 2009, Jasper Van der Jeugt
1+Copyright (c) 2009 - 2017, Jasper Van der Jeugt
22 
33All rights reserved.
44 
Makefile+6−6
@@ -1,9 +1,9 @@
1+PACKAGE="$(shell stack list-dependencies --separator='-' | grep hakyll)"
2+LOCAL_DOC_ROOT="$(shell stack path --local-doc-root)"
3+
14# Generate the docs and copy them to the website dir
25haddock:
3− cabal haddock --hyperlink-source
4− rm -rf web/reference/
5− cp -r dist/doc/html/hakyll/ web/reference/
6+ stack build --haddock --no-haddock-deps
7+ rsync -r "$(LOCAL_DOC_ROOT)/$(PACKAGE)/" web/reference/
68
7−# Run the tests
8−test:
9− runghc -isrc -itests tests/TestSuite.hs
9+.PHONY: haddock
README.markdown+1−1
@@ -1,6 +1,6 @@
11# hakyll
22
3−[![Build Status](https://img.shields.io/travis/jaspervdj/hakyll.svg)](http://travis-ci.org/jaspervdj/hakyll)
3+[![Build Status](https://img.shields.io/circleci/project/github/jaspervdj/hakyll.svg)](https://circleci.com/gh/jaspervdj/hakyll)
44
55Hakyll is a static site generator library in Haskell. More information
66(including a tutorial) can be found on
data/example/css/default.css+122−37
@@ -1,56 +1,141 @@
1−body {
2− color: black;
3− font-size: 16px;
4− margin: 0px auto 0px auto;
5− width: 600px;
1+html {
2+ font-size: 62.5%;
63}
74
8−div#header {
9− border-bottom: 2px solid black;
10− margin-bottom: 30px;
11− padding: 12px 0px 12px 0px;
5+body {
6+ font-size: 1.6rem;
7+ color: #000;
128}
139
14−div#logo a {
15− color: black;
16− float: left;
17− font-size: 18px;
18− font-weight: bold;
19− text-decoration: none;
10+header {
11+ border-bottom: 0.2rem solid #000;
2012}
2113
22−div#header #navigation {
23− text-align: right;
14+nav {
15+ text-align: right;
2416}
2517
26−div#header #navigation a {
27− color: black;
28− font-size: 18px;
29− font-weight: bold;
30− margin-left: 12px;
31− text-decoration: none;
32− text-transform: uppercase;
18+nav a {
19+ font-size: 1.8rem;
20+ font-weight: bold;
21+ color: black;
22+ text-decoration: none;
23+ text-transform: uppercase;
3324}
3425
35−div#footer {
36− border-top: solid 2px black;
37− color: #555;
38− font-size: 12px;
39− margin-top: 30px;
40− padding: 12px 0px 12px 0px;
41− text-align: right;
26+footer {
27+ margin-top: 3rem;
28+ padding: 1.2rem 0;
29+ border-top: 0.2rem solid #000;
30+ font-size: 1.2rem;
31+ color: #555;
4232}
4333
4434h1 {
45− font-size: 24px;
35+ font-size: 2.4rem;
4636}
4737
4838h2 {
49− font-size: 20px;
39+ font-size: 2rem;
40+}
41+
42+article .header {
43+ font-size: 1.4rem;
44+ font-style: italic;
45+ color: #555;
46+}
47+
48+.logo a {
49+ font-weight: bold;
50+ color: #000;
51+ text-decoration: none;
52+}
53+
54+@media (max-width: 319px) {
55+ body {
56+ width: 90%;
57+ margin: 0;
58+ padding: 0 5%;
59+ }
60+ header {
61+ margin: 4.2rem 0;
62+ }
63+ nav {
64+ margin: 0 auto 3rem;
65+ text-align: center;
66+ }
67+ footer {
68+ text-align: center;
69+ }
70+ .logo {
71+ text-align: center;
72+ margin: 1rem auto 3rem;
73+ }
74+ .logo a {
75+ font-size: 2.4rem;
76+ }
77+ nav a {
78+ display: block;
79+ line-height: 1.6;
80+ }
81+}
82+
83+@media (min-width: 320px) {
84+ body {
85+ width: 90%;
86+ margin: 0;
87+ padding: 0 5%;
88+ }
89+ header {
90+ margin: 4.2rem 0;
91+ }
92+ nav {
93+ margin: 0 auto 3rem;
94+ text-align: center;
95+ }
96+ footer {
97+ text-align: center;
98+ }
99+ .logo {
100+ text-align: center;
101+ margin: 1rem auto 3rem;
102+ }
103+ .logo a {
104+ font-size: 2.4rem;
105+ }
106+ nav a {
107+ display: inline;
108+ margin: 0 0.6rem;
109+ }
50110}
51111
52−div.info {
53− color: #555;
54− font-size: 14px;
55− font-style: italic;
112+@media (min-width: 640px) {
113+ body {
114+ width: 60rem;
115+ margin: 0 auto;
116+ padding: 0;
117+ }
118+ header {
119+ margin: 0 0 3rem;
120+ padding: 1.2rem 0;
121+ }
122+ nav {
123+ margin: 0;
124+ text-align: right;
125+ }
126+ nav a {
127+ margin: 0 0 0 1.2rem;
128+ display: inline;
129+ }
130+ footer {
131+ text-align: right;
132+ }
133+ .logo {
134+ margin: 0;
135+ text-align: left;
136+ }
137+ .logo a {
138+ float: left;
139+ font-size: 1.8rem;
140+ }
56141}
data/example/templates/default.html+9−9
@@ -8,26 +8,26 @@
88 <link rel="stylesheet" href="/css/default.css" />
99 </head>
1010 <body>
11− <div id="header">
12− <div id="logo">
11+ <header>
12+ <div class="logo">
1313 <a href="/">My Hakyll Blog</a>
1414 </div>
15− <div id="navigation">
15+ <nav>
1616 <a href="/">Home</a>
1717 <a href="/about.html">About</a>
1818 <a href="/contact.html">Contact</a>
1919 <a href="/archive.html">Archive</a>
20− </div>
21− </div>
20+ </nav>
21+ </header>
2222
23− <div id="content">
23+ <main role="main">
2424 <h1>$title$</h1>
2525 $body$
26− </div>
26+ </main>
2727
28− <div id="footer">
28+ <footer>
2929 Site proudly generated by
3030 <a href="http://jaspervdj.be/hakyll">Hakyll</a>
31− </div>
31+ </footer>
3232 </body>
3333</html>
data/example/templates/post.html+11−8
@@ -1,8 +1,11 @@
1−<div class="info">
2− Posted on $date$
3− $if(author)$
4− by $author$
5− $endif$
6−</div>
7−
8−$body$
1+<article>
2+ <section class="header">
3+ Posted on $date$
4+ $if(author)$
5+ by $author$
6+ $endif$
7+ </section>
8+ <section>
9+ $body$
10+ </section>
11+</article>
hakyll.cabal+134−127
@@ -1,5 +1,5 @@
11Name: hakyll
2−Version: 4.9.1.0
2+Version: 4.13.0.0
33
44Synopsis: A static website compiler library
55Description:
@@ -37,7 +37,7 @@ License: BSD3
3737License-File: LICENSE
3838Category: Web
3939
40−Cabal-Version: >= 1.8
40+Cabal-Version: >= 1.10
4141Build-Type: Simple
4242Data-Dir: data
4343
@@ -56,24 +56,28 @@ Data-files:
5656 example/index.html
5757 example/about.rst
5858 example/contact.markdown
59− templates/atom-item.xml
60− templates/atom.xml
61− templates/rss-item.xml
62− templates/rss.xml
6359
6460Extra-source-files:
61+ CHANGELOG.md
6562 tests/data/example.md
6663 tests/data/example.md.metadata
6764 tests/data/images/favicon.ico
65+ tests/data/just-meta.html
66+ tests/data/just-meta.html.out
6867 tests/data/partial-helper.html
6968 tests/data/partial.html
7069 tests/data/partial.html.out
7170 tests/data/posts/2010-08-26-birthday.md
71+ tests/data/posts/2018-09-26.md
7272 tests/data/russian.md
7373 tests/data/strip.html
7474 tests/data/strip.html.out
7575 tests/data/template.html
7676 tests/data/template.html.out
77+ data/templates/atom-item.xml
78+ data/templates/atom.xml
79+ data/templates/rss-item.xml
80+ data/templates/rss.xml
7781
7882Source-Repository head
7983 Type: git
@@ -91,23 +95,43 @@ Flag checkExternal
9195 Description: Include external link checking
9296 Default: True
9397
98+Flag buildWebsite
99+ Description: Build the hakyll website
100+ Default: False
101+ Manual: True
102+
103+Flag usePandoc
104+ Description: Include Pandoc support
105+ Default: True
106+ Manual: True
107+
94108Library
95− Ghc-Options: -Wall
96− Hs-Source-Dirs: src
109+ Ghc-Options: -Wall
110+ Hs-Source-Dirs: lib
111+ Default-language: Haskell2010
97112
98113 Exposed-Modules:
99114 Hakyll
115+ Hakyll.Commands
100116 Hakyll.Core.Compiler
117+ Hakyll.Core.Compiler.Internal
101118 Hakyll.Core.Configuration
102119 Hakyll.Core.Dependencies
103120 Hakyll.Core.File
104121 Hakyll.Core.Identifier
105122 Hakyll.Core.Identifier.Pattern
106123 Hakyll.Core.Item
124+ Hakyll.Core.Logger
107125 Hakyll.Core.Metadata
126+ Hakyll.Core.Provider
127+ Hakyll.Core.Provider.Metadata
108128 Hakyll.Core.Routes
109129 Hakyll.Core.Rules
130+ Hakyll.Core.Rules.Internal
131+ Hakyll.Core.Runtime
132+ Hakyll.Core.Store
110133 Hakyll.Core.UnixFilter
134+ Hakyll.Core.Util.File
111135 Hakyll.Core.Util.String
112136 Hakyll.Core.Writable
113137 Hakyll.Main
@@ -115,11 +139,9 @@ Library
115139 Hakyll.Web.Feed
116140 Hakyll.Web.Html
117141 Hakyll.Web.Html.RelativizeUrls
118− Hakyll.Web.Pandoc
119− Hakyll.Web.Pandoc.Biblio
120− Hakyll.Web.Pandoc.FileType
121− Hakyll.Web.Tags
122142 Hakyll.Web.Paginate
143+ Hakyll.Web.Redirect
144+ Hakyll.Web.Tags
123145 Hakyll.Web.Template
124146 Hakyll.Web.Template.Context
125147 Hakyll.Web.Template.Internal
@@ -131,65 +153,53 @@ Library
131153 Data.List.Extended
132154 Data.Yaml.Extended
133155 Hakyll.Check
134− Hakyll.Commands
135− Hakyll.Core.Compiler.Internal
136156 Hakyll.Core.Compiler.Require
157+ Hakyll.Core.Identifier.Pattern.Internal
137158 Hakyll.Core.Item.SomeItem
138− Hakyll.Core.Logger
139− Hakyll.Core.Provider
140159 Hakyll.Core.Provider.Internal
141− Hakyll.Core.Provider.Metadata
142160 Hakyll.Core.Provider.MetadataCache
143− Hakyll.Core.Rules.Internal
144− Hakyll.Core.Runtime
145− Hakyll.Core.Store
146− Hakyll.Core.Util.File
147161 Hakyll.Core.Util.Parser
148− Hakyll.Web.Pandoc.Binary
149162 Paths_hakyll
150163
151164 Build-Depends:
152− base >= 4.8 && < 5,
153− binary >= 0.5 && < 0.9,
154− blaze-html >= 0.5 && < 0.9,
155− blaze-markup >= 0.5.1 && < 0.8,
156− bytestring >= 0.9 && < 0.11,
157− containers >= 0.3 && < 0.6,
158− cryptohash >= 0.7 && < 0.12,
159− data-default >= 0.4 && < 0.8,
160− deepseq >= 1.3 && < 1.5,
161− directory >= 1.0 && < 1.3,
162− filepath >= 1.0 && < 1.5,
163− lrucache >= 1.1.1 && < 1.3,
164− mtl >= 1 && < 2.3,
165− network >= 2.6 && < 2.7,
166− network-uri >= 2.6 && < 2.7,
167− pandoc >= 1.14 && < 1.19,
168− pandoc-citeproc >= 0.4 && < 0.11,
169− parsec >= 3.0 && < 3.2,
170− process >= 1.0 && < 1.5,
171− random >= 1.0 && < 1.2,
172− regex-base >= 0.93 && < 0.94,
173− regex-tdfa >= 1.1 && < 1.3,
174− resourcet >= 1.1 && < 1.2,
175− scientific >= 0.3.4 && < 0.4,
176− tagsoup >= 0.13.1 && < 0.15,
177− text >= 0.11 && < 1.3,
178− time >= 1.4 && < 1.7,
179− time-locale-compat >= 0.1 && < 0.2,
180− unordered-containers >= 0.2 && < 0.3,
181− vector >= 0.11 && < 0.12,
182− yaml >= 0.8.11 && < 0.9,
183− optparse-applicative >= 0.12 && < 0.14
165+ base >= 4.8 && < 5,
166+ binary >= 0.5 && < 0.10,
167+ blaze-html >= 0.5 && < 0.10,
168+ blaze-markup >= 0.5.1 && < 0.9,
169+ bytestring >= 0.9 && < 0.11,
170+ containers >= 0.3 && < 0.7,
171+ cryptohash >= 0.7 && < 0.12,
172+ data-default >= 0.4 && < 0.8,
173+ deepseq >= 1.3 && < 1.5,
174+ directory >= 1.0 && < 1.4,
175+ file-embed >= 0.0.10.1 && < 0.0.12,
176+ filepath >= 1.0 && < 1.5,
177+ lrucache >= 1.1.1 && < 1.3,
178+ mtl >= 1 && < 2.3,
179+ network-uri >= 2.6 && < 2.7,
180+ optparse-applicative >= 0.12 && < 0.15,
181+ parsec >= 3.0 && < 3.2,
182+ process >= 1.6 && < 1.7,
183+ random >= 1.0 && < 1.2,
184+ regex-tdfa >= 1.1 && < 1.3,
185+ resourcet >= 1.1 && < 1.3,
186+ scientific >= 0.3.4 && < 0.4,
187+ tagsoup >= 0.13.1 && < 0.15,
188+ template-haskell >= 2.14 && < 2.15,
189+ text >= 0.11 && < 1.3,
190+ time >= 1.8 && < 1.10,
191+ time-locale-compat >= 0.1 && < 0.2,
192+ unordered-containers >= 0.2 && < 0.3,
193+ vector >= 0.11 && < 0.13,
194+ yaml >= 0.8.11 && < 0.12
184195
185196 If flag(previewServer)
186197 Build-depends:
187198 wai >= 3.2 && < 3.3,
188199 warp >= 3.2 && < 3.3,
189200 wai-app-static >= 3.1 && < 3.2,
190− http-types >= 0.9 && < 0.10,
191− fsnotify >= 0.2 && < 0.3,
192− system-filepath >= 0.4.6 && <= 0.5
201+ http-types >= 0.9 && < 0.13,
202+ fsnotify >= 0.2 && < 0.4
193203 Cpp-options:
194204 -DPREVIEW_SERVER
195205 Other-modules:
@@ -198,8 +208,7 @@ Library
198208
199209 If flag(watchServer)
200210 Build-depends:
201− fsnotify >= 0.2 && < 0.3,
202− system-filepath >= 0.4.6 && <= 0.5
211+ fsnotify >= 0.2 && < 0.4
203212 Cpp-options:
204213 -DWATCH_SERVER
205214 Other-modules:
@@ -207,16 +216,31 @@ Library
207216
208217 If flag(checkExternal)
209218 Build-depends:
210− http-conduit >= 2.2 && < 2.3,
211− http-types >= 0.7 && < 0.10
219+ http-conduit >= 2.2 && < 2.4,
220+ http-types >= 0.7 && < 0.13
212221 Cpp-options:
213222 -DCHECK_EXTERNAL
214223
224+ If flag(usePandoc)
225+ Exposed-Modules:
226+ Hakyll.Web.Pandoc
227+ Hakyll.Web.Pandoc.Biblio
228+ Hakyll.Web.Pandoc.FileType
229+ Other-Modules:
230+ Hakyll.Web.Pandoc.Binary
231+ Build-Depends:
232+ pandoc >= 2.0.5 && < 2.8,
233+ pandoc-citeproc >= 0.14 && < 0.17
234+ Cpp-options:
235+ -DUSE_PANDOC
236+
215237Test-suite hakyll-tests
216− Type: exitcode-stdio-1.0
217− Hs-source-dirs: src tests
218− Main-is: TestSuite.hs
219− Ghc-options: -Wall
238+ Type: exitcode-stdio-1.0
239+ Hs-source-dirs: tests
240+ Main-is: TestSuite.hs
241+ Ghc-options: -Wall -threaded
242+ Default-language: Haskell2010
243+
220244 Other-modules:
221245 Hakyll.Core.Dependencies.Tests
222246 Hakyll.Core.Identifier.Tests
@@ -231,90 +255,73 @@ Test-suite hakyll-tests
231255 Hakyll.Web.CompressCss.Tests
232256 Hakyll.Web.Html.RelativizeUrls.Tests
233257 Hakyll.Web.Html.Tests
234− Hakyll.Web.Pandoc.FileType.Tests
258+ Hakyll.Web.Tags.Tests
235259 Hakyll.Web.Template.Context.Tests
236260 Hakyll.Web.Template.Tests
237261 TestSuite.Util
238262
239263 Build-Depends:
240− QuickCheck >= 2.8 && < 2.10,
241− tasty >= 0.11 && < 0.12,
242− tasty-hunit >= 0.9 && < 0.10,
243− tasty-quickcheck >= 0.8 && < 0.9,
264+ hakyll,
265+ QuickCheck >= 2.8 && < 2.14,
266+ tasty >= 0.11 && < 1.3,
267+ tasty-hunit >= 0.9 && < 0.11,
268+ tasty-quickcheck >= 0.8 && < 0.11,
244269 -- Copy pasted from hakyll dependencies:
245− base >= 4.8 && < 5,
246− binary >= 0.5 && < 0.9,
247− blaze-html >= 0.5 && < 0.9,
248− blaze-markup >= 0.5.1 && < 0.8,
249− bytestring >= 0.9 && < 0.11,
250− containers >= 0.3 && < 0.6,
251− cryptohash >= 0.7 && < 0.12,
252− data-default >= 0.4 && < 0.8,
253− deepseq >= 1.3 && < 1.5,
254− directory >= 1.0 && < 1.3,
255− filepath >= 1.0 && < 1.5,
256− lrucache >= 1.1.1 && < 1.3,
257− mtl >= 1 && < 2.3,
258− network >= 2.6 && < 2.7,
259− network-uri >= 2.6 && < 2.7,
260− pandoc >= 1.14 && < 1.19,
261− pandoc-citeproc >= 0.4 && < 0.11,
262− parsec >= 3.0 && < 3.2,
263− process >= 1.0 && < 1.5,
264− random >= 1.0 && < 1.2,
265− regex-base >= 0.93 && < 0.94,
266− regex-tdfa >= 1.1 && < 1.3,
267− resourcet >= 1.1 && < 1.2,
268− scientific >= 0.3.4 && < 0.4,
269− tagsoup >= 0.13.1 && < 0.15,
270− text >= 0.11 && < 1.3,
271− time >= 1.4 && < 1.7,
272− time-locale-compat >= 0.1 && < 0.2,
273− unordered-containers >= 0.2 && < 0.3,
274− vector >= 0.11 && < 0.12,
275− yaml >= 0.8.11 && < 0.9,
276− optparse-applicative >= 0.12 && < 0.14
270+ base >= 4.8 && < 5,
271+ bytestring >= 0.9 && < 0.11,
272+ containers >= 0.3 && < 0.7,
273+ filepath >= 1.0 && < 1.5,
274+ text >= 0.11 && < 1.3,
275+ unordered-containers >= 0.2 && < 0.3,
276+ yaml >= 0.8.11 && < 0.12
277277
278278 If flag(previewServer)
279− Build-depends:
280− wai >= 3.2 && < 3.3,
281− warp >= 3.2 && < 3.3,
282− wai-app-static >= 3.1 && < 3.2,
283− http-types >= 0.9 && < 0.10,
284− fsnotify >= 0.2 && < 0.3,
285− system-filepath >= 0.4.6 && <= 0.5
286279 Cpp-options:
287280 -DPREVIEW_SERVER
288− Other-modules:
289− Hakyll.Preview.Poll
290− Hakyll.Preview.Server
291281
292282 If flag(watchServer)
293− Build-depends:
294− fsnotify >= 0.2 && < 0.3,
295− system-filepath >= 0.4.6 && <= 0.5
296283 Cpp-options:
297284 -DWATCH_SERVER
298− Other-modules:
299− Hakyll.Preview.Poll
300285
301286 If flag(checkExternal)
302− Build-depends:
303− http-conduit >= 2.2 && < 2.3,
304− http-types >= 0.7 && < 0.10
305287 Cpp-options:
306288 -DCHECK_EXTERNAL
307289
290+ If flag(usePandoc)
291+ Other-modules:
292+ Hakyll.Web.Pandoc.FileType.Tests
293+ Cpp-options:
294+ -DUSE_PANDOC
295+
308296Executable hakyll-init
309− Ghc-options: -Wall
310− Hs-source-dirs: src
311− Main-is: Hakyll/Init.hs
297+ Main-is: Init.hs
298+ Ghc-options: -Wall -threaded
299+ Hs-source-dirs: src
300+ Default-language: Haskell2010
301+
302+ Other-modules:
303+ Paths_hakyll
312304
313305 Build-depends:
306+ hakyll,
314307 base >= 4 && < 5,
315− directory >= 1.0 && < 1.3,
308+ directory >= 1.0 && < 1.4,
316309 filepath >= 1.0 && < 1.5
317310
318− Other-modules:
319− Hakyll.Core.Util.File
320− Paths_hakyll
311+Executable hakyll-website
312+ Main-is: site.hs
313+ Ghc-options: -Wall -threaded
314+ Hs-source-dirs: web
315+ Default-language: Haskell2010
316+
317+ If flag(buildWebsite)
318+ Buildable: True
319+ Else
320+ Buildable: False
321+
322+ Build-depends:
323+ hakyll,
324+ base >= 4 && < 5,
325+ directory >= 1.0 && < 1.4,
326+ filepath >= 1.0 && < 1.5,
327+ pandoc >= 2.0.5 && < 2.8
src/Data/List/Extended.hs → lib/Data/List/Extended.hsrenamed

The content is the same.

src/Data/Yaml/Extended.hs → lib/Data/Yaml/Extended.hsrenamed+5−1
@@ -7,12 +7,16 @@ module Data.Yaml.Extended
77import qualified Data.Text as T
88import qualified Data.Vector as V
99import Data.Yaml
10+import Data.Scientific
1011
1112toString :: Value -> Maybe String
1213toString (String t) = Just (T.unpack t)
1314toString (Bool True) = Just "true"
1415toString (Bool False) = Just "false"
15−toString (Number d) = Just (show d)
16+-- | Make sure that numeric fields containing integer numbers are shown as
17+-- | integers (i.e., "42" instead of "42.0").
18+toString (Number d) | isInteger d = Just (formatScientific Fixed (Just 0) d)
19+ | otherwise = Just (show d)
1620toString _ = Nothing
1721
1822toList :: Value -> Maybe [Value]
src/Hakyll.hs → lib/Hakyll.hsrenamed+7−1
@@ -20,11 +20,14 @@ module Hakyll
2020 , module Hakyll.Web.Feed
2121 , module Hakyll.Web.Html
2222 , module Hakyll.Web.Html.RelativizeUrls
23+ , module Hakyll.Web.Paginate
24+#ifdef USE_PANDOC
2325 , module Hakyll.Web.Pandoc
2426 , module Hakyll.Web.Pandoc.Biblio
2527 , module Hakyll.Web.Pandoc.FileType
28+#endif
29+ , module Hakyll.Web.Redirect
2630 , module Hakyll.Web.Tags
27− , module Hakyll.Web.Paginate
2831 , module Hakyll.Web.Template
2932 , module Hakyll.Web.Template.Context
3033 , module Hakyll.Web.Template.List
@@ -51,9 +54,12 @@ import Hakyll.Web.Feed
5154import Hakyll.Web.Html
5255import Hakyll.Web.Html.RelativizeUrls
5356import Hakyll.Web.Paginate
57+#ifdef USE_PANDOC
5458import Hakyll.Web.Pandoc
5559import Hakyll.Web.Pandoc.Biblio
5660import Hakyll.Web.Pandoc.FileType
61+#endif
62+import Hakyll.Web.Redirect
5763import Hakyll.Web.Tags
5864import Hakyll.Web.Template
5965import Hakyll.Web.Template.Context
src/Hakyll/Check.hs → lib/Hakyll/Check.hsrenamed+118−77
@@ -8,16 +8,20 @@ module Hakyll.Check
88
99
1010--------------------------------------------------------------------------------
11−import Control.Monad (forM_)
12−import Control.Monad.Reader (ask)
13−import Control.Monad.RWS (RWST, runRWST)
11+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar,
12+ readMVar)
13+import Control.Exception (SomeAsyncException (..),
14+ SomeException (..), throw, try)
15+import Control.Monad (foldM, forM_)
16+import Control.Monad.Reader (ReaderT, ask, runReaderT)
17+import Control.Monad.State (StateT, get, modify, runStateT)
1418import Control.Monad.Trans (liftIO)
1519import Control.Monad.Trans.Resource (runResourceT)
16−import Control.Monad.Writer (tell)
17−import Data.ByteString.Char8 (unpack)
1820import Data.List (isPrefixOf)
19−import Data.Set (Set)
20−import qualified Data.Set as S
21+import qualified Data.Map.Lazy as Map
22+#if MIN_VERSION_base(4,9,0)
23+import Data.Semigroup (Semigroup (..))
24+#endif
2125import Network.URI (unEscapeString)
2226import System.Directory (doesDirectoryExist,
2327 doesFileExist)
@@ -29,9 +33,6 @@ import qualified Text.HTML.TagSoup as TS
2933
3034--------------------------------------------------------------------------------
3135#ifdef CHECK_EXTERNAL
32−import Control.Exception (SomeAsyncException (..),
33− SomeException (..), try, throw)
34−import Control.Monad.State (get, modify)
3536import Data.List (intercalate)
3637import Data.Typeable (cast)
3738import Data.Version (versionBranch)
@@ -58,8 +59,17 @@ data Check = All | InternalLinks
5859--------------------------------------------------------------------------------
5960check :: Configuration -> Logger -> Check -> IO ExitCode
6061check config logger check' = do
61− ((), write) <- runChecker checkDestination config logger check'
62− return $ if checkerFaulty write > 0 then ExitFailure 1 else ExitSuccess
62+ ((), state) <- runChecker checkDestination config logger check'
63+ failed <- countFailedLinks state
64+ return $ if failed > 0 then ExitFailure 1 else ExitSuccess
65+
66+
67+--------------------------------------------------------------------------------
68+countFailedLinks :: CheckerState -> IO Int
69+countFailedLinks state = foldM addIfFailure 0 (Map.elems state)
70+ where addIfFailure failures mvar = do
71+ checkerWrite <- readMVar mvar
72+ return $ failures + checkerFaulty checkerWrite
6373
6474
6575--------------------------------------------------------------------------------
@@ -78,33 +88,45 @@ data CheckerWrite = CheckerWrite
7888
7989
8090--------------------------------------------------------------------------------
91+#if MIN_VERSION_base(4,9,0)
92+instance Semigroup CheckerWrite where
93+ (<>) (CheckerWrite f1 o1) (CheckerWrite f2 o2) =
94+ CheckerWrite (f1 + f2) (o1 + o2)
95+
96+instance Monoid CheckerWrite where
97+ mempty = CheckerWrite 0 0
98+ mappend = (<>)
99+#else
81100instance Monoid CheckerWrite where
82101 mempty = CheckerWrite 0 0
83102 mappend (CheckerWrite f1 o1) (CheckerWrite f2 o2) =
84103 CheckerWrite (f1 + f2) (o1 + o2)
104+#endif
105+
106+
107+--------------------------------------------------------------------------------
108+type CheckerState = Map.Map URL (MVar CheckerWrite)
85109
86110
87111--------------------------------------------------------------------------------
88−type CheckerState = Set String
112+type Checker a = ReaderT CheckerRead (StateT CheckerState IO) a
89113
90114
91115--------------------------------------------------------------------------------
92−type Checker a = RWST CheckerRead CheckerWrite CheckerState IO a
116+type URL = String
93117
94118
95119--------------------------------------------------------------------------------
96120runChecker :: Checker a -> Configuration -> Logger -> Check
97− -> IO (a, CheckerWrite)
121+ -> IO (a, CheckerState)
98122runChecker checker config logger check' = do
99123 let read' = CheckerRead
100124 { checkerConfig = config
101125 , checkerLogger = logger
102126 , checkerCheck = check'
103127 }
104−
105− (x, _, write) <- runRWST checker read' S.empty
106128 Logger.flush logger
107− return (x, write)
129+ runStateT (runReaderT checker read') Map.empty
108130
109131
110132--------------------------------------------------------------------------------
@@ -133,14 +155,31 @@ checkFile filePath = do
133155 let urls = getUrls $ TS.parseTags contents
134156 forM_ urls $ \url -> do
135157 Logger.debug logger $ "Checking link " ++ url
136− checkUrl filePath url
158+ m <- liftIO newEmptyMVar
159+ checkUrlIfNeeded filePath (canonicalizeUrl url) m
160+ where
161+ -- Check scheme-relative links
162+ canonicalizeUrl url = if schemeRelative url then "http:" ++ url else url
163+ schemeRelative = isPrefixOf "//"
137164
138165
139166--------------------------------------------------------------------------------
140−checkUrl :: FilePath -> String -> Checker ()
167+checkUrlIfNeeded :: FilePath -> URL -> MVar CheckerWrite -> Checker ()
168+checkUrlIfNeeded filepath url m = do
169+ logger <- checkerLogger <$> ask
170+ needsCheck <- (== All) . checkerCheck <$> ask
171+ checked <- (url `Map.member`) <$> get
172+ if not needsCheck || checked
173+ then Logger.debug logger "Already checked, skipping"
174+ else do modify $ Map.insert url m
175+ checkUrl filepath url
176+
177+
178+--------------------------------------------------------------------------------
179+checkUrl :: FilePath -> URL -> Checker ()
141180checkUrl filePath url
142181 | isExternal url = checkExternalUrl url
143− | hasProtocol url = skip "Unknown protocol, skipping"
182+ | hasProtocol url = skip url $ Just "Unknown protocol, skipping"
144183 | otherwise = checkInternalUrl filePath url
145184 where
146185 validProtoChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "+-."
@@ -150,30 +189,45 @@ checkUrl filePath url
150189
151190
152191--------------------------------------------------------------------------------
153−ok :: String -> Checker ()
154−ok _ = tell $ mempty {checkerOk = 1}
192+ok :: URL -> Checker ()
193+ok url = putCheckResult url mempty {checkerOk = 1}
155194
156195
157196--------------------------------------------------------------------------------
158−skip :: String -> Checker ()
159−skip reason = do
197+skip :: URL -> Maybe String -> Checker ()
198+skip url maybeReason = do
160199 logger <- checkerLogger <$> ask
161− Logger.debug logger $ reason
162− tell $ mempty {checkerOk = 1}
200+ case maybeReason of
201+ Nothing -> return ()
202+ Just reason -> Logger.debug logger reason
203+ putCheckResult url mempty {checkerOk = 1}
204+
163205
164206--------------------------------------------------------------------------------
165−faulty :: String -> Maybe String -> Checker ()
207+faulty :: URL -> Maybe String -> Checker ()
166208faulty url reason = do
167209 logger <- checkerLogger <$> ask
168210 Logger.error logger $ "Broken link to " ++ show url ++ explanation
169− tell $ mempty {checkerFaulty = 1}
211+ putCheckResult url mempty {checkerFaulty = 1}
170212 where
171213 formatExplanation = (" (" ++) . (++ ")")
172214 explanation = maybe "" formatExplanation reason
173215
174216
175217--------------------------------------------------------------------------------
176−checkInternalUrl :: FilePath -> String -> Checker ()
218+putCheckResult :: URL -> CheckerWrite -> Checker ()
219+putCheckResult url result = do
220+ state <- get
221+ let maybeMVar = Map.lookup url state
222+ case maybeMVar of
223+ Just m -> liftIO $ putMVar m result
224+ Nothing -> do
225+ logger <- checkerLogger <$> ask
226+ Logger.debug logger "Failed to find existing entry for checked URL"
227+
228+
229+--------------------------------------------------------------------------------
230+checkInternalUrl :: FilePath -> URL -> Checker ()
177231checkInternalUrl base url = case url' of
178232 "" -> ok url
179233 _ -> do
@@ -191,59 +245,46 @@ checkInternalUrl base url = case url' of
191245
192246
193247--------------------------------------------------------------------------------
194−checkExternalUrl :: String -> Checker ()
248+checkExternalUrl :: URL -> Checker ()
195249#ifdef CHECK_EXTERNAL
196250checkExternalUrl url = do
197− logger <- checkerLogger <$> ask
198− needsCheck <- (== All) . checkerCheck <$> ask
199− checked <- (url `S.member`) <$> get
200−
201− if not needsCheck || checked
202− then Logger.debug logger "Already checked, skipping"
203− else do
204− result <- liftIO $ try $ do
205− mgr <- Http.newManager Http.tlsManagerSettings
206− runResourceT $ do
207− request <- Http.parseRequest urlToCheck
208− response <- Http.http (settings request) mgr
209− let code = Http.statusCode (Http.responseStatus response)
210− return $ code >= 200 && code < 300
211−
212− modify $ if schemeRelative url
213− then S.insert urlToCheck . S.insert url
214− else S.insert url
215− case result of
216− Left (SomeException e) ->
217− case (cast e :: Maybe SomeAsyncException) of
218− Just ae -> throw ae
219− _ -> faulty url (Just $ showException e)
220− Right _ -> ok url
221− where
222− -- Add additional request info
223− settings r = r
224− { Http.method = "HEAD"
225− , Http.redirectCount = 10
226− , Http.requestHeaders = ("User-Agent", ua) : Http.requestHeaders r
227− }
228−
229− -- Nice user agent info
230− ua = fromString $ "hakyll-check/" ++
231− (intercalate "." $ map show $ versionBranch $ Paths_hakyll.version)
232−
233− -- Check scheme-relative links
234− schemeRelative = isPrefixOf "//"
235− urlToCheck = if schemeRelative url then "http:" ++ url else url
236−
237− -- Convert exception to a concise form
238− showException e = case cast e of
239− Just (Http.HttpExceptionRequest _ e') -> show e'
240− _ -> head $ words $ show e
251+ result <- requestExternalUrl url
252+ case result of
253+ Left (SomeException e) ->
254+ case (cast e :: Maybe SomeAsyncException) of
255+ Just ae -> throw ae
256+ _ -> faulty url (Just $ showException e)
257+ Right _ -> ok url
258+ where
259+ -- Convert exception to a concise form
260+ showException e = case cast e of
261+ Just (Http.HttpExceptionRequest _ e') -> show e'
262+ _ -> head $ words $ show e
263+
264+requestExternalUrl :: URL -> Checker (Either SomeException Bool)
265+requestExternalUrl url = liftIO $ try $ do
266+ mgr <- Http.newManager Http.tlsManagerSettings
267+ runResourceT $ do
268+ request <- Http.parseRequest url
269+ response <- Http.http (settings request) mgr
270+ let code = Http.statusCode (Http.responseStatus response)
271+ return $ code >= 200 && code < 300
272+ where
273+ -- Add additional request info
274+ settings r = r
275+ { Http.method = "HEAD"
276+ , Http.redirectCount = 10
277+ , Http.requestHeaders = ("User-Agent", ua) : Http.requestHeaders r
278+ }
279+
280+ -- Nice user agent info
281+ ua = fromString $ "hakyll-check/" ++
282+ (intercalate "." $ map show $ versionBranch Paths_hakyll.version)
241283#else
242−checkExternalUrl _ = return ()
284+checkExternalUrl url = skip url Nothing
243285#endif
244286
245287
246−
247288--------------------------------------------------------------------------------
248289-- | Wraps doesFileExist, also checks for index.html
249290checkFileExists :: FilePath -> Checker Bool
src/Hakyll/Commands.hs → lib/Hakyll/Commands.hsrenamed+8−4
@@ -2,7 +2,8 @@
22-- | Implementation of Hakyll commands: build, preview...
33{-# LANGUAGE CPP #-}
44module Hakyll.Commands
5− ( build
5+ ( Check(..)
6+ , build
67 , check
78 , clean
89 , preview
@@ -15,9 +16,11 @@ module Hakyll.Commands
1516
1617--------------------------------------------------------------------------------
1718import Control.Concurrent
18−import System.Exit (ExitCode, exitWith)
19+import System.Exit (ExitCode)
20+
1921
2022--------------------------------------------------------------------------------
23+import Hakyll.Check (Check(..))
2124import qualified Hakyll.Check as Check
2225import Hakyll.Core.Configuration
2326import Hakyll.Core.Logger (Logger)
@@ -27,6 +30,7 @@ import Hakyll.Core.Rules.Internal
2730import Hakyll.Core.Runtime
2831import Hakyll.Core.Util.File
2932
33+
3034--------------------------------------------------------------------------------
3135#ifdef WATCH_SERVER
3236import Hakyll.Preview.Poll (watchUpdates)
@@ -50,8 +54,8 @@ build conf logger rules = fst <$> run conf logger rules
5054
5155--------------------------------------------------------------------------------
5256-- | Run the checker and exit
53−check :: Configuration -> Logger -> Check.Check -> IO ()
54−check config logger check' = Check.check config logger check' >>= exitWith
57+check :: Configuration -> Logger -> Check.Check -> IO ExitCode
58+check = Check.check
5559
5660
5761--------------------------------------------------------------------------------
src/Hakyll/Core/Compiler.hs → lib/Hakyll/Core/Compiler.hsrenamed+44−2
@@ -24,13 +24,16 @@ module Hakyll.Core.Compiler
2424 , cached
2525 , unsafeCompiler
2626 , debugCompiler
27+ , noResult
28+ , withErrorMessage
2729 ) where
2830
2931
3032--------------------------------------------------------------------------------
31−import Control.Monad (when)
33+import Control.Monad (unless, when, (>=>))
3234import Data.Binary (Binary)
3335import Data.ByteString.Lazy (ByteString)
36+import qualified Data.List.NonEmpty as NonEmpty
3437import Data.Typeable (Typeable)
3538import System.Environment (getProgName)
3639import System.FilePath (takeExtension)
@@ -62,6 +65,7 @@ getUnderlyingExtension = takeExtension . toFilePath <$> getUnderlying
6265
6366
6467--------------------------------------------------------------------------------
68+-- | Create an item from the underlying identifier and a given value.
6569makeItem :: a -> Compiler (Item a)
6670makeItem x = do
6771 identifier <- getUnderlying
@@ -141,6 +145,10 @@ saveSnapshot snapshot item = do
141145
142146
143147--------------------------------------------------------------------------------
148+-- | Turn on caching for a compilation value to avoid recomputing it
149+-- on subsequent Hakyll runs.
150+-- The storage key consists of the underlying identifier of the compiled
151+-- ressource and the given name.
144152cached :: (Binary a, Typeable a)
145153 => String
146154 -> Compiler a
@@ -149,6 +157,10 @@ cached name compiler = do
149157 id' <- compilerUnderlying <$> compilerAsk
150158 store <- compilerStore <$> compilerAsk
151159 provider <- compilerProvider <$> compilerAsk
160+
161+ -- Give a better error message when the resource is not there at all.
162+ unless (resourceExists provider id') $ fail $ itDoesntEvenExist id'
163+
152164 let modified = resourceModified provider id'
153165 if modified
154166 then do
@@ -166,14 +178,44 @@ cached name compiler = do
166178 "Hakyll.Core.Compiler.cached: Cache corrupt! " ++
167179 "Try running: " ++ progName ++ " clean"
168180
181+ itDoesntEvenExist id' =
182+ "Hakyll.Core.Compiler.cached: You are trying to (perhaps " ++
183+ "indirectly) use `cached` on a non-existing resource: there " ++
184+ "is no file backing " ++ show id'
185+
169186
170187--------------------------------------------------------------------------------
188+-- | Run an IO computation without dependencies in a Compiler
171189unsafeCompiler :: IO a -> Compiler a
172190unsafeCompiler = compilerUnsafeIO
173191
174192
175193--------------------------------------------------------------------------------
176−-- | Compiler for debugging purposes
194+-- | Fail so that it is treated as non-defined in an @\$if()\$@ branching
195+-- "Hakyll.Web.Template" macro, and alternative
196+-- 'Hakyll.Web.Template.Context.Context's are tried
197+--
198+-- @since 4.13.0
199+noResult :: String -> Compiler a
200+noResult = compilerNoResult . return
201+
202+
203+--------------------------------------------------------------------------------
204+-- | Prepend an error line to the error, if there is one. This allows you to
205+-- add helpful context to error messages.
206+--
207+-- @since 4.13.0
208+withErrorMessage :: String -> Compiler a -> Compiler a
209+withErrorMessage x = do
210+ compilerTry >=> either (compilerResult . CompilerError . prepend) return
211+ where
212+ prepend (CompilationFailure es) = CompilationFailure (x `NonEmpty.cons` es)
213+ prepend (CompilationNoResult es) = CompilationNoResult (x : es)
214+
215+
216+--------------------------------------------------------------------------------
217+-- | Compiler for debugging purposes.
218+-- Passes a message to the debug logger that is printed in verbose mode.
177219debugCompiler :: String -> Compiler ()
178220debugCompiler msg = do
179221 logger <- compilerLogger <$> compilerAsk
src/Hakyll/Core/Compiler/Internal.hs → lib/Hakyll/Core/Compiler/Internal.hsrenamed+140−41
@@ -1,5 +1,7 @@
11--------------------------------------------------------------------------------
22-- | Internally used compiler module
3+{-# LANGUAGE CPP #-}
4+{-# LANGUAGE DeriveFunctor #-}
35{-# LANGUAGE FlexibleInstances #-}
46{-# LANGUAGE GADTs #-}
57{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -9,19 +11,26 @@ module Hakyll.Core.Compiler.Internal
911 Snapshot
1012 , CompilerRead (..)
1113 , CompilerWrite (..)
14+ , CompilerErrors (..)
1215 , CompilerResult (..)
1316 , Compiler (..)
1417 , runCompiler
1518
1619 -- * Core operations
20+ , compilerResult
1721 , compilerTell
1822 , compilerAsk
23+ , compilerUnsafeIO
24+
25+ -- * Error operations
1926 , compilerThrow
27+ , compilerNoResult
2028 , compilerCatch
21− , compilerResult
22− , compilerUnsafeIO
29+ , compilerTry
30+ , compilerErrorMessages
2331
2432 -- * Utilities
33+ , compilerDebugEntries
2534 , compilerTellDependencies
2635 , compilerTellCacheHits
2736 ) where
@@ -31,7 +40,12 @@ module Hakyll.Core.Compiler.Internal
3140import Control.Applicative (Alternative (..))
3241import Control.Exception (SomeException, handle)
3342import Control.Monad (forM_)
34−import Control.Monad.Except (MonadError (..))
43+import Control.Monad.Except (MonadError (..))
44+import Data.List.NonEmpty (NonEmpty (..))
45+import qualified Data.List.NonEmpty as NonEmpty
46+#if MIN_VERSION_base(4,9,0)
47+import Data.Semigroup (Semigroup (..))
48+#endif
3549import Data.Set (Set)
3650import qualified Data.Set as S
3751
@@ -41,7 +55,6 @@ import Hakyll.Core.Configuration
4155import Hakyll.Core.Dependencies
4256import Hakyll.Core.Identifier
4357import Hakyll.Core.Identifier.Pattern
44−import Hakyll.Core.Logger (Logger)
4558import qualified Hakyll.Core.Logger as Logger
4659import Hakyll.Core.Metadata
4760import Hakyll.Core.Provider
@@ -71,7 +84,7 @@ data CompilerRead = CompilerRead
7184 , -- | Compiler store
7285 compilerStore :: Store
7386 , -- | Logger
74− compilerLogger :: Logger
87+ compilerLogger :: Logger.Logger
7588 }
7689
7790
@@ -83,18 +96,46 @@ data CompilerWrite = CompilerWrite
8396
8497
8598--------------------------------------------------------------------------------
99+#if MIN_VERSION_base(4,9,0)
100+instance Semigroup CompilerWrite where
101+ (<>) (CompilerWrite d1 h1) (CompilerWrite d2 h2) =
102+ CompilerWrite (d1 ++ d2) (h1 + h2)
103+
104+instance Monoid CompilerWrite where
105+ mempty = CompilerWrite [] 0
106+ mappend = (<>)
107+#else
86108instance Monoid CompilerWrite where
87109 mempty = CompilerWrite [] 0
88110 mappend (CompilerWrite d1 h1) (CompilerWrite d2 h2) =
89111 CompilerWrite (d1 ++ d2) (h1 + h2)
112+#endif
90113
91114
92115--------------------------------------------------------------------------------
93−data CompilerResult a where
94− CompilerDone :: a -> CompilerWrite -> CompilerResult a
95− CompilerSnapshot :: Snapshot -> Compiler a -> CompilerResult a
96− CompilerError :: [String] -> CompilerResult a
97− CompilerRequire :: (Identifier, Snapshot) -> Compiler a -> CompilerResult a
116+-- | Distinguishes reasons in a 'CompilerError'
117+data CompilerErrors a
118+ -- | One or more exceptions occured during compilation
119+ = CompilationFailure (NonEmpty a)
120+ -- | Absence of any result, most notably in template contexts. May still
121+ -- have error messages.
122+ | CompilationNoResult [a]
123+ deriving Functor
124+
125+
126+-- | Unwrap a `CompilerErrors`
127+compilerErrorMessages :: CompilerErrors a -> [a]
128+compilerErrorMessages (CompilationFailure x) = NonEmpty.toList x
129+compilerErrorMessages (CompilationNoResult x) = x
130+
131+
132+--------------------------------------------------------------------------------
133+-- | An intermediate result of a compilation step
134+data CompilerResult a
135+ = CompilerDone a CompilerWrite
136+ | CompilerSnapshot Snapshot (Compiler a)
137+ | CompilerRequire (Identifier, Snapshot) (Compiler a)
138+ | CompilerError (CompilerErrors String)
98139
99140
100141--------------------------------------------------------------------------------
@@ -112,14 +153,14 @@ instance Functor Compiler where
112153 return $ case res of
113154 CompilerDone x w -> CompilerDone (f x) w
114155 CompilerSnapshot s c' -> CompilerSnapshot s (fmap f c')
115− CompilerError e -> CompilerError e
116156 CompilerRequire i c' -> CompilerRequire i (fmap f c')
157+ CompilerError e -> CompilerError e
117158 {-# INLINE fmap #-}
118159
119160
120161--------------------------------------------------------------------------------
121162instance Monad Compiler where
122− return x = Compiler $ \_ -> return $ CompilerDone x mempty
163+ return x = compilerResult $ CompilerDone x mempty
123164 {-# INLINE return #-}
124165
125166 Compiler c >>= f = Compiler $ \r -> do
@@ -132,14 +173,14 @@ instance Monad Compiler where
132173 CompilerSnapshot s c' -> CompilerSnapshot s $ do
133174 compilerTell w -- Save dependencies!
134175 c'
135− CompilerError e -> CompilerError e
136176 CompilerRequire i c' -> CompilerRequire i $ do
137177 compilerTell w -- Save dependencies!
138178 c'
179+ CompilerError e -> CompilerError e
139180
140181 CompilerSnapshot s c' -> return $ CompilerSnapshot s (c' >>= f)
141− CompilerError e -> return $ CompilerError e
142182 CompilerRequire i c' -> return $ CompilerRequire i (c' >>= f)
183+ CompilerError e -> return $ CompilerError e
143184 {-# INLINE (>>=) #-}
144185
145186 fail = compilerThrow . return
@@ -156,87 +197,145 @@ instance Applicative Compiler where
156197
157198
158199--------------------------------------------------------------------------------
200+-- | Access provided metadata from anywhere
159201instance MonadMetadata Compiler where
160202 getMetadata = compilerGetMetadata
161203 getMatches = compilerGetMatches
162204
163205
164206--------------------------------------------------------------------------------
207+-- | Compilation may fail with multiple error messages.
208+-- 'catchError' handles errors from 'throwError', 'fail' and 'Hakyll.Core.Compiler.noResult'
165209instance MonadError [String] Compiler where
166− throwError = compilerThrow
167− catchError = compilerCatch
210+ throwError = compilerThrow
211+ catchError c = compilerCatch c . (. compilerErrorMessages)
168212
169213
170214--------------------------------------------------------------------------------
215+-- | Like 'unCompiler' but treating IO exceptions as 'CompilerError's
171216runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)
172217runCompiler compiler read' = handle handler $ unCompiler compiler read'
173218 where
174219 handler :: SomeException -> IO (CompilerResult a)
175− handler e = return $ CompilerError [show e]
220+ handler e = return $ CompilerError $ CompilationFailure $ show e :| []
176221
177222
178223--------------------------------------------------------------------------------
224+-- | Trying alternative compilers if the first fails, regardless whether through
225+-- 'fail', 'throwError' or 'Hakyll.Core.Compiler.noResult'.
226+-- Aggregates error messages if all fail.
179227instance Alternative Compiler where
180− empty = compilerThrow []
181− x <|> y = compilerCatch x $ \es -> do
182− logger <- compilerLogger <$> compilerAsk
183− forM_ es $ \e -> compilerUnsafeIO $ Logger.debug logger $
184− "Hakyll.Core.Compiler.Internal: Alternative failed: " ++ e
185− y
228+ empty = compilerNoResult []
229+ x <|> y = x `compilerCatch` (\rx -> y `compilerCatch` (\ry ->
230+ case (rx, ry) of
231+ (CompilationFailure xs, CompilationFailure ys) ->
232+ compilerThrow $ NonEmpty.toList xs ++ NonEmpty.toList ys
233+ (CompilationFailure xs, CompilationNoResult ys) ->
234+ debug ys >> compilerThrow (NonEmpty.toList xs)
235+ (CompilationNoResult xs, CompilationFailure ys) ->
236+ debug xs >> compilerThrow (NonEmpty.toList ys)
237+ (CompilationNoResult xs, CompilationNoResult ys) -> compilerNoResult $ xs ++ ys
238+ ))
239+ where
240+ debug = compilerDebugEntries "Hakyll.Core.Compiler.Internal: Alternative fail suppressed"
186241 {-# INLINE (<|>) #-}
187242
188243
189244--------------------------------------------------------------------------------
245+-- | Put the result back in a compiler
246+compilerResult :: CompilerResult a -> Compiler a
247+compilerResult x = Compiler $ \_ -> return x
248+{-# INLINE compilerResult #-}
249+
250+
251+--------------------------------------------------------------------------------
252+-- | Get the current environment
190253compilerAsk :: Compiler CompilerRead
191254compilerAsk = Compiler $ \r -> return $ CompilerDone r mempty
192255{-# INLINE compilerAsk #-}
193256
194257
195258--------------------------------------------------------------------------------
259+-- | Put a 'CompilerWrite'
196260compilerTell :: CompilerWrite -> Compiler ()
197−compilerTell deps = Compiler $ \_ -> return $ CompilerDone () deps
261+compilerTell = compilerResult . CompilerDone ()
198262{-# INLINE compilerTell #-}
199263
200264
201265--------------------------------------------------------------------------------
266+-- | Run an IO computation without dependencies in a Compiler
267+compilerUnsafeIO :: IO a -> Compiler a
268+compilerUnsafeIO io = Compiler $ \_ -> do
269+ x <- io
270+ return $ CompilerDone x mempty
271+{-# INLINE compilerUnsafeIO #-}
272+
273+
274+--------------------------------------------------------------------------------
275+-- | Throw errors in the 'Compiler'.
276+--
277+-- If no messages are given, this is considered a 'CompilationNoResult' error.
278+-- Otherwise, it is treated as a proper compilation failure.
202279compilerThrow :: [String] -> Compiler a
203−compilerThrow es = Compiler $ \_ -> return $ CompilerError es
204−{-# INLINE compilerThrow #-}
280+compilerThrow = compilerResult . CompilerError .
281+ maybe (CompilationNoResult []) CompilationFailure .
282+ NonEmpty.nonEmpty
283+
284+-- | Put a 'CompilerError' with multiple messages as 'CompilationNoResult'
285+compilerNoResult :: [String] -> Compiler a
286+compilerNoResult = compilerResult . CompilerError . CompilationNoResult
205287
206288
207289--------------------------------------------------------------------------------
208−compilerCatch :: Compiler a -> ([String] -> Compiler a) -> Compiler a
290+-- | Allows to distinguish 'CompilerError's and branch on them with 'Either'
291+--
292+-- prop> compilerTry = (`compilerCatch` return . Left) . fmap Right
293+compilerTry :: Compiler a -> Compiler (Either (CompilerErrors String) a)
294+compilerTry (Compiler x) = Compiler $ \r -> do
295+ res <- x r
296+ case res of
297+ CompilerDone res' w -> return (CompilerDone (Right res') w)
298+ CompilerSnapshot s c -> return (CompilerSnapshot s (compilerTry c))
299+ CompilerRequire i c -> return (CompilerRequire i (compilerTry c))
300+ CompilerError e -> return (CompilerDone (Left e) mempty)
301+{-# INLINE compilerTry #-}
302+
303+
304+--------------------------------------------------------------------------------
305+-- | Allows you to recover from 'CompilerError's.
306+-- Uses the same parameter order as 'catchError' so that it can be used infix.
307+--
308+-- prop> c `compilerCatch` f = compilerTry c >>= either f return
309+compilerCatch :: Compiler a -> (CompilerErrors String -> Compiler a) -> Compiler a
209310compilerCatch (Compiler x) f = Compiler $ \r -> do
210311 res <- x r
211312 case res of
212313 CompilerDone res' w -> return (CompilerDone res' w)
213314 CompilerSnapshot s c -> return (CompilerSnapshot s (compilerCatch c f))
214− CompilerError e -> unCompiler (f e) r
215315 CompilerRequire i c -> return (CompilerRequire i (compilerCatch c f))
316+ CompilerError e -> unCompiler (f e) r
216317{-# INLINE compilerCatch #-}
217318
218319
219320--------------------------------------------------------------------------------
220−-- | Put the result back in a compiler
221−compilerResult :: CompilerResult a -> Compiler a
222−compilerResult x = Compiler $ \_ -> return x
223−{-# INLINE compilerResult #-}
224−
321+compilerDebugLog :: [String] -> Compiler ()
322+compilerDebugLog ms = do
323+ logger <- compilerLogger <$> compilerAsk
324+ compilerUnsafeIO $ forM_ ms $ Logger.debug logger
225325
226326--------------------------------------------------------------------------------
227−compilerUnsafeIO :: IO a -> Compiler a
228−compilerUnsafeIO io = Compiler $ \_ -> do
229− x <- io
230− return $ CompilerDone x mempty
231−{-# INLINE compilerUnsafeIO #-}
327+-- | Pass a list of messages with a heading to the debug logger
328+compilerDebugEntries :: String -> [String] -> Compiler ()
329+compilerDebugEntries msg = compilerDebugLog . (msg:) . map indent
330+ where
331+ indent = unlines . map (" "++) . lines
232332
233333
234334--------------------------------------------------------------------------------
235335compilerTellDependencies :: [Dependency] -> Compiler ()
236336compilerTellDependencies ds = do
237− logger <- compilerLogger <$> compilerAsk
238− forM_ ds $ \d -> compilerUnsafeIO $ Logger.debug logger $
239− "Hakyll.Core.Compiler.Internal: Adding dependency: " ++ show d
337+ compilerDebugLog $ map (\d ->
338+ "Hakyll.Core.Compiler.Internal: Adding dependency: " ++ show d) ds
240339 compilerTell mempty {compilerDependencies = ds}
241340{-# INLINE compilerTellDependencies #-}
242341
src/Hakyll/Core/Compiler/Require.hs → lib/Hakyll/Core/Compiler/Require.hsrenamed+2
@@ -91,6 +91,7 @@ loadBody id' = loadSnapshotBody id' final
9191
9292
9393--------------------------------------------------------------------------------
94+-- | A shortcut for only requiring the body for a specific snapshot of an item
9495loadSnapshotBody :: (Binary a, Typeable a)
9596 => Identifier -> Snapshot -> Compiler a
9697loadSnapshotBody id' snapshot = fmap itemBody $ loadSnapshot id' snapshot
@@ -103,6 +104,7 @@ loadAll pattern = loadAllSnapshots pattern final
103104
104105
105106--------------------------------------------------------------------------------
107+-- | Load a specific snapshot for each of dynamic list of items
106108loadAllSnapshots :: (Binary a, Typeable a)
107109 => Pattern -> Snapshot -> Compiler [Item a]
108110loadAllSnapshots pattern snapshot = do
src/Hakyll/Core/Configuration.hs → lib/Hakyll/Core/Configuration.hsrenamed

The content is the same.

src/Hakyll/Core/Dependencies.hs → lib/Hakyll/Core/Dependencies.hsrenamed

The content is the same.

src/Hakyll/Core/File.hs → lib/Hakyll/Core/File.hsrenamed+11−3
@@ -1,5 +1,6 @@
11--------------------------------------------------------------------------------
22-- | Exports simple compilers to just copy files
3+{-# LANGUAGE CPP #-}
34{-# LANGUAGE DeriveDataTypeable #-}
45{-# LANGUAGE GeneralizedNewtypeDeriving #-}
56module Hakyll.Core.File
@@ -13,7 +14,12 @@ module Hakyll.Core.File
1314--------------------------------------------------------------------------------
1415import Data.Binary (Binary (..))
1516import Data.Typeable (Typeable)
16−import System.Directory (copyFile, doesFileExist,
17+#if MIN_VERSION_directory(1,2,6)
18+import System.Directory (copyFileWithMetadata)
19+#else
20+import System.Directory (copyFile)
21+#endif
22+import System.Directory (doesFileExist,
1723 renameFile)
1824import System.FilePath ((</>))
1925import System.Random (randomIO)
@@ -38,9 +44,11 @@ newtype CopyFile = CopyFile FilePath
3844
3945--------------------------------------------------------------------------------
4046instance Writable CopyFile where
47+#if MIN_VERSION_directory(1,2,6)
48+ write dst (Item _ (CopyFile src)) = copyFileWithMetadata src dst
49+#else
4150 write dst (Item _ (CopyFile src)) = copyFile src dst
42−
43−
51+#endif
4452--------------------------------------------------------------------------------
4553copyFileCompiler :: Compiler (Item CopyFile)
4654copyFileCompiler = do
src/Hakyll/Core/Identifier.hs → lib/Hakyll/Core/Identifier.hsrenamed+1−1
@@ -62,7 +62,7 @@ instance Show Identifier where
6262
6363--------------------------------------------------------------------------------
6464-- | Parse an identifier from a string
65−fromFilePath :: String -> Identifier
65+fromFilePath :: FilePath -> Identifier
6666fromFilePath = Identifier Nothing .
6767 intercalate "/" . filter (not . null) . split'
6868 where
src/Hakyll/Core/Identifier/Pattern.hs → lib/Hakyll/Core/Identifier/Pattern.hsrenamed+14−72
@@ -27,7 +27,8 @@
2727-- * @\"foo\/*.html\"@ will match all HTML files in the @\"foo\/\"@ directory.
2828--
2929-- The 'capture' function allows the user to get access to the elements captured
30−-- by the capture elements in the pattern.
30+-- by the capture elements in a glob or regex pattern.
31+{-# OPTIONS_GHC -fno-warn-orphans #-}
3132module Hakyll.Core.Identifier.Pattern
3233 ( -- * The pattern type
3334 Pattern
@@ -57,77 +58,22 @@ module Hakyll.Core.Identifier.Pattern
5758
5859
5960--------------------------------------------------------------------------------
60−import Control.Arrow ((&&&), (>>>))
61−import Control.Monad (msum)
62−import Data.Binary (Binary (..), getWord8, putWord8)
63−import Data.List (inits, isPrefixOf, tails)
64−import Data.Maybe (isJust)
65−import Data.Set (Set)
66−import qualified Data.Set as S
61+import Control.Arrow ((&&&), (>>>))
62+import Control.Monad (msum)
63+import Data.List (inits, isPrefixOf,
64+ tails)
65+import Data.Maybe (isJust)
66+import qualified Data.Set as S
6767
6868
6969--------------------------------------------------------------------------------
70−import GHC.Exts (IsString, fromString)
71−import Text.Regex.TDFA ((=~))
70+import GHC.Exts (IsString, fromString)
71+import Text.Regex.TDFA ((=~))
7272
7373
7474--------------------------------------------------------------------------------
7575import Hakyll.Core.Identifier
76−
77−
78−--------------------------------------------------------------------------------
79−-- | Elements of a glob pattern
80−data GlobComponent
81− = Capture
82− | CaptureMany
83− | Literal String
84− deriving (Eq, Show)
85−
86−
87−--------------------------------------------------------------------------------
88−instance Binary GlobComponent where
89− put Capture = putWord8 0
90− put CaptureMany = putWord8 1
91− put (Literal s) = putWord8 2 >> put s
92−
93− get = getWord8 >>= \t -> case t of
94− 0 -> pure Capture
95− 1 -> pure CaptureMany
96− 2 -> Literal <$> get
97− _ -> error "Data.Binary.get: Invalid GlobComponent"
98−
99−
100−--------------------------------------------------------------------------------
101−-- | Type that allows matching on identifiers
102−data Pattern
103− = Everything
104− | Complement Pattern
105− | And Pattern Pattern
106− | Glob [GlobComponent]
107− | List (Set Identifier)
108− | Regex String
109− | Version (Maybe String)
110− deriving (Show)
111−
112−
113−--------------------------------------------------------------------------------
114−instance Binary Pattern where
115− put Everything = putWord8 0
116− put (Complement p) = putWord8 1 >> put p
117− put (And x y) = putWord8 2 >> put x >> put y
118− put (Glob g) = putWord8 3 >> put g
119− put (List is) = putWord8 4 >> put is
120− put (Regex r) = putWord8 5 >> put r
121− put (Version v) = putWord8 6 >> put v
122−
123− get = getWord8 >>= \t -> case t of
124− 0 -> pure Everything
125− 1 -> Complement <$> get
126− 2 -> And <$> get <*> get
127− 3 -> Glob <$> get
128− 4 -> List <$> get
129− 5 -> Regex <$> get
130− _ -> Version <$> get
76+import Hakyll.Core.Identifier.Pattern.Internal
13177
13278
13379--------------------------------------------------------------------------------
@@ -135,12 +81,6 @@ instance IsString Pattern where
13581 fromString = fromGlob
13682
13783
138−--------------------------------------------------------------------------------
139−instance Monoid Pattern where
140− mempty = Everything
141− mappend = (.&&.)
142−
143−
14484--------------------------------------------------------------------------------
14585-- | Parse a pattern from a string
14686fromGlob :: String -> Pattern
@@ -260,9 +200,11 @@ splits = inits &&& tails >>> uncurry zip >>> reverse
260200
261201
262202--------------------------------------------------------------------------------
263−-- | Match a glob against a pattern, generating a list of captures
203+-- | Match a glob or regex pattern against an identifier, generating a list of captures
264204capture :: Pattern -> Identifier -> Maybe [String]
265205capture (Glob p) i = capture' p (toFilePath i)
206+capture (Regex pat) i = Just groups
207+ where (_, _, _, groups) = ((toFilePath i) =~ pat) :: (String, String, String, [String])
266208capture _ _ = Nothing
267209
268210
lib/Hakyll/Core/Identifier/Pattern/Internal.hsnew file+92
@@ -0,0 +1,92 @@
1+-- | This internal module is mostly here to prevent CPP conflicting with Haskell
2+-- comments.
3+{-# LANGUAGE CPP #-}
4+module Hakyll.Core.Identifier.Pattern.Internal
5+ ( GlobComponent (..)
6+ , Pattern (..)
7+ ) where
8+
9+
10+--------------------------------------------------------------------------------
11+import Data.Binary (Binary (..), getWord8, putWord8)
12+import Data.Set (Set)
13+
14+
15+--------------------------------------------------------------------------------
16+#if MIN_VERSION_base(4,9,0)
17+import Data.Semigroup (Semigroup (..))
18+#endif
19+
20+
21+--------------------------------------------------------------------------------
22+import Hakyll.Core.Identifier
23+
24+
25+--------------------------------------------------------------------------------
26+-- | Elements of a glob pattern
27+data GlobComponent
28+ = Capture
29+ | CaptureMany
30+ | Literal String
31+ deriving (Eq, Show)
32+
33+
34+--------------------------------------------------------------------------------
35+instance Binary GlobComponent where
36+ put Capture = putWord8 0
37+ put CaptureMany = putWord8 1
38+ put (Literal s) = putWord8 2 >> put s
39+
40+ get = getWord8 >>= \t -> case t of
41+ 0 -> pure Capture
42+ 1 -> pure CaptureMany
43+ 2 -> Literal <$> get
44+ _ -> error "Data.Binary.get: Invalid GlobComponent"
45+
46+
47+--------------------------------------------------------------------------------
48+-- | Type that allows matching on identifiers
49+data Pattern
50+ = Everything
51+ | Complement Pattern
52+ | And Pattern Pattern
53+ | Glob [GlobComponent]
54+ | List (Set Identifier)
55+ | Regex String
56+ | Version (Maybe String)
57+ deriving (Show)
58+
59+
60+--------------------------------------------------------------------------------
61+instance Binary Pattern where
62+ put Everything = putWord8 0
63+ put (Complement p) = putWord8 1 >> put p
64+ put (And x y) = putWord8 2 >> put x >> put y
65+ put (Glob g) = putWord8 3 >> put g
66+ put (List is) = putWord8 4 >> put is
67+ put (Regex r) = putWord8 5 >> put r
68+ put (Version v) = putWord8 6 >> put v
69+
70+ get = getWord8 >>= \t -> case t of
71+ 0 -> pure Everything
72+ 1 -> Complement <$> get
73+ 2 -> And <$> get <*> get
74+ 3 -> Glob <$> get
75+ 4 -> List <$> get
76+ 5 -> Regex <$> get
77+ _ -> Version <$> get
78+
79+
80+--------------------------------------------------------------------------------
81+#if MIN_VERSION_base(4,9,0)
82+instance Semigroup Pattern where
83+ (<>) = And
84+
85+instance Monoid Pattern where
86+ mempty = Everything
87+ mappend = (<>)
88+#else
89+instance Monoid Pattern where
90+ mempty = Everything
91+ mappend = And
92+#endif
src/Hakyll/Core/Item.hs → lib/Hakyll/Core/Item.hsrenamed

The content is the same.

src/Hakyll/Core/Item/SomeItem.hs → lib/Hakyll/Core/Item/SomeItem.hsrenamed

The content is the same.

src/Hakyll/Core/Logger.hs → lib/Hakyll/Core/Logger.hsrenamed+9−3
@@ -18,6 +18,7 @@ import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
1818import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)
1919import Control.Monad (forever)
2020import Control.Monad.Trans (MonadIO, liftIO)
21+import Data.List (intercalate)
2122import Prelude hiding (error)
2223
2324
@@ -79,7 +80,7 @@ string l v m
7980
8081--------------------------------------------------------------------------------
8182error :: MonadIO m => Logger -> String -> m ()
82−error l m = string l Error $ " [ERROR] " ++ m
83+error l m = string l Error $ " [ERROR] " ++ indent m
8384
8485
8586--------------------------------------------------------------------------------
@@ -89,9 +90,14 @@ header l = string l Message
8990
9091--------------------------------------------------------------------------------
9192message :: MonadIO m => Logger -> String -> m ()
92−message l m = string l Message $ " " ++ m
93+message l m = string l Message $ " " ++ indent m
9394
9495
9596--------------------------------------------------------------------------------
9697debug :: MonadIO m => Logger -> String -> m ()
97−debug l m = string l Debug $ " [DEBUG] " ++ m
98+debug l m = string l Debug $ " [DEBUG] " ++ indent m
99+
100+
101+--------------------------------------------------------------------------------
102+indent :: String -> String
103+indent = intercalate "\n " . lines
src/Hakyll/Core/Metadata.hs → lib/Hakyll/Core/Metadata.hsrenamed

The content is the same.

src/Hakyll/Core/Provider.hs → lib/Hakyll/Core/Provider.hsrenamed

The content is the same.

src/Hakyll/Core/Provider/Internal.hs → lib/Hakyll/Core/Provider/Internal.hsrenamed

The content is the same.

src/Hakyll/Core/Provider/Metadata.hs → lib/Hakyll/Core/Provider/Metadata.hsrenamed+3−2
@@ -27,6 +27,7 @@ import Hakyll.Core.Identifier
2727import Hakyll.Core.Metadata
2828import Hakyll.Core.Provider.Internal
2929import System.IO as IO
30+import System.IO.Error (modifyIOError, ioeSetLocation)
3031
3132
3233--------------------------------------------------------------------------------
@@ -51,7 +52,7 @@ loadMetadata p identifier = do
5152--------------------------------------------------------------------------------
5253loadMetadataHeader :: FilePath -> IO (Metadata, String)
5354loadMetadataHeader fp = do
54− fileContent <- readFile fp
55+ fileContent <- modifyIOError (`ioeSetLocation` "loadMetadataHeader") $ readFile fp
5556 case parsePage fileContent of
5657 Right x -> return x
5758 Left err -> throwIO $ MetadataException fp err
@@ -60,7 +61,7 @@ loadMetadataHeader fp = do
6061--------------------------------------------------------------------------------
6162loadMetadataFile :: FilePath -> IO Metadata
6263loadMetadataFile fp = do
63− fileContent <- B.readFile fp
64+ fileContent <- modifyIOError (`ioeSetLocation` "loadMetadataFile") $ B.readFile fp
6465 let errOrMeta = Yaml.decodeEither' fileContent
6566 either (fail . show) return errOrMeta
6667
src/Hakyll/Core/Provider/MetadataCache.hs → lib/Hakyll/Core/Provider/MetadataCache.hsrenamed

The content is the same.

src/Hakyll/Core/Routes.hs → lib/Hakyll/Core/Routes.hsrenamed+17
@@ -25,6 +25,7 @@
2525-- not appear in your site directory.
2626--
2727-- * If an item matches multiple routes, the first rule will be chosen.
28+{-# LANGUAGE CPP #-}
2829{-# LANGUAGE Rank2Types #-}
2930module Hakyll.Core.Routes
3031 ( UsedMetadata
@@ -42,6 +43,9 @@ module Hakyll.Core.Routes
4243
4344
4445--------------------------------------------------------------------------------
46+#if MIN_VERSION_base(4,9,0)
47+import Data.Semigroup (Semigroup (..))
48+#endif
4549import System.FilePath (replaceExtension)
4650
4751
@@ -74,6 +78,18 @@ newtype Routes = Routes
7478
7579
7680--------------------------------------------------------------------------------
81+#if MIN_VERSION_base(4,9,0)
82+instance Semigroup Routes where
83+ (<>) (Routes f) (Routes g) = Routes $ \p id' -> do
84+ (mfp, um) <- f p id'
85+ case mfp of
86+ Nothing -> g p id'
87+ Just _ -> return (mfp, um)
88+
89+instance Monoid Routes where
90+ mempty = Routes $ \_ _ -> return (Nothing, False)
91+ mappend = (<>)
92+#else
7793instance Monoid Routes where
7894 mempty = Routes $ \_ _ -> return (Nothing, False)
7995 mappend (Routes f) (Routes g) = Routes $ \p id' -> do
@@ -81,6 +97,7 @@ instance Monoid Routes where
8197 case mfp of
8298 Nothing -> g p id'
8399 Just _ -> return (mfp, um)
100+#endif
84101
85102
86103--------------------------------------------------------------------------------
src/Hakyll/Core/Rules.hs → lib/Hakyll/Core/Rules.hsrenamed

The content is the same.

src/Hakyll/Core/Rules/Internal.hs → lib/Hakyll/Core/Rules/Internal.hsrenamed+14
@@ -1,4 +1,5 @@
11--------------------------------------------------------------------------------
2+{-# LANGUAGE CPP #-}
23{-# LANGUAGE GeneralizedNewtypeDeriving #-}
34{-# LANGUAGE Rank2Types #-}
45module Hakyll.Core.Rules.Internal
@@ -16,6 +17,9 @@ import Control.Monad.Reader (ask)
1617import Control.Monad.RWS (RWST, runRWST)
1718import Control.Monad.Trans (liftIO)
1819import qualified Data.Map as M
20+#if MIN_VERSION_base(4,9,0)
21+import Data.Semigroup (Semigroup (..))
22+#endif
1923import Data.Set (Set)
2024
2125
@@ -52,10 +56,20 @@ data RuleSet = RuleSet
5256
5357
5458--------------------------------------------------------------------------------
59+#if MIN_VERSION_base(4,9,0)
60+instance Semigroup RuleSet where
61+ (<>) (RuleSet r1 c1 s1 p1) (RuleSet r2 c2 s2 p2) =
62+ RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) (p1 .||. p2)
63+
64+instance Monoid RuleSet where
65+ mempty = RuleSet mempty mempty mempty mempty
66+ mappend = (<>)
67+#else
5568instance Monoid RuleSet where
5669 mempty = RuleSet mempty mempty mempty mempty
5770 mappend (RuleSet r1 c1 s1 p1) (RuleSet r2 c2 s2 p2) =
5871 RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) (p1 .||. p2)
72+#endif
5973
6074
6175--------------------------------------------------------------------------------
src/Hakyll/Core/Runtime.hs → lib/Hakyll/Core/Runtime.hsrenamed+3−3
@@ -199,9 +199,9 @@ chase trail id'
199199 result <- liftIO $ runCompiler compiler read'
200200 case result of
201201 -- Rethrow error
202− CompilerError [] -> throwError
203− "Compiler failed but no info given, try running with -v?"
204− CompilerError es -> throwError $ intercalate "; " es
202+ CompilerError e -> throwError $ case compilerErrorMessages e of
203+ [] -> "Compiler failed but no info given, try running with -v?"
204+ es -> intercalate "; " es
205205
206206 -- Signal that a snapshot was saved ->
207207 CompilerSnapshot snapshot c -> do
src/Hakyll/Core/Store.hs → lib/Hakyll/Core/Store.hsrenamed+26−23
@@ -16,7 +16,6 @@ module Hakyll.Core.Store
1616
1717
1818--------------------------------------------------------------------------------
19−import Control.Exception (IOException, handle)
2019import qualified Crypto.Hash.MD5 as MD5
2120import Data.Binary (Binary, decode, encodeFile)
2221import qualified Data.ByteString as B
@@ -27,11 +26,13 @@ import Data.Maybe (isJust)
2726import qualified Data.Text as T
2827import qualified Data.Text.Encoding as T
2928import Data.Typeable (TypeRep, Typeable, cast, typeOf)
29+import Numeric (showHex)
3030import System.Directory (createDirectoryIfMissing)
3131import System.Directory (doesFileExist, removeFile)
3232import System.FilePath ((</>))
3333import System.IO (IOMode (..), hClose, openFile)
34−import Text.Printf (printf)
34+import System.IO.Error (catchIOError, ioeSetFileName,
35+ ioeSetLocation, modifyIOError)
3536
3637
3738--------------------------------------------------------------------------------
@@ -84,6 +85,14 @@ new inMemory directory = do
8485 where
8586 csize = Just 500
8687
88+--------------------------------------------------------------------------------
89+withStore :: Store -> String -> (String -> FilePath -> IO a) -> [String] -> IO a
90+withStore store loc run identifier = modifyIOError handle $ run key path
91+ where
92+ key = hash identifier
93+ path = storeDirectory store </> key
94+ handle e = e `ioeSetFileName` (path ++ " for " ++ intercalate "/" identifier)
95+ `ioeSetLocation` ("Store." ++ loc)
8796
8897--------------------------------------------------------------------------------
8998-- | Auxiliary: add an item to the in-memory cache
@@ -124,17 +133,16 @@ cacheDelete (Store _ (Just lru)) key = do
124133--------------------------------------------------------------------------------
125134-- | Store an item
126135set :: (Binary a, Typeable a) => Store -> [String] -> a -> IO ()
127−set store identifier value = do
128− encodeFile (storeDirectory store </> key) value
136+set store identifier value = withStore store "set" (\key path -> do
137+ encodeFile path value
129138 cacheInsert store key value
130− where
131− key = hash identifier
139+ ) identifier
132140
133141
134142--------------------------------------------------------------------------------
135143-- | Load an item
136144get :: (Binary a, Typeable a) => Store -> [String] -> IO (Result a)
137−get store identifier = do
145+get store = withStore store "get" $ \key path -> do
138146 -- First check the in-memory map
139147 ref <- cacheLookup store key
140148 case ref of
@@ -146,17 +154,14 @@ get store identifier = do
146154 then return NotFound
147155 -- Found in the filesystem
148156 else do
149− v <- decodeClose
157+ v <- decodeClose path
150158 cacheInsert store key v
151159 return $ Found v
152160 -- Found in the in-memory map (or wrong type), just return
153161 s -> return s
154162 where
155− key = hash identifier
156− path = storeDirectory store </> key
157−
158163 -- 'decodeFile' from Data.Binary which closes the file ASAP
159− decodeClose = do
164+ decodeClose path = do
160165 h <- openFile path ReadMode
161166 lbs <- BL.hGetContents h
162167 BL.length lbs `seq` hClose h
@@ -166,32 +171,30 @@ get store identifier = do
166171--------------------------------------------------------------------------------
167172-- | Strict function
168173isMember :: Store -> [String] -> IO Bool
169−isMember store identifier = do
174+isMember store = withStore store "isMember" $ \key path -> do
170175 inCache <- cacheIsMember store key
171176 if inCache then return True else doesFileExist path
172− where
173− key = hash identifier
174− path = storeDirectory store </> key
175177
176178
177179--------------------------------------------------------------------------------
178180-- | Delete an item
179181delete :: Store -> [String] -> IO ()
180−delete store identifier = do
182+delete store = withStore store "delete" $ \key path -> do
181183 cacheDelete store key
182− deleteFile $ storeDirectory store </> key
183− where
184− key = hash identifier
184+ deleteFile path
185185
186186
187187--------------------------------------------------------------------------------
188188-- | Delete a file unless it doesn't exist...
189189deleteFile :: FilePath -> IO ()
190−deleteFile = handle (\(_ :: IOException) -> return ()) . removeFile
190+deleteFile = (`catchIOError` \_ -> return ()) . removeFile
191191
192192
193193--------------------------------------------------------------------------------
194194-- | Mostly meant for internal usage
195195hash :: [String] -> String
196−hash = concatMap (printf "%02x") . B.unpack .
197− MD5.hash . T.encodeUtf8 . T.pack . intercalate "/"
196+hash = toHex . B.unpack . MD5.hash . T.encodeUtf8 . T.pack . intercalate "/"
197+ where
198+ toHex [] = ""
199+ toHex (x : xs) | x < 16 = '0' : showHex x (toHex xs)
200+ | otherwise = showHex x (toHex xs)
src/Hakyll/Core/UnixFilter.hs → lib/Hakyll/Core/UnixFilter.hsrenamed+2−1
@@ -92,7 +92,8 @@ unixFilterWith writer reader programName args input = do
9292 ExitSuccess -> return output
9393 ExitFailure e -> fail $
9494 "Hakyll.Core.UnixFilter.unixFilterWith: " ++
95− unwords (programName : args) ++ " gave exit code " ++ show e
95+ unwords (programName : args) ++ " gave exit code " ++ show e ++
96+ ". (Error: " ++ err ++ ")"
9697
9798
9899--------------------------------------------------------------------------------
src/Hakyll/Core/Util/File.hs → lib/Hakyll/Core/Util/File.hsrenamed

The content is the same.

src/Hakyll/Core/Util/Parser.hs → lib/Hakyll/Core/Util/Parser.hsrenamed−1
@@ -2,7 +2,6 @@
22-- | Parser utilities
33module Hakyll.Core.Util.Parser
44 ( metadataKey
5− , reservedKeys
65 ) where
76
87
src/Hakyll/Core/Util/String.hs → lib/Hakyll/Core/Util/String.hsrenamed+1−1
@@ -27,7 +27,7 @@ trim = reverse . trim' . reverse . trim'
2727--------------------------------------------------------------------------------
2828-- | A simple (but inefficient) regex replace funcion
2929replaceAll :: String -- ^ Pattern
30− -> (String -> String) -- ^ Replacement (called on capture)
30+ -> (String -> String) -- ^ Replacement (called on match)
3131 -> String -- ^ Source string
3232 -> String -- ^ Result
3333replaceAll pattern f source = replaceAll' source
src/Hakyll/Core/Writable.hs → lib/Hakyll/Core/Writable.hsrenamed

The content is the same.

lib/Hakyll/Main.hsnew file+180
@@ -0,0 +1,180 @@
1+--------------------------------------------------------------------------------
2+-- | Module providing the main hakyll function and command-line argument parsing
3+{-# LANGUAGE CPP #-}
4+
5+module Hakyll.Main
6+ ( hakyll
7+ , hakyllWith
8+ , hakyllWithArgs
9+ , hakyllWithExitCode
10+ , hakyllWithExitCodeAndArgs
11+ , Options(..)
12+ , Command(..)
13+ ) where
14+
15+
16+--------------------------------------------------------------------------------
17+import System.Environment (getProgName)
18+import System.Exit (ExitCode (ExitSuccess), exitWith)
19+import System.IO.Unsafe (unsafePerformIO)
20+
21+
22+--------------------------------------------------------------------------------
23+import Data.Monoid ((<>))
24+import qualified Options.Applicative as OA
25+
26+
27+--------------------------------------------------------------------------------
28+import qualified Hakyll.Check as Check
29+import qualified Hakyll.Commands as Commands
30+import qualified Hakyll.Core.Configuration as Config
31+import qualified Hakyll.Core.Logger as Logger
32+import Hakyll.Core.Rules
33+
34+
35+--------------------------------------------------------------------------------
36+-- | This usually is the function with which the user runs the hakyll compiler
37+hakyll :: Rules a -> IO ()
38+hakyll = hakyllWith Config.defaultConfiguration
39+
40+--------------------------------------------------------------------------------
41+-- | A variant of 'hakyll' which allows the user to specify a custom
42+-- configuration
43+hakyllWith :: Config.Configuration -> Rules a -> IO ()
44+hakyllWith conf rules = hakyllWithExitCode conf rules >>= exitWith
45+
46+--------------------------------------------------------------------------------
47+-- | A variant of 'hakyll' which returns an 'ExitCode'
48+hakyllWithExitCode :: Config.Configuration -> Rules a -> IO ExitCode
49+hakyllWithExitCode conf rules = do
50+ args <- defaultParser conf
51+ hakyllWithExitCodeAndArgs conf args rules
52+
53+--------------------------------------------------------------------------------
54+-- | A variant of 'hakyll' which expects a 'Configuration' and command-line
55+-- 'Options'. This gives freedom to implement your own parsing.
56+hakyllWithArgs :: Config.Configuration -> Options -> Rules a -> IO ()
57+hakyllWithArgs conf args rules =
58+ hakyllWithExitCodeAndArgs conf args rules >>= exitWith
59+
60+--------------------------------------------------------------------------------
61+hakyllWithExitCodeAndArgs :: Config.Configuration ->
62+ Options -> Rules a -> IO ExitCode
63+hakyllWithExitCodeAndArgs conf args rules = do
64+ let args' = optCommand args
65+ verbosity' = if verbosity args then Logger.Debug else Logger.Message
66+ check =
67+ if internal_links args' then Check.InternalLinks else Check.All
68+
69+ logger <- Logger.new verbosity'
70+ invokeCommands args' conf check logger rules
71+
72+--------------------------------------------------------------------------------
73+defaultParser :: Config.Configuration -> IO Options
74+defaultParser conf =
75+ OA.customExecParser (OA.prefs OA.showHelpOnError)
76+ (OA.info (OA.helper <*> optionParser conf)
77+ (OA.fullDesc <> OA.progDesc
78+ (progName ++ " - Static site compiler created with Hakyll")))
79+
80+
81+--------------------------------------------------------------------------------
82+invokeCommands :: Command -> Config.Configuration ->
83+ Check.Check -> Logger.Logger -> Rules a -> IO ExitCode
84+invokeCommands args conf check logger rules =
85+ case args of
86+ Build -> Commands.build conf logger rules
87+ Check _ -> Commands.check conf logger check
88+ Clean -> Commands.clean conf logger >> ok
89+ Deploy -> Commands.deploy conf
90+ Preview p -> Commands.preview conf logger rules p >> ok
91+ Rebuild -> Commands.rebuild conf logger rules
92+ Server _ _ -> Commands.server conf logger (host args) (port args) >> ok
93+ Watch _ p s -> Commands.watch conf logger (host args) p (not s) rules >> ok
94+ where
95+ ok = return ExitSuccess
96+
97+
98+--------------------------------------------------------------------------------
99+
100+-- | The parsed command-line options.
101+data Options = Options {verbosity :: Bool, optCommand :: Command}
102+ deriving (Show)
103+
104+-- | The command to run.
105+data Command
106+ = Build
107+ -- ^ Generate the site.
108+ | Check {internal_links :: Bool}
109+ -- ^ Validate the site output.
110+ | Clean
111+ -- ^ Clean up and remove cache.
112+ | Deploy
113+ -- ^ Upload/deploy your site.
114+ | Preview {port :: Int}
115+ -- ^ [DEPRECATED] Please use the watch command.
116+ | Rebuild
117+ -- ^ Clean and build again.
118+ | Server {host :: String, port :: Int}
119+ -- ^ Start a preview server.
120+ | Watch {host :: String, port :: Int, no_server :: Bool }
121+ -- ^ Autocompile on changes and start a preview server.
122+ deriving (Show)
123+
124+{-# DEPRECATED Preview "Use Watch instead." #-}
125+
126+optionParser :: Config.Configuration -> OA.Parser Options
127+optionParser conf = Options <$> verboseParser <*> commandParser conf
128+ where
129+ verboseParser = OA.switch (OA.long "verbose" <> OA.short 'v' <> OA.help "Run in verbose mode")
130+
131+
132+commandParser :: Config.Configuration -> OA.Parser Command
133+commandParser conf = OA.subparser $ foldr ((<>) . produceCommand) mempty commands
134+ where
135+ portParser = OA.option OA.auto (OA.long "port" <> OA.help "Port to listen on" <> OA.value (Config.previewPort conf))
136+ hostParser = OA.strOption (OA.long "host" <> OA.help "Host to bind on" <> OA.value (Config.previewHost conf))
137+
138+ produceCommand (c,a,b) = OA.command c (OA.info (OA.helper <*> a) (b))
139+
140+ commands =
141+ [ ( "build"
142+ , pure Build
143+ , OA.fullDesc <> OA.progDesc "Generate the site"
144+ )
145+ , ( "check"
146+ , pure Check <*> OA.switch (OA.long "internal-links" <> OA.help "Check internal links only")
147+ , OA.fullDesc <> OA.progDesc "Validate the site output"
148+ )
149+ , ( "clean"
150+ , pure Clean
151+ , OA.fullDesc <> OA.progDesc "Clean up and remove cache"
152+ )
153+ , ( "deploy"
154+ , pure Deploy
155+ , OA.fullDesc <> OA.progDesc "Upload/deploy your site"
156+ )
157+ , ( "preview"
158+ , pure Preview <*> portParser
159+ , OA.fullDesc <> OA.progDesc "[DEPRECATED] Please use the watch command"
160+ )
161+ , ( "rebuild"
162+ , pure Rebuild
163+ , OA.fullDesc <> OA.progDesc "Clean and build again"
164+ )
165+ , ( "server"
166+ , pure Server <*> hostParser <*> portParser
167+ , OA.fullDesc <> OA.progDesc "Start a preview server"
168+ )
169+ , ( "watch"
170+ , pure Watch <*> hostParser <*> portParser <*> OA.switch (OA.long "no-server" <> OA.help "Disable the built-in web server")
171+ , OA.fullDesc <> OA.progDesc "Autocompile on changes and start a preview server. You can watch and recompile without running a server with --no-server."
172+ )
173+ ]
174+
175+
176+--------------------------------------------------------------------------------
177+-- | This is necessary because not everyone calls their program the same...
178+progName :: String
179+progName = unsafePerformIO getProgName
180+{-# NOINLINE progName #-}
src/Hakyll/Preview/Poll.hs → lib/Hakyll/Preview/Poll.hsrenamed+8−18
@@ -14,8 +14,7 @@ import Control.Exception (AsyncException, fromException,
1414import Control.Monad (forever, void, when)
1515import System.Directory (canonicalizePath)
1616import System.FilePath (pathSeparators)
17−import System.FSNotify (Event (..), startManager,
18− watchTree)
17+import qualified System.FSNotify as FSNotify
1918
2019#ifdef mingw32_HOST_OS
2120import Control.Concurrent (threadDelay)
@@ -44,12 +43,12 @@ watchUpdates conf update = do
4443 shouldBuild <- newEmptyMVar
4544 pattern <- update
4645 fullProviderDir <- canonicalizePath $ providerDirectory conf
47− manager <- startManager
46+ manager <- FSNotify.startManager
4847
4948 let allowed event = do
5049 -- Absolute path of the changed file. This must be inside provider
5150 -- dir, since that's the only dir we're watching.
52− let path = eventPath event
51+ let path = FSNotify.eventPath event
5352 relative = dropWhile (`elem` pathSeparators) $
5453 drop (length fullProviderDir) path
5554 identifier = fromFilePath relative
@@ -69,7 +68,7 @@ watchUpdates conf update = do
6968
7069 -- Send an event whenever something occurs so that the thread described
7170 -- above will do a build.
72− void $ watchTree manager providerDir (not . isRemove) $ \event -> do
71+ void $ FSNotify.watchTree manager providerDir (not . isRemove) $ \event -> do
7372 allowed' <- allowed event
7473 when allowed' $ void $ tryPutMVar shouldBuild event
7574 where
@@ -77,7 +76,7 @@ watchUpdates conf update = do
7776 update' _ _ = void update
7877#else
7978 update' event provider = do
80− let path = provider </> eventPath event
79+ let path = provider </> FSNotify.eventPath event
8180 -- on windows, a 'Modified' event is also sent on file deletion
8281 fileExists <- doesFileExist path
8382
@@ -105,15 +104,6 @@ watchUpdates conf update = do
105104
106105
107106--------------------------------------------------------------------------------
108−eventPath :: Event -> FilePath
109−eventPath evt = evtPath evt
110− where
111− evtPath (Added p _) = p
112− evtPath (Modified p _) = p
113− evtPath (Removed p _) = p
114−
115−
116−--------------------------------------------------------------------------------
117−isRemove :: Event -> Bool
118−isRemove (Removed _ _) = True
119−isRemove _ = False
107+isRemove :: FSNotify.Event -> Bool
108+isRemove (FSNotify.Removed {}) = True
109+isRemove _ = False
src/Hakyll/Preview/Server.hs → lib/Hakyll/Preview/Server.hsrenamed

The content is the same.

lib/Hakyll/Web/CompressCss.hsnew file+101
@@ -0,0 +1,101 @@
1+--------------------------------------------------------------------------------
2+-- | Module used for CSS compression. The compression is currently in a simple
3+-- state, but would typically reduce the number of bytes by about 25%.
4+module Hakyll.Web.CompressCss
5+ ( compressCssCompiler
6+ , compressCss
7+ ) where
8+
9+
10+--------------------------------------------------------------------------------
11+import Data.Char (isSpace)
12+import Data.List (dropWhileEnd, isPrefixOf)
13+
14+
15+--------------------------------------------------------------------------------
16+import Hakyll.Core.Compiler
17+import Hakyll.Core.Item
18+import Hakyll.Core.Util.String
19+
20+
21+--------------------------------------------------------------------------------
22+-- | Compiler form of 'compressCss'
23+compressCssCompiler :: Compiler (Item String)
24+compressCssCompiler = fmap compressCss <$> getResourceString
25+
26+
27+--------------------------------------------------------------------------------
28+-- | Compress CSS to speed up your site.
29+compressCss :: String -> String
30+compressCss = withoutStrings (handleCalcExpressions compressSeparators . compressWhitespace)
31+ . dropWhileEnd isSpace
32+ . dropWhile isSpace
33+ . stripComments
34+
35+
36+--------------------------------------------------------------------------------
37+-- | Compresses certain forms of separators.
38+compressSeparators :: String -> String
39+compressSeparators =
40+ replaceAll "; *}" (const "}") .
41+ replaceAll ";+" (const ";") .
42+ replaceAll " *[{};,>+~!] *" (take 1 . dropWhile isSpace) .
43+ replaceAll ": *" (take 1) -- not destroying pseudo selectors (#323)
44+
45+-- | Uses `compressCalcExpression` on all parenthesised calc expressions
46+-- and applies `transform` to all parts outside of them
47+handleCalcExpressions :: (String -> String) -> String -> String
48+handleCalcExpressions transform = top transform
49+ where
50+ top f "" = f ""
51+ top f str | "calc(" `isPrefixOf` str = f "calc" ++ nested 0 compressCalcExpression (drop 4 str)
52+ top f (x:xs) = top (f . (x:)) xs
53+
54+ -- when called with depth=0, the first character must be a '('
55+ nested :: Int -> (String -> String) -> String -> String
56+ nested _ f "" = f "" -- shouldn't happen, mismatched nesting
57+ nested depth f str | "calc(" `isPrefixOf` str = nested depth f (drop 4 str)
58+ nested 1 f (')':xs) = f ")" ++ top transform xs
59+ nested depth f (x:xs) = nested (case x of
60+ '(' -> depth + 1
61+ ')' -> depth - 1 -- assert: depth > 1
62+ _ -> depth
63+ ) (f . (x:)) xs
64+
65+-- | does not remove whitespace around + and -, which is important in calc() expressions
66+compressCalcExpression :: String -> String
67+compressCalcExpression =
68+ replaceAll " *[*/] *| *\\)|\\( *" (take 1 . dropWhile isSpace)
69+
70+--------------------------------------------------------------------------------
71+-- | Compresses all whitespace.
72+compressWhitespace :: String -> String
73+compressWhitespace = replaceAll "[ \t\n\r]+" (const " ")
74+
75+--------------------------------------------------------------------------------
76+-- | Function that strips CSS comments away (outside of strings).
77+stripComments :: String -> String
78+stripComments "" = ""
79+stripComments ('/':'*':str) = stripComments $ eatComment str
80+stripComments (x:xs) | x `elem` "\"'" = retainString x xs stripComments
81+ | otherwise = x : stripComments xs
82+
83+eatComment :: String -> String
84+eatComment "" = ""
85+eatComment ('*':'/':str) = str
86+eatComment (_:str) = eatComment str
87+
88+
89+--------------------------------------------------------------------------------
90+-- | Helper functions to handle string tokens correctly.
91+
92+-- TODO: handle backslash escapes
93+withoutStrings :: (String -> String) -> String -> String
94+withoutStrings f str = case span (`notElem` "\"'") str of
95+ (text, "") -> f text
96+ (text, d:rest) -> f text ++ retainString d rest (withoutStrings f)
97+
98+retainString :: Char -> String -> (String -> String) -> String
99+retainString delim str cont = case span (/= delim) str of
100+ (val, "") -> delim : val
101+ (val, _:rest) -> delim : val ++ delim : cont rest
src/Hakyll/Web/Feed.hs → lib/Hakyll/Web/Feed.hsrenamed+59−21
@@ -1,3 +1,6 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE TemplateHaskell #-}
3+
14--------------------------------------------------------------------------------
25-- | A Module that allows easy rendering of RSS feeds.
36--
@@ -20,21 +23,40 @@ module Hakyll.Web.Feed
2023 ( FeedConfiguration (..)
2124 , renderRss
2225 , renderAtom
26+ , renderRssWithTemplates
27+ , renderAtomWithTemplates
2328 ) where
2429
2530
2631--------------------------------------------------------------------------------
2732import Hakyll.Core.Compiler
28−import Hakyll.Core.Compiler.Internal
2933import Hakyll.Core.Item
30−import Hakyll.Core.Util.String (replaceAll)
34+import Hakyll.Core.Util.String (replaceAll)
3135import Hakyll.Web.Template
3236import Hakyll.Web.Template.Context
3337import Hakyll.Web.Template.List
3438
3539
3640--------------------------------------------------------------------------------
37−import Paths_hakyll
41+import Data.FileEmbed (makeRelativeToProject)
42+
43+
44+--------------------------------------------------------------------------------
45+rssTemplate :: Template
46+rssTemplate =
47+ $(makeRelativeToProject "data/templates/rss.xml" >>= embedTemplate)
48+
49+rssItemTemplate :: Template
50+rssItemTemplate =
51+ $(makeRelativeToProject "data/templates/rss-item.xml" >>= embedTemplate)
52+
53+atomTemplate :: Template
54+atomTemplate =
55+ $(makeRelativeToProject "data/templates/atom.xml" >>= embedTemplate)
56+
57+atomItemTemplate :: Template
58+atomItemTemplate =
59+ $(makeRelativeToProject "data/templates/atom-item.xml" >>= embedTemplate)
3860
3961
4062--------------------------------------------------------------------------------
@@ -55,16 +77,13 @@ data FeedConfiguration = FeedConfiguration
5577
5678--------------------------------------------------------------------------------
5779-- | Abstract function to render any feed.
58−renderFeed :: FilePath -- ^ Feed template
59− -> FilePath -- ^ Item template
80+renderFeed :: Template -- ^ Default feed template
81+ -> Template -- ^ Default item template
6082 -> FeedConfiguration -- ^ Feed configuration
6183 -> Context String -- ^ Context for the items
6284 -> [Item String] -- ^ Input items
6385 -> Compiler (Item String) -- ^ Resulting item
64−renderFeed feedPath itemPath config itemContext items = do
65− feedTpl <- loadTemplate feedPath
66− itemTpl <- loadTemplate itemPath
67−
86+renderFeed feedTpl itemTpl config itemContext items = do
6887 protectedItems <- mapM (applyFilter protectCDATA) items
6988 body <- makeItem =<< applyTemplateList itemTpl itemContext' protectedItems
7089 applyTemplate feedTpl feedContext body
@@ -73,10 +92,6 @@ renderFeed feedPath itemPath config itemContext items = do
7392 applyFilter tr str = return $ fmap tr str
7493 protectCDATA :: String -> String
7594 protectCDATA = replaceAll "]]>" (const "]]&gt;")
76− -- Auxiliary: load a template from a datafile
77− loadTemplate path = do
78− file <- compilerUnsafeIO $ getDataFileName path
79− unsafeReadTemplateFile file
8095
8196 itemContext' = mconcat
8297 [ itemContext
@@ -102,8 +117,35 @@ renderFeed feedPath itemPath config itemContext items = do
102117 updatedField = field "updated" $ \_ -> case items of
103118 [] -> return "Unknown"
104119 (x : _) -> unContext itemContext' "updated" [] x >>= \cf -> case cf of
105− ListField _ _ -> fail "Hakyll.Web.Feed.renderFeed: Internal error"
106120 StringField s -> return s
121+ _ -> fail "Hakyll.Web.Feed.renderFeed: Internal error"
122+
123+--------------------------------------------------------------------------------
124+-- | Render an RSS feed using given templates with a number of items.
125+renderRssWithTemplates ::
126+ Template -- ^ Feed template
127+ -> Template -- ^ Item template
128+ -> FeedConfiguration -- ^ Feed configuration
129+ -> Context String -- ^ Item context
130+ -> [Item String] -- ^ Feed items
131+ -> Compiler (Item String) -- ^ Resulting feed
132+renderRssWithTemplates feedTemplate itemTemplate config context = renderFeed
133+ feedTemplate itemTemplate config
134+ (makeItemContext "%a, %d %b %Y %H:%M:%S UT" context)
135+
136+
137+--------------------------------------------------------------------------------
138+-- | Render an Atom feed using given templates with a number of items.
139+renderAtomWithTemplates ::
140+ Template -- ^ Feed template
141+ -> Template -- ^ Item template
142+ -> FeedConfiguration -- ^ Feed configuration
143+ -> Context String -- ^ Item context
144+ -> [Item String] -- ^ Feed items
145+ -> Compiler (Item String) -- ^ Resulting feed
146+renderAtomWithTemplates feedTemplate itemTemplate config context = renderFeed
147+ feedTemplate itemTemplate config
148+ (makeItemContext "%Y-%m-%dT%H:%M:%SZ" context)
107149
108150
109151--------------------------------------------------------------------------------
@@ -112,9 +154,7 @@ renderRss :: FeedConfiguration -- ^ Feed configuration
112154 -> Context String -- ^ Item context
113155 -> [Item String] -- ^ Feed items
114156 -> Compiler (Item String) -- ^ Resulting feed
115−renderRss config context = renderFeed
116− "templates/rss.xml" "templates/rss-item.xml" config
117− (makeItemContext "%a, %d %b %Y %H:%M:%S UT" context)
157+renderRss = renderRssWithTemplates rssTemplate rssItemTemplate
118158
119159
120160--------------------------------------------------------------------------------
@@ -123,13 +163,11 @@ renderAtom :: FeedConfiguration -- ^ Feed configuration
123163 -> Context String -- ^ Item context
124164 -> [Item String] -- ^ Feed items
125165 -> Compiler (Item String) -- ^ Resulting feed
126−renderAtom config context = renderFeed
127− "templates/atom.xml" "templates/atom-item.xml" config
128− (makeItemContext "%Y-%m-%dT%H:%M:%SZ" context)
166+renderAtom = renderAtomWithTemplates atomTemplate atomItemTemplate
129167
130168
131169--------------------------------------------------------------------------------
132170-- | Copies @$updated$@ from @$published$@ if it is not already set.
133171makeItemContext :: String -> Context a -> Context a
134172makeItemContext fmt context = mconcat
135− [dateField "published" fmt, context, dateField "updated" fmt]
173+ [context, dateField "published" fmt, dateField "updated" fmt]
src/Hakyll/Web/Html.hs → lib/Hakyll/Web/Html.hsrenamed+6−2
@@ -3,6 +3,7 @@
33module Hakyll.Web.Html
44 ( -- * Generic
55 withTags
6+ , withTagList
67
78 -- * Headers
89 , demoteHeaders
@@ -36,8 +37,11 @@ import Network.URI (isUnreserved, escapeURIString)
3637--------------------------------------------------------------------------------
3738-- | Map over all tags in the document
3839withTags :: (TS.Tag String -> TS.Tag String) -> String -> String
39−withTags f = renderTags' . map f . parseTags'
40+withTags = withTagList . map
4041
42+-- | Map over all tags (as list) in the document
43+withTagList :: ([TS.Tag String] -> [TS.Tag String]) -> String -> String
44+withTagList f = renderTags' . f . parseTags'
4145
4246--------------------------------------------------------------------------------
4347-- | Map every @h1@ to an @h2@, @h2@ to @h3@, etc.
@@ -55,7 +59,7 @@ demoteHeaders = withTags $ \tag -> case tag of
5559
5660--------------------------------------------------------------------------------
5761isUrlAttribute :: String -> Bool
58−isUrlAttribute = (`elem` ["src", "href", "data", "poster"])
62+isUrlAttribute = (`elem` ["src", "href", "data", "poster", "srcset"])
5963
6064
6165--------------------------------------------------------------------------------
src/Hakyll/Web/Html/RelativizeUrls.hs → lib/Hakyll/Web/Html/RelativizeUrls.hsrenamed

The content is the same.

src/Hakyll/Web/Paginate.hs → lib/Hakyll/Web/Paginate.hsrenamed+28−1
@@ -11,7 +11,8 @@ module Hakyll.Web.Paginate
1111
1212
1313--------------------------------------------------------------------------------
14−import Control.Monad (forM_)
14+import Control.Applicative (empty)
15+import Control.Monad (forM_, forM)
1516import qualified Data.Map as M
1617import qualified Data.Set as S
1718
@@ -93,6 +94,18 @@ paginatePage pag pageNumber
9394-- | A default paginate context which provides the following keys:
9495--
9596--
97+-- * @firstPageNum@
98+-- * @firstPageUrl@
99+-- * @previousPageNum@
100+-- * @previousPageUrl@
101+-- * @nextPageNum@
102+-- * @nextPageUrl@
103+-- * @lastPageNum@
104+-- * @lastPageUrl@
105+-- * @currentPageNum@
106+-- * @currentPageUrl@
107+-- * @numPages@
108+-- * @allPages@
96109paginateContext :: Paginate -> PageNumber -> Context a
97110paginateContext pag currentPage = mconcat
98111 [ field "firstPageNum" $ \_ -> otherPage 1 >>= num
@@ -106,6 +119,20 @@ paginateContext pag currentPage = mconcat
106119 , field "currentPageNum" $ \i -> thisPage i >>= num
107120 , field "currentPageUrl" $ \i -> thisPage i >>= url
108121 , constField "numPages" $ show $ paginateNumPages pag
122+ , Context $ \k _ i -> case k of
123+ "allPages" -> do
124+ let ctx =
125+ field "isCurrent" (\n -> if fst (itemBody n) == currentPage then return "true" else empty) `mappend`
126+ field "num" (num . itemBody) `mappend`
127+ field "url" (url . itemBody)
128+
129+ list <- forM [1 .. lastPage] $
130+ \n -> if n == currentPage then thisPage i else otherPage n
131+ items <- mapM makeItem list
132+ return $ ListField ctx items
133+ _ -> do
134+ empty
135+
109136 ]
110137 where
111138 lastPage = paginateNumPages pag
src/Hakyll/Web/Pandoc.hs → lib/Hakyll/Web/Pandoc.hsrenamed+13−12
@@ -22,9 +22,9 @@ module Hakyll.Web.Pandoc
2222
2323
2424--------------------------------------------------------------------------------
25−import qualified Data.Set as S
25+import qualified Data.Text as T
2626import Text.Pandoc
27−import Text.Pandoc.Error (PandocError (..))
27+import Text.Pandoc.Highlighting (pygments)
2828
2929
3030--------------------------------------------------------------------------------
@@ -48,12 +48,10 @@ readPandocWith
4848 -> Item String -- ^ String to read
4949 -> Compiler (Item Pandoc) -- ^ Resulting document
5050readPandocWith ropt item =
51− case traverse (reader ropt (itemFileType item)) item of
52− Left (ParseFailure err) -> fail $
53− "Hakyll.Web.Pandoc.readPandocWith: parse failed: " ++ err
54− Left (ParsecError _ err) -> fail $
51+ case runPure $ traverse (reader ropt (itemFileType item)) (fmap T.pack item) of
52+ Left err -> fail $
5553 "Hakyll.Web.Pandoc.readPandocWith: parse failed: " ++ show err
56− Right item' -> return item'
54+ Right item' -> return item'
5755 where
5856 reader ro t = case t of
5957 DocBook -> readDocBook ro
@@ -69,7 +67,7 @@ readPandocWith ropt item =
6967 "Hakyll.Web.readPandocWith: I don't know how to read a file of " ++
7068 "the type " ++ show t ++ " for: " ++ show (itemIdentifier item)
7169
72− addExt ro e = ro {readerExtensions = S.insert e $ readerExtensions ro}
70+ addExt ro e = ro {readerExtensions = enableExtension e $ readerExtensions ro}
7371
7472
7573--------------------------------------------------------------------------------
@@ -84,7 +82,10 @@ writePandoc = writePandocWith defaultHakyllWriterOptions
8482writePandocWith :: WriterOptions -- ^ Writer options for pandoc
8583 -> Item Pandoc -- ^ Document to write
8684 -> Item String -- ^ Resulting HTML
87−writePandocWith wopt = fmap $ writeHtmlString wopt
85+writePandocWith wopt (Item itemi doc) =
86+ case runPure $ writeHtml5String wopt doc of
87+ Left err -> error $ "Hakyll.Web.Pandoc.writePandocWith: " ++ show err
88+ Right item' -> Item itemi $ T.unpack item'
8889
8990
9091--------------------------------------------------------------------------------
@@ -147,7 +148,7 @@ defaultHakyllReaderOptions :: ReaderOptions
147148defaultHakyllReaderOptions = def
148149 { -- The following option causes pandoc to read smart typography, a nice
149150 -- and free bonus.
150− readerSmart = True
151+ readerExtensions = enableExtension Ext_smart pandocExtensions
151152 }
152153
153154
@@ -157,8 +158,8 @@ defaultHakyllWriterOptions :: WriterOptions
157158defaultHakyllWriterOptions = def
158159 { -- This option causes literate haskell to be written using '>' marks in
159160 -- html, which I think is a good default.
160− writerExtensions = S.insert Ext_literate_haskell (writerExtensions def)
161+ writerExtensions = enableExtension Ext_smart pandocExtensions
161162 , -- We want to have hightlighting by default, to be compatible with earlier
162163 -- Hakyll releases
163− writerHighlight = True
164+ writerHighlightStyle = Just pygments
164165 }
src/Hakyll/Web/Pandoc/Biblio.hs → lib/Hakyll/Web/Pandoc/Biblio.hsrenamed+17−6
@@ -25,17 +25,19 @@ module Hakyll.Web.Pandoc.Biblio
2525--------------------------------------------------------------------------------
2626import Control.Monad (liftM, replicateM)
2727import Data.Binary (Binary (..))
28−import Data.Default (def)
2928import Data.Typeable (Typeable)
3029import Hakyll.Core.Compiler
30+import Hakyll.Core.Compiler.Internal
3131import Hakyll.Core.Identifier
3232import Hakyll.Core.Item
33+import Hakyll.Core.Provider
3334import Hakyll.Core.Writable
3435import Hakyll.Web.Pandoc
3536import Hakyll.Web.Pandoc.Binary ()
3637import qualified Text.CSL as CSL
3738import Text.CSL.Pandoc (processCites)
38−import Text.Pandoc (Pandoc, ReaderOptions (..))
39+import Text.Pandoc (Pandoc, ReaderOptions (..),
40+ enableExtension, Extension (..))
3941
4042
4143--------------------------------------------------------------------------------
@@ -83,8 +85,11 @@ instance Writable Biblio where
8385--------------------------------------------------------------------------------
8486biblioCompiler :: Compiler (Item Biblio)
8587biblioCompiler = do
86− filePath <- toFilePath <$> getUnderlying
87− makeItem =<< unsafeCompiler (Biblio <$> CSL.readBiblioFile filePath)
88+ filePath <- getResourceFilePath
89+ makeItem =<< unsafeCompiler (Biblio <$> CSL.readBiblioFile idpred filePath)
90+ where
91+ -- This is a filter on citations. We include all citations.
92+ idpred = const True
8893
8994
9095--------------------------------------------------------------------------------
@@ -95,7 +100,9 @@ readPandocBiblio :: ReaderOptions
95100 -> Compiler (Item Pandoc)
96101readPandocBiblio ropt csl biblio item = do
97102 -- Parse CSL file, if given
98− style <- unsafeCompiler $ CSL.readCSLFile Nothing . toFilePath . itemIdentifier $ csl
103+ provider <- compilerProvider <$> compilerAsk
104+ style <- unsafeCompiler $
105+ CSL.readCSLFile Nothing . (resourceFilePath provider) . itemIdentifier $ csl
99106
100107 -- We need to know the citation keys, add then *before* actually parsing the
101108 -- actual page. If we don't do this, pandoc won't even consider them
@@ -112,4 +119,8 @@ pandocBiblioCompiler cslFileName bibFileName = do
112119 csl <- load $ fromFilePath cslFileName
113120 bib <- load $ fromFilePath bibFileName
114121 liftM writePandoc
115− (getResourceBody >>= readPandocBiblio def csl bib)
122+ (getResourceBody >>= readPandocBiblio ropt csl bib)
123+ where ropt = defaultHakyllReaderOptions
124+ { -- The following option enables citation rendering
125+ readerExtensions = enableExtension Ext_citations $ readerExtensions defaultHakyllReaderOptions
126+ }
src/Hakyll/Web/Pandoc/Binary.hs → lib/Hakyll/Web/Pandoc/Binary.hsrenamed+19−17
@@ -1,31 +1,33 @@
11{-# OPTIONS_GHC -fno-warn-orphans #-}
2−{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE DeriveGeneric #-}
33module Hakyll.Web.Pandoc.Binary where
44
5−import Data.Binary (Binary (..))
5+import Data.Binary (Binary (..))
66
7−import qualified Text.CSL as CSL
8−import qualified Text.CSL.Reference as REF
9−import qualified Text.CSL.Style as STY
10−import Text.Pandoc
7+import qualified Text.CSL as CSL
8+import qualified Text.CSL.Reference as REF
9+import qualified Text.CSL.Style as STY
10+import Text.Pandoc
1111
1212--------------------------------------------------------------------------------
1313-- orphans
1414
15−instance Binary REF.CNum
16−instance Binary REF.Literal
17−instance Binary REF.RefDate
18−instance Binary REF.RefType
19−instance Binary STY.Agent
20−instance Binary STY.Formatted
21−instance Binary Inline
15+instance Binary Alignment
2216instance Binary Block
17+instance Binary CSL.Reference
2318instance Binary Citation
24−instance Binary MathType
25−instance Binary Alignment
2619instance Binary CitationMode
27−instance Binary QuoteType
2820instance Binary Format
21+instance Binary Inline
2922instance Binary ListNumberDelim
3023instance Binary ListNumberStyle
31−instance Binary CSL.Reference
24+instance Binary MathType
25+instance Binary QuoteType
26+instance Binary REF.CLabel
27+instance Binary REF.CNum
28+instance Binary REF.Literal
29+instance Binary REF.RefDate
30+instance Binary REF.RefType
31+instance Binary REF.Season
32+instance Binary STY.Agent
33+instance Binary STY.Formatted
src/Hakyll/Web/Pandoc/FileType.hs → lib/Hakyll/Web/Pandoc/FileType.hsrenamed

The content is the same.

lib/Hakyll/Web/Redirect.hsnew file+100
@@ -0,0 +1,100 @@
1+-- | Module used for generating HTML redirect pages. This allows renaming pages
2+-- to avoid breaking existing links without requiring server-side support for
3+-- formal 301 Redirect error codes
4+module Hakyll.Web.Redirect
5+ ( Redirect (..)
6+ , createRedirects
7+ ) where
8+
9+import Control.Applicative ((<$>))
10+import Control.Monad (forM_, when)
11+import Data.Binary (Binary (..))
12+import Data.List (sort, group)
13+import Hakyll.Core.Compiler
14+import Hakyll.Core.Identifier
15+import Hakyll.Core.Routes
16+import Hakyll.Core.Rules
17+import Hakyll.Core.Writable (Writable (..))
18+
19+-- | This function exposes a higher-level interface compared to using the
20+-- 'Redirect' type manually.
21+--
22+-- This creates, using a database mapping broken URLs to working ones, HTML
23+-- files which will do HTML META tag redirect pages (since, as a static site, we
24+-- can't use web-server-level 301 redirects, and using JS is gross).
25+--
26+-- This is useful for sending people using old URLs to renamed versions, dealing
27+-- with common typos etc, and will increase site traffic. Such broken URLs can
28+-- be found by looking at server logs or by using Google Webmaster Tools.
29+-- Broken URLs must be valid Haskell strings, non-URL-escaped valid POSIX
30+-- filenames, and relative links, since they will be defined in a @hakyll.hs@
31+-- and during generation, written to disk with the filename corresponding to the
32+-- broken URLs. (Target URLs can be absolute or relative, but should be
33+-- URL-escaped.) So broken incoming links like <http://www.gwern.net/foo/> which
34+-- should be <http://www.gwern.net/foobar> cannot be fixed (since you cannot
35+-- create a HTML file named @"foo/"@ on disk, as that would be a directory).
36+--
37+-- An example of a valid association list would be:
38+--
39+-- > brokenLinks =
40+-- > [ ("projects.html", "http://github.com/gwern")
41+-- > , ("/Black-market archive", "Black-market%20archives")
42+-- > ]
43+--
44+-- In which case the functionality can then be used in `main` with a line like:
45+--
46+-- > version "redirects" $ createRedirects brokenLinks
47+--
48+-- The 'version' is recommended to separate these items from your other pages.
49+--
50+-- The on-disk files can then be uploaded with HTML mimetypes
51+-- (either explicitly by generating and uploading them separately, by
52+-- auto-detection of the filetype, or an upload tool defaulting to HTML
53+-- mimetype, such as calling @s3cmd@ with @--default-mime-type=text/html@) and
54+-- will redirect browsers and search engines going to the old/broken URLs.
55+--
56+-- See also <https://groups.google.com/d/msg/hakyll/sWc6zxfh-uM/fUpZPsFNDgAJ>.
57+createRedirects :: [(Identifier, String)] -> Rules ()
58+createRedirects redirects =
59+ do -- redirects are many-to-fewer; keys must be unique, and must point somewhere else:
60+ let gkeys = group $ sort $ map fst redirects
61+ forM_ gkeys $ \gkey -> case gkey of
62+ (k : _ : _) -> fail $
63+ "Duplicate 301 redirects; " ++ show k ++ " is ambiguous."
64+ _ -> return ()
65+
66+ forM_ redirects $ \(r, t) ->
67+ when (toFilePath r == t) $ fail $
68+ "Self-redirect detected: " ++ show r ++ " points to itself."
69+
70+ forM_ redirects $ \(ident, to) ->
71+ create [ident] $ do
72+ route idRoute
73+ compile $ makeItem $! Redirect to
74+
75+-- | This datatype can be used directly if you want a lower-level interface to
76+-- generate redirects. For example, if you want to redirect @foo.html@ to
77+-- @bar.jpg@, you can use:
78+--
79+-- > create ["foo.html"] $ do
80+-- > route idRoute
81+-- > compile $ makeItem $ Redirect "bar.jpg"
82+data Redirect = Redirect
83+ { redirectTo :: String
84+ } deriving (Eq, Ord, Show)
85+
86+instance Binary Redirect where
87+ put (Redirect to) = put to
88+ get = Redirect <$> get
89+
90+instance Writable Redirect where
91+ write path = write path . fmap redirectToHtml
92+
93+redirectToHtml :: Redirect -> String
94+redirectToHtml (Redirect working) =
95+ "<!DOCTYPE html><html><head><meta charset=\"utf-8\"/><meta name=\"generator\" content=\"hakyll\"/>" ++
96+ "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">" ++
97+ "<meta http-equiv=\"refresh\" content=\"0; url=" ++ working ++
98+ "\"><link rel=\"canonical\" href=\"" ++ working ++
99+ "\"><title>Permanent Redirect</title></head><body><p>The page has moved to: <a href=\"" ++ working ++
100+ "\">this page</a></p></body></html>"
src/Hakyll/Web/Tags.hs → lib/Hakyll/Web/Tags.hsrenamed+2−1
@@ -43,6 +43,7 @@
4343module Hakyll.Web.Tags
4444 ( Tags (..)
4545 , getTags
46+ , getCategory
4647 , buildTagsWith
4748 , buildTags
4849 , buildCategories
@@ -112,7 +113,7 @@ getTags identifier = do
112113
113114
114115--------------------------------------------------------------------------------
115−-- | Obtain categories from a page.
116+-- | Obtain category from a page.
116117getCategory :: MonadMetadata m => Identifier -> m [String]
117118getCategory = return . return . takeBaseName . takeDirectory . toFilePath
118119
src/Hakyll/Web/Template.hs → lib/Hakyll/Web/Template.hsrenamed+24
@@ -138,6 +138,7 @@
138138-- > 3...2...1
139139-- > </p>
140140--
141+{-# LANGUAGE TemplateHaskell #-}
141142module Hakyll.Web.Template
142143 ( Template
143144 , templateBodyCompiler
@@ -146,9 +147,32 @@ module Hakyll.Web.Template
146147 , loadAndApplyTemplate
147148 , applyAsTemplate
148149 , readTemplate
150+ , compileTemplateItem
149151 , unsafeReadTemplateFile
152+ , embedTemplate
150153 ) where
151154
152155
153156--------------------------------------------------------------------------------
154157import Hakyll.Web.Template.Internal
158+
159+
160+--------------------------------------------------------------------------------
161+import Data.FileEmbed (embedFile)
162+import qualified Data.Text as T
163+import qualified Data.Text.Encoding as T
164+import Language.Haskell.TH (Exp, Q)
165+
166+
167+--------------------------------------------------------------------------------
168+-- | Embed template allows you embed a template within the Haskell binary.
169+-- Example:
170+--
171+-- > myTemplate :: Template
172+-- > myTemplate = $(embedTemplate "test.html")
173+embedTemplate :: FilePath -> Q Exp
174+embedTemplate filePath = [|
175+ let source = T.unpack $ T.decodeUtf8 $(embedFile filePath) in
176+ case parseTemplateElemsFile filePath source of
177+ Left err -> error err
178+ Right tpl -> template filePath tpl |]
src/Hakyll/Web/Template/Context.hs → lib/Hakyll/Web/Template/Context.hsrenamed+135−33
@@ -1,6 +1,27 @@
1+-- | This module provides 'Context's which are used to expand expressions in
2+-- templates and allow for arbitrary customisation.
3+--
4+-- 'Template's define a small expression DSL which consists of strings,
5+-- identifiers and function application. There is no type system, every value is
6+-- a string and on the top level they get substituted verbatim into the page.
7+--
8+-- For example, you can build a context that contains
9+--
10+-- > … <> functionField "concat" (const . concat) <> …
11+--
12+-- which will allow you to use the @concat@ identifier as a function that takes
13+-- arbitrarily many stings and concatenates them to a new string:
14+--
15+-- > $partial(concat("templates/categories/", category))$
16+--
17+-- This will evaluate the @category@ field in the context, then prepend he path,
18+-- and include the referenced file as a template.
19+
20+
121--------------------------------------------------------------------------------
222{-# LANGUAGE CPP #-}
323{-# LANGUAGE ExistentialQuantification #-}
24+{-# LANGUAGE RankNTypes #-}
425module Hakyll.Web.Template.Context
526 ( ContextField (..)
627 , Context (..)
@@ -28,13 +49,17 @@ module Hakyll.Web.Template.Context
2849 , teaserField
2950 , teaserFieldWithSeparator
3051 , missingField
52+ , bindItem
3153 ) where
3254
3355
3456--------------------------------------------------------------------------------
3557import Control.Applicative (Alternative (..))
3658import Control.Monad (msum)
37−import Data.List (intercalate)
59+import Data.List (intercalate, tails)
60+#if MIN_VERSION_base(4,9,0)
61+import Data.Semigroup (Semigroup (..))
62+#endif
3863import Data.Time.Clock (UTCTime (..))
3964import Data.Time.Format (formatTime)
4065import qualified Data.Time.Format as TF
@@ -47,13 +72,16 @@ import Hakyll.Core.Metadata
4772import Hakyll.Core.Provider
4873import Hakyll.Core.Util.String (needlePrefix, splitAll)
4974import Hakyll.Web.Html
50−import System.FilePath (splitDirectories, takeBaseName)
75+import Prelude hiding (id)
76+import System.FilePath (dropExtension, splitDirectories,
77+ takeBaseName)
5178
5279
5380--------------------------------------------------------------------------------
5481-- | Mostly for internal usage
5582data ContextField
56− = StringField String
83+ = EmptyField
84+ | StringField String
5785 | forall a. ListField (Context a) [Item a]
5886
5987
@@ -78,71 +106,123 @@ newtype Context a = Context
78106
79107
80108--------------------------------------------------------------------------------
109+-- | Tries to find a key in the left context,
110+-- or when that fails in the right context.
111+#if MIN_VERSION_base(4,9,0)
112+instance Semigroup (Context a) where
113+ (<>) (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
114+
115+instance Monoid (Context a) where
116+ mempty = missingField
117+ mappend = (<>)
118+#else
81119instance Monoid (Context a) where
82120 mempty = missingField
83121 mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
122+#endif
84123
85124
86125--------------------------------------------------------------------------------
87126field' :: String -> (Item a -> Compiler ContextField) -> Context a
88−field' key value = Context $ \k _ i -> if k == key then value i else empty
127+field' key value = Context $ \k _ i ->
128+ if k == key
129+ then value i
130+ else noResult $ "Tried field " ++ key
89131
90132
91133--------------------------------------------------------------------------------
92−-- | Constructs a new field in the 'Context.'
134+-- | Constructs a new field for a 'Context'.
135+-- If the key matches, the compiler is run and its result is substituted in the
136+-- template.
137+--
138+-- If the compiler fails, the field will be considered non-existent
139+-- in an @$if()$@ macro or ultimately break the template application
140+-- (unless the key is found in another context when using '<>').
141+-- Use 'empty' or 'noResult' for intentional failures of fields used in
142+-- @$if()$@, to distinguish them from exceptions thrown with 'fail'.
93143field
94144 :: String -- ^ Key
95145 -> (Item a -> Compiler String) -- ^ Function that constructs a value based
96− -- on the item
146+ -- on the item (e.g. accessing metadata)
97147 -> Context a
98148field key value = field' key (fmap StringField . value)
99149
100150
101151--------------------------------------------------------------------------------
102152-- | Creates a 'field' to use with the @$if()$@ template macro.
153+-- Attempting to substitute the field into the template will cause an error.
103154boolField
104155 :: String
105156 -> (Item a -> Bool)
106157 -> Context a
107−boolField name f = field name (\i -> if f i
108− then pure (error $ unwords ["no string value for bool field:",name])
109− else empty)
158+boolField name f = field' name (\i -> if f i
159+ then return EmptyField
160+ else noResult $ "Field " ++ name ++ " is false")
110161
111162
112163--------------------------------------------------------------------------------
113−-- | Creates a 'field' that does not depend on the 'Item'
114−constField :: String -> String -> Context a
164+-- | Creates a 'field' that does not depend on the 'Item' but always yields
165+-- the same string
166+constField :: String -- ^ Key
167+ -> String -- ^ Value
168+ -> Context a
115169constField key = field key . const . return
116170
117171
118172--------------------------------------------------------------------------------
173+-- | Creates a list field to be consumed by a @$for(…)$@ expression.
174+-- The compiler returns multiple items which are rendered in the loop body
175+-- with the supplied context.
119176listField :: String -> Context a -> Compiler [Item a] -> Context b
120177listField key c xs = listFieldWith key c (const xs)
121178
122179
123180--------------------------------------------------------------------------------
181+-- | Produces a new 'Context' which has list field 'key'. All fields from
182+-- 'c' are also accessible from the produced context.
183+-- Be careful when doing @listFieldWith k ca f <> cb@ as any fields in @ca@
184+-- will override fields in @cb@ with the same name.
185+-- Creates a list field like 'listField', but supplies the current page
186+-- to the compiler.
124187listFieldWith
125188 :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b
126189listFieldWith key c f = field' key $ fmap (ListField c) . f
127190
128191
129192--------------------------------------------------------------------------------
130−functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a
193+-- | Creates a variadic function field.
194+--
195+-- The function will be called with the dynamically evaluated string arguments
196+-- from the template as well as the page that is currently rendered.
197+functionField :: String -- ^ Key
198+ -> ([String] -> Item a -> Compiler String) -- ^ Function
199+ -> Context a
131200functionField name value = Context $ \k args i ->
132201 if k == name
133202 then StringField <$> value args i
134− else empty
203+ else noResult $ "Tried function field " ++ name
135204
136205
137206--------------------------------------------------------------------------------
207+-- | Transform the respective string results of all fields in a context.
208+-- For example,
209+--
210+-- > mapContext (++"c") (constField "x" "a" <> constField "y" "b")
211+--
212+-- is equivalent to
213+--
214+-- > constField "x" "ac" <> constField "y" "bc"
215+--
138216mapContext :: (String -> String) -> Context a -> Context a
139217mapContext f (Context c) = Context $ \k a i -> do
140218 fld <- c k a i
141219 case fld of
220+ EmptyField -> wrongType "boolField"
142221 StringField str -> return $ StringField (f str)
143− ListField _ _ -> fail $
144− "Hakyll.Web.Template.Context.mapContext: " ++
145− "can't map over a ListField!"
222+ _ -> wrongType "ListField"
223+ where
224+ wrongType typ = fail $ "Hakyll.Web.Template.Context.mapContext: " ++
225+ "can't map over a " ++ typ ++ "!"
146226
147227--------------------------------------------------------------------------------
148228-- | A context that allows snippet inclusion. In processed file, use as:
@@ -151,15 +231,15 @@ mapContext f (Context c) = Context $ \k a i -> do
151231-- > $snippet("path/to/snippet/")$
152232-- > ...
153233--
154−-- The contents of the included file will not be interpolated.
234+-- The contents of the included file will not be interpolated like @partial@
235+-- does it.
155236--
156237snippetField :: Context String
157238snippetField = functionField "snippet" f
158239 where
159240 f [contentsPath] _ = loadBody (fromFilePath contentsPath)
160− f _ i = error $
161− "Too many arguments to function 'snippet()' in item " ++
162− show (itemIdentifier i)
241+ f [] _ = fail "No argument to function 'snippet()'"
242+ f _ _ = fail "Too many arguments to function 'snippet()'"
163243
164244--------------------------------------------------------------------------------
165245-- | A context that contains (in that order)
@@ -179,8 +259,7 @@ defaultContext =
179259 metadataField `mappend`
180260 urlField "url" `mappend`
181261 pathField "path" `mappend`
182− titleField "title" `mappend`
183− missingField
262+ titleField "title"
184263
185264
186265--------------------------------------------------------------------------------
@@ -198,15 +277,20 @@ bodyField key = field key $ return . itemBody
198277-- | Map any field to its metadata value, if present
199278metadataField :: Context a
200279metadataField = Context $ \k _ i -> do
201− value <- getMetadataField (itemIdentifier i) k
202− maybe empty (return . StringField) value
280+ let id = itemIdentifier i
281+ empty' = noResult $ "No '" ++ k ++ "' field in metadata " ++
282+ "of item " ++ show id
283+ value <- getMetadataField id k
284+ maybe empty' (return . StringField) value
203285
204286
205287--------------------------------------------------------------------------------
206288-- | Absolute url to the resulting item
207289urlField :: String -> Context a
208−urlField key = field key $
209− fmap (maybe empty toUrl) . getRoute . itemIdentifier
290+urlField key = field key $ \i -> do
291+ let id = itemIdentifier i
292+ empty' = fail $ "No route url found for item " ++ show id
293+ fmap (maybe empty' toUrl) $ getRoute id
210294
211295
212296--------------------------------------------------------------------------------
@@ -257,6 +341,12 @@ titleField = mapContext takeBaseName . pathField
257341-- that begins with @yyyy-mm-dd@ . For example:
258342-- @folder//yyyy-mm-dd-title//dist//main.extension@ .
259343-- In case of multiple matches, the rightmost one is used.
344+--
345+-- As another alternative, if none of the above matches, and the file has a
346+-- path which contains nested directories specifying a date, then that date
347+-- will be used. In other words, if the path is of the form
348+-- @**//yyyy//mm//dd//**//main.extension@ .
349+-- As above, in case of multiple matches, the rightmost one is used.
260350
261351dateField :: String -- ^ Key in which the rendered date should be placed
262352 -> String -- ^ Format to use on the date
@@ -267,7 +357,7 @@ dateField = dateFieldWith defaultTimeLocale
267357--------------------------------------------------------------------------------
268358-- | This is an extended version of 'dateField' that allows you to
269359-- specify a time locale that is used for outputting the date. For more
270−-- details, see 'dateField'.
360+-- details, see 'dateField' and 'formatTime'.
271361dateFieldWith :: TimeLocale -- ^ Output time locale
272362 -> String -- ^ Destination key
273363 -> String -- ^ Format to use on the date
@@ -288,12 +378,13 @@ getItemUTC :: MonadMetadata m
288378getItemUTC locale id' = do
289379 metadata <- getMetadata id'
290380 let tryField k fmt = lookupString k metadata >>= parseTime' fmt
291− paths = splitDirectories $ toFilePath id'
381+ paths = splitDirectories $ (dropExtension . toFilePath) id'
292382
293383 maybe empty' return $ msum $
294384 [tryField "published" fmt | fmt <- formats] ++
295385 [tryField "date" fmt | fmt <- formats] ++
296− [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fnCand | fnCand <- reverse paths]
386+ [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fnCand | fnCand <- reverse paths] ++
387+ [parseTime' "%Y-%m-%d" $ intercalate "-" $ fnCand | fnCand <- map (take 3) $ reverse . tails $ paths]
297388 where
298389 empty' = fail $ "Hakyll.Web.Template.Context.getItemUTC: " ++
299390 "could not parse time for " ++ show id'
@@ -321,13 +412,16 @@ getItemModificationTime identifier = do
321412
322413
323414--------------------------------------------------------------------------------
415+-- | Creates a field with the last modification date of the underlying item.
324416modificationTimeField :: String -- ^ Key
325417 -> String -- ^ Format
326− -> Context a -- ^ Resuting context
418+ -> Context a -- ^ Resulting context
327419modificationTimeField = modificationTimeFieldWith defaultTimeLocale
328420
329421
330422--------------------------------------------------------------------------------
423+-- | Creates a field with the last modification date of the underlying item
424+-- in a custom localisation format (see 'formatTime').
331425modificationTimeFieldWith :: TimeLocale -- ^ Time output locale
332426 -> String -- ^ Key
333427 -> String -- ^ Format
@@ -366,10 +460,11 @@ teaserFieldWithSeparator separator key snapshot = field key $ \item -> do
366460
367461
368462--------------------------------------------------------------------------------
463+-- | Constantly reports any field as missing. Mostly for internal usage,
464+-- it is the last choice in every context used in a template application.
369465missingField :: Context a
370−missingField = Context $ \k _ i -> fail $
371− "Missing field $" ++ k ++ "$ in context for item " ++
372− show (itemIdentifier i)
466+missingField = Context $ \k _ _ -> noResult $
467+ "Missing field '" ++ k ++ "' in context"
373468
374469parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
375470#if MIN_VERSION_time(1,5,0)
@@ -377,3 +472,10 @@ parseTimeM = TF.parseTimeM
377472#else
378473parseTimeM _ = TF.parseTime
379474#endif
475+
476+--------------------------------------------------------------------------------
477+
478+-- | Binds an 'Item' to a given 'Context', allowing it to be combined with any
479+-- other 'Context' of any type.
480+bindItem :: Context a -> Item a -> forall b. Context b
481+bindItem (Context ctx) ia = Context $ \k args _ -> ctx k args ia
src/Hakyll/Web/Template/Internal.hs → lib/Hakyll/Web/Template/Internal.hsrenamed+103−45
@@ -1,15 +1,18 @@
1+{-# LANGUAGE DeriveAnyClass #-}
2+{-# LANGUAGE DeriveGeneric #-}
13{-# LANGUAGE GeneralizedNewtypeDeriving #-}
24{-# LANGUAGE ScopedTypeVariables #-}
5+
36module Hakyll.Web.Template.Internal
47 ( Template (..)
58 , template
69 , templateBodyCompiler
710 , templateCompiler
811 , applyTemplate
9− , applyTemplate'
1012 , loadAndApplyTemplate
1113 , applyAsTemplate
1214 , readTemplate
15+ , compileTemplateItem
1316 , unsafeReadTemplateFile
1417
1518 , module Hakyll.Web.Template.Internal.Element
@@ -18,16 +21,19 @@ module Hakyll.Web.Template.Internal
1821
1922
2023--------------------------------------------------------------------------------
21−import Control.Monad.Except (MonadError (..))
24+import Control.Monad (forM)
25+import Control.Monad.Except (MonadError (..), catchError)
2226import Data.Binary (Binary)
2327import Data.List (intercalate)
28+import qualified Data.List.NonEmpty as NonEmpty
2429import Data.Typeable (Typeable)
2530import GHC.Exts (IsString (..))
26−import Prelude hiding (id)
31+import GHC.Generics (Generic)
2732
2833
2934--------------------------------------------------------------------------------
3035import Hakyll.Core.Compiler
36+import Hakyll.Core.Compiler.Internal
3137import Hakyll.Core.Identifier
3238import Hakyll.Core.Item
3339import Hakyll.Core.Writable
@@ -38,9 +44,10 @@ import Hakyll.Web.Template.Internal.Trim
3844
3945--------------------------------------------------------------------------------
4046-- | Datatype used for template substitutions.
41−newtype Template = Template
42− { unTemplate :: [TemplateElement]
43− } deriving (Show, Eq, Binary, Typeable)
47+data Template = Template
48+ { tplElements :: [TemplateElement]
49+ , tplOrigin :: FilePath -- Only for error messages.
50+ } deriving (Show, Eq, Generic, Binary, Typeable)
4451
4552
4653--------------------------------------------------------------------------------
@@ -56,39 +63,68 @@ instance IsString Template where
5663
5764--------------------------------------------------------------------------------
5865-- | Wrap the constructor to ensure trim is called.
59−template :: [TemplateElement] -> Template
60−template = Template . trim
66+template :: FilePath -> [TemplateElement] -> Template
67+template p = flip Template p . trim
6168
6269
6370--------------------------------------------------------------------------------
71+-- | Parse a string into a template.
72+-- You should prefer 'compileTemplateItem' over this.
6473readTemplate :: String -> Template
65−readTemplate = Template . trim . readTemplateElems
74+readTemplate = either error (template origin) . parseTemplateElemsFile origin
75+ where
76+ origin = "{literal}"
77+{-# DEPRECATED readTemplate "Use templateCompiler instead" #-}
78+
79+--------------------------------------------------------------------------------
80+-- | Parse an item body into a template.
81+-- Provides useful error messages in the 'Compiler' monad.
82+compileTemplateItem :: Item String -> Compiler Template
83+compileTemplateItem item = let file = itemIdentifier item
84+ in compileTemplateFile file (itemBody item)
85+
86+--------------------------------------------------------------------------------
87+compileTemplateFile :: Identifier -> String -> Compiler Template
88+compileTemplateFile file = either fail (return . template origin)
89+ . parseTemplateElemsFile origin
90+ where
91+ origin = show file
6692
6793--------------------------------------------------------------------------------
6894-- | Read a template, without metadata header
6995templateBodyCompiler :: Compiler (Item Template)
7096templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do
7197 item <- getResourceBody
72− file <- getResourceFilePath
73− return $ fmap (template . readTemplateElemsFile file) item
98+ file <- getUnderlying
99+ withItemBody (compileTemplateFile file) item
74100
75101--------------------------------------------------------------------------------
76102-- | Read complete file contents as a template
77103templateCompiler :: Compiler (Item Template)
78104templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do
79105 item <- getResourceString
80− file <- getResourceFilePath
81− return $ fmap (template . readTemplateElemsFile file) item
106+ file <- getUnderlying
107+ withItemBody (compileTemplateFile file) item
82108
83109
84110--------------------------------------------------------------------------------
111+-- | Interpolate template expressions from context values in a page
85112applyTemplate :: Template -- ^ Template
86113 -> Context a -- ^ Context
87114 -> Item a -- ^ Page
88115 -> Compiler (Item String) -- ^ Resulting item
89116applyTemplate tpl context item = do
90− body <- applyTemplate' (unTemplate tpl) context item
117+ body <- applyTemplate' (tplElements tpl) context item `catchError` handler
91118 return $ itemSetBody body item
119+ where
120+ tplName = tplOrigin tpl
121+ itemName = show $ itemIdentifier item
122+ handler es = fail $ "Hakyll.Web.Template.applyTemplate: Failed to " ++
123+ (if tplName == itemName
124+ then "interpolate template in item " ++ itemName
125+ else "apply template " ++ tplName ++ " to item " ++ itemName) ++
126+ ":\n" ++ intercalate ",\n" es
127+
92128
93129
94130--------------------------------------------------------------------------------
@@ -105,9 +141,6 @@ applyTemplate' tes context x = go tes
105141
106142 go = fmap concat . mapM applyElem
107143
108− trimError = error $ "Hakyll.Web.Template.applyTemplate: template not " ++
109− "fully trimmed."
110−
111144 ---------------------------------------------------------------------------
112145
113146 applyElem :: TemplateElement -> Compiler String
@@ -118,29 +151,43 @@ applyTemplate' tes context x = go tes
118151
119152 applyElem (Chunk c) = return c
120153
121− applyElem (Expr e) = applyExpr e >>= getString e
154+ applyElem (Expr e) = withErrorMessage evalMsg (applyStringExpr typeMsg e)
155+ where
156+ evalMsg = "In expr '$" ++ show e ++ "$'"
157+ typeMsg = "expr '$" ++ show e ++ "$'"
122158
123159 applyElem Escaped = return "$"
124160
125− applyElem (If e t mf) = (applyExpr e >> go t) `catchError` handler
161+ applyElem (If e t mf) = compilerTry (applyExpr e) >>= handle
126162 where
127− handler _ = case mf of
128− Nothing -> return ""
129− Just f -> go f
130−
131− applyElem (For e b s) = applyExpr e >>= \cf -> case cf of
132− StringField _ -> fail $
133− "Hakyll.Web.Template.applyTemplateWith: expected ListField but " ++
134− "got StringField for expr " ++ show e
135− ListField c xs -> do
163+ f = maybe (return "") go mf
164+ handle (Right _) = go t
165+ handle (Left (CompilationNoResult _)) = f
166+ handle (Left (CompilationFailure es)) = debug (NonEmpty.toList es) >> f
167+ debug = compilerDebugEntries ("Hakyll.Web.Template.applyTemplate: " ++
168+ "[ERROR] in 'if' condition on expr '" ++ show e ++ "':")
169+
170+ applyElem (For e b s) = withErrorMessage headMsg (applyExpr e) >>= \cf -> case cf of
171+ EmptyField -> expected "list" "boolean" typeMsg
172+ StringField _ -> expected "list" "string" typeMsg
173+ ListField c xs -> withErrorMessage bodyMsg $ do
136174 sep <- maybe (return "") go s
137− bs <- mapM (applyTemplate' b c) xs
175+ bs <- forM xs $ applyTemplate' b $ c <> bindItem context x
138176 return $ intercalate sep bs
139−
140− applyElem (Partial e) = do
141− p <- applyExpr e >>= getString e
142− Template tpl' <- loadBody (fromFilePath p)
143− applyTemplate' tpl' context x
177+ where
178+ headMsg = "In expr '$for(" ++ show e ++ ")$'"
179+ typeMsg = "loop expr '" ++ show e ++ "'"
180+ bodyMsg = "In loop context of '$for(" ++ show e ++ ")$'"
181+
182+ applyElem (Partial e) = withErrorMessage headMsg $
183+ applyStringExpr typeMsg e >>= \p ->
184+ withErrorMessage inclMsg $ do
185+ tpl' <- loadBody (fromFilePath p)
186+ itemBody <$> applyTemplate tpl' context x
187+ where
188+ headMsg = "In expr '$partial(" ++ show e ++ ")$'"
189+ typeMsg = "partial expr '" ++ show e ++ "'"
190+ inclMsg = "In inclusion of '$partial(" ++ show e ++ ")$'"
144191
145192 ---------------------------------------------------------------------------
146193
@@ -149,17 +196,29 @@ applyTemplate' tes context x = go tes
149196 applyExpr (Ident (TemplateKey k)) = context' k [] x
150197
151198 applyExpr (Call (TemplateKey k) args) = do
152− args' <- mapM (\e -> applyExpr e >>= getString e) args
199+ args' <- mapM (\e -> applyStringExpr (typeMsg e) e) args
153200 context' k args' x
201+ where
202+ typeMsg e = "argument '" ++ show e ++ "'"
154203
155204 applyExpr (StringLiteral s) = return (StringField s)
156205
157206 ----------------------------------------------------------------------------
158207
159− getString _ (StringField s) = return s
160− getString e (ListField _ _) = fail $
161− "Hakyll.Web.Template.applyTemplateWith: expected StringField but " ++
162− "got ListField for expr " ++ show e
208+ applyStringExpr :: String -> TemplateExpr -> Compiler String
209+ applyStringExpr msg expr =
210+ applyExpr expr >>= getString
211+ where
212+ getString EmptyField = expected "string" "boolean" msg
213+ getString (StringField s) = return s
214+ getString (ListField _ _) = expected "string" "list" msg
215+
216+ expected typ act expr = fail $ unwords ["Hakyll.Web.Template.applyTemplate:",
217+ "expected", typ, "but got", act, "for", expr]
218+
219+ -- expected to never happen with all templates constructed by 'template'
220+ trimError = fail $
221+ "Hakyll.Web.Template.applyTemplate: template not fully trimmed."
163222
164223
165224--------------------------------------------------------------------------------
@@ -189,15 +248,14 @@ loadAndApplyTemplate identifier context item = do
189248applyAsTemplate :: Context String -- ^ Context
190249 -> Item String -- ^ Item and template
191250 -> Compiler (Item String) -- ^ Resulting item
192−applyAsTemplate context item =
193− let tpl = template $ readTemplateElemsFile file (itemBody item)
194− file = toFilePath $ itemIdentifier item
195− in applyTemplate tpl context item
251+applyAsTemplate context item = do
252+ tpl <- compileTemplateItem item
253+ applyTemplate tpl context item
196254
197255
198256--------------------------------------------------------------------------------
199257unsafeReadTemplateFile :: FilePath -> Compiler Template
200258unsafeReadTemplateFile file = do
201259 tpl <- unsafeCompiler $ readFile file
202− pure $ template $ readTemplateElemsFile file tpl
203−
260+ compileTemplateFile (fromFilePath file) tpl
261+{-# DEPRECATED unsafeReadTemplateFile "Use templateCompiler" #-}
src/Hakyll/Web/Template/Internal/Element.hs → lib/Hakyll/Web/Template/Internal/Element.hsrenamed+7−14
@@ -7,14 +7,14 @@ module Hakyll.Web.Template.Internal.Element
77 , TemplateExpr (..)
88 , TemplateElement (..)
99 , templateElems
10− , readTemplateElems
11− , readTemplateElemsFile
10+ , parseTemplateElemsFile
1211 ) where
1312
1413
1514--------------------------------------------------------------------------------
16−import Control.Applicative ((<|>))
15+import Control.Applicative ((<|>), (<*))
1716import Control.Monad (void)
17+import Control.Arrow (left)
1818import Data.Binary (Binary, get, getWord8, put, putWord8)
1919import Data.List (intercalate)
2020import Data.Maybe (isJust)
@@ -107,17 +107,10 @@ instance Binary TemplateExpr where
107107 2 -> StringLiteral <$> get
108108 _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
109109
110−
111−--------------------------------------------------------------------------------
112−readTemplateElems :: String -> [TemplateElement]
113−readTemplateElems = readTemplateElemsFile "{literal}"
114−
115−
116110--------------------------------------------------------------------------------
117−readTemplateElemsFile :: FilePath -> String -> [TemplateElement]
118−readTemplateElemsFile file input = case P.parse templateElems file input of
119− Left err -> error $ "Cannot parse template: " ++ show err
120− Right t -> t
111+parseTemplateElemsFile :: FilePath -> String -> Either String [TemplateElement]
112+parseTemplateElemsFile file = left (\e -> "Cannot parse template " ++ show e)
113+ . P.parse (templateElems <* P.eof) file
121114
122115
123116--------------------------------------------------------------------------------
@@ -167,7 +160,7 @@ trimOpen = do
167160--------------------------------------------------------------------------------
168161trimClose :: P.Parser Bool
169162trimClose = do
170− trimIfR <- P.optionMaybe $ P.try (P.char '-')
163+ trimIfR <- P.optionMaybe $ (P.char '-')
171164 void $ P.char '$'
172165 pure $ isJust trimIfR
173166
src/Hakyll/Web/Template/Internal/Trim.hs → lib/Hakyll/Web/Template/Internal/Trim.hsrenamed

The content is the same.

src/Hakyll/Web/Template/List.hs → lib/Hakyll/Web/Template/List.hsrenamed

The content is the same.

src/Hakyll/Main.hsdeleted−110
@@ -1,110 +0,0 @@
1−--------------------------------------------------------------------------------
2−-- | Module providing the main hakyll function and command-line argument parsing
3−{-# LANGUAGE CPP #-}
4−{-# LANGUAGE DeriveDataTypeable #-}
5−module Hakyll.Main
6− ( hakyll
7− , hakyllWith
8− , hakyllWithExitCode
9− ) where
10−
11−
12−--------------------------------------------------------------------------------
13−import System.Environment (getProgName)
14−import System.IO.Unsafe (unsafePerformIO)
15−import System.Exit (ExitCode(ExitSuccess), exitWith)
16−
17−
18−--------------------------------------------------------------------------------
19−import Data.Monoid ((<>))
20−import Options.Applicative
21−
22−
23−--------------------------------------------------------------------------------
24−import qualified Hakyll.Check as Check
25−import qualified Hakyll.Commands as Commands
26−import qualified Hakyll.Core.Configuration as Config
27−import qualified Hakyll.Core.Logger as Logger
28−import Hakyll.Core.Rules
29−
30−
31−--------------------------------------------------------------------------------
32−-- | This usualy is the function with which the user runs the hakyll compiler
33−hakyll :: Rules a -> IO ()
34−hakyll = hakyllWith Config.defaultConfiguration
35−
36−--------------------------------------------------------------------------------
37−-- | A variant of 'hakyll' which allows the user to specify a custom
38−-- configuration
39−hakyllWith :: Config.Configuration -> Rules a -> IO ()
40−hakyllWith conf rules = hakyllWithExitCode conf rules >>= exitWith
41−
42−hakyllWithExitCode :: Config.Configuration -> Rules a -> IO ExitCode
43−hakyllWithExitCode conf rules = do
44− args' <- customExecParser (prefs showHelpOnError) (info (helper <*> optionParser conf) (fullDesc <> progDesc (progName ++ " - Static site compiler created with Hakyll")))
45− let args'' = optCommand args'
46−
47− let verbosity' = if verbosity args' then Logger.Debug else Logger.Message
48− check' =
49− if internal_links args'' then Check.InternalLinks else Check.All
50−
51− logger <- Logger.new verbosity'
52−
53− case args'' of
54− Build -> Commands.build conf logger rules
55− Check _ -> Commands.check conf logger check' >> ok
56− Clean -> Commands.clean conf logger >> ok
57− Deploy -> Commands.deploy conf
58− Preview p -> Commands.preview conf logger rules p >> ok
59− Rebuild -> Commands.rebuild conf logger rules
60− Server _ _ -> Commands.server conf logger (host args'') (port args'') >> ok
61− Watch _ p s -> Commands.watch conf logger (host args'') p (not s) rules >> ok
62− where
63− ok = return ExitSuccess
64−
65−
66−--------------------------------------------------------------------------------
67−
68−data Options = Options {verbosity :: Bool, optCommand :: Command}
69− deriving (Show)
70−
71−data Command
72− = Build
73− | Check {internal_links :: Bool}
74− | Clean
75− | Deploy
76− | Preview {port :: Int}
77− | Rebuild
78− | Server {host :: String, port :: Int}
79− | Watch {host :: String, port :: Int, no_server :: Bool }
80− deriving (Show)
81−
82−optionParser :: Config.Configuration -> Parser Options
83−optionParser conf = Options <$> verboseParser <*> (commandParser conf)
84− where
85− verboseParser = switch (long "verbose" <> short 'v' <> help "Run in verbose mode")
86−
87−
88−commandParser :: Config.Configuration -> Parser Command
89−commandParser conf = subparser $ foldr ((<>) . produceCommand) mempty commands
90− where
91− produceCommand (a,b) = command a (info (helper <*> (fst b)) (snd b))
92− portParser = option auto (long "port" <> help "Port to listen on" <> value (Config.previewPort conf))
93− hostParser = strOption (long "host" <> help "Host to bind on" <> value (Config.previewHost conf))
94− commands = [
95− ("build",(pure Build,fullDesc <> progDesc "Generate the site")),
96− ("check",(pure Check <*> switch (long "internal-links" <> help "Check internal links only"), fullDesc <> progDesc "Validate the site output")),
97− ("clean",(pure Clean,fullDesc <> progDesc "Clean up and remove cache")),
98− ("deploy",(pure Deploy,fullDesc <> progDesc "Upload/deploy your site")),
99− ("preview",(pure Preview <*> portParser,fullDesc <> progDesc "[DEPRECATED] Please use the watch command")),
100− ("rebuild",(pure Rebuild,fullDesc <> progDesc "Clean and build again")),
101− ("server",(pure Server <*> hostParser <*> portParser,fullDesc <> progDesc "Start a preview server")),
102− ("watch",(pure Watch <*> hostParser <*> portParser <*> switch (long "no-server" <> help "Disable the built-in web server"),fullDesc <> progDesc "Autocompile on changes and start a preview server. You can watch and recompile without running a server with --no-server."))
103− ]
104−
105−
106−--------------------------------------------------------------------------------
107−-- | This is necessary because not everyone calls their program the same...
108−progName :: String
109−progName = unsafePerformIO getProgName
110−{-# NOINLINE progName #-}
src/Hakyll/Web/CompressCss.hsdeleted−85
@@ -1,85 +0,0 @@
1−--------------------------------------------------------------------------------
2−-- | Module used for CSS compression. The compression is currently in a simple
3−-- state, but would typically reduce the number of bytes by about 25%.
4−module Hakyll.Web.CompressCss
5− ( compressCssCompiler
6− , compressCss
7− ) where
8−
9−
10−--------------------------------------------------------------------------------
11−import Data.List (isPrefixOf)
12−
13−
14−--------------------------------------------------------------------------------
15−import Hakyll.Core.Compiler
16−import Hakyll.Core.Item
17−
18−
19−--------------------------------------------------------------------------------
20−-- | Compiler form of 'compressCss'
21−compressCssCompiler :: Compiler (Item String)
22−compressCssCompiler = fmap compressCss <$> getResourceString
23−
24−
25−--------------------------------------------------------------------------------
26−-- | Compress CSS to speed up your site.
27−compressCss :: String -> String
28−compressCss = compressSeparators . stripComments . compressWhitespace
29−
30−
31−--------------------------------------------------------------------------------
32−-- | Compresses certain forms of separators.
33−compressSeparators :: String -> String
34−compressSeparators [] = []
35−compressSeparators str
36− | isConstant = head str : retainConstants compressSeparators (head str) (drop 1 str)
37− | stripFirst = compressSeparators (drop 1 str)
38− | stripSecond = compressSeparators (head str : (drop 2 str))
39− | otherwise = head str : compressSeparators (drop 1 str)
40− where
41− isConstant = or $ map (isOfPrefix str) ["\"", "'"]
42− stripFirst = or $ map (isOfPrefix str) [" ", " {", " }", " :", ";;", ";}"]
43− stripSecond = or $ map (isOfPrefix str) ["{ ", "} ", ": ", "; "]
44−
45−--------------------------------------------------------------------------------
46−-- | Compresses all whitespace.
47−compressWhitespace :: String -> String
48−compressWhitespace [] = []
49−compressWhitespace str
50− | isConstant = head str : retainConstants compressWhitespace (head str) (drop 1 str)
51− | replaceOne = compressWhitespace (' ' : (drop 1 str))
52− | replaceTwo = compressWhitespace (' ' : (drop 2 str))
53− | otherwise = head str : compressWhitespace (drop 1 str)
54− where
55− isConstant = or $ map (isOfPrefix str) ["\"", "'"]
56− replaceOne = or $ map (isOfPrefix str) ["\t", "\n", "\r"]
57− replaceTwo = or $ map (isOfPrefix str) [" \t", " \n", " \r", " "]
58−
59−--------------------------------------------------------------------------------
60−-- | Function that strips CSS comments away.
61−stripComments :: String -> String
62−stripComments [] = []
63−stripComments str
64− | isConstant = head str : retainConstants stripComments (head str) (drop 1 str)
65− | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str
66− | otherwise = head str : stripComments (drop 1 str)
67− where
68− isConstant = or $ map (isOfPrefix str) ["\"", "'"]
69− eatComments str'
70− | null str' = []
71− | isPrefixOf "*/" str' = drop 2 str'
72− | otherwise = eatComments $ drop 1 str'
73−
74−--------------------------------------------------------------------------------
75−-- | Helper function to handle string constants correctly.
76−retainConstants :: (String -> String) -> Char -> String -> String
77−retainConstants f delim str
78− | null str = []
79− | isPrefixOf [delim] str = head str : f (drop 1 str)
80− | otherwise = head str : retainConstants f delim (drop 1 str)
81−
82−--------------------------------------------------------------------------------
83−-- | Helper function to determine whether a string is a substring.
84−isOfPrefix :: String -> String -> Bool
85−isOfPrefix = flip isPrefixOf
src/Hakyll/Init.hs → src/Init.hsrenamed+44−17
@@ -6,12 +6,12 @@ module Main
66
77--------------------------------------------------------------------------------
88import Control.Arrow (first)
9−import Control.Monad (forM_)
9+import Control.Monad (forM, forM_)
1010import Data.Char (isAlphaNum, isNumber)
11−import Data.List (foldl')
12−import Data.List (intercalate, isPrefixOf)
11+import Data.List (foldl', intercalate, isPrefixOf)
1312import Data.Version (Version (..))
14−import System.Directory (canonicalizePath, copyFile)
13+import System.Directory (canonicalizePath, copyFile,
14+ doesFileExist)
1515import System.Environment (getArgs, getProgName)
1616import System.Exit (exitFailure)
1717import System.FilePath (splitDirectories, (</>))
@@ -22,6 +22,10 @@ import Hakyll.Core.Util.File
2222import Paths_hakyll
2323
2424
25+--------------------------------------------------------------------------------
26+import Prelude
27+
28+
2529--------------------------------------------------------------------------------
2630main :: IO ()
2731main = do
@@ -37,21 +41,44 @@ main = do
3741 -- If dstDir begins with hyphens, the guard will prevent it from creating
3842 -- directory with that name so we can fall to the second alternative
3943 -- which prints a usage info for user.
40− [dstDir] | not ("-" `isPrefixOf` dstDir) -> do
41− forM_ files $ \file -> do
42− let dst = dstDir </> file
43− src = srcDir </> file
44− putStrLn $ "Creating " ++ dst
45− makeDirectories dst
46− copyFile src dst
44+ [dstDir] | not ("-" `isPrefixOf` dstDir) ->
45+ createFiles False srcDir files dstDir
46+ ["-f", dstDir] ->
47+ createFiles True srcDir files dstDir
48+ _ -> do
49+ putStrLn $ "Usage: " ++ progName ++ "[-f] <directory>"
50+ exitFailure
4751
52+ where
53+ createFiles force srcDir files dstDir = do
4854 name <- makeName dstDir
4955 let cabalPath = dstDir </> name ++ ".cabal"
50− putStrLn $ "Creating " ++ cabalPath
51− createCabal cabalPath name
52− _ -> do
53− putStrLn $ "Usage: " ++ progName ++ " <directory>"
54− exitFailure
56+
57+ diff <- if force then return []
58+ else existingFiles dstDir (cabalPath : files)
59+
60+ case diff of
61+ [] -> do
62+ forM_ files $ \file -> do
63+ let dst = dstDir </> file
64+ src = srcDir </> file
65+ putStrLn $ "Creating " ++ dst
66+ makeDirectories dst
67+ copyFile src dst
68+
69+ putStrLn $ "Creating " ++ cabalPath
70+ createCabal cabalPath name
71+ fs -> do
72+ putStrLn $ "The following files will be overwritten:"
73+ mapM_ putStrLn fs
74+ putStrLn $ "Use -f to overwrite them"
75+ exitFailure
76+
77+existingFiles :: FilePath -> [FilePath] -> IO [FilePath]
78+existingFiles dstDir files = fmap concat $ forM files $ \file -> do
79+ let dst = dstDir </> file
80+ exists <- doesFileExist dst
81+ return $ if exists then [dst] else []
5582
5683-- | Figure out a good cabal package name from the given (existing) directory
5784-- name
@@ -77,7 +104,7 @@ makeName dstDir = do
77104 safeLast = foldl' (\_ x -> Just x) Nothing
78105
79106createCabal :: FilePath -> String -> IO ()
80−createCabal path name = do
107+createCabal path name =
81108 writeFile path $ unlines [
82109 "name: " ++ name
83110 , "version: 0.1.0.0"
stack.yaml+27−7
@@ -1,13 +1,33 @@
1−resolver: nightly-2016-10-31
2−extra-package-dbs: []
3−extra-deps:
4− - 'QuickCheck-2.9.2'
1+resolver: lts-13.29
2+save-hackage-creds: false
53
64flags:
75 hakyll:
8− previewServer: True
9− watchServer: True
10− checkExternal: True
6+ previewServer: true
7+ watchServer: true
8+ checkExternal: true
9+ usePandoc: true
10+ buildWebsite: true
1111
1212packages:
1313 - '.'
14+
15+nix:
16+ enable: false
17+ packages:
18+ - zlib
19+
20+build:
21+ haddock: true
22+ haddock-hyperlink-source: true
23+ haddock-deps: false
24+
25+extra-deps:
26+- 'cmark-gfm-0.2.0'
27+- 'hslua-module-system-0.2.1'
28+- 'ipynb-0.1'
29+- 'lrucache-1.2.0.1'
30+- 'pandoc-2.7.3'
31+- 'pandoc-citeproc-0.16.2'
32+- 'skylighting-0.8.2'
33+- 'skylighting-core-0.8.2'
test.hsnew file+30
@@ -0,0 +1,30 @@
1+{-# LANGUAGE BangPatterns #-}
2+import Control.Monad (forM)
3+import qualified Crypto.Hash.SHA256 as SHA256
4+import qualified Data.ByteString.Base16 as Base16
5+import qualified Data.ByteString.Char8 as BS8
6+import qualified Data.ByteString.Lazy as BSL
7+import Data.Map (Map)
8+import qualified Data.Map as Map
9+import Hakyll
10+import System.FilePath ((</>))
11+
12+type FileHashes = Map Identifier String
13+
14+mkFileHashes :: FilePath -> IO FileHashes
15+mkFileHashes dir = do
16+ allFiles <- getRecursiveContents (\_ -> return False) dir
17+ fmap Map.fromList $ forM allFiles $ \path0 -> do
18+ let path1 = dir </> path0
19+ !h <- hash path1
20+ return (fromFilePath path1, h)
21+ where
22+ hash :: FilePath -> IO String
23+ hash fp = do
24+ !h <- SHA256.hashlazy <$> BSL.readFile fp
25+ return $! BS8.unpack $! Base16.encode h
26+
27+main :: IO ()
28+main = hakyll $ do
29+ fileHashes <- preprocess (mkFileHashes "images")
30+ undefined
tests/Hakyll/Core/Identifier/Tests.hs+1
@@ -42,6 +42,7 @@ captureTests = fromAssertions "capture"
4242 , Just ["lol", "fun/large"] @=? capture "*cat/**.jpg" "lolcat/fun/large.jpg"
4343 , Just [] @=? capture "\\*.jpg" "*.jpg"
4444 , Nothing @=? capture "\\*.jpg" "foo.jpg"
45+ , Just ["xyz","42"] @=? capture (fromRegex "cat-([a-z]+)/foo([0-9]+).jpg") "cat-xyz/foo42.jpg"
4546 ]
4647
4748
tests/Hakyll/Core/Provider/Tests.hs+2−2
@@ -9,7 +9,7 @@ module Hakyll.Core.Provider.Tests
99import Hakyll.Core.Metadata
1010import Hakyll.Core.Provider
1111import Test.Tasty (TestTree, testGroup)
12−import Test.Tasty.HUnit (Assertion, assert, testCase, (@=?))
12+import Test.Tasty.HUnit (Assertion, testCase, (@=?))
1313import TestSuite.Util
1414
1515
@@ -25,7 +25,7 @@ case01 :: Assertion
2525case01 = do
2626 store <- newTestStore
2727 provider <- newTestProvider store
28− assert $ resourceExists provider "example.md"
28+ True @=? resourceExists provider "example.md"
2929
3030 metadata <- resourceMetadata provider "example.md"
3131 Just "An example" @=? lookupString "title" metadata
tests/Hakyll/Core/Rules/Tests.hs+3−4
@@ -17,10 +17,9 @@ import Hakyll.Core.Metadata
1717import Hakyll.Core.Routes
1818import Hakyll.Core.Rules
1919import Hakyll.Core.Rules.Internal
20−import Hakyll.Web.Pandoc
2120import System.FilePath ((</>))
2221import Test.Tasty (TestTree, testGroup)
23−import Test.Tasty.HUnit (Assertion, assert, (@=?))
22+import Test.Tasty.HUnit (Assertion, (@=?))
2423import TestSuite.Util
2524
2625
@@ -50,7 +49,7 @@ case01 = do
5049 checkRoute "example.mv1" (sv "mv1" "example.md")
5150 checkRoute "example.mv2" (sv "mv2" "example.md")
5251 checkRoute "food/example.md" (sv "metadataMatch" "example.md")
53− readIORef ioref >>= assert
52+ readIORef ioref >>= (True @=?)
5453 cleanTestEnv
5554 where
5655 sv g = setVersion (Just g)
@@ -75,7 +74,7 @@ rules01 ioref = do
7574 -- Compile some posts
7675 match "*.md" $ do
7776 route $ setExtension "html"
78− compile pandocCompiler
77+ compile copyFileCompiler
7978
8079 -- Yeah. I don't know how else to test this stuff?
8180 preprocess $ writeIORef ioref True
tests/Hakyll/Core/Runtime/Tests.hs+1−1
@@ -39,7 +39,7 @@ case01 = do
3939 compile $ do
4040 getResourceBody
4141 >>= saveSnapshot "raw"
42− >>= renderPandoc
42+ >>= renderParagraphs
4343
4444 match (fromList ["partial.html", "partial-helper.html"]) $
4545 compile templateCompiler
tests/Hakyll/Core/Store/Tests.hs+7−7
@@ -63,11 +63,11 @@ wrongType = do
6363 -- Store a string and try to fetch an int
6464 Store.set store ["foo", "bar"] ("qux" :: String)
6565 value <- Store.get store ["foo", "bar"] :: IO (Store.Result Int)
66− H.assert $ case value of
67− Store.WrongType e t ->
68− e == typeOf (undefined :: Int) &&
69− t == typeOf (undefined :: String)
70− _ -> False
66+ case value of
67+ Store.WrongType e t -> do
68+ typeOf (undefined :: Int) H.@=? e
69+ typeOf (undefined :: String) H.@=? t
70+ _ -> H.assertFailure "Expecting WrongType"
7171 cleanTestEnv
7272
7373
@@ -78,6 +78,6 @@ isMembertest = do
7878 Store.set store ["foo", "bar"] ("qux" :: String)
7979 good <- Store.isMember store ["foo", "bar"]
8080 bad <- Store.isMember store ["foo", "baz"]
81− H.assert good
82− H.assert (not bad)
81+ True H.@=? good
82+ False H.@=? bad
8383 cleanTestEnv
tests/Hakyll/Core/UnixFilter/Tests.hs+22−12
@@ -6,15 +6,14 @@ module Hakyll.Core.UnixFilter.Tests
66
77
88--------------------------------------------------------------------------------
9−import Data.List (isInfixOf)
10−import Test.Tasty (TestTree, testGroup)
11−import Test.Tasty.HUnit (testCase)
12−import qualified Test.Tasty.HUnit as H
9+import Test.Tasty (TestTree, testGroup)
10+import Test.Tasty.HUnit (testCase)
11+import qualified Test.Tasty.HUnit as H
1312
1413
1514--------------------------------------------------------------------------------
1615import Hakyll.Core.Compiler
17−import Hakyll.Core.Compiler.Internal
16+import Hakyll.Core.Identifier
1817import Hakyll.Core.Item
1918import Hakyll.Core.UnixFilter
2019import TestSuite.Util
@@ -25,17 +24,20 @@ tests :: TestTree
2524tests = testGroup "Hakyll.Core.UnixFilter.Tests"
2625 [ testCase "unixFilter rev" unixFilterRev
2726 , testCase "unixFilter false" unixFilterFalse
27+ , testCase "unixFilter error" unixFilterError
2828 ]
2929
30+testMarkdown :: Identifier
31+testMarkdown = "russian.md"
3032
3133--------------------------------------------------------------------------------
3234unixFilterRev :: H.Assertion
3335unixFilterRev = do
3436 store <- newTestStore
3537 provider <- newTestProvider store
36− output <- testCompilerDone store provider "russian.md" compiler
37− expected <- testCompilerDone store provider "russian.md" getResourceString
38− H.assert $ rev (itemBody expected) == lines (itemBody output)
38+ output <- testCompilerDone store provider testMarkdown compiler
39+ expected <- testCompilerDone store provider testMarkdown getResourceString
40+ rev (itemBody expected) H.@=? lines (itemBody output)
3941 cleanTestEnv
4042 where
4143 compiler = getResourceString >>= withItemBody (unixFilter "rev" [])
@@ -47,10 +49,18 @@ unixFilterFalse :: H.Assertion
4749unixFilterFalse = do
4850 store <- newTestStore
4951 provider <- newTestProvider store
50− result <- testCompiler store provider "russian.md" compiler
51− H.assert $ case result of
52− CompilerError es -> any ("exit code" `isInfixOf`) es
53− _ -> False
52+ testCompilerError store provider testMarkdown compiler "exit code"
5453 cleanTestEnv
5554 where
5655 compiler = getResourceString >>= withItemBody (unixFilter "false" [])
56+
57+
58+--------------------------------------------------------------------------------
59+unixFilterError :: H.Assertion
60+unixFilterError = do
61+ store <- newTestStore
62+ provider <- newTestProvider store
63+ testCompilerError store provider testMarkdown compiler "option"
64+ cleanTestEnv
65+ where
66+ compiler = getResourceString >>= withItemBody (unixFilter "head" ["-#"])
tests/Hakyll/Web/CompressCss/Tests.hs+18−13
@@ -5,9 +5,8 @@ module Hakyll.Web.CompressCss.Tests
55
66
77--------------------------------------------------------------------------------
8−import Data.Char (toUpper)
98import Test.Tasty (TestTree, testGroup)
10−import Test.Tasty.HUnit (assert, (@=?))
9+import Test.Tasty.HUnit ((@=?))
1110
1211
1312--------------------------------------------------------------------------------
@@ -21,9 +20,9 @@ tests = testGroup "Hakyll.Web.CompressCss.Tests" $ concat
2120 [ fromAssertions "compressCss"
2221 [
2322 -- compress whitespace
24− " something something " @=?
23+ "something something" @=?
2524 compressCss " something \n\t\r something "
26− -- do not compress whitespace in constants
25+ -- do not compress whitespace in string tokens
2726 , "abc \" \t\n\r \" xyz" @=?
2827 compressCss "abc \" \t\n\r \" xyz"
2928 , "abc ' \t\n\r ' xyz" @=?
@@ -31,28 +30,34 @@ tests = testGroup "Hakyll.Web.CompressCss.Tests" $ concat
3130
3231 -- strip comments
3332 , "before after" @=? compressCss "before /* abc { } ;; \n\t\r */ after"
34− -- don't strip comments inside constants
33+ -- don't strip comments inside string tokens
3534 , "before \"/* abc { } ;; \n\t\r */\" after"
3635 @=? compressCss "before \"/* abc { } ;; \n\t\r */\" after"
3736
3837 -- compress separators
3938 , "}" @=? compressCss "; }"
40− , "{};" @=? compressCss " { } ; "
39+ , ";{};" @=? compressCss " ; { } ; "
40+ , "text," @=? compressCss "text , "
41+ , "a>b" @=? compressCss "a > b"
42+ , "a+b" @=? compressCss "a + b"
43+ , "a!b" @=? compressCss "a ! b"
44+ -- compress calc()
45+ , "calc(1px + 100%/(5 + 3) - (3px + 2px)*5)" @=? compressCss "calc( 1px + 100% / ( 5 + 3) - calc( 3px + 2px ) * 5 )"
4146 -- compress whitespace even after this curly brace
4247 , "}" @=? compressCss "; } "
43− -- but do not compress separators inside of constants
44− , "\" { } ; \"" @=? compressCss "\" { } ; \""
45− -- don't compress separators at the start or end of constants
48+ -- but do not compress separators inside string tokens
49+ , "\" { } ; , \"" @=? compressCss "\" { } ; , \""
50+ -- don't compress separators at the start or end of string tokens
4651 , "\" }\"" @=? compressCss "\" }\""
4752 , "\"{ \"" @=? compressCss "\"{ \""
48− -- don't get irritated by the wrong constant terminator
53+ -- don't get irritated by the wrong token delimiter
4954 , "\" ' \"" @=? compressCss "\" ' \""
5055 , "' \" '" @=? compressCss "' \" '"
51− -- don't compress whitespace around separators in constants in the middle of a string
56+ -- don't compress whitespace in the middle of a string
5257 , "abc '{ '" @=? compressCss "abc '{ '"
5358 , "abc \"{ \"" @=? compressCss "abc \"{ \""
54− -- compress whitespace after colons
55− , "abc:xyz" @=? compressCss "abc : xyz"
59+ -- compress whitespace after colons (but not before)
60+ , "abc :xyz" @=? compressCss "abc : xyz"
5661 -- compress multiple semicolons
5762 , ";" @=? compressCss ";;;;;;;"
5863 ]
tests/Hakyll/Web/Html/Tests.hs+6−6
@@ -7,7 +7,7 @@ module Hakyll.Web.Html.Tests
77--------------------------------------------------------------------------------
88import Data.Char (toUpper)
99import Test.Tasty (TestTree, testGroup)
10−import Test.Tasty.HUnit (assert, (@=?))
10+import Test.Tasty.HUnit ((@=?))
1111
1212
1313--------------------------------------------------------------------------------
@@ -64,11 +64,11 @@ tests = testGroup "Hakyll.Web.Html.Tests" $ concat
6464 ]
6565
6666 , fromAssertions "isExternal"
67− [ assert (isExternal "http://reddit.com")
68− , assert (isExternal "https://mail.google.com")
69− , assert (isExternal "//ajax.googleapis.com")
70− , assert (not (isExternal "../header.png"))
71− , assert (not (isExternal "/foo/index.html"))
67+ [ True @=? isExternal "http://reddit.com"
68+ , True @=? isExternal "https://mail.google.com"
69+ , True @=? isExternal "//ajax.googleapis.com"
70+ , False @=? isExternal "../header.png"
71+ , False @=? isExternal "/foo/index.html"
7272 ]
7373
7474 , fromAssertions "stripTags"
tests/Hakyll/Web/Template/Context/Tests.hs+40−3
@@ -13,16 +13,19 @@ import Test.Tasty.HUnit (Assertion, testCase, (@=?))
1313--------------------------------------------------------------------------------
1414import Hakyll.Core.Compiler
1515import Hakyll.Core.Identifier
16+import Hakyll.Core.Item
1617import Hakyll.Core.Provider
1718import Hakyll.Core.Store (Store)
1819import Hakyll.Web.Template.Context
20+import Hakyll.Web.Template.Internal
1921import TestSuite.Util
2022
2123
2224--------------------------------------------------------------------------------
2325tests :: TestTree
24−tests = testGroup "Hakyll.Core.Template.Context.Tests"
26+tests = testGroup "Hakyll.Web.Template.Context.Tests"
2527 [ testCase "testDateField" testDateField
28+ , testCase "testOuerLoopContextAccess" testOuerLoopContextAccess
2629 ]
2730
2831
@@ -41,6 +44,15 @@ testDateField = do
4144 dateField "date" "%B %e, %Y"
4245 date2 @=? "August 26, 2010"
4346
47+ date3 <- testContextDone store provider
48+ "posts/2018-09-26.md" "date" $
49+ dateField "date" "%B %e, %Y"
50+ date3 @=? "September 26, 2018"
51+
52+ date4 <- testContextDone store provider
53+ "posts/2019/05/10/tomorrow.md" "date" $
54+ dateField "date" "%B %e, %Y"
55+ date4 @=? "May 10, 2019"
4456 cleanTestEnv
4557
4658
@@ -53,6 +65,31 @@ testContextDone store provider identifier key context =
5365 cf <- unContext context key [] item
5466 case cf of
5567 StringField str -> return str
56− ListField _ _ -> error $
68+ _ -> error $
5769 "Hakyll.Web.Template.Context.Tests.testContextDone: " ++
58− "Didn't expect ListField"
70+ "expected StringField"
71+
72+--------------------------------------------------------------------------------
73+
74+testOuerLoopContextAccess :: Assertion
75+testOuerLoopContextAccess = do
76+ store <- newTestStore
77+ provider <- newTestProvider store
78+ test store provider ctx "baz"
79+ test store provider (ctx' <> ctx) "not baz"
80+ test store provider (ctx <> ctx') "baz"
81+
82+ cleanTestEnv
83+ where
84+ tpl = readTemplate "$for(foo)$$for(bar)$$qux$$endfor$$endfor$"
85+ ctx = mconcat [
86+ field "qux" $ const $ return "baz"
87+ , listField "foo" (listField "bar" mempty $ return [mockItem])
88+ $ return [mockItem]
89+ ]
90+ ctx' = field "qux" $ const $ return "not baz"
91+ mockItem = Item "" ()
92+ test store provider context str = do
93+ str' <- testCompilerDone store provider ""
94+ $ applyTemplate tpl context mockItem
95+ str @=? itemBody str'
tests/Hakyll/Web/Template/Tests.hs+53−19
@@ -1,5 +1,6 @@
11--------------------------------------------------------------------------------
22{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE TemplateHaskell #-}
34module Hakyll.Web.Template.Tests
45 ( tests
56 ) where
@@ -7,16 +8,16 @@ module Hakyll.Web.Template.Tests
78
89--------------------------------------------------------------------------------
910import Test.Tasty (TestTree, testGroup)
10−import Test.Tasty.HUnit (Assertion, testCase, (@=?),
11− (@?=))
11+import Test.Tasty.HUnit (Assertion, assertBool, testCase,
12+ (@=?), (@?=))
1213
14+import Data.Either (isLeft)
1315
1416--------------------------------------------------------------------------------
1517import Hakyll.Core.Compiler
1618import Hakyll.Core.Identifier
1719import Hakyll.Core.Item
1820import Hakyll.Core.Provider
19−import Hakyll.Web.Pandoc
2021import Hakyll.Web.Template
2122import Hakyll.Web.Template.Context
2223import Hakyll.Web.Template.Internal
@@ -26,19 +27,20 @@ import TestSuite.Util
2627
2728--------------------------------------------------------------------------------
2829tests :: TestTree
29−tests = testGroup "Hakyll.Core.Template.Tests" $ concat
30+tests = testGroup "Hakyll.Web.Template.Tests" $ concat
3031 [ [ testCase "case01" $ test ("template.html.out", "template.html", "example.md")
3132 , testCase "case02" $ test ("strip.html.out", "strip.html", "example.md")
33+ , testCase "case03" $ test ("just-meta.html.out", "just-meta.html", "example.md")
3234 , testCase "applyJoinTemplateList" testApplyJoinTemplateList
3335 ]
3436
35− , fromAssertions "readTemplate"
36− [ [Chunk "Hello ", Expr (Call "guest" [])]
37− @=? readTemplateElems "Hello $guest()$"
38− , [If (Call "a" [StringLiteral "bar"]) [Chunk "foo"] Nothing]
39− @=? readTemplateElems "$if(a(\"bar\"))$foo$endif$"
37+ , fromAssertions "parseTemplate"
38+ [ Right [Chunk "Hello ", Expr (Call "guest" [])]
39+ @=? parse "Hello $guest()$"
40+ , Right [If (Call "a" [StringLiteral "bar"]) [Chunk "foo"] Nothing]
41+ @=? parse "$if(a(\"bar\"))$foo$endif$"
4042 -- 'If' trim check.
41− , [ TrimL
43+ , Right [ TrimL
4244 , If (Ident (TemplateKey "body"))
4345 [ TrimR
4446 , Chunk "\n"
@@ -54,29 +56,39 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat
5456 ])
5557 , TrimR
5658 ]
57− @=? readTemplateElems "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"
59+ @=? parse "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"
5860 -- 'For' trim check.
59− , [ TrimL
61+ , Right [ TrimL
6062 , For (Ident (TemplateKey "authors"))
6163 [TrimR, Chunk "\n body \n", TrimL]
6264 Nothing
6365 , TrimR
6466 ]
65− @=? readTemplateElems "$-for(authors)-$\n body \n$-endfor-$"
67+ @=? parse "$-for(authors)-$\n body \n$-endfor-$"
6668 -- 'Partial' trim check.
67− , [ TrimL
69+ , Right [ TrimL
6870 , Partial (StringLiteral "path")
6971 , TrimR
7072 ]
71− @=? readTemplateElems "$-partial(\"path\")-$"
73+ @=? parse "$-partial(\"path\")-$"
7274 -- 'Expr' trim check.
73− , [ TrimL
75+ , Right [ TrimL
7476 , Expr (Ident (TemplateKey "foo"))
7577 , TrimR
7678 ]
77− @=? readTemplateElems "$-foo-$"
79+ @=? parse "$-foo-$"
80+ -- fail on incomplete template.
81+ , assertBool "did not yield error" $ isLeft $
82+ parse "a$b"
83+ -- fail on mismatched template syntax.
84+ , assertBool "did not fail to parse" $ isLeft $
85+ parse "$for(xs)$\n <p>foo</p>\n$endif$"
7886 ]
87+
88+ , [testCase "embeddedTemplate" testEmbeddedTemplate]
7989 ]
90+ where
91+ parse = parseTemplateElemsFile ""
8092
8193
8294--------------------------------------------------------------------------------
@@ -88,7 +100,9 @@ test (outf, tplf, itemf) = do
88100 out <- resourceString provider outf
89101 tpl <- testCompilerDone store provider tplf templateBodyCompiler
90102 item <- testCompilerDone store provider itemf $
91− pandocCompiler >>= applyTemplate (itemBody tpl) testContext
103+ getResourceBody
104+ >>= renderParagraphs
105+ >>= applyTemplate (itemBody tpl) testContext
92106
93107 out @=? itemBody item
94108 cleanTestEnv
@@ -111,6 +125,8 @@ testApplyJoinTemplateList :: Assertion
111125testApplyJoinTemplateList = do
112126 store <- newTestStore
113127 provider <- newTestProvider store
128+ tpl <- testCompilerDone store provider "tpl" $
129+ compileTemplateItem (Item "tpl" "<b>$body$</b>")
114130 str <- testCompilerDone store provider "item3" $
115131 applyJoinTemplateList ", " tpl defaultContext [i1, i2]
116132
@@ -119,4 +135,22 @@ testApplyJoinTemplateList = do
119135 where
120136 i1 = Item "item1" "Hello"
121137 i2 = Item "item2" "World"
122− tpl = readTemplate "<b>$body$</b>"
138+
139+
140+--------------------------------------------------------------------------------
141+embeddedTemplate :: Template
142+embeddedTemplate = $(embedTemplate "tests/data/embed.html")
143+
144+--------------------------------------------------------------------------------
145+testEmbeddedTemplate :: Assertion
146+testEmbeddedTemplate = do
147+ store <- newTestStore
148+ provider <- newTestProvider store
149+ str <- testCompilerDone store provider "item3" $
150+ applyTemplate embeddedTemplate defaultContext item
151+
152+ itemBody str @?= "<p>Hello, world</p>\n"
153+ cleanTestEnv
154+ where
155+ item = Item "item1" "Hello, world"
156+
tests/TestSuite.hs+7
@@ -1,4 +1,5 @@
11--------------------------------------------------------------------------------
2+{-# LANGUAGE CPP #-}
23module Main
34 ( main
45 ) where
@@ -22,9 +23,12 @@ import qualified Hakyll.Core.Util.String.Tests
2223import qualified Hakyll.Web.CompressCss.Tests
2324import qualified Hakyll.Web.Html.RelativizeUrls.Tests
2425import qualified Hakyll.Web.Html.Tests
26+#ifdef USE_PANDOC
2527import qualified Hakyll.Web.Pandoc.FileType.Tests
28+#endif
2629import qualified Hakyll.Web.Template.Context.Tests
2730import qualified Hakyll.Web.Template.Tests
31+import qualified Hakyll.Web.Tags.Tests
2832
2933
3034--------------------------------------------------------------------------------
@@ -43,7 +47,10 @@ main = defaultMain $ testGroup "Hakyll"
4347 , Hakyll.Web.CompressCss.Tests.tests
4448 , Hakyll.Web.Html.RelativizeUrls.Tests.tests
4549 , Hakyll.Web.Html.Tests.tests
50+#ifdef USE_PANDOC
4651 , Hakyll.Web.Pandoc.FileType.Tests.tests
52+#endif
53+ , Hakyll.Web.Tags.Tests.tests
4754 , Hakyll.Web.Template.Context.Tests.tests
4855 , Hakyll.Web.Template.Tests.tests
4956 ]
tests/TestSuite/Util.hs+27−5
@@ -6,13 +6,15 @@ module TestSuite.Util
66 , newTestProvider
77 , testCompiler
88 , testCompilerDone
9+ , testCompilerError
910 , testConfiguration
1011 , cleanTestEnv
12+ , renderParagraphs
1113 ) where
1214
1315
1416--------------------------------------------------------------------------------
15−import Data.List (intercalate)
17+import Data.List (intercalate, isInfixOf)
1618import Data.Monoid (mempty)
1719import qualified Data.Set as S
1820import Test.Tasty
@@ -29,6 +31,7 @@ import Hakyll.Core.Provider
2931import Hakyll.Core.Store (Store)
3032import qualified Hakyll.Core.Store as Store
3133import Hakyll.Core.Util.File
34+import Hakyll.Core.Item
3235
3336
3437--------------------------------------------------------------------------------
@@ -76,14 +79,23 @@ testCompilerDone store provider underlying compiler = do
7679 result <- testCompiler store provider underlying compiler
7780 case result of
7881 CompilerDone x _ -> return x
79− CompilerError e -> error $
82+ CompilerError e -> fail $
8083 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
81− " threw: " ++ intercalate "; " e
82− CompilerRequire i _ -> error $
84+ " threw: " ++ intercalate "; " (compilerErrorMessages e)
85+ CompilerRequire i _ -> fail $
8386 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
8487 " requires: " ++ show i
88+ CompilerSnapshot _ _ -> fail
89+ "TestSuite.Util.testCompilerDone: unexpected CompilerSnapshot"
8590
86−
91+testCompilerError :: Store -> Provider -> Identifier -> Compiler a -> String -> IO ()
92+testCompilerError store provider underlying compiler expectedMessage = do
93+ result <- testCompiler store provider underlying compiler
94+ case result of
95+ CompilerError e ->
96+ any (expectedMessage `isInfixOf`) (compilerErrorMessages e) @?
97+ "Expecting '" ++ expectedMessage ++ "' error"
98+ _ -> assertFailure "Expecting CompilerError"
8799
88100--------------------------------------------------------------------------------
89101testConfiguration :: Configuration
@@ -101,3 +113,13 @@ cleanTestEnv = do
101113 removeDirectory $ destinationDirectory testConfiguration
102114 removeDirectory $ storeDirectory testConfiguration
103115 removeDirectory $ tmpDirectory testConfiguration
116+
117+
118+--------------------------------------------------------------------------------
119+-- | like 'Hakyll.Web.Pandoc.renderPandoc'
120+-- | but allowing to test without the @usePandoc@ flag
121+renderParagraphs :: Item String -> Compiler (Item String)
122+renderParagraphs = withItemBody (return
123+ . intercalate "\n" -- no trailing line
124+ . map (("<p>"++) . (++"</p>"))
125+ . lines)
tests/data/embed.htmlnew file+1
@@ -0,0 +1 @@
1+<p>$body$</p>
tests/data/example.md.metadata+2
@@ -1,3 +1,5 @@
11external: External data
22date: 2012-10-22 14:35:24
33subblog: food
4+intfield: 42
5+numfield: 3.14
tests/data/just-meta.htmlnew file+7
@@ -0,0 +1,7 @@
1+<pre>
2+external: {$external$}
3+date: {$date$}
4+subblog: {$subblog$}
5+intfield: {$intfield$}
6+numfield: {$numfield$}
7+</pre>
tests/data/just-meta.html.outnew file+7
@@ -0,0 +1,7 @@
1+<pre>
2+external: {External data}
3+date: {2012-10-22 14:35:24}
4+subblog: {food}
5+intfield: {42}
6+numfield: {3.14}
7+</pre>
tests/data/posts/2018-09-26.mdnew file+1
@@ -0,0 +1 @@
1+Something happened today.
tests/data/posts/2019/05/10/tomorrow.mdnew file+1
@@ -0,0 +1 @@
1+This day hasn't happened yet (as of writing this).
web/css/syntax.css+61−18
@@ -1,18 +1,61 @@
1−/* Generated by pandoc. */
2−table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode, table.sourceCode pre
3− { margin: 0; padding: 0; border: 0; vertical-align: baseline; border: none; }
4−td.lineNumbers { border-right: 1px solid #AAAAAA; text-align: right; color: #AAAAAA; padding-right: 5px; padding-left: 5px; }
5−td.sourceCode { padding-left: 5px; }
6−.sourceCode span.kw { color: #007020; font-weight: bold; }
7−.sourceCode span.dt { color: #902000; }
8−.sourceCode span.dv { color: #40a070; }
9−.sourceCode span.bn { color: #40a070; }
10−.sourceCode span.fl { color: #40a070; }
11−.sourceCode span.ch { color: #4070a0; }
12−.sourceCode span.st { color: #4070a0; }
13−.sourceCode span.co { color: #60a0b0; font-style: italic; }
14−.sourceCode span.ot { color: #007020; }
15−.sourceCode span.al { color: red; font-weight: bold; }
16−.sourceCode span.fu { color: #06287e; }
17−.sourceCode span.re { }
18−.sourceCode span.er { color: red; font-weight: bold; }
1+a.sourceLine { display: inline-block; line-height: 1.25; }
2+a.sourceLine { pointer-events: none; color: inherit; text-decoration: inherit; }
3+a.sourceLine:empty { height: 1.2em; }
4+.sourceCode { overflow: visible; }
5+code.sourceCode { white-space: pre; position: relative; }
6+div.sourceCode { margin: 1em 0; }
7+pre.sourceCode { margin: 0; }
8+@media screen {
9+div.sourceCode { overflow: auto; }
10+}
11+@media print {
12+code.sourceCode { white-space: pre-wrap; }
13+a.sourceLine { text-indent: -1em; padding-left: 1em; }
14+}
15+pre.numberSource a.sourceLine
16+ { position: relative; left: -4em; }
17+pre.numberSource a.sourceLine::before
18+ { content: attr(title);
19+ position: relative; left: -1em; text-align: right; vertical-align: baseline;
20+ border: none; pointer-events: all; display: inline-block;
21+ -webkit-touch-callout: none; -webkit-user-select: none;
22+ -khtml-user-select: none; -moz-user-select: none;
23+ -ms-user-select: none; user-select: none;
24+ padding: 0 4px; width: 4em;
25+ color: #aaaaaa;
26+ }
27+pre.numberSource { margin-left: 3em; border-left: 1px solid #aaaaaa; padding-left: 4px; }
28+div.sourceCode
29+ { }
30+@media screen {
31+a.sourceLine::before { text-decoration: underline; }
32+}
33+code span.al { color: #ff0000; font-weight: bold; } /* Alert */
34+code span.an { color: #60a0b0; font-weight: bold; font-style: italic; } /* Annotation */
35+code span.at { color: #7d9029; } /* Attribute */
36+code span.bn { color: #40a070; } /* BaseN */
37+code span.bu { } /* BuiltIn */
38+code span.cf { color: #007020; font-weight: bold; } /* ControlFlow */
39+code span.ch { color: #4070a0; } /* Char */
40+code span.cn { color: #880000; } /* Constant */
41+code span.co { color: #60a0b0; font-style: italic; } /* Comment */
42+code span.cv { color: #60a0b0; font-weight: bold; font-style: italic; } /* CommentVar */
43+code span.do { color: #ba2121; font-style: italic; } /* Documentation */
44+code span.dt { color: #902000; } /* DataType */
45+code span.dv { color: #40a070; } /* DecVal */
46+code span.er { color: #ff0000; font-weight: bold; } /* Error */
47+code span.ex { } /* Extension */
48+code span.fl { color: #40a070; } /* Float */
49+code span.fu { color: #06287e; } /* Function */
50+code span.im { } /* Import */
51+code span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Information */
52+code span.kw { color: #007020; font-weight: bold; } /* Keyword */
53+code span.op { color: #666666; } /* Operator */
54+code span.ot { color: #007020; } /* Other */
55+code span.pp { color: #bc7a00; } /* Preprocessor */
56+code span.sc { color: #4070a0; } /* SpecialChar */
57+code span.ss { color: #bb6688; } /* SpecialString */
58+code span.st { color: #4070a0; } /* String */
59+code span.va { color: #19177c; } /* Variable */
60+code span.vs { color: #4070a0; } /* VerbatimString */
61+code span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warning */
web/examples.markdown+48−28
@@ -20,6 +20,8 @@ directly with the default Hakyll site.
2020 [source](https://github.com/jaspervdj/jaspervdj)
2121- <http://www.imagination-land.org/>,
2222 [source](https://github.com/Keruspe/blog/)
23+- <https://bananasandlenses.net/>,
24+ [source](https://github.com/denisshevchenko/bananasandlenses)
2325- <http://blog.clement.delafargue.name/>,
2426 [source](https://github.com/divarvel/blog)
2527- <http://bneijt.nl>,
@@ -34,8 +36,6 @@ directly with the default Hakyll site.
3436 [source](https://github.com/dannysu/hakyll-blog)
3537- <http://meta.plasm.us/>,
3638 [source](https://github.com/travisbrown/metaplasm)
37−- <http://www.web2day-nantes.org/>,
38− [source](https://github.com/CompanyCampus/web2day2013)
3939- <http://workforpizza.com/>,
4040 [source](https://github.com/irneh/workforpizza)
4141- <http://poleiro.info/>,
@@ -45,9 +45,7 @@ directly with the default Hakyll site.
4545- <http://www.regisfoucault.com/>,
4646 [source](https://github.com/regisfoucault/blog)
4747- <http://www.chaoxuprime.com/>,
48− [source](https://github.com/Mgccl/blog)
49−- <https://benjeffrey.com/>,
50− [source](https://github.com/jeffbr13/benjeffrey.com)
48+ [source](https://github.com/chaoxu/chaoxu.github.io/tree/develop)
5149- <http://www.skybluetrades.net/>,
5250 [source](https://github.com/ian-ross/blog)
5351- <http://chromaticleaves.com/>,
@@ -58,8 +56,6 @@ directly with the default Hakyll site.
5856 [source](https://github.com/blaenk/blaenk.github.io)
5957- <https://xinitrc.de/>,
6058 [source](https://github.com/xinitrc/xinitrc.de)
61−- <http://blog.darkfox.id.au/>,
62− [source](http://hub.darcs.net/DarkFox/DarkFox-blog)
6359- <http://nickcharlton.net/>,
6460 [source](https://github.com/nickcharlton/nickcharlton.net)
6561- <http://scr.stunts.hu/>,
@@ -72,16 +68,10 @@ directly with the default Hakyll site.
7268 [source](https://github.com/walkie/WebPage)
7369- <http://techblog.rosedu.org/>,
7470 [source](https://github.com/rosedu/techblog)
75−- <http://abizern.org>,
76− [source](https://github.com/Abizern/hblog)
7771- <http://freizl.github.io>,
7872 [source](https://github.com/freizl/freizl.github.com/tree/master/build)
79−- <http://covariant.me>,
80− [source](http://hub.darcs.net/co-dan/website)
8173- <http://www.gwern.net/>,
8274 [source](https://github.com/gwern/gwern.net)
83−- <http://www.rohanjain.in/>,
84− [source](https://github.com/crodjer/rohanjain.in)
8575- <http://www.corentindupont.info/>,
8676 [source](https://github.com/cdupont/CorentinDupont-WebPage)
8777- <http://jelv.is>,
@@ -90,8 +80,8 @@ directly with the default Hakyll site.
9080 [source](https://github.com/plaimi/www)
9181- <http://duplode.github.io/>,
9282 [source](https://github.com/duplode/duplode.github.io/tree/sources)
93−- <http://maseek.codes>,
94− [source](https://github.com/maseek/maseek-codes)
83+- <http://tzemanovic.github.io/>,
84+ [source](https://github.com/tzemanovic/tzemanovic)
9585- <http://listx.github.io>,
9686 [source](https://github.com/listx/listx_blog)
9787- <http://kyle.marek-spartz.org>,
@@ -102,26 +92,20 @@ directly with the default Hakyll site.
10292 [source](https://github.com/rbros/reichertbrothers.com)
10393- <http://alemedeiros.sdf.org>,
10494 [source](https://github.com/alemedeiros/homepage)
105−- <https://ruudvanasseldonk.com/>,
106− [source](https://github.com/ruud-v-a/ruudvanasseldonk.com)
10795- <http://www.haskell.mn>,
10896 [source](https://github.com/HaskellMN/www.haskell.mn)
10997- <https://axiomatic.neophilus.net/>,
11098 [source](https://github.com/Libbum/AxiomaticSemantics)
111−- <https://tesser.org/>,
99+- [https://tesser.org/](http://web.archive.org/web/20161022221713/https://tesser.org/),
112100 [source](https://github.com/fractalcat/tesser.org)
113−- <https://wei2912.github.io/>,
114− [source](https://github.com/wei2912/blog_src)
101+- <https://weien.io/>,
102+  [source](https://github.com/wei2912/blog-src)
115103- <http://www.metasepi.org/>,
116104 [source](https://github.com/metasepi/metasepi-website)
117105- <http://gisli.hamstur.is/>,
118106 [source](https://github.com/gislik/gisli.hamstur.is)
119107- <http://blog.ssanj.net/>,
120108 [source](https://github.com/ssanj/babyloncandle)
121−- <https://rockymadden.com/>,
122− [source](https://github.com/rockymadden/rockymadden-web)
123−- <http://blog.dshevchenko.biz/>,
124− [source](https://github.com/denisshevchenko/blog)
125109- <http://ruhaskell.org/>,
126110 [source](https://github.com/ruHaskell/ruhaskell)
127111- <http://www.haskell.od.ua/>,
@@ -142,8 +126,6 @@ directly with the default Hakyll site.
142126 [source](https://github.com/ismailmustafa/ismailmustafa.github.io/tree/hakyll)
143127- <http://lettier.github.io/>,
144128 [source](https://github.com/lettier/lettier.github.io)
145−- <http://jozefg.bitbucket.org/>,
146− [source](https://github.com/jozefg/blog)
147129- <http://raindev.io>,
148130 [source](https://github.com/raindev/raindev.github.io)
149131- <http://hal2016.haskell.org/>,
@@ -162,6 +144,46 @@ directly with the default Hakyll site.
162144 [source](https://github.com/jjduhamel/blog)
163145- <http://alexanderlobov.ru/>,
164146 [source](https://github.com/alexanderlobov/homepage)
147+- <http://www.rosanbo.com/>,
148+ [source](https://github.com/polo2ro/blog)
149+- <http://limansky.me/>,
150+ [source](https://github.com/limansky/limansky_me)
151+- <http://rahul.nu/>,
152+ [source](https://github.com/rp/rp.github.io/tree/dev)
153+- <http://haskanything.com/>,
154+ [source](https://github.com/beerendlauwers/HaskAnything)
155+- <https://anler.me/>,
156+ [source](https://github.com/anler/anler.me)
157+- <http://argumatronic.com/>,
158+ [source](https://gitlab.com/GinBaby/argumatronic/tree/master)
159+- <http://sillybytes.net/>,
160+ [source](https://github.com/sillybytes/sillybytes)
161+- <https://falconpilot.github.io/>,
162+ [source](https://github.com/FalconPilot/falconpilot.github.io)
163+- <http://spyhop.cafe/>,
164+ [source](https://github.com/thunky-monk/spyhop-cafe)
165+- <https://bendo.github.io/>,
166+ [source](https://github.com/bendo/bendo.github.io)
167+- <http://adarsh.cc/>,
168+ [source](https://github.com/adarshp/adarsh.cc)
169+- <http://0a.io>,
170+ [source](https://github.com/arrchyy/0a.io)
171+- <https://nasy.moe/>,
172+ [source](https://github.com/nasyxx/NasyMoe)
173+- <http://uniprocess.org/>,
174+ [source](https://gitlab.com/uniprocess/uniprocess.org)
175+- <https://regularflolloping.com/>,
176+ [source](https://github.com/techieAgnostic/rf)
177+- <http://enter-haken.github.io/>,
178+ [source](https://github.com/enter-haken/blog)
179+- <https://modular.blind.guru/>,
180+ [source](https://github.com/mlang/eurorack-metadata)
181+- <http://www.jonashietala.se/>,
182+ [source](https://github.com/treeman/jonashietala)
183+- <https://abhinavsarkar.net/>,
184+ [source](https://github.com/abhin4v/abhin4v.github.io)
185+- <https://dailyreadingnotes.com/>,
186+ [source](https://github.com/hackeryarn/daily-reading-notes)
165187
166188## Hakyll 3.X
167189
@@ -189,7 +211,5 @@ directly with the default Hakyll site.
189211 [source](http://gitorious.org/shakthimaan-blog)
190212- <http://www.alfredodinapoli.com/>,
191213 [source](https://github.com/CharlesStain/alfredodinapoli.com)
192−- <http://datahackermd.com>,
193− [source](http://github.com/akshayjshah/datahackermd)
194214- <http://michaelxavier.net>,
195215 [source](https://github.com/michaelxavier/michaelxavier.net)
web/libraries.markdown+1
@@ -18,3 +18,4 @@ Here is a list of the ones I know of (I would be happy to hear about others).
1818 a conversion tool from other blog engines to Hakyll.
1919- [hakyll-elm](https://hackage.haskell.org/package/hakyll-elm),
2020 Hakyll wrapper for the Elm compiler.
21+- [hakyll-sass](http://hackage.haskell.org/package/hakyll-sass), a compiler for SASS templates.
web/site.hs+25−39
@@ -1,19 +1,23 @@
11--------------------------------------------------------------------------------
22{-# LANGUAGE OverloadedStrings #-}
3−import Control.Arrow (second)
4−import Control.Monad (forM_)
5−import Data.Char (isDigit)
6−import Data.List (isPrefixOf, sortBy)
7−import Data.Monoid ((<>))
8−import Data.Ord (comparing)
3+import Control.Arrow (second)
4+import Control.Monad (filterM, forM_)
5+import Data.List (isPrefixOf, sortBy)
6+import Data.Monoid ((<>))
7+import Data.Ord (comparing)
98import Hakyll
10−import System.FilePath (dropTrailingPathSeparator, splitPath)
9+import System.Directory (copyFile)
10+import System.FilePath (dropTrailingPathSeparator, splitPath)
1111import Text.Pandoc
1212
1313
1414--------------------------------------------------------------------------------
1515main :: IO ()
1616main = hakyllWith config $ do
17+ -- Copy CHANGELOG.md here.
18+ preprocess $ copyFile "../CHANGELOG.md" "releases.markdown"
19+
20+ -- CSS
1721 match "css/*" $ do
1822 route idRoute
1923 compile compressCssCompiler
@@ -52,17 +56,11 @@ main = hakyllWith config $ do
5256 create ["tutorials.html"] $ do
5357 route idRoute
5458 compile $ do
55− tuts <-
59+ ctx <- tutorialsCtx <$>
5660 sortBy (comparing itemIdentifier) <$> loadAll "tutorials/*"
57−
58− let tutorialsCtx =
59− constField "title" "Tutorials" `mappend`
60− listField "tutorials" tutorialCtx (return tuts) `mappend`
61− defaultContext
62−
6361 makeItem ""
64− >>= loadAndApplyTemplate "templates/tutorials.html" tutorialsCtx
65− >>= loadAndApplyTemplate "templates/default.html" tutorialsCtx
62+ >>= loadAndApplyTemplate "templates/tutorials.html" ctx
63+ >>= loadAndApplyTemplate "templates/default.html" ctx
6664 >>= relativizeUrls
6765
6866 -- Templates
@@ -70,8 +68,7 @@ main = hakyllWith config $ do
7068 where
7169 withToc = defaultHakyllWriterOptions
7270 { writerTableOfContents = True
73− , writerTemplate = "$toc$\n$body$"
74− , writerStandalone = True
71+ , writerTemplate = Just "$toc$\n$body$"
7572 }
7673
7774
@@ -104,28 +101,17 @@ hackage url
104101 reverse $ splitPath url
105102
106103
107−--------------------------------------------------------------------------------
108−data TutorialType = SeriesTutorial | ArticlesTutorial | ExternalTutorial
109− deriving (Eq)
110−
111−
112104--------------------------------------------------------------------------------
113105-- | Partition tutorials into tutorial series, other articles, external articles
114−tutorialCtx :: Context String
115−tutorialCtx =
116− field "isSeries" (isTutorialType SeriesTutorial) <>
117− field "isArticle" (isTutorialType ArticlesTutorial) <>
118− field "isExternal" (isTutorialType ExternalTutorial) <>
106+tutorialsCtx :: [Item String] -> Context String
107+tutorialsCtx tuts =
108+ constField "title" "Tutorials" <>
109+ listField "main" defaultContext (ofType "main") <>
110+ listField "articles" defaultContext (ofType "article") <>
111+ listField "externals" defaultContext (ofType "external") <>
112+ listField "robertwpearce" defaultContext (ofType "robertwpearce") <>
119113 defaultContext
120114 where
121− getTutorialType item = do
122− mbExternal <- getMetadataField (itemIdentifier item) "external"
123− return $ case mbExternal of
124− Just _ -> ExternalTutorial
125− _ -> case splitPath (toFilePath $ itemIdentifier item) of
126− [_, (x : _)] -> if isDigit x then SeriesTutorial else ArticlesTutorial
127− _ -> ArticlesTutorial
128−
129− isTutorialType ty0 item = do
130− ty1 <- getTutorialType item
131− if ty0 == ty1 then return "yes" else fail "no"
115+ ofType ty = filterM (\item -> do
116+ mbType <- getMetadataField (itemIdentifier item) "type"
117+ return $ Just ty == mbType) tuts
web/templates/default.html+1−6
@@ -35,12 +35,7 @@
3535 <a href="/tutorials/faq.html">faq</a>
3636 <a href="/examples.html">examples</a>
3737 <a href="/releases.html">releases</a>
38−
39− <!-- Flattr button -->
40− <h1>Donate</h1>
41− <a href="https://flattr.com/thing/291889/Hakyll" target="_blank">
42− <img src="https://api.flattr.com/button/flattr-badge-large.png"
43− alt="Flattr this" title="Flattr this" border="0" /></a>
38+ <a href="https://jaspervdj.be/contact.html#donate" target="_blank">donate</a>
4439 </div>
4540
4641 <div id="content">
web/templates/tutorials.html+24−18
@@ -1,23 +1,19 @@
11<h1>Tutorials about Hakyll</h1>
22<h2 id="series">Tutorial series</h2>
33<ul>
4− $for(tutorials)$
5− $if(isSeries)$
6− <li>
7− <a href="$url$">$title$</a>
8− </li>
9− $endif$
4+ $for(main)$
5+ <li>
6+ <a href="$url$">$title$</a>
7+ </li>
108 $endfor$
119</ul>
1210<h2 id="articles">Other articles</h2>
1311<p>In no particular order:</p>
1412<ul>
15− $for(tutorials)$
16− $if(isArticle)$
17− <li>
18− <a href="$url$">$title$</a> by <em>$author$</em>
19− </li>
20− $endif$
13+ $for(articles)$
14+ <li>
15+ <a href="$url$">$title$</a> by <em>$author$</em>
16+ </li>
2117 $endfor$
2218</ul>
2319<h2 id="external-articles">External articles</h2>
@@ -28,12 +24,22 @@
2824</p>
2925<p>In no particular order:</p>
3026<ul>
31− $for(tutorials)$
32− $if(isExternal)$
33− <li>
34− <a href="$url$">$title$</a> by <em>$author$</em>
35− </li>
36− $endif$
27+ $for(externals)$
28+ <li>
29+ <a href="$url$">$title$</a> by <em>$author$</em>
30+ </li>
31+ $endfor$
32+</ul>
33+<h2 id="robertwpearce">Robert Pearce's series</h2>
34+<p>
35+ <a href="https://robertwpearce.com/">Robert Pearce</a> has been writing an
36+ excellent tutorial-style series on Hakyll as well. You can find those here:
37+</p>
38+<ul>
39+ $for(robertwpearce)$
40+ <li>
41+ <a href="$url$">$title$</a>
42+ </li>
3743 $endfor$
3844</ul>
3945<p>
web/tutorials/01-installation.markdown+4−1
@@ -1,6 +1,7 @@
11---
22title: Installation
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Installation
@@ -17,6 +18,8 @@ different distributions. For installation from source (i.e. via Hackage),
1718Linux distro packages:
1819
1920- [Debian unstable](http://packages.debian.org/source/sid/haskell-hakyll)
21+- [Fedora](https://apps.fedoraproject.org/packages/ghc-hakyll)
22+- [Nix](https://nixos.org/nixos/packages.html#hakyll): `$ nix-env -i hakyll`
2023
2124Building the example site
2225-------------------------
@@ -25,7 +28,7 @@ Apart from the main Hakyll library, the cabal package also provides you with an
2528executable `hakyll-init` to create an example site. This is an easy way to get
2629started:
2730
28− $ hakyll-init my-site
31+ $ stack exec hakyll-init my-site
2932
3033This creates a folder `my-site` in the current directory, with some example
3134content and a generic configuration.
web/tutorials/02-basics.markdown+1
@@ -1,6 +1,7 @@
11---
22title: The basics
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Building and cleaning
web/tutorials/03-rules-routes-compilers.markdown+1
@@ -1,6 +1,7 @@
11---
22title: Rules, routes and compilers
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Basic rules
web/tutorials/04-compilers.markdown+18−3
@@ -1,6 +1,7 @@
11---
22title: 'More on compilers: load, and templates'
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Loading items
@@ -92,7 +93,7 @@ And `$title$` like this:
9293titleContext :: Context a
9394titleContext = field "title" $ \item -> do
9495 metadata <- getMetadata (itemIdentifier item)
95− return $ fromMaybe "No title" $ M.lookup "title" metadata
96+ return $ fromMaybe "No title" $ lookupString "title" metadata
9697```
9798
9899And compose them using the `Monoid` instance:
@@ -130,7 +131,7 @@ postCtx =
130131### Loading and applying templates
131132
132133Now we know about templates, context and how to load arbitrary items. This gives
133−us enough background information in order to understand you can apply a
134+us enough background information in order to understand how you can apply a
134135template:
135136
136137```haskell
@@ -151,7 +152,7 @@ Control flow in templates
151152-------------------------
152153
153154Sometimes string interpolation does not suffice, and you want a little more
154−control over how your templates are layed out. Hakyll provides a few control
155+control over how your templates are laid out. Hakyll provides a few control
155156structures for this. The syntax for these structures was based on the syntax
156157used in pandoc templates, since Hakyll already has tight integration with
157158pandoc.
@@ -236,6 +237,20 @@ This uses the `$for(foo)$` construct. This construct allows you loop over a
236237list, in this case, `$posts$`. Inside the body of this for loop, all fields
237238refer to the current post, e.g.: `$url$`, `$title$` and `$date$`.
238239
240+You can also add a simple separator with the special `$sep$` field.
241+Everything between `$sep$` and `$endfor$` will be regarded as a separator
242+that will only be shown if there is more than one item in the list.
243+
244+```html
245+<ul>
246+ $for(posts)$
247+ $x$
248+ $sep$,
249+ $endfor$
250+</ul>
251+```
252+
253+
239254Of course, $posts$ does not magically appear. We have to specify this in
240255`site.hs`. Let's look at how `archive.html` is generated:
241256
web/tutorials/05-snapshots-feeds.markdown+1
@@ -1,6 +1,7 @@
11---
22title: Snapshots, and how to produce an RSS/Atom feed
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Basic feed configuration
web/tutorials/06-versions.markdown+1
@@ -1,6 +1,7 @@
11---
22title: Producing multiple versions of a single file
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Basics
web/tutorials/a-guide-to-the-hakyll-module-zoo.markdown+1
@@ -1,6 +1,7 @@
11---
22title: A Guide to the Hakyll Module Zoo
33author: Brent Yorgey
4+type: article
45---
56
67The hakyll package [contains a bewildering array](/reference/) of modules, and
web/tutorials/external-add-tags-to-your-hakyll-blog.md+1−1
@@ -2,5 +2,5 @@
22title: Add tags to your Hakyll blog
33author: Javran Cheng
44url: https://javran.github.io/posts/2014-03-01-add-tags-to-your-hakyll-blog.html
5−external: true
5+type: external
66---
web/tutorials/external-blogger-port.mdnew file+6
@@ -0,0 +1,6 @@
1+---
2+title: Port an existing Blogger blog to Hakyll
3+author: Daniel Campoverde
4+url: 'http://www.sillybytes.net/posts/from_blogger_to_hakyll.html'
5+type: external
6+---
web/tutorials/external-cassius-template.mdnew file+6
@@ -0,0 +1,6 @@
1+---
2+title: Using Cassius templating with Hakyll
3+author: Daniel Campoverde
4+url: 'http://www.sillybytes.net/posts/using_hakyll_with_cassius.html'
5+type: external
6+---
web/tutorials/external-clean-urls-with-hakyll.md+1−1
@@ -2,5 +2,5 @@
22title: Clean URLs with Hakyll
33author: Rohan Jain
44url: http://www.rohanjain.in/hakyll-clean-urls/
5−external: true
5+type: external
66---
web/tutorials/external-deploying-with-widely.md+1−1
@@ -2,5 +2,5 @@
22title: Deploying with Widely
33author: Kyle Marek-Spartz
44url: http://kyle.marek-spartz.org/posts/2013-12-09-widely-and-hakyll.html
5−external: true
5+type: external
66---
web/tutorials/external-external-code-inclusion.mdnew file+6
@@ -0,0 +1,6 @@
1+---
2+title: 'External code inclusion with Hakyll'
3+author: 'Tobias Pleyer'
4+url: 'http://blog.tpleyer.de/posts/2019-04-21-external-code-inclusion-with-hakyll.html'
5+type: external
6+---
web/tutorials/external-functionfield.md+1−1
@@ -2,5 +2,5 @@
22title: Hakyll's functionField
33author: Beerend Lauwers
44url: http://beerendlauwers.be/posts/2015-09-21-hakylls-functionfield.html
5−external: true
5+type: external
66---
web/tutorials/external-github-pages-circle-ci.md+1−1
@@ -2,5 +2,5 @@
22title: Create a GitHub page with Hakyll and CircleCI
33author: Juan Pedro Villa
44url: https://www.stackbuilders.com/news/dr-hakyll-create-a-github-page-with-hakyll-and-circleci
5−external: true
5+type: external
66---
web/tutorials/external-inlining-and-compressing-css.md+1−1
@@ -2,5 +2,5 @@
22title: Inlining and compressing CSS
33author: Kyle Marek-Spartz
44url: http://kyle.marek-spartz.org/posts/2014-12-09-hakyll-css-template-compiler.html
5−external: true
5+type: external
66---
web/tutorials/external-live-reload.mddeleted−6
@@ -1,6 +0,0 @@
1−---
2−title: Live Reloading with Hakyll
3−author: Ben Kolera
4−url: 'http://benkolera.com/posts/2015-09-14-hakyll_livereload.html'
5−external: true
6−---
web/tutorials/faq.markdown+1
@@ -1,6 +1,7 @@
11---
22title: FAQ
33author: Jasper Van der Jeugt
4+type: article
45---
56
67## "hGetContents: invalid argument" or "commitBuffer: invalid argument"
web/tutorials/github-pages-tutorial.md+1
@@ -1,6 +1,7 @@
11---
22title: Using Hakyll with GitHub Pages
33author: Erik Stevenson
4+type: article
45---
56
67## Introduction
web/tutorials/hakyll-3-to-hakyll4-migration-guide.markdown+1
@@ -1,6 +1,7 @@
11---
22title: Hakyll 3 to Hakyll 4 migration guide
33author: Jasper Van der Jeugt
4+type: article
45---
56
67Introduction
web/tutorials/robertwpearce-01-setup-and-initial-customization.htmlnew file+5
@@ -0,0 +1,5 @@
1+---
2+title: 'Pt. 1: Setup & Initial Customization'
3+url: 'https://robertwpearce.com/hakyll-pt-1-setup-and-initial-customization.html'
4+type: robertwpearce
5+---
web/tutorials/robertwpearce-02-generating-a-sitemap-xml-file.htmlnew file+5
@@ -0,0 +1,5 @@
1+---
2+title: 'Pt. 2: Generating a Sitemap XML File'
3+url: 'https://robertwpearce.com/hakyll-pt-2-generating-a-sitemap-xml-file.html'
4+type: robertwpearce
5+---
web/tutorials/robertwpearce-03-generating-rss-and-atom-xml-feeds.htmlnew file+5
@@ -0,0 +1,5 @@
1+---
2+title: 'Pt. 3: Generating RSS and Atom XML Feeds'
3+url: 'https://robertwpearce.com/hakyll-pt-3-generating-rss-and-atom-xml-feeds.html'
4+type: robertwpearce
5+---
web/tutorials/robertwpearce-04-copying-static-files-for-your-build.htmlnew file+5
@@ -0,0 +1,5 @@
1+---
2+title: 'Pt. 4: Copying Static Files For Your Build'
3+url: 'https://robertwpearce.com/hakyll-pt-4-copying-static-files-for-your-build.html'
4+type: robertwpearce
5+---
web/tutorials/robertwpearce-05-generating-custom-post-filenames-from-a-title-slug.htmlnew file+5
@@ -0,0 +1,5 @@
1+---
2+title: 'Pt. 5 – Generating Custom Post Filenames From a Title Slug'
3+url: 'https://robertwpearce.com/hakyll-pt-5-generating-custom-post-filenames-from-a-title-slug.html'
4+type: robertwpearce
5+---
web/tutorials/using-clay-with-hakyll.markdown+1
@@ -1,6 +1,7 @@
11---
22title: Using Clay with Hakyll
33author: Jasper Van der Jeugt
4+type: article
45---
56
67[Clay](http://sebastiaanvisser.github.com/clay/) is a nice CSS preprocesser
web/tutorials/using-teasers-in-hakyll.markdown+1
@@ -1,6 +1,7 @@
11---
22title: Using teasers in Hakyll
33author: Ivan Veselov
4+type: article
45---
56
67## Introduction