git.iko.soy/hakyll
on master help sign in
swap
6782404319 ahead, 0 behind
143 files changed+4105−1869
since splitsnapshots
unifiedsplit
.circleci/config.yml+19 .circleci/tickle.sh+24 .ghci+1−2 .gitignore+5−1 .travis.yml−1 web/releases.markdown → CHANGELOG.md+238 CODE_OF_CONDUCT.md+45 LICENSE+1−1 Makefile+6−6 README.markdown+5−1 data/example/css/default.css+122−37 data/example/posts/2012-08-12-spqr.markdown → data/example/posts/2015-08-12-spqr.markdown data/example/posts/2012-10-07-rosa-rosa-rosam.markdown → data/example/posts/2015-10-07-rosa-rosa-rosam.markdown data/example/posts/2012-11-28-carpe-diem.markdown → data/example/posts/2015-11-28-carpe-diem.markdown data/example/posts/2012-12-07-tu-quoque.markdown → data/example/posts/2015-12-07-tu-quoque.markdown data/example/templates/default.html+16−16 data/example/templates/post.html+11−8 hakyll.cabal+153−119 lib/Data/List/Extended.hs+15 lib/Data/Yaml/Extended.hs+24 src/Hakyll.hs → lib/Hakyll.hs+7−1 lib/Hakyll/Check.hs+302 src/Hakyll/Commands.hs → lib/Hakyll/Commands.hs+14−10 src/Hakyll/Core/Compiler.hs → lib/Hakyll/Core/Compiler.hs+44−3 src/Hakyll/Core/Compiler/Internal.hs → lib/Hakyll/Core/Compiler/Internal.hs+141−44 src/Hakyll/Core/Compiler/Require.hs → lib/Hakyll/Core/Compiler/Require.hs+2−1 src/Hakyll/Core/Configuration.hs → lib/Hakyll/Core/Configuration.hs src/Hakyll/Core/Dependencies.hs → lib/Hakyll/Core/Dependencies.hs−1 src/Hakyll/Core/File.hs → lib/Hakyll/Core/File.hs+11−4 src/Hakyll/Core/Identifier.hs → lib/Hakyll/Core/Identifier.hs+1−2 src/Hakyll/Core/Identifier/Pattern.hs → lib/Hakyll/Core/Identifier/Pattern.hs+14−74 lib/Hakyll/Core/Identifier/Pattern/Internal.hs+92 src/Hakyll/Core/Item.hs → lib/Hakyll/Core/Item.hs−2 src/Hakyll/Core/Item/SomeItem.hs → lib/Hakyll/Core/Item/SomeItem.hs src/Hakyll/Core/Logger.hs → lib/Hakyll/Core/Logger.hs+9−4 lib/Hakyll/Core/Metadata.hs+138 src/Hakyll/Core/Provider.hs → lib/Hakyll/Core/Provider.hs src/Hakyll/Core/Provider/Internal.hs → lib/Hakyll/Core/Provider/Internal.hs−2 lib/Hakyll/Core/Provider/Metadata.hs+152 src/Hakyll/Core/Provider/MetadataCache.hs → lib/Hakyll/Core/Provider/MetadataCache.hs+3−6 src/Hakyll/Core/Routes.hs → lib/Hakyll/Core/Routes.hs+17−1 src/Hakyll/Core/Rules.hs → lib/Hakyll/Core/Rules.hs−2 src/Hakyll/Core/Rules/Internal.hs → lib/Hakyll/Core/Rules/Internal.hs+14−2 src/Hakyll/Core/Runtime.hs → lib/Hakyll/Core/Runtime.hs+6−8 src/Hakyll/Core/Store.hs → lib/Hakyll/Core/Store.hs+26−24 src/Hakyll/Core/UnixFilter.hs → lib/Hakyll/Core/UnixFilter.hs+3−3 src/Hakyll/Core/Util/File.hs → lib/Hakyll/Core/Util/File.hs−1 src/Hakyll/Core/Util/Parser.hs → lib/Hakyll/Core/Util/Parser.hs+10−4 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 lib/Hakyll/Preview/Server.hs+35 lib/Hakyll/Web/CompressCss.hs+101 src/Hakyll/Web/Feed.hs → lib/Hakyll/Web/Feed.hs+65−24 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+29−3 src/Hakyll/Web/Pandoc.hs → lib/Hakyll/Web/Pandoc.hs+13−14 src/Hakyll/Web/Pandoc/Biblio.hs → lib/Hakyll/Web/Pandoc/Biblio.hs+22−14 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+10−7 lib/Hakyll/Web/Template.hs+178 src/Hakyll/Web/Template/Context.hs → lib/Hakyll/Web/Template/Context.hs+150−35 lib/Hakyll/Web/Template/Internal.hs+261 src/Hakyll/Web/Template/Internal.hs → lib/Hakyll/Web/Template/Internal/Element.hs+138−68 lib/Hakyll/Web/Template/Internal/Trim.hs+95 src/Hakyll/Web/Template/List.hs → lib/Hakyll/Web/Template/List.hs src/Hakyll/Check.hs−250 src/Hakyll/Core/Metadata.hs−64 src/Hakyll/Core/Provider/Metadata.hs−135 src/Hakyll/Main.hs−128 src/Hakyll/Preview/Server.hs−54 src/Hakyll/Web/CompressCss.hs−60 src/Hakyll/Web/Template.hs−264 src/Hakyll/Init.hs → src/Init.hs+44−17 stack.yaml+33 test.hs+30 tests/Hakyll/Core/Dependencies/Tests.hs+3−3 tests/Hakyll/Core/Identifier/Tests.hs+6−5 tests/Hakyll/Core/Provider/Metadata/Tests.hs+24−15 tests/Hakyll/Core/Provider/Tests.hs+8−12 tests/Hakyll/Core/Routes/Tests.hs+7−9 tests/Hakyll/Core/Rules/Tests.hs+8−12 tests/Hakyll/Core/Runtime/Tests.hs+17−4 tests/Hakyll/Core/Store/Tests.hs+16−16 tests/Hakyll/Core/UnixFilter/Tests.hs+23−13 tests/Hakyll/Core/Util/String/Tests.hs+3−3 tests/Hakyll/Web/CompressCss/Tests.hs+64 tests/Hakyll/Web/Html/RelativizeUrls/Tests.hs+4−3 tests/Hakyll/Web/Html/Tests.hs+9−9 tests/Hakyll/Web/Pandoc/FileType/Tests.hs+3−3 tests/Hakyll/Web/Template/Context/Tests.hs+44−8 tests/Hakyll/Web/Template/Tests.hs+93−25 tests/TestSuite.hs+11−2 tests/TestSuite/Util.hs+36−15 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/partial-helper.html+3 tests/data/partial.html+3 tests/data/partial.html.out+7 tests/data/posts/2018-09-26.md+1 tests/data/posts/2019/05/10/tomorrow.md+1 tests/data/strip.html+34 tests/data/strip.html.out+18 web/css/syntax.css+61−18 web/examples.markdown+68−30 web/index.markdown+4−2 web/libraries.markdown+1 web/site.hs+29−32 web/templates/default.html+1−6 web/templates/tutorial-item.html−1 web/templates/tutorials.html+47−4 web/tutorials/01-installation.markdown+16−22 web/tutorials/02-basics.markdown+12−11 web/tutorials/03-rules-routes-compilers.markdown+1 web/tutorials/04-compilers.markdown+23−6 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+6 web/tutorials/external-blogger-port.md+6 web/tutorials/external-cassius-template.md+6 web/tutorials/external-clean-urls-with-hakyll.md+6 web/tutorials/external-deploying-with-widely.md+6 web/tutorials/external-external-code-inclusion.md+6 web/tutorials/external-functionfield.md+6 web/tutorials/external-github-pages-circle-ci.md+6 web/tutorials/external-inlining-and-compressing-css.md+6 web/tutorials/faq.markdown+13 web/tutorials/github-pages-tutorial.md+72−14 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!"
.ghci+1−2
@@ -1,2 +1 @@
1−:set -isrc -isrc-interval -itests -idist/build/autogen -DPREVIEW_SERVER
2−:set -optP-include -optPdist/build/autogen/cabal_macros.h
1+:set -isrc -itests -idist/build/autogen -DPREVIEW_SERVER
.gitignore+5−1
@@ -1,4 +1,4 @@
1−# Ignore swap files and cabal output.
1+# Ignore swap files and stack/cabal output.
22*.hi
33*.o
44*.swo
@@ -10,6 +10,7 @@ dist
1010tags
1111cabal.sandbox.config
1212.cabal-sandbox/
13+.stack-work
1314
1415# Ignore test builds.
1516tests/Main
@@ -22,3 +23,6 @@ web/_cache
2223web/_site
2324web/site
2425web/reference
26+
27+# This is generated from the CHANGELOG
28+web/releases.markdown
.travis.ymldeleted−1
@@ -1 +0,0 @@
1−language: haskell
web/releases.markdown → CHANGELOG.mdrenamed+238
@@ -4,6 +4,244 @@ 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+
172+## Hakyll 4.9.1.0
173+
174+- Allow optparse-applicative 0.13, QuickCheck 2.9, and pandoc 1.18
175+ (contributions by Chris Wong and Felix Yan)
176+- Fix extra test files for packaging source files (contribution by Julien
177+ Langlois)
178+
179+## Hakyll 4.9.0.0
180+
181+This release switches over some dependencies to alternatives, in order to clean
182+up some stuff and build on a wider variety of setups (stack/cabal).
183+
184+- Move from `test-framework` to `tasty`
185+- Fix feed generator when item contains CDATA (contribution by Yann Esposito)
186+- Fix CompressCSS to not modify string constants (contribution by Nicole Rauch)
187+- Fix YAML dependency issue (contribution by Jens Peterson)
188+- Move from `cmdargs` to `optparse-applicative` (contribution by sk3r)
189+- Allow for trimming whitespace in templates (contribution by Sam Davis)
190+- Improve error messages for template parsing (contribution by Lorenzo
191+ Tabacchini)
192+- Improvements to the installation instructions (contribution by Thomas Koch)
193+- Move from `snap` to `warp` for preview servier (contribution by Arguggi)
194+- Fix error in CompressCSS (contribution by Luca Molteni)
195+- Move example from XHTML to HTML5 (contribution by Peter Doherty)
196+- Make errors in check less verbose (contribution by Jan Tojnar)
197+- Work on building with GHC 8.0.1 (contribution by Rohan Jain)
198+
199+## Hakyll 4.8.3.2
200+
201+This release is compatible with GHC 8.0.1, although `previewServer` might not
202+work yet on some setups.
203+
204+- Allow data-default 0.7, pandoc-citeproc 0.10, and tagsoup 0.14 (contributions
205+ by Paul van der Walt and Felix Yan)
206+- Allow binary 0.8, process 1.4, time 1.6 (contribution by Sergei Trofimovich)
207+- Fix issue with `.metadata` file reading
208+
209+## Hakyll 4.8.3.1
210+
211+- Bump scientific dependency to 0.3.4
212+
213+## Hakyll 4.8.3.0
214+
215+- Fix another compilation issue wrt. orphan `Show` instance from regex-tdfa
216+ (contribution by Sergei Trofimovich)
217+
218+## Hakyll 4.8.2.0
219+
220+- Fix compilation issue wrt. orphan `Show` instance from regex-tdfa
221+
222+## Hakyll 4.8.1.0
223+
224+- Fix compilation on windows
225+
226+## Hakyll 4.8.0.1
227+
228+- Fix issue with test suite
229+
230+## Hakyll 4.8.0.0
231+
232+- Support full YAML in page metadata
233+- Bump data-default dependency to 0.6
234+- Add snippet field for literal includes in templates (contribution by Nicolas
235+ Mattia)
236+
237+## Hakyll 4.7.5.2
238+
239+- Bump pandoc dependency to 1.17 (contribution by Felix Yan)
240+- Fix `unixFilter` documentation (contribution by Richard Cook)
241+- Bump example posts (contribution by Andrew Barchuk)
242+- Add a template compiler that only uses the template body (contribution by
243+ Bergi)
244+
7245## Hakyll 4.7.5.1
8246
9247- Bump pandoc and pandoc-citeproc dependencies to 1.16 and 0.9 respectively
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+5−1
@@ -1,6 +1,6 @@
11# hakyll
22
3−[![Build Status](https://secure.travis-ci.org/jaspervdj/hakyll.png?branch=master)](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
@@ -9,3 +9,7 @@ Hakyll is a static site generator library in Haskell. More information
99You can install this library using cabal:
1010
1111 cabal install hakyll
12+
13+Or using stack:
14+
15+ stack install hakyll
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/posts/2012-08-12-spqr.markdown → data/example/posts/2015-08-12-spqr.markdownrenamed

The content is the same.

data/example/posts/2012-10-07-rosa-rosa-rosam.markdown → data/example/posts/2015-10-07-rosa-rosa-rosam.markdownrenamed

The content is the same.

data/example/posts/2012-11-28-carpe-diem.markdown → data/example/posts/2015-11-28-carpe-diem.markdownrenamed

The content is the same.

data/example/posts/2012-12-07-tu-quoque.markdown → data/example/posts/2015-12-07-tu-quoque.markdownrenamed

The content is the same.

data/example/templates/default.html+16−16
@@ -1,33 +1,33 @@
1−<?xml version="1.0" encoding="UTF-8"?>
2−<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
3−"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
4−<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1+<!doctype html>
2+<html lang="en">
53 <head>
6− <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
4+ <meta charset="utf-8">
5+ <meta http-equiv="x-ua-compatible" content="ie=edge">
6+ <meta name="viewport" content="width=device-width, initial-scale=1">
77 <title>My Hakyll Blog - $title$</title>
8− <link rel="stylesheet" type="text/css" href="/css/default.css" />
8+ <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>
25−
2625 $body$
27− </div>
28− <div id="footer">
26+ </main>
27+
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+153−119
@@ -1,5 +1,5 @@
11Name: hakyll
2−Version: 4.7.5.1
2+Version: 4.13.0.0
33
44Synopsis: A static website compiler library
55Description:
@@ -37,15 +37,15 @@ 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
4444Data-files:
45− example/posts/2012-11-28-carpe-diem.markdown
46− example/posts/2012-10-07-rosa-rosa-rosam.markdown
47− example/posts/2012-12-07-tu-quoque.markdown
48− example/posts/2012-08-12-spqr.markdown
45+ example/posts/2015-11-28-carpe-diem.markdown
46+ example/posts/2015-10-07-rosa-rosa-rosam.markdown
47+ example/posts/2015-12-07-tu-quoque.markdown
48+ example/posts/2015-08-12-spqr.markdown
4949 example/site.hs
5050 example/images/haskell-logo.png
5151 example/templates/post-list.html
@@ -56,19 +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
67+ tests/data/partial-helper.html
68+ tests/data/partial.html
69+ tests/data/partial.html.out
6870 tests/data/posts/2010-08-26-birthday.md
71+ tests/data/posts/2018-09-26.md
6972 tests/data/russian.md
73+ tests/data/strip.html
74+ tests/data/strip.html.out
7075 tests/data/template.html
7176 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
7281
7382Source-Repository head
7483 Type: git
@@ -86,23 +95,43 @@ Flag checkExternal
8695 Description: Include external link checking
8796 Default: True
8897
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+
89108Library
90− Ghc-Options: -Wall
91− Hs-Source-Dirs: src
109+ Ghc-Options: -Wall
110+ Hs-Source-Dirs: lib
111+ Default-language: Haskell2010
92112
93113 Exposed-Modules:
94114 Hakyll
115+ Hakyll.Commands
95116 Hakyll.Core.Compiler
117+ Hakyll.Core.Compiler.Internal
96118 Hakyll.Core.Configuration
97119 Hakyll.Core.Dependencies
98120 Hakyll.Core.File
99121 Hakyll.Core.Identifier
100122 Hakyll.Core.Identifier.Pattern
101123 Hakyll.Core.Item
124+ Hakyll.Core.Logger
102125 Hakyll.Core.Metadata
126+ Hakyll.Core.Provider
127+ Hakyll.Core.Provider.Metadata
103128 Hakyll.Core.Routes
104129 Hakyll.Core.Rules
130+ Hakyll.Core.Rules.Internal
131+ Hakyll.Core.Runtime
132+ Hakyll.Core.Store
105133 Hakyll.Core.UnixFilter
134+ Hakyll.Core.Util.File
106135 Hakyll.Core.Util.String
107136 Hakyll.Core.Writable
108137 Hakyll.Main
@@ -110,70 +139,67 @@ Library
110139 Hakyll.Web.Feed
111140 Hakyll.Web.Html
112141 Hakyll.Web.Html.RelativizeUrls
113− Hakyll.Web.Pandoc
114− Hakyll.Web.Pandoc.Biblio
115− Hakyll.Web.Pandoc.FileType
116− Hakyll.Web.Tags
117142 Hakyll.Web.Paginate
143+ Hakyll.Web.Redirect
144+ Hakyll.Web.Tags
118145 Hakyll.Web.Template
119− Hakyll.Web.Template.Internal
120146 Hakyll.Web.Template.Context
147+ Hakyll.Web.Template.Internal
148+ Hakyll.Web.Template.Internal.Element
149+ Hakyll.Web.Template.Internal.Trim
121150 Hakyll.Web.Template.List
122151
123152 Other-Modules:
153+ Data.List.Extended
154+ Data.Yaml.Extended
124155 Hakyll.Check
125− Hakyll.Commands
126− Hakyll.Core.Compiler.Internal
127156 Hakyll.Core.Compiler.Require
157+ Hakyll.Core.Identifier.Pattern.Internal
128158 Hakyll.Core.Item.SomeItem
129− Hakyll.Core.Logger
130− Hakyll.Core.Provider
131159 Hakyll.Core.Provider.Internal
132− Hakyll.Core.Provider.Metadata
133160 Hakyll.Core.Provider.MetadataCache
134− Hakyll.Core.Rules.Internal
135− Hakyll.Core.Runtime
136− Hakyll.Core.Store
137− Hakyll.Core.Util.File
138161 Hakyll.Core.Util.Parser
139− Hakyll.Web.Pandoc.Binary
140162 Paths_hakyll
141163
142164 Build-Depends:
143− base >= 4 && < 5,
144− binary >= 0.5 && < 0.8,
145− blaze-html >= 0.5 && < 0.9,
146− blaze-markup >= 0.5.1 && < 0.8,
147− bytestring >= 0.9 && < 0.11,
148− cmdargs >= 0.10 && < 0.11,
149− containers >= 0.3 && < 0.6,
150− cryptohash >= 0.7 && < 0.12,
151− data-default >= 0.4 && < 0.6,
152− deepseq >= 1.3 && < 1.5,
153− directory >= 1.0 && < 1.3,
154− filepath >= 1.0 && < 1.5,
155− lrucache >= 1.1.1 && < 1.3,
156− mtl >= 1 && < 2.3,
157− network >= 2.6 && < 2.7,
158− network-uri >= 2.6 && < 2.7,
159− pandoc >= 1.14 && < 1.17,
160− pandoc-citeproc >= 0.4 && < 0.10,
161− parsec >= 3.0 && < 3.2,
162− process >= 1.0 && < 1.3,
163− random >= 1.0 && < 1.2,
164− regex-base >= 0.93 && < 0.94,
165− regex-tdfa >= 1.1 && < 1.3,
166− tagsoup >= 0.13.1 && < 0.14,
167− text >= 0.11 && < 1.3,
168− time >= 1.4 && < 1.6,
169− time-locale-compat >= 0.1 && < 0.2
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
170195
171196 If flag(previewServer)
172197 Build-depends:
173− snap-core >= 0.6 && < 0.10,
174− snap-server >= 0.6 && < 0.10,
175− fsnotify >= 0.2 && < 0.3,
176− system-filepath >= 0.4.6 && <= 0.5
198+ wai >= 3.2 && < 3.3,
199+ warp >= 3.2 && < 3.3,
200+ wai-app-static >= 3.1 && < 3.2,
201+ http-types >= 0.9 && < 0.13,
202+ fsnotify >= 0.2 && < 0.4
177203 Cpp-options:
178204 -DPREVIEW_SERVER
179205 Other-modules:
@@ -182,8 +208,7 @@ Library
182208
183209 If flag(watchServer)
184210 Build-depends:
185− fsnotify >= 0.2 && < 0.3,
186− system-filepath >= 0.4.6 && <= 0.5
211+ fsnotify >= 0.2 && < 0.4
187212 Cpp-options:
188213 -DWATCH_SERVER
189214 Other-modules:
@@ -191,16 +216,31 @@ Library
191216
192217 If flag(checkExternal)
193218 Build-depends:
194− http-conduit >= 2.1 && < 2.2,
195− http-types >= 0.7 && < 0.10
219+ http-conduit >= 2.2 && < 2.4,
220+ http-types >= 0.7 && < 0.13
196221 Cpp-options:
197222 -DCHECK_EXTERNAL
198223
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+
199237Test-suite hakyll-tests
200− Type: exitcode-stdio-1.0
201− Hs-source-dirs: src tests
202− Main-is: TestSuite.hs
203− 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+
204244 Other-modules:
205245 Hakyll.Core.Dependencies.Tests
206246 Hakyll.Core.Identifier.Tests
@@ -212,82 +252,76 @@ Test-suite hakyll-tests
212252 Hakyll.Core.Store.Tests
213253 Hakyll.Core.UnixFilter.Tests
214254 Hakyll.Core.Util.String.Tests
255+ Hakyll.Web.CompressCss.Tests
215256 Hakyll.Web.Html.RelativizeUrls.Tests
216257 Hakyll.Web.Html.Tests
217− Hakyll.Web.Pandoc.FileType.Tests
258+ Hakyll.Web.Tags.Tests
218259 Hakyll.Web.Template.Context.Tests
219260 Hakyll.Web.Template.Tests
220261 TestSuite.Util
221262
222263 Build-Depends:
223− HUnit >= 1.2 && < 1.4,
224− QuickCheck >= 2.4 && < 2.9,
225− test-framework >= 0.4 && < 0.9,
226− test-framework-hunit >= 0.3 && < 0.4,
227− test-framework-quickcheck2 >= 0.3 && < 0.4,
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,
228269 -- Copy pasted from hakyll dependencies:
229− base >= 4 && < 5,
230− binary >= 0.5 && < 0.8,
231− blaze-html >= 0.5 && < 0.9,
232− blaze-markup >= 0.5.1 && < 0.8,
233− bytestring >= 0.9 && < 0.11,
234− cmdargs >= 0.10 && < 0.11,
235− containers >= 0.3 && < 0.6,
236− cryptohash >= 0.7 && < 0.12,
237− data-default >= 0.4 && < 0.6,
238− deepseq >= 1.3 && < 1.5,
239− directory >= 1.0 && < 1.3,
240− filepath >= 1.0 && < 1.5,
241− lrucache >= 1.1.1 && < 1.3,
242− mtl >= 1 && < 2.3,
243− network >= 2.6 && < 2.7,
244− network-uri >= 2.6 && < 2.7,
245− pandoc >= 1.14 && < 1.17,
246− pandoc-citeproc >= 0.4 && < 0.10,
247− parsec >= 3.0 && < 3.2,
248− process >= 1.0 && < 1.3,
249− random >= 1.0 && < 1.2,
250− regex-base >= 0.93 && < 0.94,
251− regex-tdfa >= 1.1 && < 1.3,
252− tagsoup >= 0.13.1 && < 0.14,
253− text >= 0.11 && < 1.3,
254− time >= 1.5 && < 1.6,
255− time-locale-compat >= 0.1 && < 0.2
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
256277
257278 If flag(previewServer)
258− Build-depends:
259− snap-core >= 0.6 && < 0.10,
260− snap-server >= 0.6 && < 0.10,
261− fsnotify >= 0.2 && < 0.3,
262− system-filepath >= 0.4.6 && <= 0.5
263279 Cpp-options:
264280 -DPREVIEW_SERVER
265− Other-modules:
266− Hakyll.Preview.Poll
267− Hakyll.Preview.Server
268281
269282 If flag(watchServer)
270− Build-depends:
271− fsnotify >= 0.2 && < 0.3,
272− system-filepath >= 0.4.6 && <= 0.5
273283 Cpp-options:
274284 -DWATCH_SERVER
275− Other-modules:
276− Hakyll.Preview.Poll
277285
278286 If flag(checkExternal)
279− Build-depends:
280− http-conduit >= 2.1 && < 2.2,
281− http-types >= 0.7 && < 0.10
282287 Cpp-options:
283288 -DCHECK_EXTERNAL
284289
290+ If flag(usePandoc)
291+ Other-modules:
292+ Hakyll.Web.Pandoc.FileType.Tests
293+ Cpp-options:
294+ -DUSE_PANDOC
295+
285296Executable hakyll-init
286− Ghc-options: -Wall
287− Hs-source-dirs: src
288− 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
289304
290305 Build-depends:
306+ hakyll,
291307 base >= 4 && < 5,
292− directory >= 1.0 && < 1.3,
308+ directory >= 1.0 && < 1.4,
293309 filepath >= 1.0 && < 1.5
310+
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
lib/Data/List/Extended.hsnew file+15
@@ -0,0 +1,15 @@
1+module Data.List.Extended
2+ ( module Data.List
3+ , breakWhen
4+ ) where
5+
6+import Data.List
7+
8+-- | Like 'break', but can act on the entire tail of the list.
9+breakWhen :: ([a] -> Bool) -> [a] -> ([a], [a])
10+breakWhen predicate = go []
11+ where
12+ go buf [] = (reverse buf, [])
13+ go buf (x : xs)
14+ | predicate (x : xs) = (reverse buf, x : xs)
15+ | otherwise = go (x : buf) xs
lib/Data/Yaml/Extended.hsnew file+24
@@ -0,0 +1,24 @@
1+module Data.Yaml.Extended
2+ ( module Data.Yaml
3+ , toString
4+ , toList
5+ ) where
6+
7+import qualified Data.Text as T
8+import qualified Data.Vector as V
9+import Data.Yaml
10+import Data.Scientific
11+
12+toString :: Value -> Maybe String
13+toString (String t) = Just (T.unpack t)
14+toString (Bool True) = Just "true"
15+toString (Bool False) = Just "false"
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)
20+toString _ = Nothing
21+
22+toList :: Value -> Maybe [Value]
23+toList (Array a) = Just (V.toList a)
24+toList _ = Nothing
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
lib/Hakyll/Check.hsnew file+302
@@ -0,0 +1,302 @@
1+--------------------------------------------------------------------------------
2+{-# LANGUAGE CPP #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+module Hakyll.Check
5+ ( Check (..)
6+ , check
7+ ) where
8+
9+
10+--------------------------------------------------------------------------------
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)
18+import Control.Monad.Trans (liftIO)
19+import Control.Monad.Trans.Resource (runResourceT)
20+import Data.List (isPrefixOf)
21+import qualified Data.Map.Lazy as Map
22+#if MIN_VERSION_base(4,9,0)
23+import Data.Semigroup (Semigroup (..))
24+#endif
25+import Network.URI (unEscapeString)
26+import System.Directory (doesDirectoryExist,
27+ doesFileExist)
28+import System.Exit (ExitCode (..))
29+import System.FilePath (takeDirectory, takeExtension,
30+ (</>))
31+import qualified Text.HTML.TagSoup as TS
32+
33+
34+--------------------------------------------------------------------------------
35+#ifdef CHECK_EXTERNAL
36+import Data.List (intercalate)
37+import Data.Typeable (cast)
38+import Data.Version (versionBranch)
39+import GHC.Exts (fromString)
40+import qualified Network.HTTP.Conduit as Http
41+import qualified Network.HTTP.Types as Http
42+import qualified Paths_hakyll as Paths_hakyll
43+#endif
44+
45+
46+--------------------------------------------------------------------------------
47+import Hakyll.Core.Configuration
48+import Hakyll.Core.Logger (Logger)
49+import qualified Hakyll.Core.Logger as Logger
50+import Hakyll.Core.Util.File
51+import Hakyll.Web.Html
52+
53+
54+--------------------------------------------------------------------------------
55+data Check = All | InternalLinks
56+ deriving (Eq, Ord, Show)
57+
58+
59+--------------------------------------------------------------------------------
60+check :: Configuration -> Logger -> Check -> IO ExitCode
61+check config logger check' = do
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
73+
74+
75+--------------------------------------------------------------------------------
76+data CheckerRead = CheckerRead
77+ { checkerConfig :: Configuration
78+ , checkerLogger :: Logger
79+ , checkerCheck :: Check
80+ }
81+
82+
83+--------------------------------------------------------------------------------
84+data CheckerWrite = CheckerWrite
85+ { checkerFaulty :: Int
86+ , checkerOk :: Int
87+ } deriving (Show)
88+
89+
90+--------------------------------------------------------------------------------
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
100+instance Monoid CheckerWrite where
101+ mempty = CheckerWrite 0 0
102+ mappend (CheckerWrite f1 o1) (CheckerWrite f2 o2) =
103+ CheckerWrite (f1 + f2) (o1 + o2)
104+#endif
105+
106+
107+--------------------------------------------------------------------------------
108+type CheckerState = Map.Map URL (MVar CheckerWrite)
109+
110+
111+--------------------------------------------------------------------------------
112+type Checker a = ReaderT CheckerRead (StateT CheckerState IO) a
113+
114+
115+--------------------------------------------------------------------------------
116+type URL = String
117+
118+
119+--------------------------------------------------------------------------------
120+runChecker :: Checker a -> Configuration -> Logger -> Check
121+ -> IO (a, CheckerState)
122+runChecker checker config logger check' = do
123+ let read' = CheckerRead
124+ { checkerConfig = config
125+ , checkerLogger = logger
126+ , checkerCheck = check'
127+ }
128+ Logger.flush logger
129+ runStateT (runReaderT checker read') Map.empty
130+
131+
132+--------------------------------------------------------------------------------
133+checkDestination :: Checker ()
134+checkDestination = do
135+ config <- checkerConfig <$> ask
136+ files <- liftIO $ getRecursiveContents
137+ (const $ return False) (destinationDirectory config)
138+
139+ let htmls =
140+ [ destinationDirectory config </> file
141+ | file <- files
142+ , takeExtension file == ".html"
143+ ]
144+
145+ forM_ htmls checkFile
146+
147+
148+--------------------------------------------------------------------------------
149+checkFile :: FilePath -> Checker ()
150+checkFile filePath = do
151+ logger <- checkerLogger <$> ask
152+ contents <- liftIO $ readFile filePath
153+ Logger.header logger $ "Checking file " ++ filePath
154+
155+ let urls = getUrls $ TS.parseTags contents
156+ forM_ urls $ \url -> do
157+ Logger.debug logger $ "Checking link " ++ 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 "//"
164+
165+
166+--------------------------------------------------------------------------------
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 ()
180+checkUrl filePath url
181+ | isExternal url = checkExternalUrl url
182+ | hasProtocol url = skip url $ Just "Unknown protocol, skipping"
183+ | otherwise = checkInternalUrl filePath url
184+ where
185+ validProtoChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "+-."
186+ hasProtocol str = case break (== ':') str of
187+ (proto, ':' : _) -> all (`elem` validProtoChars) proto
188+ _ -> False
189+
190+
191+--------------------------------------------------------------------------------
192+ok :: URL -> Checker ()
193+ok url = putCheckResult url mempty {checkerOk = 1}
194+
195+
196+--------------------------------------------------------------------------------
197+skip :: URL -> Maybe String -> Checker ()
198+skip url maybeReason = do
199+ logger <- checkerLogger <$> ask
200+ case maybeReason of
201+ Nothing -> return ()
202+ Just reason -> Logger.debug logger reason
203+ putCheckResult url mempty {checkerOk = 1}
204+
205+
206+--------------------------------------------------------------------------------
207+faulty :: URL -> Maybe String -> Checker ()
208+faulty url reason = do
209+ logger <- checkerLogger <$> ask
210+ Logger.error logger $ "Broken link to " ++ show url ++ explanation
211+ putCheckResult url mempty {checkerFaulty = 1}
212+ where
213+ formatExplanation = (" (" ++) . (++ ")")
214+ explanation = maybe "" formatExplanation reason
215+
216+
217+--------------------------------------------------------------------------------
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 ()
231+checkInternalUrl base url = case url' of
232+ "" -> ok url
233+ _ -> do
234+ config <- checkerConfig <$> ask
235+ let dest = destinationDirectory config
236+ dir = takeDirectory base
237+ filePath
238+ | "/" `isPrefixOf` url' = dest ++ url'
239+ | otherwise = dir </> url'
240+
241+ exists <- checkFileExists filePath
242+ if exists then ok url else faulty url Nothing
243+ where
244+ url' = stripFragments $ unEscapeString url
245+
246+
247+--------------------------------------------------------------------------------
248+checkExternalUrl :: URL -> Checker ()
249+#ifdef CHECK_EXTERNAL
250+checkExternalUrl url = do
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)
283+#else
284+checkExternalUrl url = skip url Nothing
285+#endif
286+
287+
288+--------------------------------------------------------------------------------
289+-- | Wraps doesFileExist, also checks for index.html
290+checkFileExists :: FilePath -> Checker Bool
291+checkFileExists filePath = liftIO $ do
292+ file <- doesFileExist filePath
293+ dir <- doesDirectoryExist filePath
294+ case (file, dir) of
295+ (True, _) -> return True
296+ (_, True) -> doesFileExist $ filePath </> "index.html"
297+ _ -> return False
298+
299+
300+--------------------------------------------------------------------------------
301+stripFragments :: String -> String
302+stripFragments = takeWhile (not . flip elem ['?', '#'])
src/Hakyll/Commands.hs → lib/Hakyll/Commands.hsrenamed+14−10
@@ -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
@@ -14,13 +15,12 @@ module Hakyll.Commands
1415
1516
1617--------------------------------------------------------------------------------
17−import Control.Applicative
1818import Control.Concurrent
19−import Control.Monad (void)
20−import System.Exit (ExitCode, exitWith)
21−import System.IO.Error (catchIOError)
19+import System.Exit (ExitCode)
20+
2221
2322--------------------------------------------------------------------------------
23+import Hakyll.Check (Check(..))
2424import qualified Hakyll.Check as Check
2525import Hakyll.Core.Configuration
2626import Hakyll.Core.Logger (Logger)
@@ -30,6 +30,7 @@ import Hakyll.Core.Rules.Internal
3030import Hakyll.Core.Runtime
3131import Hakyll.Core.Util.File
3232
33+
3334--------------------------------------------------------------------------------
3435#ifdef WATCH_SERVER
3536import Hakyll.Preview.Poll (watchUpdates)
@@ -39,6 +40,11 @@ import Hakyll.Preview.Poll (watchUpdates)
3940import Hakyll.Preview.Server
4041#endif
4142
43+#ifdef mingw32_HOST_OS
44+import Control.Monad (void)
45+import System.IO.Error (catchIOError)
46+#endif
47+
4248
4349--------------------------------------------------------------------------------
4450-- | Build the site
@@ -48,8 +54,8 @@ build conf logger rules = fst <$> run conf logger rules
4854
4955--------------------------------------------------------------------------------
5056-- | Run the checker and exit
51−check :: Configuration -> Logger -> Check.Check -> IO ()
52−check config logger check' = Check.check config logger check' >>= exitWith
57+check :: Configuration -> Logger -> Check.Check -> IO ExitCode
58+check = Check.check
5359
5460
5561--------------------------------------------------------------------------------
@@ -119,9 +125,7 @@ server :: Configuration -> Logger -> String -> Int -> IO ()
119125#ifdef PREVIEW_SERVER
120126server conf logger host port = do
121127 let destination = destinationDirectory conf
122− staticServer logger destination preServeHook host port
123− where
124− preServeHook _ = return ()
128+ staticServer logger destination host port
125129#else
126130server _ _ _ _ = previewServerDisabled
127131#endif
src/Hakyll/Core/Compiler.hs → lib/Hakyll/Core/Compiler.hsrenamed+44−3
@@ -24,14 +24,16 @@ module Hakyll.Core.Compiler
2424 , cached
2525 , unsafeCompiler
2626 , debugCompiler
27+ , noResult
28+ , withErrorMessage
2729 ) where
2830
2931
3032--------------------------------------------------------------------------------
31−import Control.Applicative ((<$>))
32−import Control.Monad (when)
33+import Control.Monad (unless, when, (>=>))
3334import Data.Binary (Binary)
3435import Data.ByteString.Lazy (ByteString)
36+import qualified Data.List.NonEmpty as NonEmpty
3537import Data.Typeable (Typeable)
3638import System.Environment (getProgName)
3739import System.FilePath (takeExtension)
@@ -63,6 +65,7 @@ getUnderlyingExtension = takeExtension . toFilePath <$> getUnderlying
6365
6466
6567--------------------------------------------------------------------------------
68+-- | Create an item from the underlying identifier and a given value.
6669makeItem :: a -> Compiler (Item a)
6770makeItem x = do
6871 identifier <- getUnderlying
@@ -142,6 +145,10 @@ saveSnapshot snapshot item = do
142145
143146
144147--------------------------------------------------------------------------------
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.
145152cached :: (Binary a, Typeable a)
146153 => String
147154 -> Compiler a
@@ -150,6 +157,10 @@ cached name compiler = do
150157 id' <- compilerUnderlying <$> compilerAsk
151158 store <- compilerStore <$> compilerAsk
152159 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+
153164 let modified = resourceModified provider id'
154165 if modified
155166 then do
@@ -167,14 +178,44 @@ cached name compiler = do
167178 "Hakyll.Core.Compiler.cached: Cache corrupt! " ++
168179 "Try running: " ++ progName ++ " clean"
169180
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+
170186
171187--------------------------------------------------------------------------------
188+-- | Run an IO computation without dependencies in a Compiler
172189unsafeCompiler :: IO a -> Compiler a
173190unsafeCompiler = compilerUnsafeIO
174191
175192
176193--------------------------------------------------------------------------------
177−-- | 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.
178219debugCompiler :: String -> Compiler ()
179220debugCompiler msg = do
180221 logger <- compilerLogger <$> compilerAsk
src/Hakyll/Core/Compiler/Internal.hs → lib/Hakyll/Core/Compiler/Internal.hsrenamed+141−44
@@ -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,31 +11,41 @@ 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
2837
2938
3039--------------------------------------------------------------------------------
31−import Control.Applicative (Alternative (..),
32− Applicative (..), (<$>))
40+import Control.Applicative (Alternative (..))
3341import Control.Exception (SomeException, handle)
3442import Control.Monad (forM_)
35−import Control.Monad.Error (MonadError (..))
36−import Data.Monoid (Monoid (..))
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
3749import Data.Set (Set)
3850import qualified Data.Set as S
3951
@@ -43,7 +55,6 @@ import Hakyll.Core.Configuration
4355import Hakyll.Core.Dependencies
4456import Hakyll.Core.Identifier
4557import Hakyll.Core.Identifier.Pattern
46−import Hakyll.Core.Logger (Logger)
4758import qualified Hakyll.Core.Logger as Logger
4859import Hakyll.Core.Metadata
4960import Hakyll.Core.Provider
@@ -73,7 +84,7 @@ data CompilerRead = CompilerRead
7384 , -- | Compiler store
7485 compilerStore :: Store
7586 , -- | Logger
76− compilerLogger :: Logger
87+ compilerLogger :: Logger.Logger
7788 }
7889
7990
@@ -85,18 +96,46 @@ data CompilerWrite = CompilerWrite
8596
8697
8798--------------------------------------------------------------------------------
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
88108instance Monoid CompilerWrite where
89109 mempty = CompilerWrite [] 0
90110 mappend (CompilerWrite d1 h1) (CompilerWrite d2 h2) =
91111 CompilerWrite (d1 ++ d2) (h1 + h2)
112+#endif
92113
93114
94115--------------------------------------------------------------------------------
95−data CompilerResult a where
96− CompilerDone :: a -> CompilerWrite -> CompilerResult a
97− CompilerSnapshot :: Snapshot -> Compiler a -> CompilerResult a
98− CompilerError :: [String] -> CompilerResult a
99− 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)
100139
101140
102141--------------------------------------------------------------------------------
@@ -114,14 +153,14 @@ instance Functor Compiler where
114153 return $ case res of
115154 CompilerDone x w -> CompilerDone (f x) w
116155 CompilerSnapshot s c' -> CompilerSnapshot s (fmap f c')
117− CompilerError e -> CompilerError e
118156 CompilerRequire i c' -> CompilerRequire i (fmap f c')
157+ CompilerError e -> CompilerError e
119158 {-# INLINE fmap #-}
120159
121160
122161--------------------------------------------------------------------------------
123162instance Monad Compiler where
124− return x = Compiler $ \_ -> return $ CompilerDone x mempty
163+ return x = compilerResult $ CompilerDone x mempty
125164 {-# INLINE return #-}
126165
127166 Compiler c >>= f = Compiler $ \r -> do
@@ -134,14 +173,14 @@ instance Monad Compiler where
134173 CompilerSnapshot s c' -> CompilerSnapshot s $ do
135174 compilerTell w -- Save dependencies!
136175 c'
137− CompilerError e -> CompilerError e
138176 CompilerRequire i c' -> CompilerRequire i $ do
139177 compilerTell w -- Save dependencies!
140178 c'
179+ CompilerError e -> CompilerError e
141180
142181 CompilerSnapshot s c' -> return $ CompilerSnapshot s (c' >>= f)
143− CompilerError e -> return $ CompilerError e
144182 CompilerRequire i c' -> return $ CompilerRequire i (c' >>= f)
183+ CompilerError e -> return $ CompilerError e
145184 {-# INLINE (>>=) #-}
146185
147186 fail = compilerThrow . return
@@ -158,87 +197,145 @@ instance Applicative Compiler where
158197
159198
160199--------------------------------------------------------------------------------
200+-- | Access provided metadata from anywhere
161201instance MonadMetadata Compiler where
162202 getMetadata = compilerGetMetadata
163203 getMatches = compilerGetMatches
164204
165205
166206--------------------------------------------------------------------------------
207+-- | Compilation may fail with multiple error messages.
208+-- 'catchError' handles errors from 'throwError', 'fail' and 'Hakyll.Core.Compiler.noResult'
167209instance MonadError [String] Compiler where
168− throwError = compilerThrow
169− catchError = compilerCatch
210+ throwError = compilerThrow
211+ catchError c = compilerCatch c . (. compilerErrorMessages)
170212
171213
172214--------------------------------------------------------------------------------
215+-- | Like 'unCompiler' but treating IO exceptions as 'CompilerError's
173216runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)
174217runCompiler compiler read' = handle handler $ unCompiler compiler read'
175218 where
176219 handler :: SomeException -> IO (CompilerResult a)
177− handler e = return $ CompilerError [show e]
220+ handler e = return $ CompilerError $ CompilationFailure $ show e :| []
178221
179222
180223--------------------------------------------------------------------------------
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.
181227instance Alternative Compiler where
182− empty = compilerThrow []
183− x <|> y = compilerCatch x $ \es -> do
184− logger <- compilerLogger <$> compilerAsk
185− forM_ es $ \e -> compilerUnsafeIO $ Logger.debug logger $
186− "Hakyll.Core.Compiler.Internal: Alternative failed: " ++ e
187− 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"
188241 {-# INLINE (<|>) #-}
189242
190243
191244--------------------------------------------------------------------------------
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
192253compilerAsk :: Compiler CompilerRead
193254compilerAsk = Compiler $ \r -> return $ CompilerDone r mempty
194255{-# INLINE compilerAsk #-}
195256
196257
197258--------------------------------------------------------------------------------
259+-- | Put a 'CompilerWrite'
198260compilerTell :: CompilerWrite -> Compiler ()
199−compilerTell deps = Compiler $ \_ -> return $ CompilerDone () deps
261+compilerTell = compilerResult . CompilerDone ()
200262{-# INLINE compilerTell #-}
201263
202264
203265--------------------------------------------------------------------------------
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.
204279compilerThrow :: [String] -> Compiler a
205−compilerThrow es = Compiler $ \_ -> return $ CompilerError es
206−{-# 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
207287
208288
209289--------------------------------------------------------------------------------
210−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
211310compilerCatch (Compiler x) f = Compiler $ \r -> do
212311 res <- x r
213312 case res of
214313 CompilerDone res' w -> return (CompilerDone res' w)
215314 CompilerSnapshot s c -> return (CompilerSnapshot s (compilerCatch c f))
216− CompilerError e -> unCompiler (f e) r
217315 CompilerRequire i c -> return (CompilerRequire i (compilerCatch c f))
316+ CompilerError e -> unCompiler (f e) r
218317{-# INLINE compilerCatch #-}
219318
220319
221320--------------------------------------------------------------------------------
222−-- | Put the result back in a compiler
223−compilerResult :: CompilerResult a -> Compiler a
224−compilerResult x = Compiler $ \_ -> return x
225−{-# INLINE compilerResult #-}
226−
321+compilerDebugLog :: [String] -> Compiler ()
322+compilerDebugLog ms = do
323+ logger <- compilerLogger <$> compilerAsk
324+ compilerUnsafeIO $ forM_ ms $ Logger.debug logger
227325
228326--------------------------------------------------------------------------------
229−compilerUnsafeIO :: IO a -> Compiler a
230−compilerUnsafeIO io = Compiler $ \_ -> do
231− x <- io
232− return $ CompilerDone x mempty
233−{-# 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
234332
235333
236334--------------------------------------------------------------------------------
237335compilerTellDependencies :: [Dependency] -> Compiler ()
238336compilerTellDependencies ds = do
239− logger <- compilerLogger <$> compilerAsk
240− forM_ ds $ \d -> compilerUnsafeIO $ Logger.debug logger $
241− "Hakyll.Core.Compiler.Internal: Adding dependency: " ++ show d
337+ compilerDebugLog $ map (\d ->
338+ "Hakyll.Core.Compiler.Internal: Adding dependency: " ++ show d) ds
242339 compilerTell mempty {compilerDependencies = ds}
243340{-# INLINE compilerTellDependencies #-}
244341
src/Hakyll/Core/Compiler/Require.hs → lib/Hakyll/Core/Compiler/Require.hsrenamed+2−1
@@ -13,7 +13,6 @@ module Hakyll.Core.Compiler.Require
1313
1414
1515--------------------------------------------------------------------------------
16−import Control.Applicative ((<$>))
1716import Control.Monad (when)
1817import Data.Binary (Binary)
1918import qualified Data.Set as S
@@ -92,6 +91,7 @@ loadBody id' = loadSnapshotBody id' final
9291
9392
9493--------------------------------------------------------------------------------
94+-- | A shortcut for only requiring the body for a specific snapshot of an item
9595loadSnapshotBody :: (Binary a, Typeable a)
9696 => Identifier -> Snapshot -> Compiler a
9797loadSnapshotBody id' snapshot = fmap itemBody $ loadSnapshot id' snapshot
@@ -104,6 +104,7 @@ loadAll pattern = loadAllSnapshots pattern final
104104
105105
106106--------------------------------------------------------------------------------
107+-- | Load a specific snapshot for each of dynamic list of items
107108loadAllSnapshots :: (Binary a, Typeable a)
108109 => Pattern -> Snapshot -> Compiler [Item a]
109110loadAllSnapshots 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−1
@@ -8,7 +8,6 @@ module Hakyll.Core.Dependencies
88
99
1010--------------------------------------------------------------------------------
11−import Control.Applicative ((<$>), (<*>))
1211import Control.Monad (foldM, forM_, unless, when)
1312import Control.Monad.Reader (ask)
1413import Control.Monad.RWS (RWS, runRWS)
src/Hakyll/Core/File.hs → lib/Hakyll/Core/File.hsrenamed+11−4
@@ -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
@@ -11,10 +12,14 @@ module Hakyll.Core.File
1112
1213
1314--------------------------------------------------------------------------------
14−import Control.Applicative ((<$>))
1515import Data.Binary (Binary (..))
1616import Data.Typeable (Typeable)
17−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,
1823 renameFile)
1924import System.FilePath ((</>))
2025import System.Random (randomIO)
@@ -39,9 +44,11 @@ newtype CopyFile = CopyFile FilePath
3944
4045--------------------------------------------------------------------------------
4146instance Writable CopyFile where
47+#if MIN_VERSION_directory(1,2,6)
48+ write dst (Item _ (CopyFile src)) = copyFileWithMetadata src dst
49+#else
4250 write dst (Item _ (CopyFile src)) = copyFile src dst
43−
44−
51+#endif
4552--------------------------------------------------------------------------------
4653copyFileCompiler :: Compiler (Item CopyFile)
4754copyFileCompiler = do
src/Hakyll/Core/Identifier.hs → lib/Hakyll/Core/Identifier.hsrenamed+1−2
@@ -19,7 +19,6 @@ module Hakyll.Core.Identifier
1919
2020
2121--------------------------------------------------------------------------------
22−import Control.Applicative ((<$>), (<*>))
2322import Control.DeepSeq (NFData (..))
2423import Data.List (intercalate)
2524import System.FilePath (dropTrailingPathSeparator, splitPath)
@@ -63,7 +62,7 @@ instance Show Identifier where
6362
6463--------------------------------------------------------------------------------
6564-- | Parse an identifier from a string
66−fromFilePath :: String -> Identifier
65+fromFilePath :: FilePath -> Identifier
6766fromFilePath = Identifier Nothing .
6867 intercalate "/" . filter (not . null) . split'
6968 where
src/Hakyll/Core/Identifier/Pattern.hs → lib/Hakyll/Core/Identifier/Pattern.hsrenamed+14−74
@@ -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,79 +58,22 @@ module Hakyll.Core.Identifier.Pattern
5758
5859
5960--------------------------------------------------------------------------------
60−import Control.Applicative (pure, (<$>), (<*>))
61−import Control.Arrow ((&&&), (>>>))
62−import Control.Monad (msum)
63−import Data.Binary (Binary (..), getWord8, putWord8)
64−import Data.List (inits, isPrefixOf, tails)
65−import Data.Maybe (isJust)
66−import Data.Monoid (Monoid, mappend, mempty)
67−import Data.Set (Set)
68−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
6967
7068
7169--------------------------------------------------------------------------------
72−import GHC.Exts (IsString, fromString)
73−import Text.Regex.TDFA ((=~))
70+import GHC.Exts (IsString, fromString)
71+import Text.Regex.TDFA ((=~))
7472
7573
7674--------------------------------------------------------------------------------
7775import Hakyll.Core.Identifier
78−
79−
80−--------------------------------------------------------------------------------
81−-- | Elements of a glob pattern
82−data GlobComponent
83− = Capture
84− | CaptureMany
85− | Literal String
86− deriving (Eq, Show)
87−
88−
89−--------------------------------------------------------------------------------
90−instance Binary GlobComponent where
91− put Capture = putWord8 0
92− put CaptureMany = putWord8 1
93− put (Literal s) = putWord8 2 >> put s
94−
95− get = getWord8 >>= \t -> case t of
96− 0 -> pure Capture
97− 1 -> pure CaptureMany
98− 2 -> Literal <$> get
99− _ -> error "Data.Binary.get: Invalid GlobComponent"
100−
101−
102−--------------------------------------------------------------------------------
103−-- | Type that allows matching on identifiers
104−data Pattern
105− = Everything
106− | Complement Pattern
107− | And Pattern Pattern
108− | Glob [GlobComponent]
109− | List (Set Identifier)
110− | Regex String
111− | Version (Maybe String)
112− deriving (Show)
113−
114−
115−--------------------------------------------------------------------------------
116−instance Binary Pattern where
117− put Everything = putWord8 0
118− put (Complement p) = putWord8 1 >> put p
119− put (And x y) = putWord8 2 >> put x >> put y
120− put (Glob g) = putWord8 3 >> put g
121− put (List is) = putWord8 4 >> put is
122− put (Regex r) = putWord8 5 >> put r
123− put (Version v) = putWord8 6 >> put v
124−
125− get = getWord8 >>= \t -> case t of
126− 0 -> pure Everything
127− 1 -> Complement <$> get
128− 2 -> And <$> get <*> get
129− 3 -> Glob <$> get
130− 4 -> List <$> get
131− 5 -> Regex <$> get
132− _ -> Version <$> get
76+import Hakyll.Core.Identifier.Pattern.Internal
13377
13478
13579--------------------------------------------------------------------------------
@@ -137,12 +81,6 @@ instance IsString Pattern where
13781 fromString = fromGlob
13882
13983
140−--------------------------------------------------------------------------------
141−instance Monoid Pattern where
142− mempty = Everything
143− mappend = (.&&.)
144−
145−
14684--------------------------------------------------------------------------------
14785-- | Parse a pattern from a string
14886fromGlob :: String -> Pattern
@@ -262,9 +200,11 @@ splits = inits &&& tails >>> uncurry zip >>> reverse
262200
263201
264202--------------------------------------------------------------------------------
265−-- | 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
266204capture :: Pattern -> Identifier -> Maybe [String]
267205capture (Glob p) i = capture' p (toFilePath i)
206+capture (Regex pat) i = Just groups
207+ where (_, _, _, groups) = ((toFilePath i) =~ pat) :: (String, String, String, [String])
268208capture _ _ = Nothing
269209
270210
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−2
@@ -10,10 +10,8 @@ module Hakyll.Core.Item
1010
1111
1212--------------------------------------------------------------------------------
13−import Control.Applicative ((<$>), (<*>))
1413import Data.Binary (Binary (..))
1514import Data.Foldable (Foldable (..))
16−import Data.Traversable (Traversable (..))
1715import Data.Typeable (Typeable)
1816import Prelude hiding (foldr)
1917
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−4
@@ -13,12 +13,12 @@ module Hakyll.Core.Logger
1313
1414
1515--------------------------------------------------------------------------------
16−import Control.Applicative (pure, (<$>), (<*>))
1716import Control.Concurrent (forkIO)
1817import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
1918import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)
2019import Control.Monad (forever)
2120import Control.Monad.Trans (MonadIO, liftIO)
21+import Data.List (intercalate)
2222import Prelude hiding (error)
2323
2424
@@ -80,7 +80,7 @@ string l v m
8080
8181--------------------------------------------------------------------------------
8282error :: MonadIO m => Logger -> String -> m ()
83−error l m = string l Error $ " [ERROR] " ++ m
83+error l m = string l Error $ " [ERROR] " ++ indent m
8484
8585
8686--------------------------------------------------------------------------------
@@ -90,9 +90,14 @@ header l = string l Message
9090
9191--------------------------------------------------------------------------------
9292message :: MonadIO m => Logger -> String -> m ()
93−message l m = string l Message $ " " ++ m
93+message l m = string l Message $ " " ++ indent m
9494
9595
9696--------------------------------------------------------------------------------
9797debug :: MonadIO m => Logger -> String -> m ()
98−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
lib/Hakyll/Core/Metadata.hsnew file+138
@@ -0,0 +1,138 @@
1+--------------------------------------------------------------------------------
2+module Hakyll.Core.Metadata
3+ ( Metadata
4+ , lookupString
5+ , lookupStringList
6+
7+ , MonadMetadata (..)
8+ , getMetadataField
9+ , getMetadataField'
10+ , makePatternDependency
11+
12+ , BinaryMetadata (..)
13+ ) where
14+
15+
16+--------------------------------------------------------------------------------
17+import Control.Arrow (second)
18+import Control.Monad (forM)
19+import Data.Binary (Binary (..), getWord8,
20+ putWord8, Get)
21+import qualified Data.HashMap.Strict as HMS
22+import qualified Data.Set as S
23+import qualified Data.Text as T
24+import qualified Data.Vector as V
25+import qualified Data.Yaml.Extended as Yaml
26+import Hakyll.Core.Dependencies
27+import Hakyll.Core.Identifier
28+import Hakyll.Core.Identifier.Pattern
29+
30+
31+--------------------------------------------------------------------------------
32+type Metadata = Yaml.Object
33+
34+
35+--------------------------------------------------------------------------------
36+lookupString :: String -> Metadata -> Maybe String
37+lookupString key meta = HMS.lookup (T.pack key) meta >>= Yaml.toString
38+
39+
40+--------------------------------------------------------------------------------
41+lookupStringList :: String -> Metadata -> Maybe [String]
42+lookupStringList key meta =
43+ HMS.lookup (T.pack key) meta >>= Yaml.toList >>= mapM Yaml.toString
44+
45+
46+--------------------------------------------------------------------------------
47+class Monad m => MonadMetadata m where
48+ getMetadata :: Identifier -> m Metadata
49+ getMatches :: Pattern -> m [Identifier]
50+
51+ getAllMetadata :: Pattern -> m [(Identifier, Metadata)]
52+ getAllMetadata pattern = do
53+ matches' <- getMatches pattern
54+ forM matches' $ \id' -> do
55+ metadata <- getMetadata id'
56+ return (id', metadata)
57+
58+
59+--------------------------------------------------------------------------------
60+getMetadataField :: MonadMetadata m => Identifier -> String -> m (Maybe String)
61+getMetadataField identifier key = do
62+ metadata <- getMetadata identifier
63+ return $ lookupString key metadata
64+
65+
66+--------------------------------------------------------------------------------
67+-- | Version of 'getMetadataField' which throws an error if the field does not
68+-- exist.
69+getMetadataField' :: MonadMetadata m => Identifier -> String -> m String
70+getMetadataField' identifier key = do
71+ field <- getMetadataField identifier key
72+ case field of
73+ Just v -> return v
74+ Nothing -> fail $ "Hakyll.Core.Metadata.getMetadataField': " ++
75+ "Item " ++ show identifier ++ " has no metadata field " ++ show key
76+
77+
78+--------------------------------------------------------------------------------
79+makePatternDependency :: MonadMetadata m => Pattern -> m Dependency
80+makePatternDependency pattern = do
81+ matches' <- getMatches pattern
82+ return $ PatternDependency pattern (S.fromList matches')
83+
84+
85+--------------------------------------------------------------------------------
86+-- | Newtype wrapper for serialization.
87+newtype BinaryMetadata = BinaryMetadata
88+ {unBinaryMetadata :: Metadata}
89+
90+
91+instance Binary BinaryMetadata where
92+ put (BinaryMetadata obj) = put (BinaryYaml $ Yaml.Object obj)
93+ get = do
94+ BinaryYaml (Yaml.Object obj) <- get
95+ return $ BinaryMetadata obj
96+
97+
98+--------------------------------------------------------------------------------
99+newtype BinaryYaml = BinaryYaml {unBinaryYaml :: Yaml.Value}
100+
101+
102+--------------------------------------------------------------------------------
103+instance Binary BinaryYaml where
104+ put (BinaryYaml yaml) = case yaml of
105+ Yaml.Object obj -> do
106+ putWord8 0
107+ let list :: [(T.Text, BinaryYaml)]
108+ list = map (second BinaryYaml) $ HMS.toList obj
109+ put list
110+
111+ Yaml.Array arr -> do
112+ putWord8 1
113+ let list = map BinaryYaml (V.toList arr) :: [BinaryYaml]
114+ put list
115+
116+ Yaml.String s -> putWord8 2 >> put s
117+ Yaml.Number n -> putWord8 3 >> put n
118+ Yaml.Bool b -> putWord8 4 >> put b
119+ Yaml.Null -> putWord8 5
120+
121+ get = do
122+ tag <- getWord8
123+ case tag of
124+ 0 -> do
125+ list <- get :: Get [(T.Text, BinaryYaml)]
126+ return $ BinaryYaml $ Yaml.Object $
127+ HMS.fromList $ map (second unBinaryYaml) list
128+
129+ 1 -> do
130+ list <- get :: Get [BinaryYaml]
131+ return $ BinaryYaml $
132+ Yaml.Array $ V.fromList $ map unBinaryYaml list
133+
134+ 2 -> BinaryYaml . Yaml.String <$> get
135+ 3 -> BinaryYaml . Yaml.Number <$> get
136+ 4 -> BinaryYaml . Yaml.Bool <$> get
137+ 5 -> return $ BinaryYaml Yaml.Null
138+ _ -> fail "Data.Binary.get: Invalid Binary Metadata"
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−2
@@ -20,7 +20,6 @@ module Hakyll.Core.Provider.Internal
2020
2121
2222--------------------------------------------------------------------------------
23−import Control.Applicative ((<$>), (<*>))
2423import Control.DeepSeq (NFData (..), deepseq)
2524import Control.Monad (forM)
2625import Data.Binary (Binary (..))
@@ -28,7 +27,6 @@ import qualified Data.ByteString.Lazy as BL
2827import Data.Map (Map)
2928import qualified Data.Map as M
3029import Data.Maybe (fromMaybe)
31−import Data.Monoid (mempty)
3230import Data.Set (Set)
3331import qualified Data.Set as S
3432import Data.Time (Day (..), UTCTime (..))
lib/Hakyll/Core/Provider/Metadata.hsnew file+152
@@ -0,0 +1,152 @@
1+--------------------------------------------------------------------------------
2+-- | Internal module to parse metadata
3+{-# LANGUAGE BangPatterns #-}
4+{-# LANGUAGE RecordWildCards #-}
5+module Hakyll.Core.Provider.Metadata
6+ ( loadMetadata
7+ , parsePage
8+
9+ , MetadataException (..)
10+ ) where
11+
12+
13+--------------------------------------------------------------------------------
14+import Control.Arrow (second)
15+import Control.Exception (Exception, throwIO)
16+import Control.Monad (guard)
17+import qualified Data.ByteString as B
18+import qualified Data.ByteString.Char8 as BC
19+import Data.List.Extended (breakWhen)
20+import qualified Data.Map as M
21+import Data.Maybe (fromMaybe)
22+import Data.Monoid ((<>))
23+import qualified Data.Text as T
24+import qualified Data.Text.Encoding as T
25+import qualified Data.Yaml as Yaml
26+import Hakyll.Core.Identifier
27+import Hakyll.Core.Metadata
28+import Hakyll.Core.Provider.Internal
29+import System.IO as IO
30+import System.IO.Error (modifyIOError, ioeSetLocation)
31+
32+
33+--------------------------------------------------------------------------------
34+loadMetadata :: Provider -> Identifier -> IO (Metadata, Maybe String)
35+loadMetadata p identifier = do
36+ hasHeader <- probablyHasMetadataHeader fp
37+ (md, body) <- if hasHeader
38+ then second Just <$> loadMetadataHeader fp
39+ else return (mempty, Nothing)
40+
41+ emd <- case mi of
42+ Nothing -> return mempty
43+ Just mi' -> loadMetadataFile $ resourceFilePath p mi'
44+
45+ return (md <> emd, body)
46+ where
47+ normal = setVersion Nothing identifier
48+ fp = resourceFilePath p identifier
49+ mi = M.lookup normal (providerFiles p) >>= resourceInfoMetadata
50+
51+
52+--------------------------------------------------------------------------------
53+loadMetadataHeader :: FilePath -> IO (Metadata, String)
54+loadMetadataHeader fp = do
55+ fileContent <- modifyIOError (`ioeSetLocation` "loadMetadataHeader") $ readFile fp
56+ case parsePage fileContent of
57+ Right x -> return x
58+ Left err -> throwIO $ MetadataException fp err
59+
60+
61+--------------------------------------------------------------------------------
62+loadMetadataFile :: FilePath -> IO Metadata
63+loadMetadataFile fp = do
64+ fileContent <- modifyIOError (`ioeSetLocation` "loadMetadataFile") $ B.readFile fp
65+ let errOrMeta = Yaml.decodeEither' fileContent
66+ either (fail . show) return errOrMeta
67+
68+
69+--------------------------------------------------------------------------------
70+-- | Check if a file "probably" has a metadata header. The main goal of this is
71+-- to exclude binary files (which are unlikely to start with "---").
72+probablyHasMetadataHeader :: FilePath -> IO Bool
73+probablyHasMetadataHeader fp = do
74+ handle <- IO.openFile fp IO.ReadMode
75+ bs <- BC.hGet handle 1024
76+ IO.hClose handle
77+ return $ isMetadataHeader bs
78+ where
79+ isMetadataHeader bs =
80+ let pre = BC.takeWhile (\x -> x /= '\n' && x /= '\r') bs
81+ in BC.length pre >= 3 && BC.all (== '-') pre
82+
83+
84+--------------------------------------------------------------------------------
85+-- | Parse the page metadata and body.
86+splitMetadata :: String -> (Maybe String, String)
87+splitMetadata str0 = fromMaybe (Nothing, str0) $ do
88+ guard $ leading >= 3
89+ let !str1 = drop leading str0
90+ guard $ all isNewline (take 1 str1)
91+ let !(!meta, !content0) = breakWhen isTrailing str1
92+ guard $ not $ null content0
93+ let !content1 = drop (leading + 1) content0
94+ !content2 = dropWhile isNewline $ dropWhile isInlineSpace content1
95+ -- Adding this newline fixes the line numbers reported by the YAML parser.
96+ -- It's a bit ugly but it works.
97+ return (Just ('\n' : meta), content2)
98+ where
99+ -- Parse the leading "---"
100+ !leading = length $ takeWhile (== '-') str0
101+
102+ -- Predicate to recognize the trailing "---" or "..."
103+ isTrailing [] = False
104+ isTrailing (x : xs) =
105+ isNewline x && length (takeWhile isDash xs) == leading
106+
107+ -- Characters
108+ isNewline c = c == '\n' || c == '\r'
109+ isDash c = c == '-' || c == '.'
110+ isInlineSpace c = c == '\t' || c == ' '
111+
112+
113+--------------------------------------------------------------------------------
114+parseMetadata :: String -> Either Yaml.ParseException Metadata
115+parseMetadata = Yaml.decodeEither' . T.encodeUtf8 . T.pack
116+
117+
118+--------------------------------------------------------------------------------
119+parsePage :: String -> Either Yaml.ParseException (Metadata, String)
120+parsePage fileContent = case mbMetaBlock of
121+ Nothing -> return (mempty, content)
122+ Just metaBlock -> case parseMetadata metaBlock of
123+ Left err -> Left err
124+ Right meta -> return (meta, content)
125+ where
126+ !(!mbMetaBlock, !content) = splitMetadata fileContent
127+
128+
129+--------------------------------------------------------------------------------
130+-- | Thrown in the IO monad if things go wrong. Provides a nice-ish error
131+-- message.
132+data MetadataException = MetadataException FilePath Yaml.ParseException
133+
134+
135+--------------------------------------------------------------------------------
136+instance Exception MetadataException
137+
138+
139+--------------------------------------------------------------------------------
140+instance Show MetadataException where
141+ show (MetadataException fp err) =
142+ fp ++ ": " ++ Yaml.prettyPrintParseException err ++ hint
143+
144+ where
145+ hint = case err of
146+ Yaml.InvalidYaml (Just (Yaml.YamlParseException {..}))
147+ | yamlProblem == problem -> "\n" ++
148+ "Hint: if the metadata value contains characters such\n" ++
149+ "as ':' or '-', try enclosing it in quotes."
150+ _ -> ""
151+
152+ problem = "mapping values are not allowed in this context"
src/Hakyll/Core/Provider/MetadataCache.hs → lib/Hakyll/Core/Provider/MetadataCache.hsrenamed+3−6
@@ -8,9 +8,6 @@ module Hakyll.Core.Provider.MetadataCache
88
99--------------------------------------------------------------------------------
1010import Control.Monad (unless)
11−import qualified Data.Map as M
12−
13−--------------------------------------------------------------------------------
1411import Hakyll.Core.Identifier
1512import Hakyll.Core.Metadata
1613import Hakyll.Core.Provider.Internal
@@ -21,11 +18,11 @@ import qualified Hakyll.Core.Store as Store
2118--------------------------------------------------------------------------------
2219resourceMetadata :: Provider -> Identifier -> IO Metadata
2320resourceMetadata p r
24− | not (resourceExists p r) = return M.empty
21+ | not (resourceExists p r) = return mempty
2522 | otherwise = do
2623 -- TODO keep time in md cache
2724 load p r
28− Store.Found md <- Store.get (providerStore p)
25+ Store.Found (BinaryMetadata md) <- Store.get (providerStore p)
2926 [name, toFilePath r, "metadata"]
3027 return md
3128
@@ -52,7 +49,7 @@ load p r = do
5249 mmof <- Store.isMember store mdk
5350 unless mmof $ do
5451 (md, body) <- loadMetadata p r
55− Store.set store mdk md
52+ Store.set store mdk (BinaryMetadata md)
5653 Store.set store bk body
5754 where
5855 store = providerStore p
src/Hakyll/Core/Routes.hs → lib/Hakyll/Core/Routes.hsrenamed+17−1
@@ -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,7 +43,9 @@ module Hakyll.Core.Routes
4243
4344
4445--------------------------------------------------------------------------------
45−import Data.Monoid (Monoid, mappend, mempty)
46+#if MIN_VERSION_base(4,9,0)
47+import Data.Semigroup (Semigroup (..))
48+#endif
4649import System.FilePath (replaceExtension)
4750
4851
@@ -75,6 +78,18 @@ newtype Routes = Routes
7578
7679
7780--------------------------------------------------------------------------------
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
7893instance Monoid Routes where
7994 mempty = Routes $ \_ _ -> return (Nothing, False)
8095 mappend (Routes f) (Routes g) = Routes $ \p id' -> do
@@ -82,6 +97,7 @@ instance Monoid Routes where
8297 case mfp of
8398 Nothing -> g p id'
8499 Just _ -> return (mfp, um)
100+#endif
85101
86102
87103--------------------------------------------------------------------------------
src/Hakyll/Core/Rules.hs → lib/Hakyll/Core/Rules.hsrenamed−2
@@ -33,13 +33,11 @@ module Hakyll.Core.Rules
3333
3434
3535--------------------------------------------------------------------------------
36−import Control.Applicative ((<$>))
3736import Control.Monad.Reader (ask, local)
3837import Control.Monad.State (get, modify, put)
3938import Control.Monad.Trans (liftIO)
4039import Control.Monad.Writer (censor, tell)
4140import Data.Maybe (fromMaybe)
42−import Data.Monoid (mempty)
4341import qualified Data.Set as S
4442
4543
src/Hakyll/Core/Rules/Internal.hs → lib/Hakyll/Core/Rules/Internal.hsrenamed+14−2
@@ -1,4 +1,5 @@
11--------------------------------------------------------------------------------
2+{-# LANGUAGE CPP #-}
23{-# LANGUAGE GeneralizedNewtypeDeriving #-}
34{-# LANGUAGE Rank2Types #-}
45module Hakyll.Core.Rules.Internal
@@ -12,12 +13,13 @@ module Hakyll.Core.Rules.Internal
1213
1314
1415--------------------------------------------------------------------------------
15−import Control.Applicative (Applicative, (<$>))
1616import Control.Monad.Reader (ask)
1717import Control.Monad.RWS (RWST, runRWST)
1818import Control.Monad.Trans (liftIO)
1919import qualified Data.Map as M
20−import Data.Monoid (Monoid, mappend, mempty)
20+#if MIN_VERSION_base(4,9,0)
21+import Data.Semigroup (Semigroup (..))
22+#endif
2123import Data.Set (Set)
2224
2325
@@ -54,10 +56,20 @@ data RuleSet = RuleSet
5456
5557
5658--------------------------------------------------------------------------------
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
5768instance Monoid RuleSet where
5869 mempty = RuleSet mempty mempty mempty mempty
5970 mappend (RuleSet r1 c1 s1 p1) (RuleSet r2 c2 s2 p2) =
6071 RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) (p1 .||. p2)
72+#endif
6173
6274
6375--------------------------------------------------------------------------------
src/Hakyll/Core/Runtime.hs → lib/Hakyll/Core/Runtime.hsrenamed+6−8
@@ -5,9 +5,8 @@ module Hakyll.Core.Runtime
55
66
77--------------------------------------------------------------------------------
8−import Control.Applicative ((<$>))
98import Control.Monad (unless)
10−import Control.Monad.Error (ErrorT, runErrorT, throwError)
9+import Control.Monad.Except (ExceptT, runExceptT, throwError)
1110import Control.Monad.Reader (ask)
1211import Control.Monad.RWS (RWST, runRWST)
1312import Control.Monad.State (get, modify)
@@ -15,7 +14,6 @@ import Control.Monad.Trans (liftIO)
1514import Data.List (intercalate)
1615import Data.Map (Map)
1716import qualified Data.Map as M
18−import Data.Monoid (mempty)
1917import Data.Set (Set)
2018import qualified Data.Set as S
2119import System.Exit (ExitCode (..))
@@ -77,7 +75,7 @@ run config logger rules = do
7775 }
7876
7977 -- Run the program and fetch the resulting state
80− result <- runErrorT $ runRWST build read' state
78+ result <- runExceptT $ runRWST build read' state
8179 case result of
8280 Left e -> do
8381 Logger.error logger e
@@ -117,7 +115,7 @@ data RuntimeState = RuntimeState
117115
118116
119117--------------------------------------------------------------------------------
120−type Runtime a = RWST RuntimeRead () RuntimeState (ErrorT String IO) a
118+type Runtime a = RWST RuntimeRead () RuntimeState (ExceptT String IO) a
121119
122120
123121--------------------------------------------------------------------------------
@@ -201,9 +199,9 @@ chase trail id'
201199 result <- liftIO $ runCompiler compiler read'
202200 case result of
203201 -- Rethrow error
204− CompilerError [] -> throwError
205− "Compiler failed but no info given, try running with -v?"
206− 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
207205
208206 -- Signal that a snapshot was saved ->
209207 CompilerSnapshot snapshot c -> do
src/Hakyll/Core/Store.hs → lib/Hakyll/Core/Store.hsrenamed+26−24
@@ -16,8 +16,6 @@ module Hakyll.Core.Store
1616
1717
1818--------------------------------------------------------------------------------
19−import Control.Applicative ((<$>))
20−import Control.Exception (IOException, handle)
2119import qualified Crypto.Hash.MD5 as MD5
2220import Data.Binary (Binary, decode, encodeFile)
2321import qualified Data.ByteString as B
@@ -28,11 +26,13 @@ import Data.Maybe (isJust)
2826import qualified Data.Text as T
2927import qualified Data.Text.Encoding as T
3028import Data.Typeable (TypeRep, Typeable, cast, typeOf)
29+import Numeric (showHex)
3130import System.Directory (createDirectoryIfMissing)
3231import System.Directory (doesFileExist, removeFile)
3332import System.FilePath ((</>))
3433import System.IO (IOMode (..), hClose, openFile)
35−import Text.Printf (printf)
34+import System.IO.Error (catchIOError, ioeSetFileName,
35+ ioeSetLocation, modifyIOError)
3636
3737
3838--------------------------------------------------------------------------------
@@ -85,6 +85,14 @@ new inMemory directory = do
8585 where
8686 csize = Just 500
8787
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)
8896
8997--------------------------------------------------------------------------------
9098-- | Auxiliary: add an item to the in-memory cache
@@ -125,17 +133,16 @@ cacheDelete (Store _ (Just lru)) key = do
125133--------------------------------------------------------------------------------
126134-- | Store an item
127135set :: (Binary a, Typeable a) => Store -> [String] -> a -> IO ()
128−set store identifier value = do
129− encodeFile (storeDirectory store </> key) value
136+set store identifier value = withStore store "set" (\key path -> do
137+ encodeFile path value
130138 cacheInsert store key value
131− where
132− key = hash identifier
139+ ) identifier
133140
134141
135142--------------------------------------------------------------------------------
136143-- | Load an item
137144get :: (Binary a, Typeable a) => Store -> [String] -> IO (Result a)
138−get store identifier = do
145+get store = withStore store "get" $ \key path -> do
139146 -- First check the in-memory map
140147 ref <- cacheLookup store key
141148 case ref of
@@ -147,17 +154,14 @@ get store identifier = do
147154 then return NotFound
148155 -- Found in the filesystem
149156 else do
150− v <- decodeClose
157+ v <- decodeClose path
151158 cacheInsert store key v
152159 return $ Found v
153160 -- Found in the in-memory map (or wrong type), just return
154161 s -> return s
155162 where
156− key = hash identifier
157− path = storeDirectory store </> key
158−
159163 -- 'decodeFile' from Data.Binary which closes the file ASAP
160− decodeClose = do
164+ decodeClose path = do
161165 h <- openFile path ReadMode
162166 lbs <- BL.hGetContents h
163167 BL.length lbs `seq` hClose h
@@ -167,32 +171,30 @@ get store identifier = do
167171--------------------------------------------------------------------------------
168172-- | Strict function
169173isMember :: Store -> [String] -> IO Bool
170−isMember store identifier = do
174+isMember store = withStore store "isMember" $ \key path -> do
171175 inCache <- cacheIsMember store key
172176 if inCache then return True else doesFileExist path
173− where
174− key = hash identifier
175− path = storeDirectory store </> key
176177
177178
178179--------------------------------------------------------------------------------
179180-- | Delete an item
180181delete :: Store -> [String] -> IO ()
181−delete store identifier = do
182+delete store = withStore store "delete" $ \key path -> do
182183 cacheDelete store key
183− deleteFile $ storeDirectory store </> key
184− where
185− key = hash identifier
184+ deleteFile path
186185
187186
188187--------------------------------------------------------------------------------
189188-- | Delete a file unless it doesn't exist...
190189deleteFile :: FilePath -> IO ()
191−deleteFile = handle (\(_ :: IOException) -> return ()) . removeFile
190+deleteFile = (`catchIOError` \_ -> return ()) . removeFile
192191
193192
194193--------------------------------------------------------------------------------
195194-- | Mostly meant for internal usage
196195hash :: [String] -> String
197−hash = concatMap (printf "%02x") . B.unpack .
198− 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+3−3
@@ -16,7 +16,6 @@ import Control.Monad (forM_)
1616import Data.ByteString.Lazy (ByteString)
1717import qualified Data.ByteString.Lazy as LB
1818import Data.IORef (newIORef, readIORef, writeIORef)
19−import Data.Monoid (Monoid, mempty)
2019import System.Exit (ExitCode (..))
2120import System.IO (Handle, hClose, hFlush, hGetContents,
2221 hPutStr, hSetEncoding, localeEncoding)
@@ -30,7 +29,7 @@ import Hakyll.Core.Compiler
3029-- | Use a unix filter as compiler. For example, we could use the 'rev' program
3130-- as a compiler.
3231--
33−-- > rev :: Compiler String
32+-- > rev :: Compiler (Item String)
3433-- > rev = getResourceString >>= withItemBody (unixFilter "rev" [])
3534--
3635-- A more realistic example: one can use this to call, for example, the sass
@@ -93,7 +92,8 @@ unixFilterWith writer reader programName args input = do
9392 ExitSuccess -> return output
9493 ExitFailure e -> fail $
9594 "Hakyll.Core.UnixFilter.unixFilterWith: " ++
96− unwords (programName : args) ++ " gave exit code " ++ show e
95+ unwords (programName : args) ++ " gave exit code " ++ show e ++
96+ ". (Error: " ++ err ++ ")"
9797
9898
9999--------------------------------------------------------------------------------
src/Hakyll/Core/Util/File.hs → lib/Hakyll/Core/Util/File.hsrenamed−1
@@ -8,7 +8,6 @@ module Hakyll.Core.Util.File
88
99
1010--------------------------------------------------------------------------------
11−import Control.Applicative ((<$>))
1211import Control.Monad (filterM, forM, when)
1312import System.Directory (createDirectoryIfMissing,
1413 doesDirectoryExist, getDirectoryContents,
src/Hakyll/Core/Util/Parser.hs → lib/Hakyll/Core/Util/Parser.hsrenamed+10−4
@@ -2,13 +2,12 @@
22-- | Parser utilities
33module Hakyll.Core.Util.Parser
44 ( metadataKey
5− , reservedKeys
65 ) where
76
87
98--------------------------------------------------------------------------------
10−import Control.Applicative ((<$>), (<*>), (<|>))
11−import Control.Monad (mzero)
9+import Control.Applicative ((<|>))
10+import Control.Monad (guard, mzero, void)
1211import qualified Text.Parsec as P
1312import Text.Parsec.String (Parser)
1413
@@ -16,7 +15,14 @@ import Text.Parsec.String (Parser)
1615--------------------------------------------------------------------------------
1716metadataKey :: Parser String
1817metadataKey = do
19− i <- (:) <$> P.letter <*> (P.many $ P.alphaNum <|> P.oneOf "_-.")
18+ -- Ensure trailing '-' binds to '$' if present.
19+ let hyphon = P.try $ do
20+ void $ P.char '-'
21+ x <- P.lookAhead P.anyChar
22+ guard $ x /= '$'
23+ pure '-'
24+
25+ i <- (:) <$> P.letter <*> P.many (P.alphaNum <|> P.oneOf "_." <|> hyphon)
2026 if i `elem` reservedKeys then mzero else return i
2127
2228
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
lib/Hakyll/Preview/Server.hsnew file+35
@@ -0,0 +1,35 @@
1+--------------------------------------------------------------------------------
2+-- | Implements a basic static file server for previewing options
3+{-# LANGUAGE OverloadedStrings #-}
4+module Hakyll.Preview.Server
5+ ( staticServer
6+ ) where
7+
8+
9+--------------------------------------------------------------------------------
10+import Data.String
11+import qualified Network.Wai.Handler.Warp as Warp
12+import qualified Network.Wai.Application.Static as Static
13+import qualified Network.Wai as Wai
14+import Network.HTTP.Types.Status (Status)
15+
16+--------------------------------------------------------------------------------
17+import Hakyll.Core.Logger (Logger)
18+import qualified Hakyll.Core.Logger as Logger
19+
20+staticServer :: Logger -- ^ Logger
21+ -> FilePath -- ^ Directory to serve
22+ -> String -- ^ Host to bind on
23+ -> Int -- ^ Port to listen on
24+ -> IO () -- ^ Blocks forever
25+staticServer logger directory host port = do
26+ Logger.header logger $ "Listening on http://" ++ host ++ ":" ++ show port
27+ Warp.runSettings warpSettings $
28+ Static.staticApp (Static.defaultFileServerSettings directory)
29+ where
30+ warpSettings = Warp.setLogger noLog
31+ $ Warp.setHost (fromString host)
32+ $ Warp.setPort port Warp.defaultSettings
33+
34+noLog :: Wai.Request -> Status -> Maybe Integer -> IO ()
35+noLog _ _ _ = return ()
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+65−24
@@ -1,3 +1,6 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE TemplateHaskell #-}
3+
14--------------------------------------------------------------------------------
25-- | A Module that allows easy rendering of RSS feeds.
36--
@@ -20,25 +23,40 @@ module Hakyll.Web.Feed
2023 ( FeedConfiguration (..)
2124 , renderRss
2225 , renderAtom
26+ , renderRssWithTemplates
27+ , renderAtomWithTemplates
2328 ) where
2429
2530
26−--------------------------------------------------------------------------------
27−import Control.Monad ((<=<))
28−import Data.Monoid (mconcat)
29−
30−
3131--------------------------------------------------------------------------------
3232import Hakyll.Core.Compiler
33−import Hakyll.Core.Compiler.Internal
3433import Hakyll.Core.Item
34+import Hakyll.Core.Util.String (replaceAll)
3535import Hakyll.Web.Template
3636import Hakyll.Web.Template.Context
3737import Hakyll.Web.Template.List
3838
3939
4040--------------------------------------------------------------------------------
41−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)
4260
4361
4462--------------------------------------------------------------------------------
@@ -59,21 +77,21 @@ data FeedConfiguration = FeedConfiguration
5977
6078--------------------------------------------------------------------------------
6179-- | Abstract function to render any feed.
62−renderFeed :: FilePath -- ^ Feed template
63− -> FilePath -- ^ Item template
80+renderFeed :: Template -- ^ Default feed template
81+ -> Template -- ^ Default item template
6482 -> FeedConfiguration -- ^ Feed configuration
6583 -> Context String -- ^ Context for the items
6684 -> [Item String] -- ^ Input items
6785 -> Compiler (Item String) -- ^ Resulting item
68−renderFeed feedPath itemPath config itemContext items = do
69− feedTpl <- compilerUnsafeIO $ loadTemplate feedPath
70− itemTpl <- compilerUnsafeIO $ loadTemplate itemPath
71−
72− body <- makeItem =<< applyTemplateList itemTpl itemContext' items
86+renderFeed feedTpl itemTpl config itemContext items = do
87+ protectedItems <- mapM (applyFilter protectCDATA) items
88+ body <- makeItem =<< applyTemplateList itemTpl itemContext' protectedItems
7389 applyTemplate feedTpl feedContext body
7490 where
75− -- Auxiliary: load a template from a datafile
76− loadTemplate = fmap readTemplate . readFile <=< getDataFileName
91+ applyFilter :: (Monad m,Functor f) => (String -> String) -> f String -> m (f String)
92+ applyFilter tr str = return $ fmap tr str
93+ protectCDATA :: String -> String
94+ protectCDATA = replaceAll "]]>" (const "]]&gt;")
7795
7896 itemContext' = mconcat
7997 [ itemContext
@@ -99,8 +117,35 @@ renderFeed feedPath itemPath config itemContext items = do
99117 updatedField = field "updated" $ \_ -> case items of
100118 [] -> return "Unknown"
101119 (x : _) -> unContext itemContext' "updated" [] x >>= \cf -> case cf of
102− ListField _ _ -> fail "Hakyll.Web.Feed.renderFeed: Internal error"
103120 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)
104149
105150
106151--------------------------------------------------------------------------------
@@ -109,9 +154,7 @@ renderRss :: FeedConfiguration -- ^ Feed configuration
109154 -> Context String -- ^ Item context
110155 -> [Item String] -- ^ Feed items
111156 -> Compiler (Item String) -- ^ Resulting feed
112−renderRss config context = renderFeed
113− "templates/rss.xml" "templates/rss-item.xml" config
114− (makeItemContext "%a, %d %b %Y %H:%M:%S UT" context)
157+renderRss = renderRssWithTemplates rssTemplate rssItemTemplate
115158
116159
117160--------------------------------------------------------------------------------
@@ -120,13 +163,11 @@ renderAtom :: FeedConfiguration -- ^ Feed configuration
120163 -> Context String -- ^ Item context
121164 -> [Item String] -- ^ Feed items
122165 -> Compiler (Item String) -- ^ Resulting feed
123−renderAtom config context = renderFeed
124− "templates/atom.xml" "templates/atom-item.xml" config
125− (makeItemContext "%Y-%m-%dT%H:%M:%SZ" context)
166+renderAtom = renderAtomWithTemplates atomTemplate atomItemTemplate
126167
127168
128169--------------------------------------------------------------------------------
129170-- | Copies @$updated$@ from @$published$@ if it is not already set.
130171makeItemContext :: String -> Context a -> Context a
131172makeItemContext fmt context = mconcat
132− [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+29−3
@@ -11,9 +11,9 @@ 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
16−import Data.Monoid (mconcat)
1717import qualified Data.Set as S
1818
1919
@@ -38,7 +38,7 @@ data Paginate = Paginate
3838 { paginateMap :: M.Map PageNumber [Identifier]
3939 , paginateMakeId :: PageNumber -> Identifier
4040 , paginateDependency :: Dependency
41− } deriving (Show)
41+ }
4242
4343
4444--------------------------------------------------------------------------------
@@ -94,6 +94,18 @@ paginatePage pag pageNumber
9494-- | A default paginate context which provides the following keys:
9595--
9696--
97+-- * @firstPageNum@
98+-- * @firstPageUrl@
99+-- * @previousPageNum@
100+-- * @previousPageUrl@
101+-- * @nextPageNum@
102+-- * @nextPageUrl@
103+-- * @lastPageNum@
104+-- * @lastPageUrl@
105+-- * @currentPageNum@
106+-- * @currentPageUrl@
107+-- * @numPages@
108+-- * @allPages@
97109paginateContext :: Paginate -> PageNumber -> Context a
98110paginateContext pag currentPage = mconcat
99111 [ field "firstPageNum" $ \_ -> otherPage 1 >>= num
@@ -107,6 +119,20 @@ paginateContext pag currentPage = mconcat
107119 , field "currentPageNum" $ \i -> thisPage i >>= num
108120 , field "currentPageUrl" $ \i -> thisPage i >>= url
109121 , 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+
110136 ]
111137 where
112138 lastPage = paginateNumPages pag
src/Hakyll/Web/Pandoc.hs → lib/Hakyll/Web/Pandoc.hsrenamed+13−14
@@ -22,11 +22,9 @@ module Hakyll.Web.Pandoc
2222
2323
2424--------------------------------------------------------------------------------
25−import Control.Applicative ((<$>))
26−import qualified Data.Set as S
27−import Data.Traversable (traverse)
25+import qualified Data.Text as T
2826import Text.Pandoc
29−import Text.Pandoc.Error (PandocError (..))
27+import Text.Pandoc.Highlighting (pygments)
3028
3129
3230--------------------------------------------------------------------------------
@@ -50,12 +48,10 @@ readPandocWith
5048 -> Item String -- ^ String to read
5149 -> Compiler (Item Pandoc) -- ^ Resulting document
5250readPandocWith ropt item =
53− case traverse (reader ropt (itemFileType item)) item of
54− Left (ParseFailure err) -> fail $
55− "Hakyll.Web.Pandoc.readPandocWith: parse failed: " ++ err
56− Left (ParsecError _ err) -> fail $
51+ case runPure $ traverse (reader ropt (itemFileType item)) (fmap T.pack item) of
52+ Left err -> fail $
5753 "Hakyll.Web.Pandoc.readPandocWith: parse failed: " ++ show err
58− Right item' -> return item'
54+ Right item' -> return item'
5955 where
6056 reader ro t = case t of
6157 DocBook -> readDocBook ro
@@ -71,7 +67,7 @@ readPandocWith ropt item =
7167 "Hakyll.Web.readPandocWith: I don't know how to read a file of " ++
7268 "the type " ++ show t ++ " for: " ++ show (itemIdentifier item)
7369
74− addExt ro e = ro {readerExtensions = S.insert e $ readerExtensions ro}
70+ addExt ro e = ro {readerExtensions = enableExtension e $ readerExtensions ro}
7571
7672
7773--------------------------------------------------------------------------------
@@ -86,7 +82,10 @@ writePandoc = writePandocWith defaultHakyllWriterOptions
8682writePandocWith :: WriterOptions -- ^ Writer options for pandoc
8783 -> Item Pandoc -- ^ Document to write
8884 -> Item String -- ^ Resulting HTML
89−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'
9089
9190
9291--------------------------------------------------------------------------------
@@ -149,7 +148,7 @@ defaultHakyllReaderOptions :: ReaderOptions
149148defaultHakyllReaderOptions = def
150149 { -- The following option causes pandoc to read smart typography, a nice
151150 -- and free bonus.
152− readerSmart = True
151+ readerExtensions = enableExtension Ext_smart pandocExtensions
153152 }
154153
155154
@@ -159,8 +158,8 @@ defaultHakyllWriterOptions :: WriterOptions
159158defaultHakyllWriterOptions = def
160159 { -- This option causes literate haskell to be written using '>' marks in
161160 -- html, which I think is a good default.
162− writerExtensions = S.insert Ext_literate_haskell (writerExtensions def)
161+ writerExtensions = enableExtension Ext_smart pandocExtensions
163162 , -- We want to have hightlighting by default, to be compatible with earlier
164163 -- Hakyll releases
165− writerHighlight = True
164+ writerHighlightStyle = Just pygments
166165 }
src/Hakyll/Web/Pandoc/Biblio.hs → lib/Hakyll/Web/Pandoc/Biblio.hsrenamed+22−14
@@ -23,22 +23,21 @@ module Hakyll.Web.Pandoc.Biblio
2323
2424
2525--------------------------------------------------------------------------------
26−import Control.Applicative ((<$>))
27−import Control.Monad (replicateM, liftM)
28−import Data.Binary (Binary (..))
29−import Data.Default (def)
30−import Data.Typeable (Typeable)
31−import qualified Text.CSL as CSL
32−import Text.CSL.Pandoc (processCites)
33−import Text.Pandoc (Pandoc, ReaderOptions (..))
34−
35−--------------------------------------------------------------------------------
26+import Control.Monad (liftM, replicateM)
27+import Data.Binary (Binary (..))
28+import Data.Typeable (Typeable)
3629import Hakyll.Core.Compiler
30+import Hakyll.Core.Compiler.Internal
3731import Hakyll.Core.Identifier
3832import Hakyll.Core.Item
33+import Hakyll.Core.Provider
3934import Hakyll.Core.Writable
4035import Hakyll.Web.Pandoc
4136import Hakyll.Web.Pandoc.Binary ()
37+import qualified Text.CSL as CSL
38+import Text.CSL.Pandoc (processCites)
39+import Text.Pandoc (Pandoc, ReaderOptions (..),
40+ enableExtension, Extension (..))
4241
4342
4443--------------------------------------------------------------------------------
@@ -86,8 +85,11 @@ instance Writable Biblio where
8685--------------------------------------------------------------------------------
8786biblioCompiler :: Compiler (Item Biblio)
8887biblioCompiler = do
89− filePath <- toFilePath <$> getUnderlying
90− 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
9193
9294
9395--------------------------------------------------------------------------------
@@ -98,7 +100,9 @@ readPandocBiblio :: ReaderOptions
98100 -> Compiler (Item Pandoc)
99101readPandocBiblio ropt csl biblio item = do
100102 -- Parse CSL file, if given
101− style <- unsafeCompiler $ CSL.readCSLFile Nothing . toFilePath . itemIdentifier $ csl
103+ provider <- compilerProvider <$> compilerAsk
104+ style <- unsafeCompiler $
105+ CSL.readCSLFile Nothing . (resourceFilePath provider) . itemIdentifier $ csl
102106
103107 -- We need to know the citation keys, add then *before* actually parsing the
104108 -- actual page. If we don't do this, pandoc won't even consider them
@@ -115,4 +119,8 @@ pandocBiblioCompiler cslFileName bibFileName = do
115119 csl <- load $ fromFilePath cslFileName
116120 bib <- load $ fromFilePath bibFileName
117121 liftM writePandoc
118− (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+10−7
@@ -43,6 +43,7 @@
4343module Hakyll.Web.Tags
4444 ( Tags (..)
4545 , getTags
46+ , getCategory
4647 , buildTagsWith
4748 , buildTags
4849 , buildCategories
@@ -63,13 +64,12 @@ module Hakyll.Web.Tags
6364
6465--------------------------------------------------------------------------------
6566import Control.Arrow ((&&&))
66−import Control.Monad (foldM, forM, forM_)
67+import Control.Monad (foldM, forM, forM_, mplus)
6768import Data.Char (toLower)
6869import Data.List (intercalate, intersperse,
6970 sortBy)
7071import qualified Data.Map as M
7172import Data.Maybe (catMaybes, fromMaybe)
72−import Data.Monoid (mconcat)
7373import Data.Ord (comparing)
7474import qualified Data.Set as S
7575import System.FilePath (takeBaseName, takeDirectory)
@@ -88,8 +88,8 @@ import Hakyll.Core.Item
8888import Hakyll.Core.Metadata
8989import Hakyll.Core.Rules
9090import Hakyll.Core.Util.String
91−import Hakyll.Web.Template.Context
9291import Hakyll.Web.Html
92+import Hakyll.Web.Template.Context
9393
9494
9595--------------------------------------------------------------------------------
@@ -98,19 +98,22 @@ data Tags = Tags
9898 { tagsMap :: [(String, [Identifier])]
9999 , tagsMakeId :: String -> Identifier
100100 , tagsDependency :: Dependency
101− } deriving (Show)
101+ }
102102
103103
104104--------------------------------------------------------------------------------
105105-- | Obtain tags from a page in the default way: parse them from the @tags@
106−-- metadata field.
106+-- metadata field. This can either be a list or a comma-separated string.
107107getTags :: MonadMetadata m => Identifier -> m [String]
108108getTags identifier = do
109109 metadata <- getMetadata identifier
110− return $ maybe [] (map trim . splitAll ",") $ M.lookup "tags" metadata
110+ return $ fromMaybe [] $
111+ (lookupStringList "tags" metadata) `mplus`
112+ (map trim . splitAll "," <$> lookupString "tags" metadata)
113+
111114
112115--------------------------------------------------------------------------------
113−-- | Obtain categories from a page.
116+-- | Obtain category from a page.
114117getCategory :: MonadMetadata m => Identifier -> m [String]
115118getCategory = return . return . takeBaseName . takeDirectory . toFilePath
116119
lib/Hakyll/Web/Template.hsnew file+178
@@ -0,0 +1,178 @@
1+-- | This module provides means for reading and applying 'Template's.
2+--
3+-- Templates are tools to convert items into a string. They are perfectly suited
4+-- for laying out your site.
5+--
6+-- Let's look at an example template:
7+--
8+-- > <html>
9+-- > <head>
10+-- > <title>My crazy homepage - $title$</title>
11+-- > </head>
12+-- > <body>
13+-- > <div id="header">
14+-- > <h1>My crazy homepage - $title$</h1>
15+-- > </div>
16+-- > <div id="content">
17+-- > $body$
18+-- > </div>
19+-- > <div id="footer">
20+-- > By reading this you agree that I now own your soul
21+-- > </div>
22+-- > </body>
23+-- > </html>
24+--
25+-- As you can see, the format is very simple -- @$key$@ is used to render the
26+-- @$key$@ field from the page, everything else is literally copied. If you want
27+-- to literally insert @\"$key$\"@ into your page (for example, when you're
28+-- writing a Hakyll tutorial) you can use
29+--
30+-- > <p>
31+-- > A literal $$key$$.
32+-- > </p>
33+--
34+-- Because of it's simplicity, these templates can be used for more than HTML:
35+-- you could make, for example, CSS or JS templates as well.
36+--
37+-- Apart from interpolating @$key$@s from the 'Context' you can also
38+-- use the following macros:
39+--
40+-- * @$if(key)$@
41+--
42+-- > $if(key)$
43+-- > <b> Defined </b>
44+-- > $else$
45+-- > <b> Non-defined </b>
46+-- > $endif$
47+--
48+-- This example will print @Defined@ if @key@ is defined in the
49+-- context and @Non-defined@ otherwise. The @$else$@ clause is
50+-- optional.
51+--
52+-- * @$for(key)$@
53+--
54+-- The @for@ macro is used for enumerating 'Context' elements that are
55+-- lists, i.e. constructed using the 'listField' function. Assume that
56+-- in a context we have an element @listField \"key\" c itms@. Then
57+-- the snippet
58+--
59+-- > $for(key)$
60+-- > $x$
61+-- > $sep$,
62+-- > $endfor$
63+--
64+-- would, for each item @i@ in 'itms', lookup @$x$@ in the context @c@
65+-- with item @i@, interpolate it, and join the resulting list with
66+-- @,@.
67+--
68+-- Another concrete example one may consider is the following. Given the
69+-- context
70+--
71+-- > listField "things" (field "thing" (return . itemBody))
72+-- > (sequence [makeItem "fruits", makeItem "vegetables"])
73+--
74+-- and a template
75+--
76+-- > I like
77+-- > $for(things)$
78+-- > fresh $thing$$sep$, and
79+-- > $endfor$
80+--
81+-- the resulting page would look like
82+--
83+-- > <p>
84+-- > I like
85+-- >
86+-- > fresh fruits, and
87+-- >
88+-- > fresh vegetables
89+-- > </p>
90+--
91+-- The @$sep$@ part can be omitted. Usually, you can get by using the
92+-- 'applyListTemplate' and 'applyJoinListTemplate' functions.
93+--
94+-- * @$partial(path)$@
95+--
96+-- Loads a template located in a separate file and interpolates it
97+-- under the current context.
98+--
99+-- Assuming that the file @test.html@ contains
100+--
101+-- > <b>$key$</b>
102+--
103+-- The result of rendering
104+--
105+-- > <p>
106+-- > $partial("test.html")$
107+-- > </p>
108+--
109+-- is the same as the result of rendering
110+--
111+-- > <p>
112+-- > <b>$key$</b>
113+-- > </p>
114+--
115+-- That is, calling @$partial$@ is equivalent to just copying and pasting
116+-- template code.
117+--
118+-- In the examples above you can see that the outputs contain a lot of leftover
119+-- whitespace that you may wish to remove. Using @'$-'@ or @'-$'@ instead of
120+-- @'$'@ in a macro strips all whitespace to the left or right of that clause
121+-- respectively. Given the context
122+--
123+-- > listField "counts" (field "count" (return . itemBody))
124+-- > (sequence [makeItem "3", makeItem "2", makeItem "1"])
125+--
126+-- and a template
127+--
128+-- > <p>
129+-- > $for(counts)-$
130+-- > $count$
131+-- > $-sep$...
132+-- > $-endfor$
133+-- > </p>
134+--
135+-- the resulting page would look like
136+--
137+-- > <p>
138+-- > 3...2...1
139+-- > </p>
140+--
141+{-# LANGUAGE TemplateHaskell #-}
142+module Hakyll.Web.Template
143+ ( Template
144+ , templateBodyCompiler
145+ , templateCompiler
146+ , applyTemplate
147+ , loadAndApplyTemplate
148+ , applyAsTemplate
149+ , readTemplate
150+ , compileTemplateItem
151+ , unsafeReadTemplateFile
152+ , embedTemplate
153+ ) where
154+
155+
156+--------------------------------------------------------------------------------
157+import 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+150−35
@@ -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 (..)
@@ -18,6 +39,7 @@ module Hakyll.Web.Template.Context
1839 , urlField
1940 , pathField
2041 , titleField
42+ , snippetField
2143 , dateField
2244 , dateFieldWith
2345 , getItemUTC
@@ -27,22 +49,21 @@ module Hakyll.Web.Template.Context
2749 , teaserField
2850 , teaserFieldWithSeparator
2951 , missingField
52+ , bindItem
3053 ) where
3154
3255
3356--------------------------------------------------------------------------------
34−import Control.Applicative (Alternative (..), pure, (<$>))
57+import Control.Applicative (Alternative (..))
3558import Control.Monad (msum)
36−import Data.List (intercalate)
37−import qualified Data.Map as M
38−import Data.Monoid (Monoid (..))
59+import Data.List (intercalate, tails)
60+#if MIN_VERSION_base(4,9,0)
61+import Data.Semigroup (Semigroup (..))
62+#endif
3963import Data.Time.Clock (UTCTime (..))
4064import Data.Time.Format (formatTime)
4165import qualified Data.Time.Format as TF
4266import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale)
43−import System.FilePath (splitDirectories, takeBaseName)
44−
45−--------------------------------------------------------------------------------
4667import Hakyll.Core.Compiler
4768import Hakyll.Core.Compiler.Internal
4869import Hakyll.Core.Identifier
@@ -51,12 +72,16 @@ import Hakyll.Core.Metadata
5172import Hakyll.Core.Provider
5273import Hakyll.Core.Util.String (needlePrefix, splitAll)
5374import Hakyll.Web.Html
75+import Prelude hiding (id)
76+import System.FilePath (dropExtension, splitDirectories,
77+ takeBaseName)
5478
5579
5680--------------------------------------------------------------------------------
5781-- | Mostly for internal usage
5882data ContextField
59− = StringField String
83+ = EmptyField
84+ | StringField String
6085 | forall a. ListField (Context a) [Item a]
6186
6287
@@ -81,72 +106,140 @@ newtype Context a = Context
81106
82107
83108--------------------------------------------------------------------------------
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
84119instance Monoid (Context a) where
85120 mempty = missingField
86121 mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
122+#endif
87123
88124
89125--------------------------------------------------------------------------------
90126field' :: String -> (Item a -> Compiler ContextField) -> Context a
91−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
92131
93132
94133--------------------------------------------------------------------------------
95−-- | 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'.
96143field
97144 :: String -- ^ Key
98145 -> (Item a -> Compiler String) -- ^ Function that constructs a value based
99− -- on the item
146+ -- on the item (e.g. accessing metadata)
100147 -> Context a
101148field key value = field' key (fmap StringField . value)
102149
103150
104151--------------------------------------------------------------------------------
105152-- | Creates a 'field' to use with the @$if()$@ template macro.
153+-- Attempting to substitute the field into the template will cause an error.
106154boolField
107155 :: String
108156 -> (Item a -> Bool)
109157 -> Context a
110−boolField name f = field name (\i -> if f i
111− then pure (error $ unwords ["no string value for bool field:",name])
112− else empty)
158+boolField name f = field' name (\i -> if f i
159+ then return EmptyField
160+ else noResult $ "Field " ++ name ++ " is false")
113161
114162
115163--------------------------------------------------------------------------------
116−-- | Creates a 'field' that does not depend on the 'Item'
117−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
118169constField key = field key . const . return
119170
120171
121172--------------------------------------------------------------------------------
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.
122176listField :: String -> Context a -> Compiler [Item a] -> Context b
123177listField key c xs = listFieldWith key c (const xs)
124178
125179
126180--------------------------------------------------------------------------------
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.
127187listFieldWith
128188 :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b
129189listFieldWith key c f = field' key $ fmap (ListField c) . f
130190
131191
132192--------------------------------------------------------------------------------
133−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
134200functionField name value = Context $ \k args i ->
135201 if k == name
136202 then StringField <$> value args i
137− else empty
203+ else noResult $ "Tried function field " ++ name
138204
139205
140206--------------------------------------------------------------------------------
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+--
141216mapContext :: (String -> String) -> Context a -> Context a
142217mapContext f (Context c) = Context $ \k a i -> do
143218 fld <- c k a i
144219 case fld of
220+ EmptyField -> wrongType "boolField"
145221 StringField str -> return $ StringField (f str)
146− ListField _ _ -> fail $
147− "Hakyll.Web.Template.Context.mapContext: " ++
148− "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 ++ "!"
149226
227+--------------------------------------------------------------------------------
228+-- | A context that allows snippet inclusion. In processed file, use as:
229+--
230+-- > ...
231+-- > $snippet("path/to/snippet/")$
232+-- > ...
233+--
234+-- The contents of the included file will not be interpolated like @partial@
235+-- does it.
236+--
237+snippetField :: Context String
238+snippetField = functionField "snippet" f
239+ where
240+ f [contentsPath] _ = loadBody (fromFilePath contentsPath)
241+ f [] _ = fail "No argument to function 'snippet()'"
242+ f _ _ = fail "Too many arguments to function 'snippet()'"
150243
151244--------------------------------------------------------------------------------
152245-- | A context that contains (in that order)
@@ -166,8 +259,7 @@ defaultContext =
166259 metadataField `mappend`
167260 urlField "url" `mappend`
168261 pathField "path" `mappend`
169− titleField "title" `mappend`
170− missingField
262+ titleField "title"
171263
172264
173265--------------------------------------------------------------------------------
@@ -185,15 +277,20 @@ bodyField key = field key $ return . itemBody
185277-- | Map any field to its metadata value, if present
186278metadataField :: Context a
187279metadataField = Context $ \k _ i -> do
188− value <- getMetadataField (itemIdentifier i) k
189− 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
190285
191286
192287--------------------------------------------------------------------------------
193288-- | Absolute url to the resulting item
194289urlField :: String -> Context a
195−urlField key = field key $
196− 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
197294
198295
199296--------------------------------------------------------------------------------
@@ -244,6 +341,12 @@ titleField = mapContext takeBaseName . pathField
244341-- that begins with @yyyy-mm-dd@ . For example:
245342-- @folder//yyyy-mm-dd-title//dist//main.extension@ .
246343-- 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.
247350
248351dateField :: String -- ^ Key in which the rendered date should be placed
249352 -> String -- ^ Format to use on the date
@@ -254,7 +357,7 @@ dateField = dateFieldWith defaultTimeLocale
254357--------------------------------------------------------------------------------
255358-- | This is an extended version of 'dateField' that allows you to
256359-- specify a time locale that is used for outputting the date. For more
257−-- details, see 'dateField'.
360+-- details, see 'dateField' and 'formatTime'.
258361dateFieldWith :: TimeLocale -- ^ Output time locale
259362 -> String -- ^ Destination key
260363 -> String -- ^ Format to use on the date
@@ -274,13 +377,14 @@ getItemUTC :: MonadMetadata m
274377 -> m UTCTime -- ^ Parsed UTCTime
275378getItemUTC locale id' = do
276379 metadata <- getMetadata id'
277− let tryField k fmt = M.lookup k metadata >>= parseTime' fmt
278− paths = splitDirectories $ toFilePath id'
380+ let tryField k fmt = lookupString k metadata >>= parseTime' fmt
381+ paths = splitDirectories $ (dropExtension . toFilePath) id'
279382
280383 maybe empty' return $ msum $
281384 [tryField "published" fmt | fmt <- formats] ++
282385 [tryField "date" fmt | fmt <- formats] ++
283− [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]
284388 where
285389 empty' = fail $ "Hakyll.Web.Template.Context.getItemUTC: " ++
286390 "could not parse time for " ++ show id'
@@ -308,13 +412,16 @@ getItemModificationTime identifier = do
308412
309413
310414--------------------------------------------------------------------------------
415+-- | Creates a field with the last modification date of the underlying item.
311416modificationTimeField :: String -- ^ Key
312417 -> String -- ^ Format
313− -> Context a -- ^ Resuting context
418+ -> Context a -- ^ Resulting context
314419modificationTimeField = modificationTimeFieldWith defaultTimeLocale
315420
316421
317422--------------------------------------------------------------------------------
423+-- | Creates a field with the last modification date of the underlying item
424+-- in a custom localisation format (see 'formatTime').
318425modificationTimeFieldWith :: TimeLocale -- ^ Time output locale
319426 -> String -- ^ Key
320427 -> String -- ^ Format
@@ -353,10 +460,11 @@ teaserFieldWithSeparator separator key snapshot = field key $ \item -> do
353460
354461
355462--------------------------------------------------------------------------------
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.
356465missingField :: Context a
357−missingField = Context $ \k _ i -> fail $
358− "Missing field $" ++ k ++ "$ in context for item " ++
359− show (itemIdentifier i)
466+missingField = Context $ \k _ _ -> noResult $
467+ "Missing field '" ++ k ++ "' in context"
360468
361469parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
362470#if MIN_VERSION_time(1,5,0)
@@ -364,3 +472,10 @@ parseTimeM = TF.parseTimeM
364472#else
365473parseTimeM _ = TF.parseTime
366474#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
lib/Hakyll/Web/Template/Internal.hsnew file+261
@@ -0,0 +1,261 @@
1+{-# LANGUAGE DeriveAnyClass #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
5+
6+module Hakyll.Web.Template.Internal
7+ ( Template (..)
8+ , template
9+ , templateBodyCompiler
10+ , templateCompiler
11+ , applyTemplate
12+ , loadAndApplyTemplate
13+ , applyAsTemplate
14+ , readTemplate
15+ , compileTemplateItem
16+ , unsafeReadTemplateFile
17+
18+ , module Hakyll.Web.Template.Internal.Element
19+ , module Hakyll.Web.Template.Internal.Trim
20+ ) where
21+
22+
23+--------------------------------------------------------------------------------
24+import Control.Monad (forM)
25+import Control.Monad.Except (MonadError (..), catchError)
26+import Data.Binary (Binary)
27+import Data.List (intercalate)
28+import qualified Data.List.NonEmpty as NonEmpty
29+import Data.Typeable (Typeable)
30+import GHC.Exts (IsString (..))
31+import GHC.Generics (Generic)
32+
33+
34+--------------------------------------------------------------------------------
35+import Hakyll.Core.Compiler
36+import Hakyll.Core.Compiler.Internal
37+import Hakyll.Core.Identifier
38+import Hakyll.Core.Item
39+import Hakyll.Core.Writable
40+import Hakyll.Web.Template.Context
41+import Hakyll.Web.Template.Internal.Element
42+import Hakyll.Web.Template.Internal.Trim
43+
44+
45+--------------------------------------------------------------------------------
46+-- | Datatype used for template substitutions.
47+data Template = Template
48+ { tplElements :: [TemplateElement]
49+ , tplOrigin :: FilePath -- Only for error messages.
50+ } deriving (Show, Eq, Generic, Binary, Typeable)
51+
52+
53+--------------------------------------------------------------------------------
54+instance Writable Template where
55+ -- Writing a template is impossible
56+ write _ _ = return ()
57+
58+
59+--------------------------------------------------------------------------------
60+instance IsString Template where
61+ fromString = readTemplate
62+
63+
64+--------------------------------------------------------------------------------
65+-- | Wrap the constructor to ensure trim is called.
66+template :: FilePath -> [TemplateElement] -> Template
67+template p = flip Template p . trim
68+
69+
70+--------------------------------------------------------------------------------
71+-- | Parse a string into a template.
72+-- You should prefer 'compileTemplateItem' over this.
73+readTemplate :: String -> Template
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
92+
93+--------------------------------------------------------------------------------
94+-- | Read a template, without metadata header
95+templateBodyCompiler :: Compiler (Item Template)
96+templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do
97+ item <- getResourceBody
98+ file <- getUnderlying
99+ withItemBody (compileTemplateFile file) item
100+
101+--------------------------------------------------------------------------------
102+-- | Read complete file contents as a template
103+templateCompiler :: Compiler (Item Template)
104+templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do
105+ item <- getResourceString
106+ file <- getUnderlying
107+ withItemBody (compileTemplateFile file) item
108+
109+
110+--------------------------------------------------------------------------------
111+-- | Interpolate template expressions from context values in a page
112+applyTemplate :: Template -- ^ Template
113+ -> Context a -- ^ Context
114+ -> Item a -- ^ Page
115+ -> Compiler (Item String) -- ^ Resulting item
116+applyTemplate tpl context item = do
117+ body <- applyTemplate' (tplElements tpl) context item `catchError` handler
118+ 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+
128+
129+
130+--------------------------------------------------------------------------------
131+applyTemplate'
132+ :: forall a.
133+ [TemplateElement] -- ^ Unwrapped Template
134+ -> Context a -- ^ Context
135+ -> Item a -- ^ Page
136+ -> Compiler String -- ^ Resulting item
137+applyTemplate' tes context x = go tes
138+ where
139+ context' :: String -> [String] -> Item a -> Compiler ContextField
140+ context' = unContext (context `mappend` missingField)
141+
142+ go = fmap concat . mapM applyElem
143+
144+ ---------------------------------------------------------------------------
145+
146+ applyElem :: TemplateElement -> Compiler String
147+
148+ applyElem TrimL = trimError
149+
150+ applyElem TrimR = trimError
151+
152+ applyElem (Chunk c) = return c
153+
154+ applyElem (Expr e) = withErrorMessage evalMsg (applyStringExpr typeMsg e)
155+ where
156+ evalMsg = "In expr '$" ++ show e ++ "$'"
157+ typeMsg = "expr '$" ++ show e ++ "$'"
158+
159+ applyElem Escaped = return "$"
160+
161+ applyElem (If e t mf) = compilerTry (applyExpr e) >>= handle
162+ where
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
174+ sep <- maybe (return "") go s
175+ bs <- forM xs $ applyTemplate' b $ c <> bindItem context x
176+ return $ intercalate sep bs
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 ++ ")$'"
191+
192+ ---------------------------------------------------------------------------
193+
194+ applyExpr :: TemplateExpr -> Compiler ContextField
195+
196+ applyExpr (Ident (TemplateKey k)) = context' k [] x
197+
198+ applyExpr (Call (TemplateKey k) args) = do
199+ args' <- mapM (\e -> applyStringExpr (typeMsg e) e) args
200+ context' k args' x
201+ where
202+ typeMsg e = "argument '" ++ show e ++ "'"
203+
204+ applyExpr (StringLiteral s) = return (StringField s)
205+
206+ ----------------------------------------------------------------------------
207+
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."
222+
223+
224+--------------------------------------------------------------------------------
225+-- | The following pattern is so common:
226+--
227+-- > tpl <- loadBody "templates/foo.html"
228+-- > someCompiler
229+-- > >>= applyTemplate tpl context
230+--
231+-- That we have a single function which does this:
232+--
233+-- > someCompiler
234+-- > >>= loadAndApplyTemplate "templates/foo.html" context
235+loadAndApplyTemplate :: Identifier -- ^ Template identifier
236+ -> Context a -- ^ Context
237+ -> Item a -- ^ Page
238+ -> Compiler (Item String) -- ^ Resulting item
239+loadAndApplyTemplate identifier context item = do
240+ tpl <- loadBody identifier
241+ applyTemplate tpl context item
242+
243+
244+--------------------------------------------------------------------------------
245+-- | It is also possible that you want to substitute @$key$@s within the body of
246+-- an item. This function does that by interpreting the item body as a template,
247+-- and then applying it to itself.
248+applyAsTemplate :: Context String -- ^ Context
249+ -> Item String -- ^ Item and template
250+ -> Compiler (Item String) -- ^ Resulting item
251+applyAsTemplate context item = do
252+ tpl <- compileTemplateItem item
253+ applyTemplate tpl context item
254+
255+
256+--------------------------------------------------------------------------------
257+unsafeReadTemplateFile :: FilePath -> Compiler Template
258+unsafeReadTemplateFile file = do
259+ tpl <- unsafeCompiler $ readFile file
260+ compileTemplateFile (fromFilePath file) tpl
261+{-# DEPRECATED unsafeReadTemplateFile "Use templateCompiler" #-}
src/Hakyll/Web/Template/Internal.hs → lib/Hakyll/Web/Template/Internal/Element.hsrenamed+138−68
@@ -1,22 +1,24 @@
11--------------------------------------------------------------------------------
2−-- | Module containing the template data structure
3−{-# LANGUAGE DeriveDataTypeable #-}
2+-- | Module containing the elements used in a template. A template is generally
3+-- just a list of these elements.
44{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5−module Hakyll.Web.Template.Internal
6− ( Template (..)
7− , TemplateKey (..)
5+module Hakyll.Web.Template.Internal.Element
6+ ( TemplateKey (..)
87 , TemplateExpr (..)
98 , TemplateElement (..)
10− , readTemplate
9+ , templateElems
10+ , parseTemplateElemsFile
1111 ) where
1212
1313
1414--------------------------------------------------------------------------------
15−import Control.Applicative (pure, (<$), (<$>), (<*>), (<|>))
15+import Control.Applicative ((<|>), (<*))
1616import Control.Monad (void)
17+import Control.Arrow (left)
1718import Data.Binary (Binary, get, getWord8, put, putWord8)
19+import Data.List (intercalate)
20+import Data.Maybe (isJust)
1821import Data.Typeable (Typeable)
19−import Data.List (intercalate)
2022import GHC.Exts (IsString (..))
2123import qualified Text.Parsec as P
2224import qualified Text.Parsec.String as P
@@ -24,25 +26,6 @@ import qualified Text.Parsec.String as P
2426
2527--------------------------------------------------------------------------------
2628import Hakyll.Core.Util.Parser
27−import Hakyll.Core.Writable
28−
29−
30−--------------------------------------------------------------------------------
31−-- | Datatype used for template substitutions.
32−newtype Template = Template
33− { unTemplate :: [TemplateElement]
34− } deriving (Show, Eq, Binary, Typeable)
35−
36−
37−--------------------------------------------------------------------------------
38−instance Writable Template where
39− -- Writing a template is impossible
40− write _ _ = return ()
41−
42−
43−--------------------------------------------------------------------------------
44−instance IsString Template where
45− fromString = readTemplate
4629
4730
4831--------------------------------------------------------------------------------
@@ -61,9 +44,14 @@ data TemplateElement
6144 = Chunk String
6245 | Expr TemplateExpr
6346 | Escaped
64− | If TemplateExpr Template (Maybe Template) -- expr, then, else
65− | For TemplateExpr Template (Maybe Template) -- expr, body, separator
66− | Partial TemplateExpr -- filename
47+ -- expr, then, else
48+ | If TemplateExpr [TemplateElement] (Maybe [TemplateElement])
49+ -- expr, body, separator
50+ | For TemplateExpr [TemplateElement] (Maybe [TemplateElement])
51+ -- filename
52+ | Partial TemplateExpr
53+ | TrimL
54+ | TrimR
6755 deriving (Show, Eq, Typeable)
6856
6957
@@ -71,10 +59,12 @@ data TemplateElement
7159instance Binary TemplateElement where
7260 put (Chunk string) = putWord8 0 >> put string
7361 put (Expr e) = putWord8 1 >> put e
74− put (Escaped) = putWord8 2
75− put (If e t f ) = putWord8 3 >> put e >> put t >> put f
62+ put Escaped = putWord8 2
63+ put (If e t f) = putWord8 3 >> put e >> put t >> put f
7664 put (For e b s) = putWord8 4 >> put e >> put b >> put s
7765 put (Partial e) = putWord8 5 >> put e
66+ put TrimL = putWord8 6
67+ put TrimR = putWord8 7
7868
7969 get = getWord8 >>= \tag -> case tag of
8070 0 -> Chunk <$> get
@@ -83,8 +73,9 @@ instance Binary TemplateElement where
8373 3 -> If <$> get <*> get <*> get
8474 4 -> For <$> get <*> get <*> get
8575 5 -> Partial <$> get
86− _ -> error $
87− "Hakyll.Web.Template.Internal: Error reading cached template"
76+ 6 -> pure TrimL
77+ 7 -> pure TrimR
78+ _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
8879
8980
9081--------------------------------------------------------------------------------
@@ -114,35 +105,38 @@ instance Binary TemplateExpr where
114105 0 -> Ident <$> get
115106 1 -> Call <$> get <*> get
116107 2 -> StringLiteral <$> get
117− _ -> error $
118− "Hakyll.Web.Tamplte.Internal: Error reading cached template"
119−
108+ _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
120109
121110--------------------------------------------------------------------------------
122−readTemplate :: String -> Template
123−readTemplate input = case P.parse template "" input of
124− Left err -> error $ "Cannot parse template: " ++ show err
125− 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
126114
127115
128116--------------------------------------------------------------------------------
129−template :: P.Parser Template
130−template = Template <$>
131− (P.many $ chunk <|> escaped <|> conditional <|> for <|> partial <|> expr)
117+templateElems :: P.Parser [TemplateElement]
118+templateElems = mconcat <$> P.many (P.choice [ lift chunk
119+ , lift escaped
120+ , conditional
121+ , for
122+ , partial
123+ , expr
124+ ])
125+ where lift = fmap (:[])
132126
133127
134128--------------------------------------------------------------------------------
135129chunk :: P.Parser TemplateElement
136−chunk = Chunk <$> (P.many1 $ P.noneOf "$")
130+chunk = Chunk <$> P.many1 (P.noneOf "$")
137131
138132
139133--------------------------------------------------------------------------------
140−expr :: P.Parser TemplateElement
134+expr :: P.Parser [TemplateElement]
141135expr = P.try $ do
142− void $ P.char '$'
136+ trimLExpr <- trimOpen
143137 e <- expr'
144− void $ P.char '$'
145− return $ Expr e
138+ trimRExpr <- trimClose
139+ return $ [TrimL | trimLExpr] ++ [Expr e] ++ [TrimR | trimRExpr]
146140
147141
148142--------------------------------------------------------------------------------
@@ -152,40 +146,105 @@ expr' = stringLiteral <|> call <|> ident
152146
153147--------------------------------------------------------------------------------
154148escaped :: P.Parser TemplateElement
155−escaped = Escaped <$ (P.try $ P.string "$$")
149+escaped = Escaped <$ P.try (P.string "$$")
150+
151+
152+--------------------------------------------------------------------------------
153+trimOpen :: P.Parser Bool
154+trimOpen = do
155+ void $ P.char '$'
156+ trimLIf <- P.optionMaybe $ P.try (P.char '-')
157+ pure $ isJust trimLIf
158+
159+
160+--------------------------------------------------------------------------------
161+trimClose :: P.Parser Bool
162+trimClose = do
163+ trimIfR <- P.optionMaybe $ (P.char '-')
164+ void $ P.char '$'
165+ pure $ isJust trimIfR
156166
157167
158168--------------------------------------------------------------------------------
159−conditional :: P.Parser TemplateElement
169+conditional :: P.Parser [TemplateElement]
160170conditional = P.try $ do
161− void $ P.string "$if("
171+ -- if
172+ trimLIf <- trimOpen
173+ void $ P.string "if("
162174 e <- expr'
163− void $ P.string ")$"
164− thenBranch <- template
165− elseBranch <- P.optionMaybe $ P.try (P.string "$else$") >> template
166− void $ P.string "$endif$"
167− return $ If e thenBranch elseBranch
175+ void $ P.char ')'
176+ trimRIf <- trimClose
177+ -- then
178+ thenBranch <- templateElems
179+ -- else
180+ elseParse <- opt "else"
181+ -- endif
182+ trimLEnd <- trimOpen
183+ void $ P.string "endif"
184+ trimREnd <- trimClose
185+
186+ -- As else is optional we need to sort out where any Trim_s need to go.
187+ let (thenBody, elseBody) = maybe (thenNoElse, Nothing) thenElse elseParse
188+ where thenNoElse =
189+ [TrimR | trimRIf] ++ thenBranch ++ [TrimL | trimLEnd]
190+
191+ thenElse (trimLElse, elseBranch, trimRElse) = (thenB, elseB)
192+ where thenB = [TrimR | trimRIf]
193+ ++ thenBranch
194+ ++ [TrimL | trimLElse]
195+
196+ elseB = Just $ [TrimR | trimRElse]
197+ ++ elseBranch
198+ ++ [TrimL | trimLEnd]
199+
200+ pure $ [TrimL | trimLIf] ++ [If e thenBody elseBody] ++ [TrimR | trimREnd]
168201
169202
170203--------------------------------------------------------------------------------
171−for :: P.Parser TemplateElement
204+for :: P.Parser [TemplateElement]
172205for = P.try $ do
173− void $ P.string "$for("
206+ -- for
207+ trimLFor <- trimOpen
208+ void $ P.string "for("
174209 e <- expr'
175− void $ P.string ")$"
176− body <- template
177− sep <- P.optionMaybe $ P.try (P.string "$sep$") >> template
178− void $ P.string "$endfor$"
179− return $ For e body sep
210+ void $ P.char ')'
211+ trimRFor <- trimClose
212+ -- body
213+ bodyBranch <- templateElems
214+ -- sep
215+ sepParse <- opt "sep"
216+ -- endfor
217+ trimLEnd <- trimOpen
218+ void $ P.string "endfor"
219+ trimREnd <- trimClose
220+
221+ -- As sep is optional we need to sort out where any Trim_s need to go.
222+ let (forBody, sepBody) = maybe (forNoSep, Nothing) forSep sepParse
223+ where forNoSep =
224+ [TrimR | trimRFor] ++ bodyBranch ++ [TrimL | trimLEnd]
225+
226+ forSep (trimLSep, sepBranch, trimRSep) = (forB, sepB)
227+ where forB = [TrimR | trimRFor]
228+ ++ bodyBranch
229+ ++ [TrimL | trimLSep]
230+
231+ sepB = Just $ [TrimR | trimRSep]
232+ ++ sepBranch
233+ ++ [TrimL | trimLEnd]
234+
235+ pure $ [TrimL | trimLFor] ++ [For e forBody sepBody] ++ [TrimR | trimREnd]
180236
181237
182238--------------------------------------------------------------------------------
183−partial :: P.Parser TemplateElement
239+partial :: P.Parser [TemplateElement]
184240partial = P.try $ do
185− void $ P.string "$partial("
241+ trimLPart <- trimOpen
242+ void $ P.string "partial("
186243 e <- expr'
187− void $ P.string ")$"
188− return $ Partial e
244+ void $ P.char ')'
245+ trimRPart <- trimClose
246+
247+ pure $ [TrimL | trimLPart] ++ [Partial e] ++ [TrimR | trimRPart]
189248
190249
191250--------------------------------------------------------------------------------
@@ -219,3 +278,14 @@ stringLiteral = do
219278--------------------------------------------------------------------------------
220279key :: P.Parser TemplateKey
221280key = TemplateKey <$> metadataKey
281+
282+
283+--------------------------------------------------------------------------------
284+opt :: String -> P.Parser (Maybe (Bool, [TemplateElement], Bool))
285+opt clause = P.optionMaybe $ P.try $ do
286+ trimL <- trimOpen
287+ void $ P.string clause
288+ trimR <- trimClose
289+ branch <- templateElems
290+ pure (trimL, branch, trimR)
291+
lib/Hakyll/Web/Template/Internal/Trim.hsnew file+95
@@ -0,0 +1,95 @@
1+--------------------------------------------------------------------------------
2+-- | Module for trimming whitespace from tempaltes.
3+module Hakyll.Web.Template.Internal.Trim
4+ ( trim
5+ ) where
6+
7+
8+--------------------------------------------------------------------------------
9+import Data.Char (isSpace)
10+import Data.List (dropWhileEnd)
11+
12+
13+--------------------------------------------------------------------------------
14+import Hakyll.Web.Template.Internal.Element
15+
16+
17+--------------------------------------------------------------------------------
18+trim :: [TemplateElement] -> [TemplateElement]
19+trim = cleanse . canonicalize
20+
21+
22+--------------------------------------------------------------------------------
23+-- | Apply the Trim nodes to the Chunks.
24+cleanse :: [TemplateElement] -> [TemplateElement]
25+cleanse = recurse cleanse . process
26+ where process [] = []
27+ process (TrimR:Chunk str:ts) = let str' = dropWhile isSpace str
28+ in if null str'
29+ then process ts
30+ -- Might need to TrimL.
31+ else process $ Chunk str':ts
32+
33+ process (Chunk str:TrimL:ts) = let str' = dropWhileEnd isSpace str
34+ in if null str'
35+ then process ts
36+ else Chunk str':process ts
37+
38+ process (t:ts) = t:process ts
39+
40+--------------------------------------------------------------------------------
41+-- | Enforce the invariant that:
42+--
43+-- * Every 'TrimL' has a 'Chunk' to its left.
44+-- * Every 'TrimR' has a 'Chunk' to its right.
45+--
46+canonicalize :: [TemplateElement] -> [TemplateElement]
47+canonicalize = go
48+ where go t = let t' = redundant . swap $ dedupe t
49+ in if t == t' then t else go t'
50+
51+
52+--------------------------------------------------------------------------------
53+-- | Remove the 'TrimR' and 'TrimL's that are no-ops.
54+redundant :: [TemplateElement] -> [TemplateElement]
55+redundant = recurse redundant . process
56+ where -- Remove the leading 'TrimL's.
57+ process (TrimL:ts) = process ts
58+ -- Remove trailing 'TrimR's.
59+ process ts = foldr trailing [] ts
60+ where trailing TrimR [] = []
61+ trailing x xs = x:xs
62+
63+
64+--------------------------------------------------------------------------------
65+-- >>> swap $ [TrimR, TrimL]
66+-- [TrimL, TrimR]
67+swap :: [TemplateElement] -> [TemplateElement]
68+swap = recurse swap . process
69+ where process [] = []
70+ process (TrimR:TrimL:ts) = TrimL:process (TrimR:ts)
71+ process (t:ts) = t:process ts
72+
73+
74+--------------------------------------------------------------------------------
75+-- | Remove 'TrimR' and 'TrimL' duplication.
76+dedupe :: [TemplateElement] -> [TemplateElement]
77+dedupe = recurse dedupe . process
78+ where process [] = []
79+ process (TrimR:TrimR:ts) = process (TrimR:ts)
80+ process (TrimL:TrimL:ts) = process (TrimL:ts)
81+ process (t:ts) = t:process ts
82+
83+
84+--------------------------------------------------------------------------------
85+-- | @'recurse' f t@ applies f to every '[TemplateElement]' in t.
86+recurse :: ([TemplateElement] -> [TemplateElement])
87+ -> [TemplateElement]
88+ -> [TemplateElement]
89+recurse _ [] = []
90+recurse f (x:xs) = process x:recurse f xs
91+ where process y = case y of
92+ If e tb eb -> If e (f tb) (f <$> eb)
93+ For e t s -> For e (f t) (f <$> s)
94+ _ -> y
95+
src/Hakyll/Web/Template/List.hs → lib/Hakyll/Web/Template/List.hsrenamed

The content is the same.

src/Hakyll/Check.hsdeleted−250
@@ -1,250 +0,0 @@
1−--------------------------------------------------------------------------------
2−{-# LANGUAGE CPP #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−module Hakyll.Check
5− ( Check (..)
6− , check
7− ) where
8−
9−
10−--------------------------------------------------------------------------------
11−import Control.Applicative ((<$>))
12−import Control.Monad (forM_)
13−import Control.Monad.Reader (ask)
14−import Control.Monad.RWS (RWST, runRWST)
15−import Control.Monad.Trans (liftIO)
16−import Control.Monad.Writer (tell)
17−import Data.List (isPrefixOf)
18−import Data.Monoid (Monoid (..))
19−import Data.Set (Set)
20−import qualified Data.Set as S
21−import Network.URI (unEscapeString)
22−import System.Directory (doesDirectoryExist, doesFileExist)
23−import System.Exit (ExitCode (..))
24−import System.FilePath (takeDirectory, takeExtension, (</>))
25−import qualified Text.HTML.TagSoup as TS
26−
27−
28−--------------------------------------------------------------------------------
29−#ifdef CHECK_EXTERNAL
30−import Control.Exception (AsyncException (..),
31− SomeException (..), handle, throw)
32−import Control.Monad.State (get, modify)
33−import Data.List (intercalate)
34−import Data.Typeable (cast)
35−import Data.Version (versionBranch)
36−import GHC.Exts (fromString)
37−import qualified Network.HTTP.Conduit as Http
38−import qualified Network.HTTP.Types as Http
39−import qualified Paths_hakyll as Paths_hakyll
40−#endif
41−
42−
43−--------------------------------------------------------------------------------
44−import Hakyll.Core.Configuration
45−import Hakyll.Core.Logger (Logger)
46−import qualified Hakyll.Core.Logger as Logger
47−import Hakyll.Core.Util.File
48−import Hakyll.Web.Html
49−
50−
51−--------------------------------------------------------------------------------
52−data Check = All | InternalLinks
53− deriving (Eq, Ord, Show)
54−
55−
56−--------------------------------------------------------------------------------
57−check :: Configuration -> Logger -> Check -> IO ExitCode
58−check config logger check' = do
59− ((), write) <- runChecker checkDestination config logger check'
60− return $ if checkerFaulty write > 0 then ExitFailure 1 else ExitSuccess
61−
62−
63−--------------------------------------------------------------------------------
64−data CheckerRead = CheckerRead
65− { checkerConfig :: Configuration
66− , checkerLogger :: Logger
67− , checkerCheck :: Check
68− }
69−
70−
71−--------------------------------------------------------------------------------
72−data CheckerWrite = CheckerWrite
73− { checkerFaulty :: Int
74− , checkerOk :: Int
75− } deriving (Show)
76−
77−
78−--------------------------------------------------------------------------------
79−instance Monoid CheckerWrite where
80− mempty = CheckerWrite 0 0
81− mappend (CheckerWrite f1 o1) (CheckerWrite f2 o2) =
82− CheckerWrite (f1 + f2) (o1 + o2)
83−
84−
85−--------------------------------------------------------------------------------
86−type CheckerState = Set String
87−
88−
89−--------------------------------------------------------------------------------
90−type Checker a = RWST CheckerRead CheckerWrite CheckerState IO a
91−
92−
93−--------------------------------------------------------------------------------
94−runChecker :: Checker a -> Configuration -> Logger -> Check
95− -> IO (a, CheckerWrite)
96−runChecker checker config logger check' = do
97− let read' = CheckerRead
98− { checkerConfig = config
99− , checkerLogger = logger
100− , checkerCheck = check'
101− }
102−
103− (x, _, write) <- runRWST checker read' S.empty
104− Logger.flush logger
105− return (x, write)
106−
107−
108−--------------------------------------------------------------------------------
109−checkDestination :: Checker ()
110−checkDestination = do
111− config <- checkerConfig <$> ask
112− files <- liftIO $ getRecursiveContents
113− (const $ return False) (destinationDirectory config)
114−
115− let htmls =
116− [ destinationDirectory config </> file
117− | file <- files
118− , takeExtension file == ".html"
119− ]
120−
121− forM_ htmls checkFile
122−
123−
124−--------------------------------------------------------------------------------
125−checkFile :: FilePath -> Checker ()
126−checkFile filePath = do
127− logger <- checkerLogger <$> ask
128− contents <- liftIO $ readFile filePath
129− Logger.header logger $ "Checking file " ++ filePath
130−
131− let urls = getUrls $ TS.parseTags contents
132− forM_ urls $ \url -> do
133− Logger.debug logger $ "Checking link " ++ url
134− checkUrl filePath url
135−
136−
137−--------------------------------------------------------------------------------
138−checkUrl :: FilePath -> String -> Checker ()
139−checkUrl filePath url
140− | isExternal url = checkExternalUrl url
141− | hasProtocol url = skip "Unknown protocol, skipping"
142− | otherwise = checkInternalUrl filePath url
143− where
144− validProtoChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "+-."
145− hasProtocol str = case break (== ':') str of
146− (proto, ':' : _) -> all (`elem` validProtoChars) proto
147− _ -> False
148−
149−
150−--------------------------------------------------------------------------------
151−ok :: String -> Checker ()
152−ok _ = tell $ mempty {checkerOk = 1}
153−
154−
155−--------------------------------------------------------------------------------
156−skip :: String -> Checker ()
157−skip reason = do
158− logger <- checkerLogger <$> ask
159− Logger.debug logger $ reason
160− tell $ mempty {checkerOk = 1}
161−
162−--------------------------------------------------------------------------------
163−faulty :: String -> Checker ()
164−faulty url = do
165− logger <- checkerLogger <$> ask
166− Logger.error logger $ "Broken link to " ++ show url
167− tell $ mempty {checkerFaulty = 1}
168−
169−
170−--------------------------------------------------------------------------------
171−checkInternalUrl :: FilePath -> String -> Checker ()
172−checkInternalUrl base url = case url' of
173− "" -> ok url
174− _ -> do
175− config <- checkerConfig <$> ask
176− let dest = destinationDirectory config
177− dir = takeDirectory base
178− filePath
179− | "/" `isPrefixOf` url' = dest ++ url'
180− | otherwise = dir </> url'
181−
182− exists <- checkFileExists filePath
183− if exists then ok url else faulty url
184− where
185− url' = stripFragments $ unEscapeString url
186−
187−
188−--------------------------------------------------------------------------------
189−checkExternalUrl :: String -> Checker ()
190−#ifdef CHECK_EXTERNAL
191−checkExternalUrl url = do
192− logger <- checkerLogger <$> ask
193− needsCheck <- (== All) . checkerCheck <$> ask
194− checked <- (url `S.member`) <$> get
195−
196− if not needsCheck || checked
197− then Logger.debug logger "Already checked, skipping"
198− else do
199− isOk <- liftIO $ handle (failure logger) $
200− Http.withManager $ \mgr -> do
201− request <- Http.parseUrl urlToCheck
202− response <- Http.http (settings request) mgr
203− let code = Http.statusCode (Http.responseStatus response)
204− return $ code >= 200 && code < 300
205−
206− modify $ if schemeRelative url
207− then S.insert urlToCheck . S.insert url
208− else S.insert url
209− if isOk then ok url else faulty url
210− where
211− -- Add additional request info
212− settings r = r
213− { Http.method = "HEAD"
214− , Http.redirectCount = 10
215− , Http.requestHeaders = ("User-Agent", ua) : Http.requestHeaders r
216− }
217−
218− -- Nice user agent info
219− ua = fromString $ "hakyll-check/" ++
220− (intercalate "." $ map show $ versionBranch $ Paths_hakyll.version)
221−
222− -- Catch all the things except UserInterrupt
223− failure logger (SomeException e) = case cast e of
224− Just UserInterrupt -> throw UserInterrupt
225− _ -> Logger.error logger (show e) >> return False
226−
227− -- Check scheme-relative links
228− schemeRelative = isPrefixOf "//"
229− urlToCheck = if schemeRelative url then "http:" ++ url else url
230−#else
231−checkExternalUrl _ = return ()
232−#endif
233−
234−
235−
236−--------------------------------------------------------------------------------
237−-- | Wraps doesFileExist, also checks for index.html
238−checkFileExists :: FilePath -> Checker Bool
239−checkFileExists filePath = liftIO $ do
240− file <- doesFileExist filePath
241− dir <- doesDirectoryExist filePath
242− case (file, dir) of
243− (True, _) -> return True
244− (_, True) -> doesFileExist $ filePath </> "index.html"
245− _ -> return False
246−
247−
248−--------------------------------------------------------------------------------
249−stripFragments :: String -> String
250−stripFragments = takeWhile (not . flip elem ['?', '#'])
src/Hakyll/Core/Metadata.hsdeleted−64
@@ -1,64 +0,0 @@
1−--------------------------------------------------------------------------------
2−module Hakyll.Core.Metadata
3− ( Metadata
4− , MonadMetadata (..)
5− , getMetadataField
6− , getMetadataField'
7− , makePatternDependency
8− ) where
9−
10−
11−--------------------------------------------------------------------------------
12−import Control.Monad (forM)
13−import Data.Map (Map)
14−import qualified Data.Map as M
15−import qualified Data.Set as S
16−
17−
18−--------------------------------------------------------------------------------
19−import Hakyll.Core.Dependencies
20−import Hakyll.Core.Identifier
21−import Hakyll.Core.Identifier.Pattern
22−
23−
24−--------------------------------------------------------------------------------
25−type Metadata = Map String String
26−
27−
28−--------------------------------------------------------------------------------
29−class Monad m => MonadMetadata m where
30− getMetadata :: Identifier -> m Metadata
31− getMatches :: Pattern -> m [Identifier]
32−
33− getAllMetadata :: Pattern -> m [(Identifier, Metadata)]
34− getAllMetadata pattern = do
35− matches' <- getMatches pattern
36− forM matches' $ \id' -> do
37− metadata <- getMetadata id'
38− return (id', metadata)
39−
40−
41−--------------------------------------------------------------------------------
42−getMetadataField :: MonadMetadata m => Identifier -> String -> m (Maybe String)
43−getMetadataField identifier key = do
44− metadata <- getMetadata identifier
45− return $ M.lookup key metadata
46−
47−
48−--------------------------------------------------------------------------------
49−-- | Version of 'getMetadataField' which throws an error if the field does not
50−-- exist.
51−getMetadataField' :: MonadMetadata m => Identifier -> String -> m String
52−getMetadataField' identifier key = do
53− field <- getMetadataField identifier key
54− case field of
55− Just v -> return v
56− Nothing -> fail $ "Hakyll.Core.Metadata.getMetadataField': " ++
57− "Item " ++ show identifier ++ " has no metadata field " ++ show key
58−
59−
60−--------------------------------------------------------------------------------
61−makePatternDependency :: MonadMetadata m => Pattern -> m Dependency
62−makePatternDependency pattern = do
63− matches' <- getMatches pattern
64− return $ PatternDependency pattern (S.fromList matches')
src/Hakyll/Core/Provider/Metadata.hsdeleted−135
@@ -1,135 +0,0 @@
1−--------------------------------------------------------------------------------
2−-- | Internal module to parse metadata
3−module Hakyll.Core.Provider.Metadata
4− ( loadMetadata
5− , metadata
6− , page
7−
8− -- This parser can be reused in some places
9− , metadataKey
10− ) where
11−
12−
13−--------------------------------------------------------------------------------
14−import Control.Applicative
15−import Control.Arrow (second)
16−import qualified Data.ByteString.Char8 as BC
17−import Data.List (intercalate)
18−import qualified Data.Map as M
19−import System.IO as IO
20−import Text.Parsec ((<?>))
21−import qualified Text.Parsec as P
22−import Text.Parsec.String (Parser)
23−
24−
25−--------------------------------------------------------------------------------
26−import Hakyll.Core.Identifier
27−import Hakyll.Core.Metadata
28−import Hakyll.Core.Provider.Internal
29−import Hakyll.Core.Util.Parser
30−import Hakyll.Core.Util.String
31−
32−
33−--------------------------------------------------------------------------------
34−loadMetadata :: Provider -> Identifier -> IO (Metadata, Maybe String)
35−loadMetadata p identifier = do
36− hasHeader <- probablyHasMetadataHeader fp
37− (md, body) <- if hasHeader
38− then second Just <$> loadMetadataHeader fp
39− else return (M.empty, Nothing)
40−
41− emd <- case mi of
42− Nothing -> return M.empty
43− Just mi' -> loadMetadataFile $ resourceFilePath p mi'
44−
45− return (M.union md emd, body)
46− where
47− normal = setVersion Nothing identifier
48− fp = resourceFilePath p identifier
49− mi = M.lookup normal (providerFiles p) >>= resourceInfoMetadata
50−
51−
52−--------------------------------------------------------------------------------
53−loadMetadataHeader :: FilePath -> IO (Metadata, String)
54−loadMetadataHeader fp = do
55− contents <- readFile fp
56− case P.parse page fp contents of
57− Left err -> error (show err)
58− Right (md, b) -> return (M.fromList md, b)
59−
60−
61−--------------------------------------------------------------------------------
62−loadMetadataFile :: FilePath -> IO Metadata
63−loadMetadataFile fp = do
64− contents <- readFile fp
65− case P.parse metadata fp contents of
66− Left err -> error (show err)
67− Right md -> return $ M.fromList md
68−
69−
70−--------------------------------------------------------------------------------
71−-- | Check if a file "probably" has a metadata header. The main goal of this is
72−-- to exclude binary files (which are unlikely to start with "---").
73−probablyHasMetadataHeader :: FilePath -> IO Bool
74−probablyHasMetadataHeader fp = do
75− handle <- IO.openFile fp IO.ReadMode
76− bs <- BC.hGet handle 1024
77− IO.hClose handle
78− return $ isMetadataHeader bs
79− where
80− isMetadataHeader bs =
81− let pre = BC.takeWhile (\x -> x /= '\n' && x /= '\r') bs
82− in BC.length pre >= 3 && BC.all (== '-') pre
83−
84−
85−--------------------------------------------------------------------------------
86−-- | Space or tab, no newline
87−inlineSpace :: Parser Char
88−inlineSpace = P.oneOf ['\t', ' '] <?> "space"
89−
90−
91−--------------------------------------------------------------------------------
92−-- | Parse Windows newlines as well (i.e. "\n" or "\r\n")
93−newline :: Parser String
94−newline = P.string "\n" <|> P.string "\r\n"
95−
96−
97−--------------------------------------------------------------------------------
98−-- | Parse a single metadata field
99−metadataField :: Parser (String, String)
100−metadataField = do
101− key <- metadataKey
102− _ <- P.char ':'
103− P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key
104− value <- P.manyTill P.anyChar newline
105− trailing' <- P.many trailing
106− return (key, trim $ intercalate " " $ value : trailing')
107− where
108− trailing = P.many1 inlineSpace *> P.manyTill P.anyChar newline
109−
110−
111−--------------------------------------------------------------------------------
112−-- | Parse a metadata block
113−metadata :: Parser [(String, String)]
114−metadata = P.many metadataField
115−
116−
117−--------------------------------------------------------------------------------
118−-- | Parse a metadata block, including delimiters and trailing newlines
119−metadataBlock :: Parser [(String, String)]
120−metadataBlock = do
121− open <- P.many1 (P.char '-') <* P.many inlineSpace <* newline
122− metadata' <- metadata
123− _ <- P.choice $ map (P.string . replicate (length open)) ['-', '.']
124− P.skipMany inlineSpace
125− P.skipMany1 newline
126− return metadata'
127−
128−
129−--------------------------------------------------------------------------------
130−-- | Parse a page consisting of a metadata header and a body
131−page :: Parser ([(String, String)], String)
132−page = do
133− metadata' <- P.option [] metadataBlock
134− body <- P.many P.anyChar
135− return (metadata', body)
src/Hakyll/Main.hsdeleted−128
@@ -1,128 +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.Console.CmdArgs
14−import qualified System.Console.CmdArgs.Explicit as CA
15−import System.Environment (getProgName)
16−import System.IO.Unsafe (unsafePerformIO)
17−import System.Exit (ExitCode(ExitSuccess), exitWith)
18−
19−--------------------------------------------------------------------------------
20−import qualified Hakyll.Check as Check
21−import qualified Hakyll.Commands as Commands
22−import qualified Hakyll.Core.Configuration as Config
23−import qualified Hakyll.Core.Logger as Logger
24−import Hakyll.Core.Rules
25−
26−
27−--------------------------------------------------------------------------------
28−-- | This usualy is the function with which the user runs the hakyll compiler
29−hakyll :: Rules a -> IO ()
30−hakyll = hakyllWith Config.defaultConfiguration
31−
32−--------------------------------------------------------------------------------
33−-- | A variant of 'hakyll' which allows the user to specify a custom
34−-- configuration
35−hakyllWith :: Config.Configuration -> Rules a -> IO ()
36−hakyllWith conf rules = hakyllWithExitCode conf rules >>= exitWith
37−
38−hakyllWithExitCode :: Config.Configuration -> Rules a -> IO ExitCode
39−hakyllWithExitCode conf rules = do
40− args' <- cmdArgs (hakyllArgs conf)
41−
42− let verbosity' = if verbose args' then Logger.Debug else Logger.Message
43− check' =
44− if internal_links args' then Check.InternalLinks else Check.All
45−
46− logger <- Logger.new verbosity'
47− case args' of
48− Build _ -> Commands.build conf logger rules
49− Check _ _ -> Commands.check conf logger check' >> ok
50− Clean _ -> Commands.clean conf logger >> ok
51− Deploy _ -> Commands.deploy conf
52− Help _ -> showHelp >> ok
53− Preview _ p -> Commands.preview conf logger rules p >> ok
54− Rebuild _ -> Commands.rebuild conf logger rules
55− Server _ _ _ -> Commands.server conf logger (host args') (port args') >> ok
56− Watch _ _ p s -> Commands.watch conf logger (host args') p (not s) rules >> ok
57− where
58− ok = return ExitSuccess
59−
60−
61−--------------------------------------------------------------------------------
62−-- | Show usage information.
63−showHelp :: IO ()
64−showHelp = print $ CA.helpText [] CA.HelpFormatOne $ cmdArgsMode (hakyllArgs Config.defaultConfiguration)
65−
66−
67−--------------------------------------------------------------------------------
68−data HakyllArgs
69− = Build {verbose :: Bool}
70− | Check {verbose :: Bool, internal_links :: Bool}
71− | Clean {verbose :: Bool}
72− | Deploy {verbose :: Bool}
73− | Help {verbose :: Bool}
74− | Preview {verbose :: Bool, port :: Int}
75− | Rebuild {verbose :: Bool}
76− | Server {verbose :: Bool, host :: String, port :: Int}
77− | Watch {verbose :: Bool, host :: String, port :: Int, no_server :: Bool }
78− deriving (Data, Typeable, Show)
79−
80−
81−--------------------------------------------------------------------------------
82−hakyllArgs :: Config.Configuration -> HakyllArgs
83−hakyllArgs conf = modes
84− [ (Build $ verboseFlag def) &= help "Generate the site"
85− , (Check (verboseFlag def) (False &= help "Check internal links only")) &=
86− help "Validate the site output"
87− , (Clean $ verboseFlag def) &= help "Clean up and remove cache"
88− , (Deploy $ verboseFlag def) &= help "Upload/deploy your site"
89− , (Help $ verboseFlag def) &= help "Show this message" &= auto
90− , (Preview (verboseFlag def) (portFlag defaultPort)) &=
91− help "[Deprecated] Please use the watch command"
92− , (Rebuild $ verboseFlag def) &= help "Clean and build again"
93− , (Server (verboseFlag def) (hostFlag defaultHost) (portFlag defaultPort)) &=
94− help "Start a preview server"
95− , (Watch (verboseFlag def) (hostFlag defaultHost) (portFlag defaultPort) (noServerFlag False) &=
96− help "Autocompile on changes and start a preview server. You can watch and recompile without running a server with --no-server.")
97− ] &= help "Hakyll static site compiler" &= program progName
98− where
99− defaultHost = Config.previewHost conf
100− defaultPort = Config.previewPort conf
101−
102−--------------------------------------------------------------------------------
103−verboseFlag :: Data a => a -> a
104−verboseFlag x = x &= help "Run in verbose mode"
105−{-# INLINE verboseFlag #-}
106−
107−
108−--------------------------------------------------------------------------------
109−noServerFlag :: Data a => a -> a
110−noServerFlag x = x &= help "Disable the built-in web server"
111−{-# INLINE noServerFlag #-}
112−
113−--------------------------------------------------------------------------------
114−hostFlag :: Data a => a -> a
115−hostFlag x = x &= help "Host to bind on"
116−{-# INLINE hostFlag #-}
117−
118−--------------------------------------------------------------------------------
119−portFlag :: Data a => a -> a
120−portFlag x = x &= help "Port to listen on"
121−{-# INLINE portFlag #-}
122−
123−
124−--------------------------------------------------------------------------------
125−-- | This is necessary because not everyone calls their program the same...
126−progName :: String
127−progName = unsafePerformIO getProgName
128−{-# NOINLINE progName #-}
src/Hakyll/Preview/Server.hsdeleted−54
@@ -1,54 +0,0 @@
1−--------------------------------------------------------------------------------
2−-- | Implements a basic static file server for previewing options
3−{-# LANGUAGE OverloadedStrings #-}
4−module Hakyll.Preview.Server
5− ( staticServer
6− ) where
7−
8−
9−--------------------------------------------------------------------------------
10−import Control.Monad.Trans (liftIO)
11−import qualified Data.ByteString.Char8 as B
12−import qualified Snap.Core as Snap
13−import qualified Snap.Http.Server as Snap
14−import qualified Snap.Util.FileServe as Snap
15−
16−
17−--------------------------------------------------------------------------------
18−import Hakyll.Core.Logger (Logger)
19−import qualified Hakyll.Core.Logger as Logger
20−
21−
22−--------------------------------------------------------------------------------
23−-- | Serve a given directory
24−static :: FilePath -- ^ Directory to serve
25− -> (FilePath -> IO ()) -- ^ Pre-serve hook
26− -> Snap.Snap ()
27−static directory preServe =
28− Snap.serveDirectoryWith directoryConfig directory
29− where
30− directoryConfig :: Snap.DirectoryConfig Snap.Snap
31− directoryConfig = Snap.fancyDirectoryConfig
32− { Snap.preServeHook = liftIO . preServe
33− }
34−
35−
36−--------------------------------------------------------------------------------
37−-- | Main method, runs a static server in the given directory
38−staticServer :: Logger -- ^ Logger
39− -> FilePath -- ^ Directory to serve
40− -> (FilePath -> IO ()) -- ^ Pre-serve hook
41− -> String -- ^ Host to bind on
42− -> Int -- ^ Port to listen on
43− -> IO () -- ^ Blocks forever
44−staticServer logger directory preServe host port = do
45− Logger.header logger $ "Listening on http://" ++ host ++ ":" ++ show port
46− Snap.httpServe config $ static directory preServe
47− where
48− -- Snap server config
49− config = Snap.setBind (B.pack host)
50− $ Snap.setPort port
51− $ Snap.setAccessLog Snap.ConfigNoLog
52− $ Snap.setErrorLog Snap.ConfigNoLog
53− $ Snap.setVerbose False
54− $ Snap.emptyConfig
src/Hakyll/Web/CompressCss.hsdeleted−60
@@ -1,60 +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 Control.Applicative ((<$>))
12−import Data.Char (isSpace)
13−import Data.List (isPrefixOf)
14−
15−
16−--------------------------------------------------------------------------------
17−import Hakyll.Core.Compiler
18−import Hakyll.Core.Item
19−import Hakyll.Core.Util.String
20−
21−
22−--------------------------------------------------------------------------------
23−-- | Compiler form of 'compressCss'
24−compressCssCompiler :: Compiler (Item String)
25−compressCssCompiler = fmap compressCss <$> getResourceString
26−
27−
28−--------------------------------------------------------------------------------
29−-- | Compress CSS to speed up your site.
30−compressCss :: String -> String
31−compressCss = compressSeparators . stripComments . compressWhitespace
32−
33−
34−--------------------------------------------------------------------------------
35−-- | Compresses certain forms of separators.
36−compressSeparators :: String -> String
37−compressSeparators =
38− replaceAll "; *}" (const "}") .
39− replaceAll " *([{};:]) *" (take 1 . dropWhile isSpace) .
40− replaceAll ";+" (const ";")
41−
42−
43−--------------------------------------------------------------------------------
44−-- | Compresses all whitespace.
45−compressWhitespace :: String -> String
46−compressWhitespace = replaceAll "[ \t\n\r]+" (const " ")
47−
48−
49−--------------------------------------------------------------------------------
50−-- | Function that strips CSS comments away.
51−stripComments :: String -> String
52−stripComments [] = []
53−stripComments str
54− | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str
55− | otherwise = head str : stripComments (drop 1 str)
56− where
57− eatComments str'
58− | null str' = []
59− | isPrefixOf "*/" str' = drop 2 str'
60− | otherwise = eatComments $ drop 1 str'
src/Hakyll/Web/Template.hsdeleted−264
@@ -1,264 +0,0 @@
1−-- | This module provides means for reading and applying 'Template's.
2−--
3−-- Templates are tools to convert items into a string. They are perfectly suited
4−-- for laying out your site.
5−--
6−-- Let's look at an example template:
7−--
8−-- > <html>
9−-- > <head>
10−-- > <title>My crazy homepage - $title$</title>
11−-- > </head>
12−-- > <body>
13−-- > <div id="header">
14−-- > <h1>My crazy homepage - $title$</h1>
15−-- > </div>
16−-- > <div id="content">
17−-- > $body$
18−-- > </div>
19−-- > <div id="footer">
20−-- > By reading this you agree that I now own your soul
21−-- > </div>
22−-- > </body>
23−-- > </html>
24−--
25−-- As you can see, the format is very simple -- @$key$@ is used to render the
26−-- @$key$@ field from the page, everything else is literally copied. If you want
27−-- to literally insert @\"$key$\"@ into your page (for example, when you're
28−-- writing a Hakyll tutorial) you can use
29−--
30−-- > <p>
31−-- > A literal $$key$$.
32−-- > </p>
33−--
34−-- Because of it's simplicity, these templates can be used for more than HTML:
35−-- you could make, for example, CSS or JS templates as well.
36−--
37−-- Apart from interpolating @$key$@s from the 'Context' you can also
38−-- use the following macros:
39−--
40−-- * @$if(key)$@
41−--
42−-- > $if(key)$
43−-- > <b> Defined </b>
44−-- > $else$
45−-- > <b> Non-defined </b>
46−-- > $endif$
47−--
48−-- This example will print @Defined@ if @key@ is defined in the
49−-- context and @Non-defined@ otherwise. The @$else$@ clause is
50−-- optional.
51−--
52−-- * @$for(key)$@
53−--
54−-- The @for@ macro is used for enumerating 'Context' elements that are
55−-- lists, i.e. constructed using the 'listField' function. Assume that
56−-- in a context we have an element @listField \"key\" c itms@. Then
57−-- the snippet
58−--
59−-- > $for(key)$
60−-- > $x$
61−-- > $sep$,
62−-- > $endfor$
63−--
64−-- would, for each item @i@ in 'itms', lookup @$x$@ in the context @c@
65−-- with item @i@, interpolate it, and join the resulting list with
66−-- @,@.
67−--
68−-- Another concrete example one may consider is the following. Given the
69−-- context
70−--
71−-- > listField "things" (field "thing" (return . itemBody))
72−-- > (sequence [makeItem "fruits", makeItem "vegetables"])
73−--
74−-- and a template
75−--
76−-- > I like
77−-- > $for(things)$
78−-- > fresh $thing$$sep$, and
79−-- > $endfor$
80−--
81−-- the resulting page would look like
82−--
83−-- > <p>
84−-- > I like
85−-- >
86−-- > fresh fruits, and
87−-- >
88−-- > fresh vegetables
89−-- > </p>
90−--
91−-- The @$sep$@ part can be omitted. Usually, you can get by using the
92−-- 'applyListTemplate' and 'applyJoinListTemplate' functions.
93−--
94−-- * @$partial(path)$@
95−--
96−-- Loads a template located in a separate file and interpolates it
97−-- under the current context.
98−--
99−-- Assuming that the file @test.html@ contains
100−--
101−-- > <b>$key$</b>
102−--
103−-- The result of rendering
104−--
105−-- > <p>
106−-- > $partial("test.html")$
107−-- > </p>
108−--
109−-- is the same as the result of rendering
110−--
111−-- > <p>
112−-- > <b>$key$</b>
113−-- > </p>
114−--
115−-- That is, calling @$partial$@ is equivalent to just copying and pasting
116−-- template code.
117−--
118−{-# LANGUAGE ScopedTypeVariables #-}
119−module Hakyll.Web.Template
120− ( Template
121− , templateBodyCompiler
122− , templateCompiler
123− , applyTemplate
124− , loadAndApplyTemplate
125− , applyAsTemplate
126− , readTemplate
127− ) where
128−
129−
130−--------------------------------------------------------------------------------
131−import Control.Monad (liftM)
132−import Control.Monad.Error (MonadError (..))
133−import Data.List (intercalate)
134−import Data.Monoid (mappend)
135−import Prelude hiding (id)
136−
137−
138−--------------------------------------------------------------------------------
139−import Hakyll.Core.Compiler
140−import Hakyll.Core.Identifier
141−import Hakyll.Core.Item
142−import Hakyll.Web.Template.Context
143−import Hakyll.Web.Template.Internal
144−
145−
146−--------------------------------------------------------------------------------
147−-- | Read a template, without metadata header
148−templateBodyCompiler :: Compiler (Item Template)
149−templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do
150− item <- getResourceBody
151− return $ fmap readTemplate item
152−
153−--------------------------------------------------------------------------------
154−-- | Read complete file contents as a template
155−templateCompiler :: Compiler (Item Template)
156−templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do
157− item <- getResourceString
158− return $ fmap readTemplate item
159−
160−
161−--------------------------------------------------------------------------------
162−applyTemplate :: Template -- ^ Template
163− -> Context a -- ^ Context
164− -> Item a -- ^ Page
165− -> Compiler (Item String) -- ^ Resulting item
166−applyTemplate tpl context item = do
167− body <- applyTemplate' tpl context item
168− return $ itemSetBody body item
169−
170−
171−--------------------------------------------------------------------------------
172−applyTemplate'
173− :: forall a.
174− Template -- ^ Template
175− -> Context a -- ^ Context
176− -> Item a -- ^ Page
177− -> Compiler String -- ^ Resulting item
178−applyTemplate' tpl context x = go tpl
179− where
180− context' :: String -> [String] -> Item a -> Compiler ContextField
181− context' = unContext (context `mappend` missingField)
182−
183− go = liftM concat . mapM applyElem . unTemplate
184−
185− ---------------------------------------------------------------------------
186−
187− applyElem :: TemplateElement -> Compiler String
188−
189− applyElem (Chunk c) = return c
190−
191− applyElem (Expr e) = applyExpr e >>= getString e
192−
193− applyElem Escaped = return "$"
194−
195− applyElem (If e t mf) = (applyExpr e >> go t) `catchError` handler
196− where
197− handler _ = case mf of
198− Nothing -> return ""
199− Just f -> go f
200−
201− applyElem (For e b s) = applyExpr e >>= \cf -> case cf of
202− StringField _ -> fail $
203− "Hakyll.Web.Template.applyTemplateWith: expected ListField but " ++
204− "got StringField for expr " ++ show e
205− ListField c xs -> do
206− sep <- maybe (return "") go s
207− bs <- mapM (applyTemplate' b c) xs
208− return $ intercalate sep bs
209−
210− applyElem (Partial e) = do
211− p <- applyExpr e >>= getString e
212− tpl' <- loadBody (fromFilePath p)
213− applyTemplate' tpl' context x
214−
215− ---------------------------------------------------------------------------
216−
217− applyExpr :: TemplateExpr -> Compiler ContextField
218−
219− applyExpr (Ident (TemplateKey k)) = context' k [] x
220−
221− applyExpr (Call (TemplateKey k) args) = do
222− args' <- mapM (\e -> applyExpr e >>= getString e) args
223− context' k args' x
224−
225− applyExpr (StringLiteral s) = return (StringField s)
226−
227− ----------------------------------------------------------------------------
228−
229− getString _ (StringField s) = return s
230− getString e (ListField _ _) = fail $
231− "Hakyll.Web.Template.applyTemplateWith: expected StringField but " ++
232− "got ListField for expr " ++ show e
233−
234−
235−--------------------------------------------------------------------------------
236−-- | The following pattern is so common:
237−--
238−-- > tpl <- loadBody "templates/foo.html"
239−-- > someCompiler
240−-- > >>= applyTemplate tpl context
241−--
242−-- That we have a single function which does this:
243−--
244−-- > someCompiler
245−-- > >>= loadAndApplyTemplate "templates/foo.html" context
246−loadAndApplyTemplate :: Identifier -- ^ Template identifier
247− -> Context a -- ^ Context
248− -> Item a -- ^ Page
249− -> Compiler (Item String) -- ^ Resulting item
250−loadAndApplyTemplate identifier context item = do
251− tpl <- loadBody identifier
252− applyTemplate tpl context item
253−
254−
255−--------------------------------------------------------------------------------
256−-- | It is also possible that you want to substitute @$key$@s within the body of
257−-- an item. This function does that by interpreting the item body as a template,
258−-- and then applying it to itself.
259−applyAsTemplate :: Context String -- ^ Context
260− -> Item String -- ^ Item and template
261− -> Compiler (Item String) -- ^ Resulting item
262−applyAsTemplate context item =
263− let tpl = readTemplate $ itemBody item
264− in applyTemplate tpl context item
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.yamlnew file+33
@@ -0,0 +1,33 @@
1+resolver: lts-13.29
2+save-hackage-creds: false
3+
4+flags:
5+ hakyll:
6+ previewServer: true
7+ watchServer: true
8+ checkExternal: true
9+ usePandoc: true
10+ buildWebsite: true
11+
12+packages:
13+ - '.'
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/Dependencies/Tests.hs+3−3
@@ -9,8 +9,8 @@ module Hakyll.Core.Dependencies.Tests
99import Data.List (delete)
1010import qualified Data.Map as M
1111import qualified Data.Set as S
12−import Test.Framework (Test, testGroup)
13−import Test.HUnit (Assertion, (@=?))
12+import Test.Tasty (TestTree, testGroup)
13+import Test.Tasty.HUnit (Assertion, (@=?))
1414
1515
1616--------------------------------------------------------------------------------
@@ -20,7 +20,7 @@ import TestSuite.Util
2020
2121
2222--------------------------------------------------------------------------------
23−tests :: Test
23+tests :: TestTree
2424tests = testGroup "Hakyll.Core.Dependencies.Tests" $
2525 fromAssertions "analyze" [case01, case02, case03]
2626
tests/Hakyll/Core/Identifier/Tests.hs+6−5
@@ -6,8 +6,8 @@ module Hakyll.Core.Identifier.Tests
66
77
88--------------------------------------------------------------------------------
9−import Test.Framework (Test, testGroup)
10−import Test.HUnit ((@=?))
9+import Test.Tasty (TestTree, testGroup)
10+import Test.Tasty.HUnit ((@=?))
1111
1212
1313--------------------------------------------------------------------------------
@@ -17,7 +17,7 @@ import TestSuite.Util
1717
1818
1919--------------------------------------------------------------------------------
20−tests :: Test
20+tests :: TestTree
2121tests = testGroup "Hakyll.Core.Identifier.Tests" $ concat
2222 [ captureTests
2323 , matchesTests
@@ -25,7 +25,7 @@ tests = testGroup "Hakyll.Core.Identifier.Tests" $ concat
2525
2626
2727--------------------------------------------------------------------------------
28−captureTests :: [Test]
28+captureTests :: [TestTree]
2929captureTests = fromAssertions "capture"
3030 [ Just ["bar"] @=? capture "foo/**" "foo/bar"
3131 , Just ["foo/bar"] @=? capture "**" "foo/bar"
@@ -42,11 +42,12 @@ 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
4849--------------------------------------------------------------------------------
49−matchesTests :: [Test]
50+matchesTests :: [TestTree]
5051matchesTests = fromAssertions "matches"
5152 [ True @=? matches (fromList ["foo.markdown"]) "foo.markdown"
5253 , False @=? matches (fromList ["foo"]) (setVersion (Just "x") "foo")
tests/Hakyll/Core/Provider/Metadata/Tests.hs+24−15
@@ -5,26 +5,27 @@ module Hakyll.Core.Provider.Metadata.Tests
55
66
77--------------------------------------------------------------------------------
8−import Test.Framework (Test, testGroup)
9−import Test.HUnit (Assertion, (@=?))
10−import Text.Parsec as P
11−import Text.Parsec.String (Parser)
12−
13−
14−--------------------------------------------------------------------------------
8+import qualified Data.HashMap.Strict as HMS
9+import qualified Data.Text as T
10+import qualified Data.Yaml as Yaml
11+import Hakyll.Core.Metadata
1512import Hakyll.Core.Provider.Metadata
13+import Test.Tasty (TestTree, testGroup)
14+import Test.Tasty.HUnit (Assertion, assertFailure, (@=?))
1615import TestSuite.Util
1716
1817
1918--------------------------------------------------------------------------------
20−tests :: Test
19+tests :: TestTree
2120tests = testGroup "Hakyll.Core.Provider.Metadata.Tests" $
2221 fromAssertions "page" [testPage01, testPage02]
2322
2423
24+
2525--------------------------------------------------------------------------------
2626testPage01 :: Assertion
27−testPage01 = testParse page ([("foo", "bar")], "qux\n")
27+testPage01 =
28+ (meta [("foo", "bar")], "qux\n") `expectRight` parsePage
2829 "---\n\
2930 \foo: bar\n\
3031 \---\n\
@@ -33,21 +34,29 @@ testPage01 = testParse page ([("foo", "bar")], "qux\n")
3334
3435--------------------------------------------------------------------------------
3536testPage02 :: Assertion
36−testPage02 = testParse page
37− ([("description", descr)], "Hello I am dog\n")
37+testPage02 =
38+ (meta [("description", descr)], "Hello I am dog\n") `expectRight`
39+ parsePage
3840 "---\n\
3941 \description: A long description that would look better if it\n\
4042 \ spanned multiple lines and was indented\n\
4143 \---\n\
4244 \Hello I am dog\n"
4345 where
46+ descr :: String
4447 descr =
4548 "A long description that would look better if it \
4649 \spanned multiple lines and was indented"
4750
4851
4952--------------------------------------------------------------------------------
50−testParse :: (Eq a, Show a) => Parser a -> a -> String -> Assertion
51−testParse parser expected input = case P.parse parser "<inline>" input of
52− Left err -> error $ show err
53− Right x -> expected @=? x
53+meta :: Yaml.ToJSON a => [(String, a)] -> Metadata
54+meta pairs = HMS.fromList [(T.pack k, Yaml.toJSON v) | (k, v) <- pairs]
55+
56+
57+--------------------------------------------------------------------------------
58+-- | This is useful when the 'Left' side of 'Either' doesn't have an 'Eq'
59+-- instance.
60+expectRight :: (Eq b, Show a, Show b) => b -> Either a b -> Assertion
61+expectRight _ (Left err) = assertFailure (show err)
62+expectRight expected (Right res) = expected @=? res
tests/Hakyll/Core/Provider/Tests.hs+8−12
@@ -6,19 +6,15 @@ module Hakyll.Core.Provider.Tests
66
77
88--------------------------------------------------------------------------------
9−import qualified Data.Map as M
10−import Test.Framework (Test, testGroup)
11−import Test.Framework.Providers.HUnit (testCase)
12−import Test.HUnit (Assertion, assert, (@=?))
13−
14−
15−--------------------------------------------------------------------------------
9+import Hakyll.Core.Metadata
1610import Hakyll.Core.Provider
11+import Test.Tasty (TestTree, testGroup)
12+import Test.Tasty.HUnit (Assertion, testCase, (@=?))
1713import TestSuite.Util
1814
1915
2016--------------------------------------------------------------------------------
21−tests :: Test
17+tests :: TestTree
2218tests = testGroup "Hakyll.Core.Provider.Tests"
2319 [ testCase "case01" case01
2420 ]
@@ -29,12 +25,12 @@ case01 :: Assertion
2925case01 = do
3026 store <- newTestStore
3127 provider <- newTestProvider store
32− assert $ resourceExists provider "example.md"
28+ True @=? resourceExists provider "example.md"
3329
3430 metadata <- resourceMetadata provider "example.md"
35− Just "An example" @=? M.lookup "title" metadata
36− Just "External data" @=? M.lookup "external" metadata
31+ Just "An example" @=? lookupString "title" metadata
32+ Just "External data" @=? lookupString "external" metadata
3733
3834 doesntExist <- resourceMetadata provider "doesntexist.md"
39− M.empty @=? doesntExist
35+ mempty @=? doesntExist
4036 cleanTestEnv
tests/Hakyll/Core/Routes/Tests.hs+7−9
@@ -6,20 +6,18 @@ module Hakyll.Core.Routes.Tests
66
77
88--------------------------------------------------------------------------------
9−import qualified Data.Map as M
10−import System.FilePath ((</>))
11−import Test.Framework (Test, testGroup)
12−import Test.HUnit (Assertion, (@=?))
13−
14−
15−--------------------------------------------------------------------------------
9+import Data.Maybe (fromMaybe)
1610import Hakyll.Core.Identifier
11+import Hakyll.Core.Metadata
1712import Hakyll.Core.Routes
13+import System.FilePath ((</>))
14+import Test.Tasty (TestTree, testGroup)
15+import Test.Tasty.HUnit (Assertion, (@=?))
1816import TestSuite.Util
1917
2018
2119--------------------------------------------------------------------------------
22−tests :: Test
20+tests :: TestTree
2321tests = testGroup "Hakyll.Core.Routes.Tests" $ fromAssertions "runRoutes"
2422 [ testRoutes "foo.html" (setExtension "html") "foo"
2523 , testRoutes "foo.html" (setExtension ".html") "foo"
@@ -37,7 +35,7 @@ tests = testGroup "Hakyll.Core.Routes.Tests" $ fromAssertions "runRoutes"
3735 "tags/rss/bar"
3836
3937 , testRoutes "food/example.md" (metadataRoute $ \md -> customRoute $ \id' ->
40− M.findWithDefault "?" "subblog" md </> toFilePath id')
38+ fromMaybe "?" (lookupString "subblog" md) </> toFilePath id')
4139 "example.md"
4240 ]
4341
tests/Hakyll/Core/Rules/Tests.hs+8−12
@@ -8,27 +8,23 @@ module Hakyll.Core.Rules.Tests
88--------------------------------------------------------------------------------
99import Data.IORef (IORef, newIORef, readIORef,
1010 writeIORef)
11−import qualified Data.Map as M
1211import qualified Data.Set as S
13−import System.FilePath ((</>))
14−import Test.Framework (Test, testGroup)
15−import Test.HUnit (Assertion, assert, (@=?))
16−
17−
18−--------------------------------------------------------------------------------
1912import Hakyll.Core.Compiler
2013import Hakyll.Core.File
2114import Hakyll.Core.Identifier
2215import Hakyll.Core.Identifier.Pattern
16+import Hakyll.Core.Metadata
2317import Hakyll.Core.Routes
2418import Hakyll.Core.Rules
2519import Hakyll.Core.Rules.Internal
26−import Hakyll.Web.Pandoc
20+import System.FilePath ((</>))
21+import Test.Tasty (TestTree, testGroup)
22+import Test.Tasty.HUnit (Assertion, (@=?))
2723import TestSuite.Util
2824
2925
3026--------------------------------------------------------------------------------
31−tests :: Test
27+tests :: TestTree
3228tests = testGroup "Hakyll.Core.Rules.Tests" $ fromAssertions "runRules"
3329 [case01]
3430
@@ -53,7 +49,7 @@ case01 = do
5349 checkRoute "example.mv1" (sv "mv1" "example.md")
5450 checkRoute "example.mv2" (sv "mv2" "example.md")
5551 checkRoute "food/example.md" (sv "metadataMatch" "example.md")
56− readIORef ioref >>= assert
52+ readIORef ioref >>= (True @=?)
5753 cleanTestEnv
5854 where
5955 sv g = setVersion (Just g)
@@ -78,7 +74,7 @@ rules01 ioref = do
7874 -- Compile some posts
7975 match "*.md" $ do
8076 route $ setExtension "html"
81− compile pandocCompiler
77+ compile copyFileCompiler
8278
8379 -- Yeah. I don't know how else to test this stuff?
8480 preprocess $ writeIORef ioref True
@@ -89,7 +85,7 @@ rules01 ioref = do
8985 compile getResourceString
9086
9187 version "metadataMatch" $
92− matchMetadata "*.md" (\md -> M.lookup "subblog" md == Just "food") $ do
88+ matchMetadata "*.md" (\md -> lookupString "subblog" md == Just "food") $ do
9389 route $ customRoute $ \id' -> "food" </> toFilePath id'
9490 compile getResourceString
9591
tests/Hakyll/Core/Runtime/Tests.hs+17−4
@@ -8,8 +8,8 @@ module Hakyll.Core.Runtime.Tests
88--------------------------------------------------------------------------------
99import qualified Data.ByteString as B
1010import System.FilePath ((</>))
11−import Test.Framework (Test, testGroup)
12−import Test.HUnit (Assertion, (@?=))
11+import Test.Tasty (TestTree, testGroup)
12+import Test.Tasty.HUnit (Assertion, (@?=))
1313
1414
1515--------------------------------------------------------------------------------
@@ -20,7 +20,7 @@ import TestSuite.Util
2020
2121
2222--------------------------------------------------------------------------------
23−tests :: Test
23+tests :: TestTree
2424tests = testGroup "Hakyll.Core.Runtime.Tests" $
2525 fromAssertions "run" [case01, case02]
2626
@@ -39,7 +39,16 @@ case01 = do
3939 compile $ do
4040 getResourceBody
4141 >>= saveSnapshot "raw"
42− >>= renderPandoc
42+ >>= renderParagraphs
43+
44+ match (fromList ["partial.html", "partial-helper.html"]) $
45+ compile templateCompiler
46+ create ["partial.html.out"] $ do
47+ route idRoute
48+ compile $ do
49+ example <- loadSnapshotBody "example.md" "raw"
50+ makeItem example
51+ >>= loadAndApplyTemplate "partial.html" defaultContext
4352
4453 create ["bodies.txt"] $ do
4554 route idRoute
@@ -60,6 +69,10 @@ case01 = do
6069 bodies <- readFile $ destinationDirectory testConfiguration </> "bodies.txt"
6170 head (lines bodies) @?= "This is an example."
6271
72+ partial <- readFile $ providerDirectory testConfiguration </> "partial.html.out"
73+ partial' <- readFile $ destinationDirectory testConfiguration </> "partial.html.out"
74+ partial @?= partial'
75+
6376 cleanTestEnv
6477
6578
tests/Hakyll/Core/Store/Tests.hs+16−16
@@ -6,22 +6,22 @@ module Hakyll.Core.Store.Tests
66
77
88--------------------------------------------------------------------------------
9−import Data.Typeable (typeOf)
10−import Test.Framework (Test, testGroup)
11−import Test.Framework.Providers.HUnit (testCase)
12−import Test.Framework.Providers.QuickCheck2 (testProperty)
13−import qualified Test.HUnit as H
14−import qualified Test.QuickCheck as Q
15−import qualified Test.QuickCheck.Monadic as Q
9+import Data.Typeable (typeOf)
10+import qualified Test.QuickCheck as Q
11+import qualified Test.QuickCheck.Monadic as Q
12+import Test.Tasty (TestTree, testGroup)
13+import Test.Tasty.HUnit (testCase)
14+import qualified Test.Tasty.HUnit as H
15+import Test.Tasty.QuickCheck (testProperty)
1616
1717
1818--------------------------------------------------------------------------------
19−import qualified Hakyll.Core.Store as Store
19+import qualified Hakyll.Core.Store as Store
2020import TestSuite.Util
2121
2222
2323--------------------------------------------------------------------------------
24−tests :: Test
24+tests :: TestTree
2525tests = testGroup "Hakyll.Core.Store.Tests"
2626 [ testProperty "simple get . set" simpleSetGet
2727 , testProperty "persistent get . set" persistentSetGet
@@ -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+23−13
@@ -6,36 +6,38 @@ module Hakyll.Core.UnixFilter.Tests
66
77
88--------------------------------------------------------------------------------
9−import Data.List (isInfixOf)
10−import Test.Framework (Test, testGroup)
11−import Test.Framework.Providers.HUnit (testCase)
12−import qualified Test.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
2120
2221
2322--------------------------------------------------------------------------------
24−tests :: Test
23+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/Core/Util/String/Tests.hs+3−3
@@ -5,8 +5,8 @@ module Hakyll.Core.Util.String.Tests
55
66
77--------------------------------------------------------------------------------
8−import Test.Framework (Test, testGroup)
9−import Test.HUnit ((@=?))
8+import Test.Tasty (TestTree, testGroup)
9+import Test.Tasty.HUnit ((@=?))
1010
1111
1212--------------------------------------------------------------------------------
@@ -15,7 +15,7 @@ import TestSuite.Util
1515
1616
1717--------------------------------------------------------------------------------
18−tests :: Test
18+tests :: TestTree
1919tests = testGroup "Hakyll.Core.Util.String.Tests" $ concat
2020 [ fromAssertions "trim"
2121 [ "foo" @=? trim " foo\n\t "
tests/Hakyll/Web/CompressCss/Tests.hsnew file+64
@@ -0,0 +1,64 @@
1+--------------------------------------------------------------------------------
2+module Hakyll.Web.CompressCss.Tests
3+ ( tests
4+ ) where
5+
6+
7+--------------------------------------------------------------------------------
8+import Test.Tasty (TestTree, testGroup)
9+import Test.Tasty.HUnit ((@=?))
10+
11+
12+--------------------------------------------------------------------------------
13+import Hakyll.Web.CompressCss
14+import TestSuite.Util
15+
16+
17+--------------------------------------------------------------------------------
18+tests :: TestTree
19+tests = testGroup "Hakyll.Web.CompressCss.Tests" $ concat
20+ [ fromAssertions "compressCss"
21+ [
22+ -- compress whitespace
23+ "something something" @=?
24+ compressCss " something \n\t\r something "
25+ -- do not compress whitespace in string tokens
26+ , "abc \" \t\n\r \" xyz" @=?
27+ compressCss "abc \" \t\n\r \" xyz"
28+ , "abc ' \t\n\r ' xyz" @=?
29+ compressCss "abc ' \t\n\r ' xyz"
30+
31+ -- strip comments
32+ , "before after" @=? compressCss "before /* abc { } ;; \n\t\r */ after"
33+ -- don't strip comments inside string tokens
34+ , "before \"/* abc { } ;; \n\t\r */\" after"
35+ @=? compressCss "before \"/* abc { } ;; \n\t\r */\" after"
36+
37+ -- compress separators
38+ , "}" @=? 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 )"
46+ -- compress whitespace even after this curly brace
47+ , "}" @=? compressCss "; } "
48+ -- but do not compress separators inside string tokens
49+ , "\" { } ; , \"" @=? compressCss "\" { } ; , \""
50+ -- don't compress separators at the start or end of string tokens
51+ , "\" }\"" @=? compressCss "\" }\""
52+ , "\"{ \"" @=? compressCss "\"{ \""
53+ -- don't get irritated by the wrong token delimiter
54+ , "\" ' \"" @=? compressCss "\" ' \""
55+ , "' \" '" @=? compressCss "' \" '"
56+ -- don't compress whitespace in the middle of a string
57+ , "abc '{ '" @=? compressCss "abc '{ '"
58+ , "abc \"{ \"" @=? compressCss "abc \"{ \""
59+ -- compress whitespace after colons (but not before)
60+ , "abc :xyz" @=? compressCss "abc : xyz"
61+ -- compress multiple semicolons
62+ , ";" @=? compressCss ";;;;;;;"
63+ ]
64+ ]
tests/Hakyll/Web/Html/RelativizeUrls/Tests.hs+4−3
@@ -6,8 +6,9 @@ module Hakyll.Web.Html.RelativizeUrls.Tests
66
77
88--------------------------------------------------------------------------------
9−import Test.Framework (Test, testGroup)
10−import Test.HUnit ((@=?))
9+import Test.Tasty (TestTree, testGroup)
10+import Test.Tasty.HUnit ((@=?))
11+
1112
1213--------------------------------------------------------------------------------
1314import Hakyll.Web.Html.RelativizeUrls
@@ -15,7 +16,7 @@ import TestSuite.Util
1516
1617
1718--------------------------------------------------------------------------------
18−tests :: Test
19+tests :: TestTree
1920tests = testGroup "Hakyll.Web.Html.RelativizeUrls.Tests" $
2021 fromAssertions "relativizeUrls"
2122 [ "<a href=\"../foo\">bar</a>" @=?
tests/Hakyll/Web/Html/Tests.hs+9−9
@@ -5,9 +5,9 @@ module Hakyll.Web.Html.Tests
55
66
77--------------------------------------------------------------------------------
8−import Data.Char (toUpper)
9−import Test.Framework (Test, testGroup)
10−import Test.HUnit (assert, (@=?))
8+import Data.Char (toUpper)
9+import Test.Tasty (TestTree, testGroup)
10+import Test.Tasty.HUnit ((@=?))
1111
1212
1313--------------------------------------------------------------------------------
@@ -16,7 +16,7 @@ import TestSuite.Util
1616
1717
1818--------------------------------------------------------------------------------
19−tests :: Test
19+tests :: TestTree
2020tests = testGroup "Hakyll.Web.Html.Tests" $ concat
2121 [ fromAssertions "demoteHeaders"
2222 [ "<h2>A h1 title</h2>" @=?
@@ -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/Pandoc/FileType/Tests.hs+3−3
@@ -6,8 +6,8 @@ module Hakyll.Web.Pandoc.FileType.Tests
66
77
88--------------------------------------------------------------------------------
9−import Test.Framework (Test, testGroup)
10−import Test.HUnit ((@=?))
9+import Test.Tasty (TestTree, testGroup)
10+import Test.Tasty.HUnit ((@=?))
1111
1212
1313--------------------------------------------------------------------------------
@@ -16,7 +16,7 @@ import TestSuite.Util
1616
1717
1818--------------------------------------------------------------------------------
19−tests :: Test
19+tests :: TestTree
2020tests = testGroup "Hakyll.Web.Pandoc.FileType.Tests" $
2121 fromAssertions "fileType"
2222 [ Markdown @=? fileType "index.md"
tests/Hakyll/Web/Template/Context/Tests.hs+44−8
@@ -6,24 +6,26 @@ module Hakyll.Web.Template.Context.Tests
66
77
88--------------------------------------------------------------------------------
9−import Test.Framework (Test, testGroup)
10−import Test.Framework.Providers.HUnit (testCase)
11−import Test.HUnit (Assertion, (@=?))
9+import Test.Tasty (TestTree, testGroup)
10+import Test.Tasty.HUnit (Assertion, testCase, (@=?))
1211
1312
1413--------------------------------------------------------------------------------
1514import Hakyll.Core.Compiler
1615import Hakyll.Core.Identifier
16+import Hakyll.Core.Item
1717import Hakyll.Core.Provider
18−import Hakyll.Core.Store (Store)
18+import Hakyll.Core.Store (Store)
1919import Hakyll.Web.Template.Context
20+import Hakyll.Web.Template.Internal
2021import TestSuite.Util
2122
2223
2324--------------------------------------------------------------------------------
24−tests :: Test
25−tests = testGroup "Hakyll.Core.Template.Context.Tests"
25+tests :: TestTree
26+tests = testGroup "Hakyll.Web.Template.Context.Tests"
2627 [ testCase "testDateField" testDateField
28+ , testCase "testOuerLoopContextAccess" testOuerLoopContextAccess
2729 ]
2830
2931
@@ -42,6 +44,15 @@ testDateField = do
4244 dateField "date" "%B %e, %Y"
4345 date2 @=? "August 26, 2010"
4446
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"
4556 cleanTestEnv
4657
4758
@@ -54,6 +65,31 @@ testContextDone store provider identifier key context =
5465 cf <- unContext context key [] item
5566 case cf of
5667 StringField str -> return str
57− ListField _ _ -> error $
68+ _ -> error $
5869 "Hakyll.Web.Template.Context.Tests.testContextDone: " ++
59− "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+93−25
@@ -1,22 +1,23 @@
11--------------------------------------------------------------------------------
22{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE TemplateHaskell #-}
34module Hakyll.Web.Template.Tests
45 ( tests
56 ) where
67
78
89--------------------------------------------------------------------------------
9−import Data.Monoid (mconcat)
10−import Test.Framework (Test, testGroup)
11−import Test.Framework.Providers.HUnit (testCase)
12−import Test.HUnit (Assertion, (@=?), (@?=))
10+import Test.Tasty (TestTree, testGroup)
11+import Test.Tasty.HUnit (Assertion, assertBool, testCase,
12+ (@=?), (@?=))
1313
14+import Data.Either (isLeft)
1415
1516--------------------------------------------------------------------------------
1617import Hakyll.Core.Compiler
18+import 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
@@ -25,35 +26,83 @@ import TestSuite.Util
2526
2627
2728--------------------------------------------------------------------------------
28−tests :: Test
29−tests = testGroup "Hakyll.Core.Template.Tests" $ concat
30− [ [ testCase "case01" case01
29+tests :: TestTree
30+tests = testGroup "Hakyll.Web.Template.Tests" $ concat
31+ [ [ testCase "case01" $ test ("template.html.out", "template.html", "example.md")
32+ , testCase "case02" $ test ("strip.html.out", "strip.html", "example.md")
33+ , testCase "case03" $ test ("just-meta.html.out", "just-meta.html", "example.md")
3134 , testCase "applyJoinTemplateList" testApplyJoinTemplateList
3235 ]
3336
34− , fromAssertions "readTemplate"
35− [ Template [Chunk "Hello ", Expr (Call "guest" [])]
36− @=? readTemplate "Hello $guest()$"
37− , Template
38− [If (Call "a" [StringLiteral "bar"])
39− (Template [Chunk "foo"])
40− Nothing]
41− @=? readTemplate "$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$"
42+ -- 'If' trim check.
43+ , Right [ TrimL
44+ , If (Ident (TemplateKey "body"))
45+ [ TrimR
46+ , Chunk "\n"
47+ , Expr (Ident (TemplateKey "body"))
48+ , Chunk "\n"
49+ , TrimL
50+ ]
51+ (Just [ TrimR
52+ , Chunk "\n"
53+ , Expr (Ident (TemplateKey "body"))
54+ , Chunk "\n"
55+ , TrimL
56+ ])
57+ , TrimR
58+ ]
59+ @=? parse "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"
60+ -- 'For' trim check.
61+ , Right [ TrimL
62+ , For (Ident (TemplateKey "authors"))
63+ [TrimR, Chunk "\n body \n", TrimL]
64+ Nothing
65+ , TrimR
66+ ]
67+ @=? parse "$-for(authors)-$\n body \n$-endfor-$"
68+ -- 'Partial' trim check.
69+ , Right [ TrimL
70+ , Partial (StringLiteral "path")
71+ , TrimR
72+ ]
73+ @=? parse "$-partial(\"path\")-$"
74+ -- 'Expr' trim check.
75+ , Right [ TrimL
76+ , Expr (Ident (TemplateKey "foo"))
77+ , TrimR
78+ ]
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$"
4286 ]
87+
88+ , [testCase "embeddedTemplate" testEmbeddedTemplate]
4389 ]
90+ where
91+ parse = parseTemplateElemsFile ""
4492
4593
4694--------------------------------------------------------------------------------
47−case01 :: Assertion
48−case01 = do
95+test :: (Identifier, Identifier, Identifier) -> Assertion
96+test (outf, tplf, itemf) = do
4997 store <- newTestStore
5098 provider <- newTestProvider store
5199
52− out <- resourceString provider "template.html.out"
53− tpl <- testCompilerDone store provider "template.html" $
54− templateBodyCompiler
55− item <- testCompilerDone store provider "example.md" $
56− pandocCompiler >>= applyTemplate (itemBody tpl) testContext
100+ out <- resourceString provider outf
101+ tpl <- testCompilerDone store provider tplf templateBodyCompiler
102+ item <- testCompilerDone store provider itemf $
103+ getResourceBody
104+ >>= renderParagraphs
105+ >>= applyTemplate (itemBody tpl) testContext
57106
58107 out @=? itemBody item
59108 cleanTestEnv
@@ -69,7 +118,6 @@ testContext = mconcat
69118 return [n1, n2]
70119 , functionField "rev" $ \args _ -> return $ unwords $ map reverse args
71120 ]
72− where
73121
74122
75123--------------------------------------------------------------------------------
@@ -77,6 +125,8 @@ testApplyJoinTemplateList :: Assertion
77125testApplyJoinTemplateList = do
78126 store <- newTestStore
79127 provider <- newTestProvider store
128+ tpl <- testCompilerDone store provider "tpl" $
129+ compileTemplateItem (Item "tpl" "<b>$body$</b>")
80130 str <- testCompilerDone store provider "item3" $
81131 applyJoinTemplateList ", " tpl defaultContext [i1, i2]
82132
@@ -85,4 +135,22 @@ testApplyJoinTemplateList = do
85135 where
86136 i1 = Item "item1" "Hello"
87137 i2 = Item "item2" "World"
88− tpl = Template [Chunk "<b>", Expr (Ident "body"), Chunk "</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+11−2
@@ -1,11 +1,12 @@
11--------------------------------------------------------------------------------
2+{-# LANGUAGE CPP #-}
23module Main
34 ( main
45 ) where
56
67
78--------------------------------------------------------------------------------
8−import Test.Framework (defaultMain)
9+import Test.Tasty (defaultMain, testGroup)
910
1011
1112--------------------------------------------------------------------------------
@@ -19,16 +20,20 @@ import qualified Hakyll.Core.Runtime.Tests
1920import qualified Hakyll.Core.Store.Tests
2021import qualified Hakyll.Core.UnixFilter.Tests
2122import qualified Hakyll.Core.Util.String.Tests
23+import qualified Hakyll.Web.CompressCss.Tests
2224import qualified Hakyll.Web.Html.RelativizeUrls.Tests
2325import qualified Hakyll.Web.Html.Tests
26+#ifdef USE_PANDOC
2427import qualified Hakyll.Web.Pandoc.FileType.Tests
28+#endif
2529import qualified Hakyll.Web.Template.Context.Tests
2630import qualified Hakyll.Web.Template.Tests
31+import qualified Hakyll.Web.Tags.Tests
2732
2833
2934--------------------------------------------------------------------------------
3035main :: IO ()
31−main = defaultMain
36+main = defaultMain $ testGroup "Hakyll"
3237 [ Hakyll.Core.Dependencies.Tests.tests
3338 , Hakyll.Core.Identifier.Tests.tests
3439 , Hakyll.Core.Provider.Metadata.Tests.tests
@@ -39,9 +44,13 @@ main = defaultMain
3944 , Hakyll.Core.Store.Tests.tests
4045 , Hakyll.Core.UnixFilter.Tests.tests
4146 , Hakyll.Core.Util.String.Tests.tests
47+ , Hakyll.Web.CompressCss.Tests.tests
4248 , Hakyll.Web.Html.RelativizeUrls.Tests.tests
4349 , Hakyll.Web.Html.Tests.tests
50+#ifdef USE_PANDOC
4451 , Hakyll.Web.Pandoc.FileType.Tests.tests
52+#endif
53+ , Hakyll.Web.Tags.Tests.tests
4554 , Hakyll.Web.Template.Context.Tests.tests
4655 , Hakyll.Web.Template.Tests.tests
4756 ]
tests/TestSuite/Util.hs+36−15
@@ -6,36 +6,38 @@ 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)
16−import Data.Monoid (mempty)
17−import qualified Data.Set as S
18−import Test.Framework
19−import Test.Framework.Providers.HUnit
20−import Test.HUnit hiding (Test)
21−import Text.Printf (printf)
17+import Data.List (intercalate, isInfixOf)
18+import Data.Monoid (mempty)
19+import qualified Data.Set as S
20+import Test.Tasty
21+import Test.Tasty.HUnit
22+import Text.Printf (printf)
2223
2324
2425--------------------------------------------------------------------------------
2526import Hakyll.Core.Compiler.Internal
2627import Hakyll.Core.Configuration
2728import Hakyll.Core.Identifier
28−import qualified Hakyll.Core.Logger as Logger
29+import qualified Hakyll.Core.Logger as Logger
2930import Hakyll.Core.Provider
30−import Hakyll.Core.Store (Store)
31−import qualified Hakyll.Core.Store as Store
31+import Hakyll.Core.Store (Store)
32+import qualified Hakyll.Core.Store as Store
3233import Hakyll.Core.Util.File
34+import Hakyll.Core.Item
3335
3436
3537--------------------------------------------------------------------------------
3638fromAssertions :: String -- ^ Name
3739 -> [Assertion] -- ^ Cases
38− -> [Test] -- ^ Result tests
40+ -> [TestTree] -- ^ Result tests
3941fromAssertions name =
4042 zipWith testCase [printf "[%2d] %s" n name | n <- [1 :: Int ..]]
4143
@@ -77,14 +79,23 @@ testCompilerDone store provider underlying compiler = do
7779 result <- testCompiler store provider underlying compiler
7880 case result of
7981 CompilerDone x _ -> return x
80− CompilerError e -> error $
82+ CompilerError e -> fail $
8183 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
82− " threw: " ++ intercalate "; " e
83− CompilerRequire i _ -> error $
84+ " threw: " ++ intercalate "; " (compilerErrorMessages e)
85+ CompilerRequire i _ -> fail $
8486 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
8587 " requires: " ++ show i
88+ CompilerSnapshot _ _ -> fail
89+ "TestSuite.Util.testCompilerDone: unexpected CompilerSnapshot"
8690
87−
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"
8899
89100--------------------------------------------------------------------------------
90101testConfiguration :: Configuration
@@ -102,3 +113,13 @@ cleanTestEnv = do
102113 removeDirectory $ destinationDirectory testConfiguration
103114 removeDirectory $ storeDirectory testConfiguration
104115 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/partial-helper.htmlnew file+3
@@ -0,0 +1,3 @@
1+<p>This is an included partial.</p>
2+
3+$body$
tests/data/partial.htmlnew file+3
@@ -0,0 +1,3 @@
1+<p>This is a file that includes a partial.</p>
2+
3+$partial("partial-helper.html")$
tests/data/partial.html.outnew file+7
@@ -0,0 +1,7 @@
1+<p>This is a file that includes a partial.</p>
2+
3+<p>This is an included partial.</p>
4+
5+This is an example.
6+
7+
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).
tests/data/strip.htmlnew file+34
@@ -0,0 +1,34 @@
1+<div>
2+ I'm so rich I have $$3.
3+
4+ $rev("foo")$
5+ $-rev(rev("foo"))$
6+
7+ $if(body)-$
8+ I have body
9+ $else-$
10+ or no
11+ $-endif-$
12+
13+ $if(unbound)$
14+ should not be printed
15+ $endif$
16+
17+ $-if(body)-$
18+ should be printed
19+ $-endif$
20+
21+ <ul>
22+ $for(authors)-$
23+ <li>$name$</li>
24+ $endfor-$
25+ </ul>
26+
27+ $for(authors)-$
28+ $name-$
29+ $sep$,
30+ $-endfor$
31+
32+ $body$
33+</div>
34+
tests/data/strip.html.outnew file+18
@@ -0,0 +1,18 @@
1+<div>
2+ I'm so rich I have $3.
3+
4+ ooffoo
5+
6+ I have body
7+ should be printed
8+
9+ <ul>
10+ <li>Jan</li>
11+ <li>Piet</li>
12+ </ul>
13+
14+ Jan,Piet
15+
16+ <p>This is an example.</p>
17+</div>
18+
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+68−30
@@ -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,32 +56,22 @@ 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/>,
6662 [literate source](http://scr.stunts.hu/hakyll.html)
6763- <http://www.eanalytica.com/>,
6864 [literate source](http://www.eanalytica.com/site/)
69−- <http://dikmax.name/>,
70− [source](https://github.com/dikmax/dikmax.name)
7165- <http://cse.iitk.ac.in/users/ppk>,
7266 [source](https://github.com/piyush-kurur-pages/website)
7367- <http://web.engr.oregonstate.edu/~walkiner/>,
7468 [source](https://github.com/walkie/WebPage)
7569- <http://techblog.rosedu.org/>,
7670 [source](https://github.com/rosedu/techblog)
77−- <http://abizern.org>,
78− [source](https://github.com/Abizern/hblog)
7971- <http://freizl.github.io>,
8072 [source](https://github.com/freizl/freizl.github.com/tree/master/build)
81−- <http://covariant.me>,
82− [source](http://hub.darcs.net/co-dan/website)
8373- <http://www.gwern.net/>,
8474 [source](https://github.com/gwern/gwern.net)
85−- <http://www.rohanjain.in/>,
86− [source](https://github.com/crodjer/rohanjain.in)
8775- <http://www.corentindupont.info/>,
8876 [source](https://github.com/cdupont/CorentinDupont-WebPage)
8977- <http://jelv.is>,
@@ -92,8 +80,8 @@ directly with the default Hakyll site.
9280 [source](https://github.com/plaimi/www)
9381- <http://duplode.github.io/>,
9482 [source](https://github.com/duplode/duplode.github.io/tree/sources)
95−- <http://maseek.codes>,
96− [source](https://github.com/maseek/maseek-codes)
83+- <http://tzemanovic.github.io/>,
84+ [source](https://github.com/tzemanovic/tzemanovic)
9785- <http://listx.github.io>,
9886 [source](https://github.com/listx/listx_blog)
9987- <http://kyle.marek-spartz.org>,
@@ -104,28 +92,20 @@ directly with the default Hakyll site.
10492 [source](https://github.com/rbros/reichertbrothers.com)
10593- <http://alemedeiros.sdf.org>,
10694 [source](https://github.com/alemedeiros/homepage)
107−- <http://blog.ssanj.net/>,
108− [source](https://github.com/ssanj/babyloncandle)
109−- <https://ruudvanasseldonk.com/>,
110− [source](https://github.com/ruud-v-a/ruudvanasseldonk.com)
11195- <http://www.haskell.mn>,
11296 [source](https://github.com/HaskellMN/www.haskell.mn)
11397- <https://axiomatic.neophilus.net/>,
11498 [source](https://github.com/Libbum/AxiomaticSemantics)
115−- <https://tesser.org/>,
99+- [https://tesser.org/](http://web.archive.org/web/20161022221713/https://tesser.org/),
116100 [source](https://github.com/fractalcat/tesser.org)
117−- <https://wei2912.github.io/>,
118− [source](https://github.com/wei2912/blog_src)
101+- <https://weien.io/>,
102+  [source](https://github.com/wei2912/blog-src)
119103- <http://www.metasepi.org/>,
120104 [source](https://github.com/metasepi/metasepi-website)
121105- <http://gisli.hamstur.is/>,
122106 [source](https://github.com/gislik/gisli.hamstur.is)
123107- <http://blog.ssanj.net/>,
124108 [source](https://github.com/ssanj/babyloncandle)
125−- <https://rockymadden.com/>,
126− [source](https://github.com/rockymadden/rockymadden-web)
127−- <http://blog.dshevchenko.biz/>,
128− [source](https://github.com/denisshevchenko/blog)
129109- <http://ruhaskell.org/>,
130110 [source](https://github.com/ruHaskell/ruhaskell)
131111- <http://www.haskell.od.ua/>,
@@ -144,6 +124,66 @@ directly with the default Hakyll site.
144124 [source](https://github.com/curry-club-aux/curry-club-augsburg.de)
145125- <http://ismailmustafa.com/>,
146126 [source](https://github.com/ismailmustafa/ismailmustafa.github.io/tree/hakyll)
127+- <http://lettier.github.io/>,
128+ [source](https://github.com/lettier/lettier.github.io)
129+- <http://raindev.io>,
130+ [source](https://github.com/raindev/raindev.github.io)
131+- <http://hal2016.haskell.org/>,
132+ [source](https://github.com/nomeata/hal2016-website/)
133+- <http://acehack.org/>,
134+ [source](https://github.com/sakshamsharma/acehack/)
135+- <https://nek0.eu/>,
136+ [source](https://github.com/nek0/nek0.eu)
137+- <http://static-dust.klpn.se/>,
138+ [source](https://github.com/klpn/static-dust)
139+- <http://www.kuznero.com/>,
140+ [source](https://github.com/kuznero/kuznero.github.io)
141+- <http://nicolerauch.de/>,
142+ [source](https://github.com/NicoleRauch/BusinessWebsite)
143+- <http://johnduhamel.io/>,
144+ [source](https://github.com/jjduhamel/blog)
145+- <http://alexanderlobov.ru/>,
146+ [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)
147187
148188## Hakyll 3.X
149189
@@ -171,7 +211,5 @@ directly with the default Hakyll site.
171211 [source](http://gitorious.org/shakthimaan-blog)
172212- <http://www.alfredodinapoli.com/>,
173213 [source](https://github.com/CharlesStain/alfredodinapoli.com)
174−- <http://datahackermd.com>,
175− [source](http://github.com/akshayjshah/datahackermd)
176214- <http://michaelxavier.net>,
177215 [source](https://github.com/michaelxavier/michaelxavier.net)
web/index.markdown+4−2
@@ -31,8 +31,10 @@ and TeX support, including syntax highlighting and other goodies.
3131
3232# Getting Started
3333
34−You can get the latest version from hackage using `cabal install hakyll`. Then,
35−you can:
34+You can get the latest version from hackage using `cabal install hakyll`, or
35+using [stack] by using `stack install hakyll`. Then, you can:
36+
37+[stack]: http://www.haskellstack.org/
3638
3739- read the [tutorials](/tutorials.html);
3840- mail the [google discussion group](http://groups.google.com/group/hakyll);
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+29−32
@@ -1,20 +1,23 @@
11--------------------------------------------------------------------------------
22{-# LANGUAGE OverloadedStrings #-}
3−import Control.Applicative ((<$>))
4−import Control.Arrow (second)
5−import Control.Monad (forM_)
6−import Data.Char (isDigit)
7−import Data.List (isPrefixOf, partition, sortBy)
8−import Data.Monoid (mappend)
9−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)
108import Hakyll
11−import System.FilePath (dropTrailingPathSeparator, splitPath)
9+import System.Directory (copyFile)
10+import System.FilePath (dropTrailingPathSeparator, splitPath)
1211import Text.Pandoc
1312
1413
1514--------------------------------------------------------------------------------
1615main :: IO ()
1716main = hakyllWith config $ do
17+ -- Copy CHANGELOG.md here.
18+ preprocess $ copyFile "../CHANGELOG.md" "releases.markdown"
19+
20+ -- CSS
1821 match "css/*" $ do
1922 route idRoute
2023 compile compressCssCompiler
@@ -53,23 +56,11 @@ main = hakyllWith config $ do
5356 create ["tutorials.html"] $ do
5457 route idRoute
5558 compile $ do
56− tutorials <- loadAll "tutorials/*"
57− itemTpl <- loadBody "templates/tutorial-item.html"
58− let (series, articles) = partitionTutorials $
59− sortBy (comparing itemIdentifier) tutorials
60−
61− series' <- applyTemplateList itemTpl defaultContext series
62− articles' <- applyTemplateList itemTpl defaultContext articles
63−
64− let tutorialsCtx =
65− constField "title" "Tutorials" `mappend`
66− constField "series" series' `mappend`
67− constField "articles" articles' `mappend`
68− defaultContext
69−
59+ ctx <- tutorialsCtx <$>
60+ sortBy (comparing itemIdentifier) <$> loadAll "tutorials/*"
7061 makeItem ""
71− >>= loadAndApplyTemplate "templates/tutorials.html" tutorialsCtx
72− >>= loadAndApplyTemplate "templates/default.html" tutorialsCtx
62+ >>= loadAndApplyTemplate "templates/tutorials.html" ctx
63+ >>= loadAndApplyTemplate "templates/default.html" ctx
7364 >>= relativizeUrls
7465
7566 -- Templates
@@ -77,8 +68,7 @@ main = hakyllWith config $ do
7768 where
7869 withToc = defaultHakyllWriterOptions
7970 { writerTableOfContents = True
80− , writerTemplate = "$toc$\n$body$"
81− , writerStandalone = True
71+ , writerTemplate = Just "$toc$\n$body$"
8272 }
8373
8474
@@ -112,9 +102,16 @@ hackage url
112102
113103
114104--------------------------------------------------------------------------------
115−-- | Partition tutorials into tutorial series & other articles
116−partitionTutorials :: [Item a] -> ([Item a], [Item a])
117−partitionTutorials = partition $ \i ->
118− case splitPath (toFilePath $ itemIdentifier i) of
119− [_, (x : _)] -> isDigit x
120− _ -> False
105+-- | Partition tutorials into tutorial series, other articles, external articles
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") <>
113+ defaultContext
114+ where
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="http://flattr.com/thing/291889/Hakyll" target="_blank">
42− <img src="http://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/tutorial-item.htmldeleted−1
@@ -1 +0,0 @@
1−<li><a href="$url$">$title$</a> by <em>$author$</em></li>
web/templates/tutorials.html+47−4
@@ -1,9 +1,47 @@
11<h1>Tutorials about Hakyll</h1>
2−<h2>Tutorial series</h2>
3−<ul>$series$</ul>
4−<h2>Other articles</h2>
2+<h2 id="series">Tutorial series</h2>
3+<ul>
4+ $for(main)$
5+ <li>
6+ <a href="$url$">$title$</a>
7+ </li>
8+ $endfor$
9+</ul>
10+<h2 id="articles">Other articles</h2>
511<p>In no particular order:</p>
6−<ul>$articles$</ul>
12+<ul>
13+ $for(articles)$
14+ <li>
15+ <a href="$url$">$title$</a> by <em>$author$</em>
16+ </li>
17+ $endfor$
18+</ul>
19+<h2 id="external-articles">External articles</h2>
20+<p>
21+ These are articles on external blogs. If you wrote a similar article, feel
22+ free to <a href="http://jaspervdj.be/contact.html">shoot me an email</a> so
23+ I can add it to the list.
24+</p>
25+<p>In no particular order:</p>
26+<ul>
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>
43+ $endfor$
44+</ul>
745<p>
846 All these tutorials assume you are using the latest stable version of
947 Hakyll. If this is not the case, you might want to update using:
@@ -11,3 +49,8 @@
1149<pre><code>$$ ghc-pkg unregister hakyll
1250$$ cabal update
1351$$ cabal install hakyll</code></pre>
52+
53+<p>
54+ Or using stack:
55+</p>
56+<pre><code>$$ stack install hakyll</code></pre>
web/tutorials/01-installation.markdown+16−22
@@ -1,26 +1,25 @@
11---
22title: Installation
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Installation
78------------
89
9−Installation is provided using [cabal], and some packages are available for
10−different distributions.
10+Installation is provided via Hackage, and some packages are available for
11+different distributions. For installation from source (i.e. via Hackage),
12+[stack] is recommended:
1113
12− $ cabal install hakyll
14+ $ stack install hakyll
1315
14−[cabal]: http://www.haskell.org/cabal/
15−
16−If you have a recent installation of `cabal` and your time is somewhat valuable,
17−use:
18−
19− $ cabal install -j hakyll
16+[stack]: http://www.haskellstack.org/
2017
2118Linux distro packages:
2219
2320- [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`
2423
2524Building the example site
2625-------------------------
@@ -29,32 +28,27 @@ Apart from the main Hakyll library, the cabal package also provides you with an
2928executable `hakyll-init` to create an example site. This is an easy way to get
3029started:
3130
32− $ hakyll-init my-site
31+ $ stack exec hakyll-init my-site
3332
3433This creates a folder `my-site` in the current directory, with some example
3534content and a generic configuration.
3635
37−If `hakyll-init` is not found, you should make sure `$HOME/.cabal/bin` is in
38−your `$PATH`.
39−
40−(If you're on OS X you may not have a bin directory in `$HOME/.cabal`. In this
41−case, check `$HOME/Library/Haskell/bin` and put it on your path if you find
42−`hakyll-init` there. See [here] for more information on installation paths on
43−OS X.)
44−
45−[here]: http://www.haskell.org/haskellwiki/Mac_OS_X_Common_Installation_Paths
36+If `hakyll-init` is not found, you should make sure your stack bin path
37+(usually `$HOME/.local/bin`) is in your `$PATH`. You can check your stack local
38+bin path by running `stack path --local-bin`.
4639
4740The file `site.hs` holds the configuration of your site, as an executable
4841haskell program. We can compile and run it like this:
4942
5043 $ cd my-site
51− $ ghc --make -threaded site.hs
52− $ ./site build
44+ $ stack init # creates stack.yaml file based on my-site.cabal
45+ $ stack build
46+ $ stack exec site build
5347
5448If you installed `hakyll` with a preview server (this is the default), you can
5549now use
5650
57− $ ./site watch
51+ $ stack exec site watch
5852
5953and have a look at your site at
6054[http://localhost:8000/](http://localhost:8000/).
web/tutorials/02-basics.markdown+12−11
@@ -1,30 +1,31 @@
11---
22title: The basics
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Building and cleaning
78---------------------
89
910If you followed along with the previous tutorial, you should now have the
10−example site up and running. By running `./site build`, you created two
11−directories:
11+example site up and running. By running `stack exec site build`, you created
12+two directories:
1213
1314- `_site`, with your site as HTML files, ready to be deployed;
1415- `_cache`, which Hakyll uses internally.
1516
16−`./site clean` removes these directories, and `./site rebuild` performs a
17−`clean` and then a `build`.
17+`stack exec site clean` removes these directories, and `stack exec site
18+rebuild` performs a `clean` and then a `build`.
1819
19−In general, you want to use `./site build` when you just made changes to the
20−contents of your website. If you made important changes to `site.hs`, you need
21−to recompile `site.hs` followed by a rebuild:
20+In general, you want to use `stack exec site build` when you just made changes
21+to the contents of your website. If you made changes to `site.hs`, you need to
22+recompile `site.hs` followed by a rebuild:
2223
23− ghc --make site.hs
24− ./site rebuild
24+ stack build
25+ stack exec site rebuild
2526
26−At this point, feel free to change some files, `./site build` and see what
27−happens!
27+At this point, feel free to change some files, `stack exec site build` and see
28+what happens!
2829
2930Pages and metadata
3031------------------
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+23−6
@@ -1,6 +1,7 @@
11---
2−title: More on compilers: load, and templates
2+title: '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:
@@ -115,8 +116,10 @@ you to use:
115116- `$path$` for the original filepath of the page;
116117- `$foo$` where foo is specified in the metadata.
117118
118−`$date$` is not provided by default, you can see how we add it in the definition
119−of `postCtx` in `site.hs`:
119+`$date$` is not provided by default. In the scaffold, we use the convenience
120+context function `dateField`, which will parse an `Item`'s filename to check if
121+it begins with a date. You can see how we add it in the definition of `postCtx`
122+in `site.hs`:
120123
121124```haskell
122125postCtx :: Context String
@@ -128,7 +131,7 @@ postCtx =
128131### Loading and applying templates
129132
130133Now we know about templates, context and how to load arbitrary items. This gives
131−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
132135template:
133136
134137```haskell
@@ -149,7 +152,7 @@ Control flow in templates
149152-------------------------
150153
151154Sometimes string interpolation does not suffice, and you want a little more
152−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
153156structures for this. The syntax for these structures was based on the syntax
154157used in pandoc templates, since Hakyll already has tight integration with
155158pandoc.
@@ -234,6 +237,20 @@ This uses the `$for(foo)$` construct. This construct allows you loop over a
234237list, in this case, `$posts$`. Inside the body of this for loop, all fields
235238refer to the current post, e.g.: `$url$`, `$title$` and `$date$`.
236239
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+
237254Of course, $posts$ does not magically appear. We have to specify this in
238255`site.hs`. Let's look at how `archive.html` is generated:
239256
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.mdnew file+6
@@ -0,0 +1,6 @@
1+---
2+title: Add tags to your Hakyll blog
3+author: Javran Cheng
4+url: https://javran.github.io/posts/2014-03-01-add-tags-to-your-hakyll-blog.html
5+type: external
6+---
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.mdnew file+6
@@ -0,0 +1,6 @@
1+---
2+title: Clean URLs with Hakyll
3+author: Rohan Jain
4+url: http://www.rohanjain.in/hakyll-clean-urls/
5+type: external
6+---
web/tutorials/external-deploying-with-widely.mdnew file+6
@@ -0,0 +1,6 @@
1+---
2+title: Deploying with Widely
3+author: Kyle Marek-Spartz
4+url: http://kyle.marek-spartz.org/posts/2013-12-09-widely-and-hakyll.html
5+type: external
6+---
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.mdnew file+6
@@ -0,0 +1,6 @@
1+---
2+title: Hakyll's functionField
3+author: Beerend Lauwers
4+url: http://beerendlauwers.be/posts/2015-09-21-hakylls-functionfield.html
5+type: external
6+---
web/tutorials/external-github-pages-circle-ci.mdnew file+6
@@ -0,0 +1,6 @@
1+---
2+title: Create a GitHub page with Hakyll and CircleCI
3+author: Juan Pedro Villa
4+url: https://www.stackbuilders.com/news/dr-hakyll-create-a-github-page-with-hakyll-and-circleci
5+type: external
6+---
web/tutorials/external-inlining-and-compressing-css.mdnew file+6
@@ -0,0 +1,6 @@
1+---
2+title: Inlining and compressing CSS
3+author: Kyle Marek-Spartz
4+url: http://kyle.marek-spartz.org/posts/2014-12-09-hakyll-css-template-compiler.html
5+type: external
6+---
web/tutorials/faq.markdown+13
@@ -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"
@@ -27,6 +28,18 @@ You should also add this to your `.profile`, or whatever config file you use.
2728On Windows, running `chcp 65001` before running your Hakyll executable has been
2829reported to work.
2930
31+Alternatively, you can specify this in your `site.hs`:
32+
33+```haskell
34+import qualified GHC.IO.Encoding as E
35+
36+main :: IO ()
37+main = do
38+ E.setLocaleEncoding E.utf8
39+ hakyll $ do
40+ ...
41+```
42+
3043## "File name does not match module name" on Mac OS
3144
3245 Hakyll.hs:1:1:
web/tutorials/github-pages-tutorial.md+72−14
@@ -1,4 +1,10 @@
1−## Using Hakyll with GitHub Pages
1+---
2+title: Using Hakyll with GitHub Pages
3+author: Erik Stevenson
4+type: article
5+---
6+
7+## Introduction
28
39[GitHub Pages](http://pages.github.com) has become a popular static website hosting solution due to its simplicity. Simply push a couple files to a repository and it's off to the races.
410
@@ -19,7 +25,7 @@ In the interest of keeping this guide as simple as possible, I'll be making a fe
1925
2026These instructions should be easy to adapt for any situation though.
2127
22−### GitHub Setup
28+## GitHub Setup
2329
24301. If required, create a new repository for your blog.
25312. If required, create a ```master``` branch.
@@ -32,7 +38,7 @@ _site/
3238.stack-work/
3339```
3440
35−### Local setup
41+## Local setup
3642
37431. If required, create a new Hakyll project. If you're a stack user, there is a Hakyll template available that makes this step easy.
3844
@@ -53,11 +59,11 @@ git commit -m "initial commit."
5359git remote add origin <URL to your GitHub pages repository>
5460```
5561
56−### Deployment
62+## Deployment
5763
5864So everything's all setup and we're ready to deploy.
5965
60−> Note: Performing the following commands from your ```develop``` branch is recommended since you will end up back in that branch at the end.
66+> **Note:** Performing the following commands from your ```develop``` branch is recommended since you will end up back in that branch at the end.
6167
6268Temporarily save any uncommitted changes that may exist in the current branch.
6369
@@ -81,16 +87,20 @@ stack exec myblog build
8187Update the local list of remote branches to ensure we're able to checkout the branch we want in the next step.
8288
8389```
84−git fetch -all
90+git fetch --all
8591```
8692
87−Switches to a new branch called "publish" that tracks the origin "master" branch. **Note:** Checking out the publish branch does not overwrite the files that Hakyll just produced because we have '_site' in both .gitignore files.
93+Switch to the `master` branch.
94+
95+> **Note:** Checking out this branch does not overwrite the files that Hakyll just produced because we have '_site' listed in both .gitignore files.
8896
8997```
90−git checkout -b publish --track origin/master
98+git checkout -b master --track origin/master
9199```
92100
93−Copy the freshly made contents of '_site' over the old ones. Note that if a file is *no longer* being produced (for example if you deleted a blog posting), it will continue to persist in your published site until it's been removed from that repository as well.
101+Next, copy the freshly made contents of '_site' over the old ones.
102+
103+> **Note:** Deleting a file from your site's source will not remove it from your `master` repository if it has already been published. An alternative to `cp` is discussed at the end of this guide.
94104
95105```
96106cp -a _site/. .
@@ -100,24 +110,72 @@ Commit our changes.
100110
101111```
102112git add -A
103−git commit -m "publish."
113+git commit -m "Publish."
104114```
105115
106116And send them to GitHub.
107117
108118```
109−git push origin publish:master
119+git push origin master:master
110120```
111121
112122Final clean up and return to the original state.
113123
114124```
115125git checkout develop
116−git branch -D publish
126+git branch -D master
117127git stash pop
118128```
119129
120−### *And that's it.*
130+## Putting it all together
131+
132+Below is a complete listing of all the commands used to automate deployment to Github Pages. A `deployCommand` can be set as part of Hakyll's configuration options. More information and an example is provided [here](https://jaspervdj.be/hakyll/reference/Hakyll-Core-Configuration.html).
133+
134+```
135+# Temporarily store uncommited changes
136+git stash
137+
138+# Verify correct branch
139+git checkout develop
121140
122−A full listing of the "script" is available [here](https://gist.github.com/narrative/5edb976b2f8754a79104).
141+# Build new files
142+stack exec myblog clean
143+stack exec myblog build
144+
145+# Get previous files
146+git fetch --all
147+git checkout -b master --track origin/master
148+
149+# Overwrite existing files with new files
150+cp -a _site/. .
151+
152+# Commit
153+git add -A
154+git commit -m "Publish."
155+
156+# Push
157+git push origin master:master
158+
159+# Restoration
160+git checkout develop
161+git branch -D master
162+git stash pop
163+```
164+
165+*And that's it.*
166+
167+## Removing old files with `rsync`
168+
169+Earlier it was mentioned a flaw is that deleted files will persist in the published site until deleted manually. This is easily overcome by using `rsync` instead of `cp`.
170+
171+```
172+rsync -a --filter='P _site/' \
173+ --filter='P _cache/' \
174+ --filter='P .git/' \
175+ --filter='P .gitignore' \
176+ --filter='P .stack-work' \
177+ --delete-excluded \
178+ _site/ .
179+```
123180
181+The only drawback this approach has is the requirement that *every* file in your site "go through" Hakyll. Fortunately, in many cases this is not an issue.
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