git.iko.soy/hakyll
on master help sign in
swap
6782404287 ahead, 0 behind
134 files changed+3365−1400
since splitsnapshots
unifiedsplit
.circleci/config.yml+19 .circleci/tickle.sh+24 .ghci+1−2 .gitignore+3 .travis.yml−2 web/releases.markdown → CHANGELOG.md+230 CODE_OF_CONDUCT.md+45 LICENSE+1−1 Makefile+6−6 README.markdown+1−1 data/example/css/default.css+122−37 data/example/templates/default.html+16−16 data/example/templates/post.html+11−8 hakyll.cabal+146−126 src/Data/List/Extended.hs → lib/Data/List/Extended.hs src/Data/Yaml/Extended.hs → lib/Data/Yaml/Extended.hs+5−1 src/Hakyll.hs → lib/Hakyll.hs+7−1 src/Hakyll/Check.hs → lib/Hakyll/Check.hs+124−75 src/Hakyll/Commands.hs → lib/Hakyll/Commands.hs+14−7 src/Hakyll/Core/Compiler.hs → lib/Hakyll/Core/Compiler.hs+44−2 src/Hakyll/Core/Compiler/Internal.hs → lib/Hakyll/Core/Compiler/Internal.hs+140−41 src/Hakyll/Core/Compiler/Require.hs → lib/Hakyll/Core/Compiler/Require.hs+2 src/Hakyll/Core/Configuration.hs → lib/Hakyll/Core/Configuration.hs src/Hakyll/Core/Dependencies.hs → lib/Hakyll/Core/Dependencies.hs src/Hakyll/Core/File.hs → lib/Hakyll/Core/File.hs+11−3 src/Hakyll/Core/Identifier.hs → lib/Hakyll/Core/Identifier.hs+1−1 src/Hakyll/Core/Identifier/Pattern.hs → lib/Hakyll/Core/Identifier/Pattern.hs+14−72 lib/Hakyll/Core/Identifier/Pattern/Internal.hs+92 src/Hakyll/Core/Item.hs → lib/Hakyll/Core/Item.hs src/Hakyll/Core/Item/SomeItem.hs → lib/Hakyll/Core/Item/SomeItem.hs src/Hakyll/Core/Logger.hs → lib/Hakyll/Core/Logger.hs+9−3 src/Hakyll/Core/Metadata.hs → lib/Hakyll/Core/Metadata.hs src/Hakyll/Core/Provider.hs → lib/Hakyll/Core/Provider.hs src/Hakyll/Core/Provider/Internal.hs → lib/Hakyll/Core/Provider/Internal.hs src/Hakyll/Core/Provider/Metadata.hs → lib/Hakyll/Core/Provider/Metadata.hs+5−2 src/Hakyll/Core/Provider/MetadataCache.hs → lib/Hakyll/Core/Provider/MetadataCache.hs src/Hakyll/Core/Routes.hs → lib/Hakyll/Core/Routes.hs+17 src/Hakyll/Core/Rules.hs → lib/Hakyll/Core/Rules.hs src/Hakyll/Core/Rules/Internal.hs → lib/Hakyll/Core/Rules/Internal.hs+14 src/Hakyll/Core/Runtime.hs → lib/Hakyll/Core/Runtime.hs+3−3 src/Hakyll/Core/Store.hs → lib/Hakyll/Core/Store.hs+26−23 src/Hakyll/Core/UnixFilter.hs → lib/Hakyll/Core/UnixFilter.hs+2−1 src/Hakyll/Core/Util/File.hs → lib/Hakyll/Core/Util/File.hs src/Hakyll/Core/Util/Parser.hs → lib/Hakyll/Core/Util/Parser.hs+9−3 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−23 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−2 src/Hakyll/Web/Pandoc.hs → lib/Hakyll/Web/Pandoc.hs+13−12 src/Hakyll/Web/Pandoc/Biblio.hs → lib/Hakyll/Web/Pandoc/Biblio.hs+17−6 src/Hakyll/Web/Pandoc/Binary.hs → lib/Hakyll/Web/Pandoc/Binary.hs+19−17 src/Hakyll/Web/Pandoc/FileType.hs → lib/Hakyll/Web/Pandoc/FileType.hs lib/Hakyll/Web/Redirect.hs+100 src/Hakyll/Web/Tags.hs → lib/Hakyll/Web/Tags.hs+3−2 lib/Hakyll/Web/Template.hs+178 src/Hakyll/Web/Template/Context.hs → lib/Hakyll/Web/Template/Context.hs+135−33 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/Main.hs−128 src/Hakyll/Preview/Server.hs−54 src/Hakyll/Web/CompressCss.hs−59 src/Hakyll/Web/Template.hs−263 src/Hakyll/Init.hs → src/Init.hs+44−17 stack.yaml+27−6 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+13−5 tests/Hakyll/Core/Provider/Tests.hs+4−5 tests/Hakyll/Core/Routes/Tests.hs+3−3 tests/Hakyll/Core/Rules/Tests.hs+5−6 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+66−30 web/libraries.markdown+1 web/site.hs+25−39 web/templates/default.html+1−6 web/templates/tutorials.html+24−18 web/tutorials/01-installation.markdown+6−2 web/tutorials/02-basics.markdown+1 web/tutorials/03-rules-routes-compilers.markdown+1 web/tutorials/04-compilers.markdown+18−3 web/tutorials/05-snapshots-feeds.markdown+1 web/tutorials/06-versions.markdown+1 web/tutorials/a-guide-to-the-hakyll-module-zoo.markdown+1 web/tutorials/external-add-tags-to-your-hakyll-blog.md+1−1 web/tutorials/external-blogger-port.md+6 web/tutorials/external-cassius-template.md+6 web/tutorials/external-clean-urls-with-hakyll.md+1−1 web/tutorials/external-deploying-with-widely.md+1−1 web/tutorials/external-external-code-inclusion.md+6 web/tutorials/external-functionfield.md+1−1 web/tutorials/external-github-pages-circle-ci.md+6 web/tutorials/external-inlining-and-compressing-css.md+1−1 web/tutorials/faq.markdown+1 web/tutorials/github-pages-tutorial.md+10−3 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+3
@@ -23,3 +23,6 @@ web/_cache
2323web/_site
2424web/site
2525web/reference
26+
27+# This is generated from the CHANGELOG
28+web/releases.markdown
.travis.ymldeleted−2
@@ -1,2 +0,0 @@
1−language: haskell
2−ghc: '7.10'
web/releases.markdown → CHANGELOG.mdrenamed+230
@@ -4,6 +4,236 @@ 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+
7237## Hakyll 4.7.5.2
8238
9239- Bump pandoc dependency to 1.17 (contribution by Felix Yan)
CODE_OF_CONDUCT.mdnew file+45
@@ -0,0 +1,45 @@
1+# Contributor Covenant Code of Conduct
2+
3+## Our Pledge
4+
5+In the interest of fostering an open and welcoming environment, we as contributors and maintainers pledge to making participation in our project and our community a harassment-free experience for everyone, regardless of age, body size, disability, ethnicity, gender identity and expression, level of experience, nationality, personal appearance, race, religion, or sexual identity and orientation.
6+
7+## Our Standards
8+
9+Examples of behavior that contributes to creating a positive environment include:
10+* Using welcoming and inclusive language
11+* Being respectful of differing viewpoints and experiences
12+* Gracefully accepting constructive criticism
13+* Focusing on what is best for the community
14+* Showing empathy towards other community members
15+
16+Examples of unacceptable behavior by participants include:
17+
18+* The use of sexualized language or imagery and unwelcome sexual attention or advances
19+* Trolling, insulting/derogatory comments, and personal or political attacks
20+* Public or private harassment
21+* Publishing others' private information, such as a physical or electronic address, without explicit permission
22+* Other conduct which could reasonably be considered inappropriate in a professional setting
23+
24+## Our Responsibilities
25+
26+Project maintainers are responsible for clarifying the standards of acceptable behavior and are expected to take appropriate and fair corrective action in response to any instances of unacceptable behavior.
27+
28+Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, or to ban temporarily or permanently any contributor for other behaviors that they deem inappropriate, threatening, offensive, or harmful.
29+
30+## Scope
31+
32+This Code of Conduct applies both within project spaces and in public spaces when an individual is representing the project or its community. Examples of representing a project or community include using an official project e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. Representation of a project may be further defined and clarified by project maintainers.
33+
34+## Enforcement
35+
36+Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by [contacting the project team at m@jaspervdj.be](mailto:m@jaspervdj.be). All complaints will be reviewed and investigated and will result in a response that is deemed necessary and appropriate to the circumstances. The project team is obligated to maintain confidentiality with regard to the reporter of an incident. Further details of specific enforcement policies may be posted separately.
37+
38+Project maintainers who do not follow or enforce the Code of Conduct in good faith may face temporary or permanent repercussions as determined by other members of the project's leadership.
39+
40+## Attribution
41+
42+This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, available at [http://contributor-covenant.org/version/1/4][version]
43+
44+[homepage]: http://contributor-covenant.org
45+[version]: http://contributor-covenant.org/version/1/4/
LICENSE+1−1
@@ -1,4 +1,4 @@
1−Copyright (c) 2009, Jasper Van der Jeugt
1+Copyright (c) 2009 - 2017, Jasper Van der Jeugt
22 
33All rights reserved.
44 
Makefile+6−6
@@ -1,9 +1,9 @@
1+PACKAGE="$(shell stack list-dependencies --separator='-' | grep hakyll)"
2+LOCAL_DOC_ROOT="$(shell stack path --local-doc-root)"
3+
14# Generate the docs and copy them to the website dir
25haddock:
3− cabal haddock --hyperlink-source
4− rm -rf web/reference/
5− cp -r dist/doc/html/hakyll/ web/reference/
6+ stack build --haddock --no-haddock-deps
7+ rsync -r "$(LOCAL_DOC_ROOT)/$(PACKAGE)/" web/reference/
68
7−# Run the tests
8−test:
9− runghc -isrc -itests tests/TestSuite.hs
9+.PHONY: haddock
README.markdown+1−1
@@ -1,6 +1,6 @@
11# hakyll
22
3−[![Build Status](https://img.shields.io/travis/jaspervdj/hakyll.svg)](http://travis-ci.org/jaspervdj/hakyll)
3+[![Build Status](https://img.shields.io/circleci/project/github/jaspervdj/hakyll.svg)](https://circleci.com/gh/jaspervdj/hakyll)
44
55Hakyll is a static site generator library in Haskell. More information
66(including a tutorial) can be found on
data/example/css/default.css+122−37
@@ -1,56 +1,141 @@
1−body {
2− color: black;
3− font-size: 16px;
4− margin: 0px auto 0px auto;
5− width: 600px;
1+html {
2+ font-size: 62.5%;
63}
74
8−div#header {
9− border-bottom: 2px solid black;
10− margin-bottom: 30px;
11− padding: 12px 0px 12px 0px;
5+body {
6+ font-size: 1.6rem;
7+ color: #000;
128}
139
14−div#logo a {
15− color: black;
16− float: left;
17− font-size: 18px;
18− font-weight: bold;
19− text-decoration: none;
10+header {
11+ border-bottom: 0.2rem solid #000;
2012}
2113
22−div#header #navigation {
23− text-align: right;
14+nav {
15+ text-align: right;
2416}
2517
26−div#header #navigation a {
27− color: black;
28− font-size: 18px;
29− font-weight: bold;
30− margin-left: 12px;
31− text-decoration: none;
32− text-transform: uppercase;
18+nav a {
19+ font-size: 1.8rem;
20+ font-weight: bold;
21+ color: black;
22+ text-decoration: none;
23+ text-transform: uppercase;
3324}
3425
35−div#footer {
36− border-top: solid 2px black;
37− color: #555;
38− font-size: 12px;
39− margin-top: 30px;
40− padding: 12px 0px 12px 0px;
41− text-align: right;
26+footer {
27+ margin-top: 3rem;
28+ padding: 1.2rem 0;
29+ border-top: 0.2rem solid #000;
30+ font-size: 1.2rem;
31+ color: #555;
4232}
4333
4434h1 {
45− font-size: 24px;
35+ font-size: 2.4rem;
4636}
4737
4838h2 {
49− font-size: 20px;
39+ font-size: 2rem;
40+}
41+
42+article .header {
43+ font-size: 1.4rem;
44+ font-style: italic;
45+ color: #555;
46+}
47+
48+.logo a {
49+ font-weight: bold;
50+ color: #000;
51+ text-decoration: none;
52+}
53+
54+@media (max-width: 319px) {
55+ body {
56+ width: 90%;
57+ margin: 0;
58+ padding: 0 5%;
59+ }
60+ header {
61+ margin: 4.2rem 0;
62+ }
63+ nav {
64+ margin: 0 auto 3rem;
65+ text-align: center;
66+ }
67+ footer {
68+ text-align: center;
69+ }
70+ .logo {
71+ text-align: center;
72+ margin: 1rem auto 3rem;
73+ }
74+ .logo a {
75+ font-size: 2.4rem;
76+ }
77+ nav a {
78+ display: block;
79+ line-height: 1.6;
80+ }
81+}
82+
83+@media (min-width: 320px) {
84+ body {
85+ width: 90%;
86+ margin: 0;
87+ padding: 0 5%;
88+ }
89+ header {
90+ margin: 4.2rem 0;
91+ }
92+ nav {
93+ margin: 0 auto 3rem;
94+ text-align: center;
95+ }
96+ footer {
97+ text-align: center;
98+ }
99+ .logo {
100+ text-align: center;
101+ margin: 1rem auto 3rem;
102+ }
103+ .logo a {
104+ font-size: 2.4rem;
105+ }
106+ nav a {
107+ display: inline;
108+ margin: 0 0.6rem;
109+ }
50110}
51111
52−div.info {
53− color: #555;
54− font-size: 14px;
55− font-style: italic;
112+@media (min-width: 640px) {
113+ body {
114+ width: 60rem;
115+ margin: 0 auto;
116+ padding: 0;
117+ }
118+ header {
119+ margin: 0 0 3rem;
120+ padding: 1.2rem 0;
121+ }
122+ nav {
123+ margin: 0;
124+ text-align: right;
125+ }
126+ nav a {
127+ margin: 0 0 0 1.2rem;
128+ display: inline;
129+ }
130+ footer {
131+ text-align: right;
132+ }
133+ .logo {
134+ margin: 0;
135+ text-align: left;
136+ }
137+ .logo a {
138+ float: left;
139+ font-size: 1.8rem;
140+ }
56141}
data/example/templates/default.html+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+146−126
@@ -1,5 +1,5 @@
11Name: hakyll
2−Version: 4.7.5.2
2+Version: 4.13.0.0
33
44Synopsis: A static website compiler library
55Description:
@@ -37,7 +37,7 @@ License: BSD3
3737License-File: LICENSE
3838Category: Web
3939
40−Cabal-Version: >= 1.8
40+Cabal-Version: >= 1.10
4141Build-Type: Simple
4242Data-Dir: data
4343
@@ -56,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,76 +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:
124153 Data.List.Extended
125154 Data.Yaml.Extended
126155 Hakyll.Check
127− Hakyll.Commands
128− Hakyll.Core.Compiler.Internal
129156 Hakyll.Core.Compiler.Require
157+ Hakyll.Core.Identifier.Pattern.Internal
130158 Hakyll.Core.Item.SomeItem
131− Hakyll.Core.Logger
132− Hakyll.Core.Provider
133159 Hakyll.Core.Provider.Internal
134− Hakyll.Core.Provider.Metadata
135160 Hakyll.Core.Provider.MetadataCache
136− Hakyll.Core.Rules.Internal
137− Hakyll.Core.Runtime
138− Hakyll.Core.Store
139− Hakyll.Core.Util.File
140161 Hakyll.Core.Util.Parser
141− Hakyll.Web.Pandoc.Binary
142162 Paths_hakyll
143163
144164 Build-Depends:
145− base >= 4.8 && < 5,
146− binary >= 0.5 && < 0.8,
147− blaze-html >= 0.5 && < 0.9,
148− blaze-markup >= 0.5.1 && < 0.8,
149− bytestring >= 0.9 && < 0.11,
150− cmdargs >= 0.10 && < 0.11,
151− containers >= 0.3 && < 0.6,
152− cryptohash >= 0.7 && < 0.12,
153− data-default >= 0.4 && < 0.6,
154− deepseq >= 1.3 && < 1.5,
155− directory >= 1.0 && < 1.3,
156− filepath >= 1.0 && < 1.5,
157− lrucache >= 1.1.1 && < 1.3,
158− mtl >= 1 && < 2.3,
159− network >= 2.6 && < 2.7,
160− network-uri >= 2.6 && < 2.7,
161− pandoc >= 1.14 && < 1.18,
162− pandoc-citeproc >= 0.4 && < 0.10,
163− parsec >= 3.0 && < 3.2,
164− process >= 1.0 && < 1.3,
165− random >= 1.0 && < 1.2,
166− regex-base >= 0.93 && < 0.94,
167− regex-tdfa >= 1.1 && < 1.3,
168− resourcet >= 1.1 && < 1.2,
169− tagsoup >= 0.13.1 && < 0.14,
170− text >= 0.11 && < 1.3,
171− time >= 1.4 && < 1.6,
172− time-locale-compat >= 0.1 && < 0.2,
173− unordered-containers >= 0.2 && < 0.3,
174− vector >= 0.11 && < 0.12,
175− yaml >= 0.8 && < 0.9
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
176195
177196 If flag(previewServer)
178197 Build-depends:
179− snap-core >= 0.6 && < 0.10,
180− snap-server >= 0.6 && < 0.10,
181− fsnotify >= 0.2 && < 0.3,
182− 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
183203 Cpp-options:
184204 -DPREVIEW_SERVER
185205 Other-modules:
@@ -188,8 +208,7 @@ Library
188208
189209 If flag(watchServer)
190210 Build-depends:
191− fsnotify >= 0.2 && < 0.3,
192− system-filepath >= 0.4.6 && <= 0.5
211+ fsnotify >= 0.2 && < 0.4
193212 Cpp-options:
194213 -DWATCH_SERVER
195214 Other-modules:
@@ -197,16 +216,31 @@ Library
197216
198217 If flag(checkExternal)
199218 Build-depends:
200− http-conduit >= 2.1 && < 2.2,
201− http-types >= 0.7 && < 0.10
219+ http-conduit >= 2.2 && < 2.4,
220+ http-types >= 0.7 && < 0.13
202221 Cpp-options:
203222 -DCHECK_EXTERNAL
204223
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+
205237Test-suite hakyll-tests
206− Type: exitcode-stdio-1.0
207− Hs-source-dirs: src tests
208− Main-is: TestSuite.hs
209− 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+
210244 Other-modules:
211245 Hakyll.Core.Dependencies.Tests
212246 Hakyll.Core.Identifier.Tests
@@ -218,90 +252,76 @@ Test-suite hakyll-tests
218252 Hakyll.Core.Store.Tests
219253 Hakyll.Core.UnixFilter.Tests
220254 Hakyll.Core.Util.String.Tests
255+ Hakyll.Web.CompressCss.Tests
221256 Hakyll.Web.Html.RelativizeUrls.Tests
222257 Hakyll.Web.Html.Tests
223− Hakyll.Web.Pandoc.FileType.Tests
258+ Hakyll.Web.Tags.Tests
224259 Hakyll.Web.Template.Context.Tests
225260 Hakyll.Web.Template.Tests
226261 TestSuite.Util
227262
228263 Build-Depends:
229− HUnit >= 1.2 && < 1.4,
230− QuickCheck >= 2.4 && < 2.9,
231− test-framework >= 0.4 && < 0.9,
232− test-framework-hunit >= 0.3 && < 0.4,
233− 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,
234269 -- Copy pasted from hakyll dependencies:
235− base >= 4.8 && < 5,
236− binary >= 0.5 && < 0.8,
237− blaze-html >= 0.5 && < 0.9,
238− blaze-markup >= 0.5.1 && < 0.8,
239− bytestring >= 0.9 && < 0.11,
240− cmdargs >= 0.10 && < 0.11,
241− containers >= 0.3 && < 0.6,
242− cryptohash >= 0.7 && < 0.12,
243− data-default >= 0.4 && < 0.6,
244− deepseq >= 1.3 && < 1.5,
245− directory >= 1.0 && < 1.3,
246− filepath >= 1.0 && < 1.5,
247− lrucache >= 1.1.1 && < 1.3,
248− mtl >= 1 && < 2.3,
249− network >= 2.6 && < 2.7,
250− network-uri >= 2.6 && < 2.7,
251− pandoc >= 1.14 && < 1.18,
252− pandoc-citeproc >= 0.4 && < 0.10,
253− parsec >= 3.0 && < 3.2,
254− process >= 1.0 && < 1.3,
255− random >= 1.0 && < 1.2,
256− regex-base >= 0.93 && < 0.94,
257− regex-tdfa >= 1.1 && < 1.3,
258− resourcet >= 1.1 && < 1.2,
259− tagsoup >= 0.13.1 && < 0.14,
260− text >= 0.11 && < 1.3,
261− time >= 1.4 && < 1.6,
262− time-locale-compat >= 0.1 && < 0.2,
263− unordered-containers >= 0.2 && < 0.3,
264− vector >= 0.11 && < 0.12,
265− yaml >= 0.8 && < 0.9
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
266277
267278 If flag(previewServer)
268− Build-depends:
269− snap-core >= 0.6 && < 0.10,
270− snap-server >= 0.6 && < 0.10,
271− fsnotify >= 0.2 && < 0.3,
272− system-filepath >= 0.4.6 && <= 0.5
273279 Cpp-options:
274280 -DPREVIEW_SERVER
275− Other-modules:
276− Hakyll.Preview.Poll
277− Hakyll.Preview.Server
278281
279282 If flag(watchServer)
280− Build-depends:
281− fsnotify >= 0.2 && < 0.3,
282− system-filepath >= 0.4.6 && <= 0.5
283283 Cpp-options:
284284 -DWATCH_SERVER
285− Other-modules:
286− Hakyll.Preview.Poll
287285
288286 If flag(checkExternal)
289− Build-depends:
290− http-conduit >= 2.1 && < 2.2,
291− http-types >= 0.7 && < 0.10
292287 Cpp-options:
293288 -DCHECK_EXTERNAL
294289
290+ If flag(usePandoc)
291+ Other-modules:
292+ Hakyll.Web.Pandoc.FileType.Tests
293+ Cpp-options:
294+ -DUSE_PANDOC
295+
295296Executable hakyll-init
296− Ghc-options: -Wall
297− Hs-source-dirs: src
298− 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
299304
300305 Build-depends:
306+ hakyll,
301307 base >= 4 && < 5,
302− directory >= 1.0 && < 1.3,
308+ directory >= 1.0 && < 1.4,
303309 filepath >= 1.0 && < 1.5
304310
305− Other-modules:
306− Hakyll.Core.Util.File
307− Paths_hakyll
311+Executable hakyll-website
312+ Main-is: site.hs
313+ Ghc-options: -Wall -threaded
314+ Hs-source-dirs: web
315+ Default-language: Haskell2010
316+
317+ If flag(buildWebsite)
318+ Buildable: True
319+ Else
320+ Buildable: False
321+
322+ Build-depends:
323+ hakyll,
324+ base >= 4 && < 5,
325+ directory >= 1.0 && < 1.4,
326+ filepath >= 1.0 && < 1.5,
327+ pandoc >= 2.0.5 && < 2.8
src/Data/List/Extended.hs → lib/Data/List/Extended.hsrenamed

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

src/Hakyll/Core/Provider/Metadata.hs → lib/Hakyll/Core/Provider/Metadata.hsrenamed+5−2
@@ -14,6 +14,7 @@ module Hakyll.Core.Provider.Metadata
1414import Control.Arrow (second)
1515import Control.Exception (Exception, throwIO)
1616import Control.Monad (guard)
17+import qualified Data.ByteString as B
1718import qualified Data.ByteString.Char8 as BC
1819import Data.List.Extended (breakWhen)
1920import qualified Data.Map as M
@@ -26,6 +27,7 @@ import Hakyll.Core.Identifier
2627import Hakyll.Core.Metadata
2728import Hakyll.Core.Provider.Internal
2829import System.IO as IO
30+import System.IO.Error (modifyIOError, ioeSetLocation)
2931
3032
3133--------------------------------------------------------------------------------
@@ -50,7 +52,7 @@ loadMetadata p identifier = do
5052--------------------------------------------------------------------------------
5153loadMetadataHeader :: FilePath -> IO (Metadata, String)
5254loadMetadataHeader fp = do
53− fileContent <- readFile fp
55+ fileContent <- modifyIOError (`ioeSetLocation` "loadMetadataHeader") $ readFile fp
5456 case parsePage fileContent of
5557 Right x -> return x
5658 Left err -> throwIO $ MetadataException fp err
@@ -59,7 +61,8 @@ loadMetadataHeader fp = do
5961--------------------------------------------------------------------------------
6062loadMetadataFile :: FilePath -> IO Metadata
6163loadMetadataFile fp = do
62− errOrMeta <- Yaml.decodeFileEither fp
64+ fileContent <- modifyIOError (`ioeSetLocation` "loadMetadataFile") $ B.readFile fp
65+ let errOrMeta = Yaml.decodeEither' fileContent
6366 either (fail . show) return errOrMeta
6467
6568
src/Hakyll/Core/Provider/MetadataCache.hs → lib/Hakyll/Core/Provider/MetadataCache.hsrenamed

The content is the same.

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

The content is the same.

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

The content is the same.

src/Hakyll/Core/Util/Parser.hs → lib/Hakyll/Core/Util/Parser.hsrenamed+9−3
@@ -2,13 +2,12 @@
22-- | Parser utilities
33module Hakyll.Core.Util.Parser
44 ( metadataKey
5− , reservedKeys
65 ) where
76
87
98--------------------------------------------------------------------------------
109import Control.Applicative ((<|>))
11−import Control.Monad (mzero)
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−23
@@ -1,3 +1,6 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE TemplateHaskell #-}
3+
14--------------------------------------------------------------------------------
25-- | A Module that allows easy rendering of RSS feeds.
36--
@@ -20,24 +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−
29−
3031--------------------------------------------------------------------------------
3132import Hakyll.Core.Compiler
32−import Hakyll.Core.Compiler.Internal
3333import Hakyll.Core.Item
34+import Hakyll.Core.Util.String (replaceAll)
3435import Hakyll.Web.Template
3536import Hakyll.Web.Template.Context
3637import Hakyll.Web.Template.List
3738
3839
3940--------------------------------------------------------------------------------
40−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)
4160
4261
4362--------------------------------------------------------------------------------
@@ -58,21 +77,21 @@ data FeedConfiguration = FeedConfiguration
5877
5978--------------------------------------------------------------------------------
6079-- | Abstract function to render any feed.
61−renderFeed :: FilePath -- ^ Feed template
62− -> FilePath -- ^ Item template
80+renderFeed :: Template -- ^ Default feed template
81+ -> Template -- ^ Default item template
6382 -> FeedConfiguration -- ^ Feed configuration
6483 -> Context String -- ^ Context for the items
6584 -> [Item String] -- ^ Input items
6685 -> Compiler (Item String) -- ^ Resulting item
67−renderFeed feedPath itemPath config itemContext items = do
68− feedTpl <- compilerUnsafeIO $ loadTemplate feedPath
69− itemTpl <- compilerUnsafeIO $ loadTemplate itemPath
70−
71− 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
7289 applyTemplate feedTpl feedContext body
7390 where
74− -- Auxiliary: load a template from a datafile
75− 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;")
7695
7796 itemContext' = mconcat
7897 [ itemContext
@@ -98,8 +117,35 @@ renderFeed feedPath itemPath config itemContext items = do
98117 updatedField = field "updated" $ \_ -> case items of
99118 [] -> return "Unknown"
100119 (x : _) -> unContext itemContext' "updated" [] x >>= \cf -> case cf of
101− ListField _ _ -> fail "Hakyll.Web.Feed.renderFeed: Internal error"
102120 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)
103149
104150
105151--------------------------------------------------------------------------------
@@ -108,9 +154,7 @@ renderRss :: FeedConfiguration -- ^ Feed configuration
108154 -> Context String -- ^ Item context
109155 -> [Item String] -- ^ Feed items
110156 -> Compiler (Item String) -- ^ Resulting feed
111−renderRss config context = renderFeed
112− "templates/rss.xml" "templates/rss-item.xml" config
113− (makeItemContext "%a, %d %b %Y %H:%M:%S UT" context)
157+renderRss = renderRssWithTemplates rssTemplate rssItemTemplate
114158
115159
116160--------------------------------------------------------------------------------
@@ -119,13 +163,11 @@ renderAtom :: FeedConfiguration -- ^ Feed configuration
119163 -> Context String -- ^ Item context
120164 -> [Item String] -- ^ Feed items
121165 -> Compiler (Item String) -- ^ Resulting feed
122−renderAtom config context = renderFeed
123− "templates/atom.xml" "templates/atom-item.xml" config
124− (makeItemContext "%Y-%m-%dT%H:%M:%SZ" context)
166+renderAtom = renderAtomWithTemplates atomTemplate atomItemTemplate
125167
126168
127169--------------------------------------------------------------------------------
128170-- | Copies @$updated$@ from @$published$@ if it is not already set.
129171makeItemContext :: String -> Context a -> Context a
130172makeItemContext fmt context = mconcat
131− [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−2
@@ -11,7 +11,8 @@ module Hakyll.Web.Paginate
1111
1212
1313--------------------------------------------------------------------------------
14−import Control.Monad (forM_)
14+import Control.Applicative (empty)
15+import Control.Monad (forM_, forM)
1516import qualified Data.Map as M
1617import qualified Data.Set as S
1718
@@ -37,7 +38,7 @@ data Paginate = Paginate
3738 { paginateMap :: M.Map PageNumber [Identifier]
3839 , paginateMakeId :: PageNumber -> Identifier
3940 , paginateDependency :: Dependency
40− } deriving (Show)
41+ }
4142
4243
4344--------------------------------------------------------------------------------
@@ -93,6 +94,18 @@ paginatePage pag pageNumber
9394-- | A default paginate context which provides the following keys:
9495--
9596--
97+-- * @firstPageNum@
98+-- * @firstPageUrl@
99+-- * @previousPageNum@
100+-- * @previousPageUrl@
101+-- * @nextPageNum@
102+-- * @nextPageUrl@
103+-- * @lastPageNum@
104+-- * @lastPageUrl@
105+-- * @currentPageNum@
106+-- * @currentPageUrl@
107+-- * @numPages@
108+-- * @allPages@
96109paginateContext :: Paginate -> PageNumber -> Context a
97110paginateContext pag currentPage = mconcat
98111 [ field "firstPageNum" $ \_ -> otherPage 1 >>= num
@@ -106,6 +119,20 @@ paginateContext pag currentPage = mconcat
106119 , field "currentPageNum" $ \i -> thisPage i >>= num
107120 , field "currentPageUrl" $ \i -> thisPage i >>= url
108121 , constField "numPages" $ show $ paginateNumPages pag
122+ , Context $ \k _ i -> case k of
123+ "allPages" -> do
124+ let ctx =
125+ field "isCurrent" (\n -> if fst (itemBody n) == currentPage then return "true" else empty) `mappend`
126+ field "num" (num . itemBody) `mappend`
127+ field "url" (url . itemBody)
128+
129+ list <- forM [1 .. lastPage] $
130+ \n -> if n == currentPage then thisPage i else otherPage n
131+ items <- mapM makeItem list
132+ return $ ListField ctx items
133+ _ -> do
134+ empty
135+
109136 ]
110137 where
111138 lastPage = paginateNumPages pag
src/Hakyll/Web/Pandoc.hs → lib/Hakyll/Web/Pandoc.hsrenamed+13−12
@@ -22,9 +22,9 @@ module Hakyll.Web.Pandoc
2222
2323
2424--------------------------------------------------------------------------------
25−import qualified Data.Set as S
25+import qualified Data.Text as T
2626import Text.Pandoc
27−import Text.Pandoc.Error (PandocError (..))
27+import Text.Pandoc.Highlighting (pygments)
2828
2929
3030--------------------------------------------------------------------------------
@@ -48,12 +48,10 @@ readPandocWith
4848 -> Item String -- ^ String to read
4949 -> Compiler (Item Pandoc) -- ^ Resulting document
5050readPandocWith ropt item =
51− case traverse (reader ropt (itemFileType item)) item of
52− Left (ParseFailure err) -> fail $
53− "Hakyll.Web.Pandoc.readPandocWith: parse failed: " ++ err
54− Left (ParsecError _ err) -> fail $
51+ case runPure $ traverse (reader ropt (itemFileType item)) (fmap T.pack item) of
52+ Left err -> fail $
5553 "Hakyll.Web.Pandoc.readPandocWith: parse failed: " ++ show err
56− Right item' -> return item'
54+ Right item' -> return item'
5755 where
5856 reader ro t = case t of
5957 DocBook -> readDocBook ro
@@ -69,7 +67,7 @@ readPandocWith ropt item =
6967 "Hakyll.Web.readPandocWith: I don't know how to read a file of " ++
7068 "the type " ++ show t ++ " for: " ++ show (itemIdentifier item)
7169
72− addExt ro e = ro {readerExtensions = S.insert e $ readerExtensions ro}
70+ addExt ro e = ro {readerExtensions = enableExtension e $ readerExtensions ro}
7371
7472
7573--------------------------------------------------------------------------------
@@ -84,7 +82,10 @@ writePandoc = writePandocWith defaultHakyllWriterOptions
8482writePandocWith :: WriterOptions -- ^ Writer options for pandoc
8583 -> Item Pandoc -- ^ Document to write
8684 -> Item String -- ^ Resulting HTML
87−writePandocWith wopt = fmap $ writeHtmlString wopt
85+writePandocWith wopt (Item itemi doc) =
86+ case runPure $ writeHtml5String wopt doc of
87+ Left err -> error $ "Hakyll.Web.Pandoc.writePandocWith: " ++ show err
88+ Right item' -> Item itemi $ T.unpack item'
8889
8990
9091--------------------------------------------------------------------------------
@@ -147,7 +148,7 @@ defaultHakyllReaderOptions :: ReaderOptions
147148defaultHakyllReaderOptions = def
148149 { -- The following option causes pandoc to read smart typography, a nice
149150 -- and free bonus.
150− readerSmart = True
151+ readerExtensions = enableExtension Ext_smart pandocExtensions
151152 }
152153
153154
@@ -157,8 +158,8 @@ defaultHakyllWriterOptions :: WriterOptions
157158defaultHakyllWriterOptions = def
158159 { -- This option causes literate haskell to be written using '>' marks in
159160 -- html, which I think is a good default.
160− writerExtensions = S.insert Ext_literate_haskell (writerExtensions def)
161+ writerExtensions = enableExtension Ext_smart pandocExtensions
161162 , -- We want to have hightlighting by default, to be compatible with earlier
162163 -- Hakyll releases
163− writerHighlight = True
164+ writerHighlightStyle = Just pygments
164165 }
src/Hakyll/Web/Pandoc/Biblio.hs → lib/Hakyll/Web/Pandoc/Biblio.hsrenamed+17−6
@@ -25,17 +25,19 @@ module Hakyll.Web.Pandoc.Biblio
2525--------------------------------------------------------------------------------
2626import Control.Monad (liftM, replicateM)
2727import Data.Binary (Binary (..))
28−import Data.Default (def)
2928import Data.Typeable (Typeable)
3029import Hakyll.Core.Compiler
30+import Hakyll.Core.Compiler.Internal
3131import Hakyll.Core.Identifier
3232import Hakyll.Core.Item
33+import Hakyll.Core.Provider
3334import Hakyll.Core.Writable
3435import Hakyll.Web.Pandoc
3536import Hakyll.Web.Pandoc.Binary ()
3637import qualified Text.CSL as CSL
3738import Text.CSL.Pandoc (processCites)
38−import Text.Pandoc (Pandoc, ReaderOptions (..))
39+import Text.Pandoc (Pandoc, ReaderOptions (..),
40+ enableExtension, Extension (..))
3941
4042
4143--------------------------------------------------------------------------------
@@ -83,8 +85,11 @@ instance Writable Biblio where
8385--------------------------------------------------------------------------------
8486biblioCompiler :: Compiler (Item Biblio)
8587biblioCompiler = do
86− filePath <- toFilePath <$> getUnderlying
87− makeItem =<< unsafeCompiler (Biblio <$> CSL.readBiblioFile filePath)
88+ filePath <- getResourceFilePath
89+ makeItem =<< unsafeCompiler (Biblio <$> CSL.readBiblioFile idpred filePath)
90+ where
91+ -- This is a filter on citations. We include all citations.
92+ idpred = const True
8893
8994
9095--------------------------------------------------------------------------------
@@ -95,7 +100,9 @@ readPandocBiblio :: ReaderOptions
95100 -> Compiler (Item Pandoc)
96101readPandocBiblio ropt csl biblio item = do
97102 -- Parse CSL file, if given
98− style <- unsafeCompiler $ CSL.readCSLFile Nothing . toFilePath . itemIdentifier $ csl
103+ provider <- compilerProvider <$> compilerAsk
104+ style <- unsafeCompiler $
105+ CSL.readCSLFile Nothing . (resourceFilePath provider) . itemIdentifier $ csl
99106
100107 -- We need to know the citation keys, add then *before* actually parsing the
101108 -- actual page. If we don't do this, pandoc won't even consider them
@@ -112,4 +119,8 @@ pandocBiblioCompiler cslFileName bibFileName = do
112119 csl <- load $ fromFilePath cslFileName
113120 bib <- load $ fromFilePath bibFileName
114121 liftM writePandoc
115− (getResourceBody >>= readPandocBiblio def csl bib)
122+ (getResourceBody >>= readPandocBiblio ropt csl bib)
123+ where ropt = defaultHakyllReaderOptions
124+ { -- The following option enables citation rendering
125+ readerExtensions = enableExtension Ext_citations $ readerExtensions defaultHakyllReaderOptions
126+ }
src/Hakyll/Web/Pandoc/Binary.hs → lib/Hakyll/Web/Pandoc/Binary.hsrenamed+19−17
@@ -1,31 +1,33 @@
11{-# OPTIONS_GHC -fno-warn-orphans #-}
2−{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE DeriveGeneric #-}
33module Hakyll.Web.Pandoc.Binary where
44
5−import Data.Binary (Binary (..))
5+import Data.Binary (Binary (..))
66
7−import qualified Text.CSL as CSL
8−import qualified Text.CSL.Reference as REF
9−import qualified Text.CSL.Style as STY
10−import Text.Pandoc
7+import qualified Text.CSL as CSL
8+import qualified Text.CSL.Reference as REF
9+import qualified Text.CSL.Style as STY
10+import Text.Pandoc
1111
1212--------------------------------------------------------------------------------
1313-- orphans
1414
15−instance Binary REF.CNum
16−instance Binary REF.Literal
17−instance Binary REF.RefDate
18−instance Binary REF.RefType
19−instance Binary STY.Agent
20−instance Binary STY.Formatted
21−instance Binary Inline
15+instance Binary Alignment
2216instance Binary Block
17+instance Binary CSL.Reference
2318instance Binary Citation
24−instance Binary MathType
25−instance Binary Alignment
2619instance Binary CitationMode
27−instance Binary QuoteType
2820instance Binary Format
21+instance Binary Inline
2922instance Binary ListNumberDelim
3023instance Binary ListNumberStyle
31−instance Binary CSL.Reference
24+instance Binary MathType
25+instance Binary QuoteType
26+instance Binary REF.CLabel
27+instance Binary REF.CNum
28+instance Binary REF.Literal
29+instance Binary REF.RefDate
30+instance Binary REF.RefType
31+instance Binary REF.Season
32+instance Binary STY.Agent
33+instance Binary STY.Formatted
src/Hakyll/Web/Pandoc/FileType.hs → lib/Hakyll/Web/Pandoc/FileType.hsrenamed

The content is the same.

lib/Hakyll/Web/Redirect.hsnew file+100
@@ -0,0 +1,100 @@
1+-- | Module used for generating HTML redirect pages. This allows renaming pages
2+-- to avoid breaking existing links without requiring server-side support for
3+-- formal 301 Redirect error codes
4+module Hakyll.Web.Redirect
5+ ( Redirect (..)
6+ , createRedirects
7+ ) where
8+
9+import Control.Applicative ((<$>))
10+import Control.Monad (forM_, when)
11+import Data.Binary (Binary (..))
12+import Data.List (sort, group)
13+import Hakyll.Core.Compiler
14+import Hakyll.Core.Identifier
15+import Hakyll.Core.Routes
16+import Hakyll.Core.Rules
17+import Hakyll.Core.Writable (Writable (..))
18+
19+-- | This function exposes a higher-level interface compared to using the
20+-- 'Redirect' type manually.
21+--
22+-- This creates, using a database mapping broken URLs to working ones, HTML
23+-- files which will do HTML META tag redirect pages (since, as a static site, we
24+-- can't use web-server-level 301 redirects, and using JS is gross).
25+--
26+-- This is useful for sending people using old URLs to renamed versions, dealing
27+-- with common typos etc, and will increase site traffic. Such broken URLs can
28+-- be found by looking at server logs or by using Google Webmaster Tools.
29+-- Broken URLs must be valid Haskell strings, non-URL-escaped valid POSIX
30+-- filenames, and relative links, since they will be defined in a @hakyll.hs@
31+-- and during generation, written to disk with the filename corresponding to the
32+-- broken URLs. (Target URLs can be absolute or relative, but should be
33+-- URL-escaped.) So broken incoming links like <http://www.gwern.net/foo/> which
34+-- should be <http://www.gwern.net/foobar> cannot be fixed (since you cannot
35+-- create a HTML file named @"foo/"@ on disk, as that would be a directory).
36+--
37+-- An example of a valid association list would be:
38+--
39+-- > brokenLinks =
40+-- > [ ("projects.html", "http://github.com/gwern")
41+-- > , ("/Black-market archive", "Black-market%20archives")
42+-- > ]
43+--
44+-- In which case the functionality can then be used in `main` with a line like:
45+--
46+-- > version "redirects" $ createRedirects brokenLinks
47+--
48+-- The 'version' is recommended to separate these items from your other pages.
49+--
50+-- The on-disk files can then be uploaded with HTML mimetypes
51+-- (either explicitly by generating and uploading them separately, by
52+-- auto-detection of the filetype, or an upload tool defaulting to HTML
53+-- mimetype, such as calling @s3cmd@ with @--default-mime-type=text/html@) and
54+-- will redirect browsers and search engines going to the old/broken URLs.
55+--
56+-- See also <https://groups.google.com/d/msg/hakyll/sWc6zxfh-uM/fUpZPsFNDgAJ>.
57+createRedirects :: [(Identifier, String)] -> Rules ()
58+createRedirects redirects =
59+ do -- redirects are many-to-fewer; keys must be unique, and must point somewhere else:
60+ let gkeys = group $ sort $ map fst redirects
61+ forM_ gkeys $ \gkey -> case gkey of
62+ (k : _ : _) -> fail $
63+ "Duplicate 301 redirects; " ++ show k ++ " is ambiguous."
64+ _ -> return ()
65+
66+ forM_ redirects $ \(r, t) ->
67+ when (toFilePath r == t) $ fail $
68+ "Self-redirect detected: " ++ show r ++ " points to itself."
69+
70+ forM_ redirects $ \(ident, to) ->
71+ create [ident] $ do
72+ route idRoute
73+ compile $ makeItem $! Redirect to
74+
75+-- | This datatype can be used directly if you want a lower-level interface to
76+-- generate redirects. For example, if you want to redirect @foo.html@ to
77+-- @bar.jpg@, you can use:
78+--
79+-- > create ["foo.html"] $ do
80+-- > route idRoute
81+-- > compile $ makeItem $ Redirect "bar.jpg"
82+data Redirect = Redirect
83+ { redirectTo :: String
84+ } deriving (Eq, Ord, Show)
85+
86+instance Binary Redirect where
87+ put (Redirect to) = put to
88+ get = Redirect <$> get
89+
90+instance Writable Redirect where
91+ write path = write path . fmap redirectToHtml
92+
93+redirectToHtml :: Redirect -> String
94+redirectToHtml (Redirect working) =
95+ "<!DOCTYPE html><html><head><meta charset=\"utf-8\"/><meta name=\"generator\" content=\"hakyll\"/>" ++
96+ "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">" ++
97+ "<meta http-equiv=\"refresh\" content=\"0; url=" ++ working ++
98+ "\"><link rel=\"canonical\" href=\"" ++ working ++
99+ "\"><title>Permanent Redirect</title></head><body><p>The page has moved to: <a href=\"" ++ working ++
100+ "\">this page</a></p></body></html>"
src/Hakyll/Web/Tags.hs → lib/Hakyll/Web/Tags.hsrenamed+3−2
@@ -43,6 +43,7 @@
4343module Hakyll.Web.Tags
4444 ( Tags (..)
4545 , getTags
46+ , getCategory
4647 , buildTagsWith
4748 , buildTags
4849 , buildCategories
@@ -97,7 +98,7 @@ data Tags = Tags
9798 { tagsMap :: [(String, [Identifier])]
9899 , tagsMakeId :: String -> Identifier
99100 , tagsDependency :: Dependency
100− } deriving (Show)
101+ }
101102
102103
103104--------------------------------------------------------------------------------
@@ -112,7 +113,7 @@ getTags identifier = do
112113
113114
114115--------------------------------------------------------------------------------
115−-- | Obtain categories from a page.
116+-- | Obtain category from a page.
116117getCategory :: MonadMetadata m => Identifier -> m [String]
117118getCategory = return . return . takeBaseName . takeDirectory . toFilePath
118119
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+135−33
@@ -1,6 +1,27 @@
1+-- | This module provides 'Context's which are used to expand expressions in
2+-- templates and allow for arbitrary customisation.
3+--
4+-- 'Template's define a small expression DSL which consists of strings,
5+-- identifiers and function application. There is no type system, every value is
6+-- a string and on the top level they get substituted verbatim into the page.
7+--
8+-- For example, you can build a context that contains
9+--
10+-- > … <> functionField "concat" (const . concat) <> …
11+--
12+-- which will allow you to use the @concat@ identifier as a function that takes
13+-- arbitrarily many stings and concatenates them to a new string:
14+--
15+-- > $partial(concat("templates/categories/", category))$
16+--
17+-- This will evaluate the @category@ field in the context, then prepend he path,
18+-- and include the referenced file as a template.
19+
20+
121--------------------------------------------------------------------------------
222{-# LANGUAGE CPP #-}
323{-# LANGUAGE ExistentialQuantification #-}
24+{-# LANGUAGE RankNTypes #-}
425module Hakyll.Web.Template.Context
526 ( ContextField (..)
627 , Context (..)
@@ -28,13 +49,17 @@ module Hakyll.Web.Template.Context
2849 , teaserField
2950 , teaserFieldWithSeparator
3051 , missingField
52+ , bindItem
3153 ) where
3254
3355
3456--------------------------------------------------------------------------------
3557import Control.Applicative (Alternative (..))
3658import Control.Monad (msum)
37−import Data.List (intercalate)
59+import Data.List (intercalate, tails)
60+#if MIN_VERSION_base(4,9,0)
61+import Data.Semigroup (Semigroup (..))
62+#endif
3863import Data.Time.Clock (UTCTime (..))
3964import Data.Time.Format (formatTime)
4065import qualified Data.Time.Format as TF
@@ -47,13 +72,16 @@ import Hakyll.Core.Metadata
4772import Hakyll.Core.Provider
4873import Hakyll.Core.Util.String (needlePrefix, splitAll)
4974import Hakyll.Web.Html
50−import System.FilePath (splitDirectories, takeBaseName)
75+import Prelude hiding (id)
76+import System.FilePath (dropExtension, splitDirectories,
77+ takeBaseName)
5178
5279
5380--------------------------------------------------------------------------------
5481-- | Mostly for internal usage
5582data ContextField
56− = StringField String
83+ = EmptyField
84+ | StringField String
5785 | forall a. ListField (Context a) [Item a]
5886
5987
@@ -78,71 +106,123 @@ newtype Context a = Context
78106
79107
80108--------------------------------------------------------------------------------
109+-- | Tries to find a key in the left context,
110+-- or when that fails in the right context.
111+#if MIN_VERSION_base(4,9,0)
112+instance Semigroup (Context a) where
113+ (<>) (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
114+
115+instance Monoid (Context a) where
116+ mempty = missingField
117+ mappend = (<>)
118+#else
81119instance Monoid (Context a) where
82120 mempty = missingField
83121 mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
122+#endif
84123
85124
86125--------------------------------------------------------------------------------
87126field' :: String -> (Item a -> Compiler ContextField) -> Context a
88−field' key value = Context $ \k _ i -> if k == key then value i else empty
127+field' key value = Context $ \k _ i ->
128+ if k == key
129+ then value i
130+ else noResult $ "Tried field " ++ key
89131
90132
91133--------------------------------------------------------------------------------
92−-- | Constructs a new field in the 'Context.'
134+-- | Constructs a new field for a 'Context'.
135+-- If the key matches, the compiler is run and its result is substituted in the
136+-- template.
137+--
138+-- If the compiler fails, the field will be considered non-existent
139+-- in an @$if()$@ macro or ultimately break the template application
140+-- (unless the key is found in another context when using '<>').
141+-- Use 'empty' or 'noResult' for intentional failures of fields used in
142+-- @$if()$@, to distinguish them from exceptions thrown with 'fail'.
93143field
94144 :: String -- ^ Key
95145 -> (Item a -> Compiler String) -- ^ Function that constructs a value based
96− -- on the item
146+ -- on the item (e.g. accessing metadata)
97147 -> Context a
98148field key value = field' key (fmap StringField . value)
99149
100150
101151--------------------------------------------------------------------------------
102152-- | Creates a 'field' to use with the @$if()$@ template macro.
153+-- Attempting to substitute the field into the template will cause an error.
103154boolField
104155 :: String
105156 -> (Item a -> Bool)
106157 -> Context a
107−boolField name f = field name (\i -> if f i
108− then pure (error $ unwords ["no string value for bool field:",name])
109− else empty)
158+boolField name f = field' name (\i -> if f i
159+ then return EmptyField
160+ else noResult $ "Field " ++ name ++ " is false")
110161
111162
112163--------------------------------------------------------------------------------
113−-- | Creates a 'field' that does not depend on the 'Item'
114−constField :: String -> String -> Context a
164+-- | Creates a 'field' that does not depend on the 'Item' but always yields
165+-- the same string
166+constField :: String -- ^ Key
167+ -> String -- ^ Value
168+ -> Context a
115169constField key = field key . const . return
116170
117171
118172--------------------------------------------------------------------------------
173+-- | Creates a list field to be consumed by a @$for(…)$@ expression.
174+-- The compiler returns multiple items which are rendered in the loop body
175+-- with the supplied context.
119176listField :: String -> Context a -> Compiler [Item a] -> Context b
120177listField key c xs = listFieldWith key c (const xs)
121178
122179
123180--------------------------------------------------------------------------------
181+-- | Produces a new 'Context' which has list field 'key'. All fields from
182+-- 'c' are also accessible from the produced context.
183+-- Be careful when doing @listFieldWith k ca f <> cb@ as any fields in @ca@
184+-- will override fields in @cb@ with the same name.
185+-- Creates a list field like 'listField', but supplies the current page
186+-- to the compiler.
124187listFieldWith
125188 :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b
126189listFieldWith key c f = field' key $ fmap (ListField c) . f
127190
128191
129192--------------------------------------------------------------------------------
130−functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a
193+-- | Creates a variadic function field.
194+--
195+-- The function will be called with the dynamically evaluated string arguments
196+-- from the template as well as the page that is currently rendered.
197+functionField :: String -- ^ Key
198+ -> ([String] -> Item a -> Compiler String) -- ^ Function
199+ -> Context a
131200functionField name value = Context $ \k args i ->
132201 if k == name
133202 then StringField <$> value args i
134− else empty
203+ else noResult $ "Tried function field " ++ name
135204
136205
137206--------------------------------------------------------------------------------
207+-- | Transform the respective string results of all fields in a context.
208+-- For example,
209+--
210+-- > mapContext (++"c") (constField "x" "a" <> constField "y" "b")
211+--
212+-- is equivalent to
213+--
214+-- > constField "x" "ac" <> constField "y" "bc"
215+--
138216mapContext :: (String -> String) -> Context a -> Context a
139217mapContext f (Context c) = Context $ \k a i -> do
140218 fld <- c k a i
141219 case fld of
220+ EmptyField -> wrongType "boolField"
142221 StringField str -> return $ StringField (f str)
143− ListField _ _ -> fail $
144− "Hakyll.Web.Template.Context.mapContext: " ++
145− "can't map over a ListField!"
222+ _ -> wrongType "ListField"
223+ where
224+ wrongType typ = fail $ "Hakyll.Web.Template.Context.mapContext: " ++
225+ "can't map over a " ++ typ ++ "!"
146226
147227--------------------------------------------------------------------------------
148228-- | A context that allows snippet inclusion. In processed file, use as:
@@ -151,15 +231,15 @@ mapContext f (Context c) = Context $ \k a i -> do
151231-- > $snippet("path/to/snippet/")$
152232-- > ...
153233--
154−-- The contents of the included file will not be interpolated.
234+-- The contents of the included file will not be interpolated like @partial@
235+-- does it.
155236--
156237snippetField :: Context String
157238snippetField = functionField "snippet" f
158239 where
159240 f [contentsPath] _ = loadBody (fromFilePath contentsPath)
160− f _ i = error $
161− "Too many arguments to function 'snippet()' in item " ++
162− show (itemIdentifier i)
241+ f [] _ = fail "No argument to function 'snippet()'"
242+ f _ _ = fail "Too many arguments to function 'snippet()'"
163243
164244--------------------------------------------------------------------------------
165245-- | A context that contains (in that order)
@@ -179,8 +259,7 @@ defaultContext =
179259 metadataField `mappend`
180260 urlField "url" `mappend`
181261 pathField "path" `mappend`
182− titleField "title" `mappend`
183− missingField
262+ titleField "title"
184263
185264
186265--------------------------------------------------------------------------------
@@ -198,15 +277,20 @@ bodyField key = field key $ return . itemBody
198277-- | Map any field to its metadata value, if present
199278metadataField :: Context a
200279metadataField = Context $ \k _ i -> do
201− value <- getMetadataField (itemIdentifier i) k
202− maybe empty (return . StringField) value
280+ let id = itemIdentifier i
281+ empty' = noResult $ "No '" ++ k ++ "' field in metadata " ++
282+ "of item " ++ show id
283+ value <- getMetadataField id k
284+ maybe empty' (return . StringField) value
203285
204286
205287--------------------------------------------------------------------------------
206288-- | Absolute url to the resulting item
207289urlField :: String -> Context a
208−urlField key = field key $
209− fmap (maybe empty toUrl) . getRoute . itemIdentifier
290+urlField key = field key $ \i -> do
291+ let id = itemIdentifier i
292+ empty' = fail $ "No route url found for item " ++ show id
293+ fmap (maybe empty' toUrl) $ getRoute id
210294
211295
212296--------------------------------------------------------------------------------
@@ -257,6 +341,12 @@ titleField = mapContext takeBaseName . pathField
257341-- that begins with @yyyy-mm-dd@ . For example:
258342-- @folder//yyyy-mm-dd-title//dist//main.extension@ .
259343-- In case of multiple matches, the rightmost one is used.
344+--
345+-- As another alternative, if none of the above matches, and the file has a
346+-- path which contains nested directories specifying a date, then that date
347+-- will be used. In other words, if the path is of the form
348+-- @**//yyyy//mm//dd//**//main.extension@ .
349+-- As above, in case of multiple matches, the rightmost one is used.
260350
261351dateField :: String -- ^ Key in which the rendered date should be placed
262352 -> String -- ^ Format to use on the date
@@ -267,7 +357,7 @@ dateField = dateFieldWith defaultTimeLocale
267357--------------------------------------------------------------------------------
268358-- | This is an extended version of 'dateField' that allows you to
269359-- specify a time locale that is used for outputting the date. For more
270−-- details, see 'dateField'.
360+-- details, see 'dateField' and 'formatTime'.
271361dateFieldWith :: TimeLocale -- ^ Output time locale
272362 -> String -- ^ Destination key
273363 -> String -- ^ Format to use on the date
@@ -288,12 +378,13 @@ getItemUTC :: MonadMetadata m
288378getItemUTC locale id' = do
289379 metadata <- getMetadata id'
290380 let tryField k fmt = lookupString k metadata >>= parseTime' fmt
291− paths = splitDirectories $ toFilePath id'
381+ paths = splitDirectories $ (dropExtension . toFilePath) id'
292382
293383 maybe empty' return $ msum $
294384 [tryField "published" fmt | fmt <- formats] ++
295385 [tryField "date" fmt | fmt <- formats] ++
296− [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fnCand | fnCand <- reverse paths]
386+ [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fnCand | fnCand <- reverse paths] ++
387+ [parseTime' "%Y-%m-%d" $ intercalate "-" $ fnCand | fnCand <- map (take 3) $ reverse . tails $ paths]
297388 where
298389 empty' = fail $ "Hakyll.Web.Template.Context.getItemUTC: " ++
299390 "could not parse time for " ++ show id'
@@ -321,13 +412,16 @@ getItemModificationTime identifier = do
321412
322413
323414--------------------------------------------------------------------------------
415+-- | Creates a field with the last modification date of the underlying item.
324416modificationTimeField :: String -- ^ Key
325417 -> String -- ^ Format
326− -> Context a -- ^ Resuting context
418+ -> Context a -- ^ Resulting context
327419modificationTimeField = modificationTimeFieldWith defaultTimeLocale
328420
329421
330422--------------------------------------------------------------------------------
423+-- | Creates a field with the last modification date of the underlying item
424+-- in a custom localisation format (see 'formatTime').
331425modificationTimeFieldWith :: TimeLocale -- ^ Time output locale
332426 -> String -- ^ Key
333427 -> String -- ^ Format
@@ -366,10 +460,11 @@ teaserFieldWithSeparator separator key snapshot = field key $ \item -> do
366460
367461
368462--------------------------------------------------------------------------------
463+-- | Constantly reports any field as missing. Mostly for internal usage,
464+-- it is the last choice in every context used in a template application.
369465missingField :: Context a
370−missingField = Context $ \k _ i -> fail $
371− "Missing field $" ++ k ++ "$ in context for item " ++
372− show (itemIdentifier i)
466+missingField = Context $ \k _ _ -> noResult $
467+ "Missing field '" ++ k ++ "' in context"
373468
374469parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
375470#if MIN_VERSION_time(1,5,0)
@@ -377,3 +472,10 @@ parseTimeM = TF.parseTimeM
377472#else
378473parseTimeM _ = TF.parseTime
379474#endif
475+
476+--------------------------------------------------------------------------------
477+
478+-- | Binds an 'Item' to a given 'Context', allowing it to be combined with any
479+-- other 'Context' of any type.
480+bindItem :: Context a -> Item a -> forall b. Context b
481+bindItem (Context ctx) ia = Context $ \k args _ -> ctx k args ia
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 ((<|>))
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/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−59
@@ -1,59 +0,0 @@
1−--------------------------------------------------------------------------------
2−-- | Module used for CSS compression. The compression is currently in a simple
3−-- state, but would typically reduce the number of bytes by about 25%.
4−module Hakyll.Web.CompressCss
5− ( compressCssCompiler
6− , compressCss
7− ) where
8−
9−
10−--------------------------------------------------------------------------------
11−import Data.Char (isSpace)
12−import Data.List (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 = compressSeparators . stripComments . compressWhitespace
31−
32−
33−--------------------------------------------------------------------------------
34−-- | Compresses certain forms of separators.
35−compressSeparators :: String -> String
36−compressSeparators =
37− replaceAll "; *}" (const "}") .
38− replaceAll " *([{};:]) *" (take 1 . dropWhile isSpace) .
39− replaceAll ";+" (const ";")
40−
41−
42−--------------------------------------------------------------------------------
43−-- | Compresses all whitespace.
44−compressWhitespace :: String -> String
45−compressWhitespace = replaceAll "[ \t\n\r]+" (const " ")
46−
47−
48−--------------------------------------------------------------------------------
49−-- | Function that strips CSS comments away.
50−stripComments :: String -> String
51−stripComments [] = []
52−stripComments str
53− | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str
54− | otherwise = head str : stripComments (drop 1 str)
55− where
56− eatComments str'
57− | null str' = []
58− | isPrefixOf "*/" str' = drop 2 str'
59− | otherwise = eatComments $ drop 1 str'
src/Hakyll/Web/Template.hsdeleted−263
@@ -1,263 +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.Except (MonadError (..))
133−import Data.List (intercalate)
134−import Prelude hiding (id)
135−
136−
137−--------------------------------------------------------------------------------
138−import Hakyll.Core.Compiler
139−import Hakyll.Core.Identifier
140−import Hakyll.Core.Item
141−import Hakyll.Web.Template.Context
142−import Hakyll.Web.Template.Internal
143−
144−
145−--------------------------------------------------------------------------------
146−-- | Read a template, without metadata header
147−templateBodyCompiler :: Compiler (Item Template)
148−templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do
149− item <- getResourceBody
150− return $ fmap readTemplate item
151−
152−--------------------------------------------------------------------------------
153−-- | Read complete file contents as a template
154−templateCompiler :: Compiler (Item Template)
155−templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do
156− item <- getResourceString
157− return $ fmap readTemplate item
158−
159−
160−--------------------------------------------------------------------------------
161−applyTemplate :: Template -- ^ Template
162− -> Context a -- ^ Context
163− -> Item a -- ^ Page
164− -> Compiler (Item String) -- ^ Resulting item
165−applyTemplate tpl context item = do
166− body <- applyTemplate' tpl context item
167− return $ itemSetBody body item
168−
169−
170−--------------------------------------------------------------------------------
171−applyTemplate'
172− :: forall a.
173− Template -- ^ Template
174− -> Context a -- ^ Context
175− -> Item a -- ^ Page
176− -> Compiler String -- ^ Resulting item
177−applyTemplate' tpl context x = go tpl
178− where
179− context' :: String -> [String] -> Item a -> Compiler ContextField
180− context' = unContext (context `mappend` missingField)
181−
182− go = liftM concat . mapM applyElem . unTemplate
183−
184− ---------------------------------------------------------------------------
185−
186− applyElem :: TemplateElement -> Compiler String
187−
188− applyElem (Chunk c) = return c
189−
190− applyElem (Expr e) = applyExpr e >>= getString e
191−
192− applyElem Escaped = return "$"
193−
194− applyElem (If e t mf) = (applyExpr e >> go t) `catchError` handler
195− where
196− handler _ = case mf of
197− Nothing -> return ""
198− Just f -> go f
199−
200− applyElem (For e b s) = applyExpr e >>= \cf -> case cf of
201− StringField _ -> fail $
202− "Hakyll.Web.Template.applyTemplateWith: expected ListField but " ++
203− "got StringField for expr " ++ show e
204− ListField c xs -> do
205− sep <- maybe (return "") go s
206− bs <- mapM (applyTemplate' b c) xs
207− return $ intercalate sep bs
208−
209− applyElem (Partial e) = do
210− p <- applyExpr e >>= getString e
211− tpl' <- loadBody (fromFilePath p)
212− applyTemplate' tpl' context x
213−
214− ---------------------------------------------------------------------------
215−
216− applyExpr :: TemplateExpr -> Compiler ContextField
217−
218− applyExpr (Ident (TemplateKey k)) = context' k [] x
219−
220− applyExpr (Call (TemplateKey k) args) = do
221− args' <- mapM (\e -> applyExpr e >>= getString e) args
222− context' k args' x
223−
224− applyExpr (StringLiteral s) = return (StringField s)
225−
226− ----------------------------------------------------------------------------
227−
228− getString _ (StringField s) = return s
229− getString e (ListField _ _) = fail $
230− "Hakyll.Web.Template.applyTemplateWith: expected StringField but " ++
231− "got ListField for expr " ++ show e
232−
233−
234−--------------------------------------------------------------------------------
235−-- | The following pattern is so common:
236−--
237−-- > tpl <- loadBody "templates/foo.html"
238−-- > someCompiler
239−-- > >>= applyTemplate tpl context
240−--
241−-- That we have a single function which does this:
242−--
243−-- > someCompiler
244−-- > >>= loadAndApplyTemplate "templates/foo.html" context
245−loadAndApplyTemplate :: Identifier -- ^ Template identifier
246− -> Context a -- ^ Context
247− -> Item a -- ^ Page
248− -> Compiler (Item String) -- ^ Resulting item
249−loadAndApplyTemplate identifier context item = do
250− tpl <- loadBody identifier
251− applyTemplate tpl context item
252−
253−
254−--------------------------------------------------------------------------------
255−-- | It is also possible that you want to substitute @$key$@s within the body of
256−-- an item. This function does that by interpreting the item body as a template,
257−-- and then applying it to itself.
258−applyAsTemplate :: Context String -- ^ Context
259− -> Item String -- ^ Item and template
260− -> Compiler (Item String) -- ^ Resulting item
261−applyAsTemplate context item =
262− let tpl = readTemplate $ itemBody item
263− 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.yaml+27−6
@@ -1,12 +1,33 @@
1−resolver: lts-5.11
2−extra-deps: []
3−extra-package-dbs: []
1+resolver: lts-13.29
2+save-hackage-creds: false
43
54flags:
65 hakyll:
7− previewServer: True
8− watchServer: True
9− checkExternal: True
6+ previewServer: true
7+ watchServer: true
8+ checkExternal: true
9+ usePandoc: true
10+ buildWebsite: true
1011
1112packages:
1213 - '.'
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+13−5
@@ -10,13 +10,13 @@ import qualified Data.Text as T
1010import qualified Data.Yaml as Yaml
1111import Hakyll.Core.Metadata
1212import Hakyll.Core.Provider.Metadata
13−import Test.Framework (Test, testGroup)
14−import Test.HUnit (Assertion, (@=?))
13+import Test.Tasty (TestTree, testGroup)
14+import Test.Tasty.HUnit (Assertion, assertFailure, (@=?))
1515import TestSuite.Util
1616
1717
1818--------------------------------------------------------------------------------
19−tests :: Test
19+tests :: TestTree
2020tests = testGroup "Hakyll.Core.Provider.Metadata.Tests" $
2121 fromAssertions "page" [testPage01, testPage02]
2222
@@ -25,7 +25,7 @@ tests = testGroup "Hakyll.Core.Provider.Metadata.Tests" $
2525--------------------------------------------------------------------------------
2626testPage01 :: Assertion
2727testPage01 =
28− Right (meta [("foo", "bar")], "qux\n") @=? parsePage
28+ (meta [("foo", "bar")], "qux\n") `expectRight` parsePage
2929 "---\n\
3030 \foo: bar\n\
3131 \---\n\
@@ -35,7 +35,7 @@ testPage01 =
3535--------------------------------------------------------------------------------
3636testPage02 :: Assertion
3737testPage02 =
38− Right (meta [("description", descr)], "Hello I am dog\n") @=?
38+ (meta [("description", descr)], "Hello I am dog\n") `expectRight`
3939 parsePage
4040 "---\n\
4141 \description: A long description that would look better if it\n\
@@ -52,3 +52,11 @@ testPage02 =
5252--------------------------------------------------------------------------------
5353meta :: Yaml.ToJSON a => [(String, a)] -> Metadata
5454meta 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+4−5
@@ -8,14 +8,13 @@ module Hakyll.Core.Provider.Tests
88--------------------------------------------------------------------------------
99import Hakyll.Core.Metadata
1010import Hakyll.Core.Provider
11−import Test.Framework (Test, testGroup)
12−import Test.Framework.Providers.HUnit (testCase)
13−import Test.HUnit (Assertion, assert, (@=?))
11+import Test.Tasty (TestTree, testGroup)
12+import Test.Tasty.HUnit (Assertion, testCase, (@=?))
1413import TestSuite.Util
1514
1615
1716--------------------------------------------------------------------------------
18−tests :: Test
17+tests :: TestTree
1918tests = testGroup "Hakyll.Core.Provider.Tests"
2019 [ testCase "case01" case01
2120 ]
@@ -26,7 +25,7 @@ case01 :: Assertion
2625case01 = do
2726 store <- newTestStore
2827 provider <- newTestProvider store
29− assert $ resourceExists provider "example.md"
28+ True @=? resourceExists provider "example.md"
3029
3130 metadata <- resourceMetadata provider "example.md"
3231 Just "An example" @=? lookupString "title" metadata
tests/Hakyll/Core/Routes/Tests.hs+3−3
@@ -11,13 +11,13 @@ import Hakyll.Core.Identifier
1111import Hakyll.Core.Metadata
1212import Hakyll.Core.Routes
1313import System.FilePath ((</>))
14−import Test.Framework (Test, testGroup)
15−import Test.HUnit (Assertion, (@=?))
14+import Test.Tasty (TestTree, testGroup)
15+import Test.Tasty.HUnit (Assertion, (@=?))
1616import TestSuite.Util
1717
1818
1919--------------------------------------------------------------------------------
20−tests :: Test
20+tests :: TestTree
2121tests = testGroup "Hakyll.Core.Routes.Tests" $ fromAssertions "runRoutes"
2222 [ testRoutes "foo.html" (setExtension "html") "foo"
2323 , testRoutes "foo.html" (setExtension ".html") "foo"
tests/Hakyll/Core/Rules/Tests.hs+5−6
@@ -17,15 +17,14 @@ import Hakyll.Core.Metadata
1717import Hakyll.Core.Routes
1818import Hakyll.Core.Rules
1919import Hakyll.Core.Rules.Internal
20−import Hakyll.Web.Pandoc
2120import System.FilePath ((</>))
22−import Test.Framework (Test, testGroup)
23−import Test.HUnit (Assertion, assert, (@=?))
21+import Test.Tasty (TestTree, testGroup)
22+import Test.Tasty.HUnit (Assertion, (@=?))
2423import TestSuite.Util
2524
2625
2726--------------------------------------------------------------------------------
28−tests :: Test
27+tests :: TestTree
2928tests = testGroup "Hakyll.Core.Rules.Tests" $ fromAssertions "runRules"
3029 [case01]
3130
@@ -50,7 +49,7 @@ case01 = do
5049 checkRoute "example.mv1" (sv "mv1" "example.md")
5150 checkRoute "example.mv2" (sv "mv2" "example.md")
5251 checkRoute "food/example.md" (sv "metadataMatch" "example.md")
53− readIORef ioref >>= assert
52+ readIORef ioref >>= (True @=?)
5453 cleanTestEnv
5554 where
5655 sv g = setVersion (Just g)
@@ -75,7 +74,7 @@ rules01 ioref = do
7574 -- Compile some posts
7675 match "*.md" $ do
7776 route $ setExtension "html"
78− compile pandocCompiler
77+ compile copyFileCompiler
7978
8079 -- Yeah. I don't know how else to test this stuff?
8180 preprocess $ writeIORef ioref True
tests/Hakyll/Core/Runtime/Tests.hs+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+66−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,26 +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−- <https://ruudvanasseldonk.com/>,
108− [source](https://github.com/ruud-v-a/ruudvanasseldonk.com)
10995- <http://www.haskell.mn>,
11096 [source](https://github.com/HaskellMN/www.haskell.mn)
11197- <https://axiomatic.neophilus.net/>,
11298 [source](https://github.com/Libbum/AxiomaticSemantics)
113−- <https://tesser.org/>,
99+- [https://tesser.org/](http://web.archive.org/web/20161022221713/https://tesser.org/),
114100 [source](https://github.com/fractalcat/tesser.org)
115−- <https://wei2912.github.io/>,
116− [source](https://github.com/wei2912/blog_src)
101+- <https://weien.io/>,
102+  [source](https://github.com/wei2912/blog-src)
117103- <http://www.metasepi.org/>,
118104 [source](https://github.com/metasepi/metasepi-website)
119105- <http://gisli.hamstur.is/>,
120106 [source](https://github.com/gislik/gisli.hamstur.is)
121107- <http://blog.ssanj.net/>,
122108 [source](https://github.com/ssanj/babyloncandle)
123−- <https://rockymadden.com/>,
124− [source](https://github.com/rockymadden/rockymadden-web)
125−- <http://blog.dshevchenko.biz/>,
126− [source](https://github.com/denisshevchenko/blog)
127109- <http://ruhaskell.org/>,
128110 [source](https://github.com/ruHaskell/ruhaskell)
129111- <http://www.haskell.od.ua/>,
@@ -144,8 +126,64 @@ directly with the default Hakyll site.
144126 [source](https://github.com/ismailmustafa/ismailmustafa.github.io/tree/hakyll)
145127- <http://lettier.github.io/>,
146128 [source](https://github.com/lettier/lettier.github.io)
147−- <http://jozefg.bitbucket.org/>,
148− [source](https://github.com/jozefg/blog)
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)
149187
150188## Hakyll 3.X
151189
@@ -173,7 +211,5 @@ directly with the default Hakyll site.
173211 [source](http://gitorious.org/shakthimaan-blog)
174212- <http://www.alfredodinapoli.com/>,
175213 [source](https://github.com/CharlesStain/alfredodinapoli.com)
176−- <http://datahackermd.com>,
177− [source](http://github.com/akshayjshah/datahackermd)
178214- <http://michaelxavier.net>,
179215 [source](https://github.com/michaelxavier/michaelxavier.net)
web/libraries.markdown+1
@@ -18,3 +18,4 @@ Here is a list of the ones I know of (I would be happy to hear about others).
1818 a conversion tool from other blog engines to Hakyll.
1919- [hakyll-elm](https://hackage.haskell.org/package/hakyll-elm),
2020 Hakyll wrapper for the Elm compiler.
21+- [hakyll-sass](http://hackage.haskell.org/package/hakyll-sass), a compiler for SASS templates.
web/site.hs+25−39
@@ -1,19 +1,23 @@
11--------------------------------------------------------------------------------
22{-# LANGUAGE OverloadedStrings #-}
3−import Control.Arrow (second)
4−import Control.Monad (forM_)
5−import Data.Char (isDigit)
6−import Data.List (isPrefixOf, sortBy)
7−import Data.Monoid ((<>))
8−import Data.Ord (comparing)
3+import Control.Arrow (second)
4+import Control.Monad (filterM, forM_)
5+import Data.List (isPrefixOf, sortBy)
6+import Data.Monoid ((<>))
7+import Data.Ord (comparing)
98import Hakyll
10−import System.FilePath (dropTrailingPathSeparator, splitPath)
9+import System.Directory (copyFile)
10+import System.FilePath (dropTrailingPathSeparator, splitPath)
1111import Text.Pandoc
1212
1313
1414--------------------------------------------------------------------------------
1515main :: IO ()
1616main = hakyllWith config $ do
17+ -- Copy CHANGELOG.md here.
18+ preprocess $ copyFile "../CHANGELOG.md" "releases.markdown"
19+
20+ -- CSS
1721 match "css/*" $ do
1822 route idRoute
1923 compile compressCssCompiler
@@ -52,17 +56,11 @@ main = hakyllWith config $ do
5256 create ["tutorials.html"] $ do
5357 route idRoute
5458 compile $ do
55− tuts <-
59+ ctx <- tutorialsCtx <$>
5660 sortBy (comparing itemIdentifier) <$> loadAll "tutorials/*"
57−
58− let tutorialsCtx =
59− constField "title" "Tutorials" `mappend`
60− listField "tutorials" tutorialCtx (return tuts) `mappend`
61− defaultContext
62−
6361 makeItem ""
64− >>= loadAndApplyTemplate "templates/tutorials.html" tutorialsCtx
65− >>= loadAndApplyTemplate "templates/default.html" tutorialsCtx
62+ >>= loadAndApplyTemplate "templates/tutorials.html" ctx
63+ >>= loadAndApplyTemplate "templates/default.html" ctx
6664 >>= relativizeUrls
6765
6866 -- Templates
@@ -70,8 +68,7 @@ main = hakyllWith config $ do
7068 where
7169 withToc = defaultHakyllWriterOptions
7270 { writerTableOfContents = True
73− , writerTemplate = "$toc$\n$body$"
74− , writerStandalone = True
71+ , writerTemplate = Just "$toc$\n$body$"
7572 }
7673
7774
@@ -104,28 +101,17 @@ hackage url
104101 reverse $ splitPath url
105102
106103
107−--------------------------------------------------------------------------------
108−data TutorialType = SeriesTutorial | ArticlesTutorial | ExternalTutorial
109− deriving (Eq)
110−
111−
112104--------------------------------------------------------------------------------
113105-- | Partition tutorials into tutorial series, other articles, external articles
114−tutorialCtx :: Context String
115−tutorialCtx =
116− field "isSeries" (isTutorialType SeriesTutorial) <>
117− field "isArticle" (isTutorialType ArticlesTutorial) <>
118− field "isExternal" (isTutorialType ExternalTutorial) <>
106+tutorialsCtx :: [Item String] -> Context String
107+tutorialsCtx tuts =
108+ constField "title" "Tutorials" <>
109+ listField "main" defaultContext (ofType "main") <>
110+ listField "articles" defaultContext (ofType "article") <>
111+ listField "externals" defaultContext (ofType "external") <>
112+ listField "robertwpearce" defaultContext (ofType "robertwpearce") <>
119113 defaultContext
120114 where
121− getTutorialType item = do
122− mbExternal <- getMetadataField (itemIdentifier item) "external"
123− return $ case mbExternal of
124− Just _ -> ExternalTutorial
125− _ -> case splitPath (toFilePath $ itemIdentifier item) of
126− [_, (x : _)] -> if isDigit x then SeriesTutorial else ArticlesTutorial
127− _ -> ArticlesTutorial
128−
129− isTutorialType ty0 item = do
130− ty1 <- getTutorialType item
131− if ty0 == ty1 then return "yes" else fail "no"
115+ ofType ty = filterM (\item -> do
116+ mbType <- getMetadataField (itemIdentifier item) "type"
117+ return $ Just ty == mbType) tuts
web/templates/default.html+1−6
@@ -35,12 +35,7 @@
3535 <a href="/tutorials/faq.html">faq</a>
3636 <a href="/examples.html">examples</a>
3737 <a href="/releases.html">releases</a>
38−
39− <!-- Flattr button -->
40− <h1>Donate</h1>
41− <a href="https://flattr.com/thing/291889/Hakyll" target="_blank">
42− <img src="https://api.flattr.com/button/flattr-badge-large.png"
43− alt="Flattr this" title="Flattr this" border="0" /></a>
38+ <a href="https://jaspervdj.be/contact.html#donate" target="_blank">donate</a>
4439 </div>
4540
4641 <div id="content">
web/templates/tutorials.html+24−18
@@ -1,23 +1,19 @@
11<h1>Tutorials about Hakyll</h1>
22<h2 id="series">Tutorial series</h2>
33<ul>
4− $for(tutorials)$
5− $if(isSeries)$
6− <li>
7− <a href="$url$">$title$</a>
8− </li>
9− $endif$
4+ $for(main)$
5+ <li>
6+ <a href="$url$">$title$</a>
7+ </li>
108 $endfor$
119</ul>
1210<h2 id="articles">Other articles</h2>
1311<p>In no particular order:</p>
1412<ul>
15− $for(tutorials)$
16− $if(isArticle)$
17− <li>
18− <a href="$url$">$title$</a> by <em>$author$</em>
19− </li>
20− $endif$
13+ $for(articles)$
14+ <li>
15+ <a href="$url$">$title$</a> by <em>$author$</em>
16+ </li>
2117 $endfor$
2218</ul>
2319<h2 id="external-articles">External articles</h2>
@@ -28,12 +24,22 @@
2824</p>
2925<p>In no particular order:</p>
3026<ul>
31− $for(tutorials)$
32− $if(isExternal)$
33− <li>
34− <a href="$url$">$title$</a> by <em>$author$</em>
35− </li>
36− $endif$
27+ $for(externals)$
28+ <li>
29+ <a href="$url$">$title$</a> by <em>$author$</em>
30+ </li>
31+ $endfor$
32+</ul>
33+<h2 id="robertwpearce">Robert Pearce's series</h2>
34+<p>
35+ <a href="https://robertwpearce.com/">Robert Pearce</a> has been writing an
36+ excellent tutorial-style series on Hakyll as well. You can find those here:
37+</p>
38+<ul>
39+ $for(robertwpearce)$
40+ <li>
41+ <a href="$url$">$title$</a>
42+ </li>
3743 $endfor$
3844</ul>
3945<p>
web/tutorials/01-installation.markdown+6−2
@@ -1,6 +1,7 @@
11---
22title: Installation
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Installation
@@ -17,6 +18,8 @@ different distributions. For installation from source (i.e. via Hackage),
1718Linux distro packages:
1819
1920- [Debian unstable](http://packages.debian.org/source/sid/haskell-hakyll)
21+- [Fedora](https://apps.fedoraproject.org/packages/ghc-hakyll)
22+- [Nix](https://nixos.org/nixos/packages.html#hakyll): `$ nix-env -i hakyll`
2023
2124Building the example site
2225-------------------------
@@ -25,19 +28,20 @@ Apart from the main Hakyll library, the cabal package also provides you with an
2528executable `hakyll-init` to create an example site. This is an easy way to get
2629started:
2730
28− $ hakyll-init my-site
31+ $ stack exec hakyll-init my-site
2932
3033This creates a folder `my-site` in the current directory, with some example
3134content and a generic configuration.
3235
3336If `hakyll-init` is not found, you should make sure your stack bin path
3437(usually `$HOME/.local/bin`) is in your `$PATH`. You can check your stack local
35−bin path by running `stack path --local-bin-path`.
38+bin path by running `stack path --local-bin`.
3639
3740The file `site.hs` holds the configuration of your site, as an executable
3841haskell program. We can compile and run it like this:
3942
4043 $ cd my-site
44+ $ stack init # creates stack.yaml file based on my-site.cabal
4145 $ stack build
4246 $ stack exec site build
4347
web/tutorials/02-basics.markdown+1
@@ -1,6 +1,7 @@
11---
22title: The basics
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Building and cleaning
web/tutorials/03-rules-routes-compilers.markdown+1
@@ -1,6 +1,7 @@
11---
22title: Rules, routes and compilers
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Basic rules
web/tutorials/04-compilers.markdown+18−3
@@ -1,6 +1,7 @@
11---
22title: 'More on compilers: load, and templates'
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Loading items
@@ -92,7 +93,7 @@ And `$title$` like this:
9293titleContext :: Context a
9394titleContext = field "title" $ \item -> do
9495 metadata <- getMetadata (itemIdentifier item)
95− return $ fromMaybe "No title" $ M.lookup "title" metadata
96+ return $ fromMaybe "No title" $ lookupString "title" metadata
9697```
9798
9899And compose them using the `Monoid` instance:
@@ -130,7 +131,7 @@ postCtx =
130131### Loading and applying templates
131132
132133Now we know about templates, context and how to load arbitrary items. This gives
133−us enough background information in order to understand you can apply a
134+us enough background information in order to understand how you can apply a
134135template:
135136
136137```haskell
@@ -151,7 +152,7 @@ Control flow in templates
151152-------------------------
152153
153154Sometimes string interpolation does not suffice, and you want a little more
154−control over how your templates are layed out. Hakyll provides a few control
155+control over how your templates are laid out. Hakyll provides a few control
155156structures for this. The syntax for these structures was based on the syntax
156157used in pandoc templates, since Hakyll already has tight integration with
157158pandoc.
@@ -236,6 +237,20 @@ This uses the `$for(foo)$` construct. This construct allows you loop over a
236237list, in this case, `$posts$`. Inside the body of this for loop, all fields
237238refer to the current post, e.g.: `$url$`, `$title$` and `$date$`.
238239
240+You can also add a simple separator with the special `$sep$` field.
241+Everything between `$sep$` and `$endfor$` will be regarded as a separator
242+that will only be shown if there is more than one item in the list.
243+
244+```html
245+<ul>
246+ $for(posts)$
247+ $x$
248+ $sep$,
249+ $endfor$
250+</ul>
251+```
252+
253+
239254Of course, $posts$ does not magically appear. We have to specify this in
240255`site.hs`. Let's look at how `archive.html` is generated:
241256
web/tutorials/05-snapshots-feeds.markdown+1
@@ -1,6 +1,7 @@
11---
22title: Snapshots, and how to produce an RSS/Atom feed
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Basic feed configuration
web/tutorials/06-versions.markdown+1
@@ -1,6 +1,7 @@
11---
22title: Producing multiple versions of a single file
33author: Jasper Van der Jeugt
4+type: main
45---
56
67Basics
web/tutorials/a-guide-to-the-hakyll-module-zoo.markdown+1
@@ -1,6 +1,7 @@
11---
22title: A Guide to the Hakyll Module Zoo
33author: Brent Yorgey
4+type: article
45---
56
67The hakyll package [contains a bewildering array](/reference/) of modules, and
web/tutorials/external-add-tags-to-your-hakyll-blog.md+1−1
@@ -2,5 +2,5 @@
22title: Add tags to your Hakyll blog
33author: Javran Cheng
44url: https://javran.github.io/posts/2014-03-01-add-tags-to-your-hakyll-blog.html
5−external: true
5+type: external
66---
web/tutorials/external-blogger-port.mdnew file+6
@@ -0,0 +1,6 @@
1+---
2+title: Port an existing Blogger blog to Hakyll
3+author: Daniel Campoverde
4+url: 'http://www.sillybytes.net/posts/from_blogger_to_hakyll.html'
5+type: external
6+---
web/tutorials/external-cassius-template.mdnew file+6
@@ -0,0 +1,6 @@
1+---
2+title: Using Cassius templating with Hakyll
3+author: Daniel Campoverde
4+url: 'http://www.sillybytes.net/posts/using_hakyll_with_cassius.html'
5+type: external
6+---
web/tutorials/external-clean-urls-with-hakyll.md+1−1
@@ -2,5 +2,5 @@
22title: Clean URLs with Hakyll
33author: Rohan Jain
44url: http://www.rohanjain.in/hakyll-clean-urls/
5−external: true
5+type: external
66---
web/tutorials/external-deploying-with-widely.md+1−1
@@ -2,5 +2,5 @@
22title: Deploying with Widely
33author: Kyle Marek-Spartz
44url: http://kyle.marek-spartz.org/posts/2013-12-09-widely-and-hakyll.html
5−external: true
5+type: external
66---
web/tutorials/external-external-code-inclusion.mdnew file+6
@@ -0,0 +1,6 @@
1+---
2+title: 'External code inclusion with Hakyll'
3+author: 'Tobias Pleyer'
4+url: 'http://blog.tpleyer.de/posts/2019-04-21-external-code-inclusion-with-hakyll.html'
5+type: external
6+---
web/tutorials/external-functionfield.md+1−1
@@ -2,5 +2,5 @@
22title: Hakyll's functionField
33author: Beerend Lauwers
44url: http://beerendlauwers.be/posts/2015-09-21-hakylls-functionfield.html
5−external: true
5+type: external
66---
web/tutorials/external-github-pages-circle-ci.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.md+1−1
@@ -2,5 +2,5 @@
22title: Inlining and compressing CSS
33author: Kyle Marek-Spartz
44url: http://kyle.marek-spartz.org/posts/2014-12-09-hakyll-css-template-compiler.html
5−external: true
5+type: external
66---
web/tutorials/faq.markdown+1
@@ -1,6 +1,7 @@
11---
22title: FAQ
33author: Jasper Van der Jeugt
4+type: article
45---
56
67## "hGetContents: invalid argument" or "commitBuffer: invalid argument"
web/tutorials/github-pages-tutorial.md+10−3
@@ -1,6 +1,7 @@
11---
22title: Using Hakyll with GitHub Pages
33author: Erik Stevenson
4+type: article
45---
56
67## Introduction
@@ -86,7 +87,7 @@ stack exec myblog build
8687Update the local list of remote branches to ensure we're able to checkout the branch we want in the next step.
8788
8889```
89−git fetch -all
90+git fetch --all
9091```
9192
9293Switch to the `master` branch.
@@ -142,7 +143,7 @@ stack exec myblog clean
142143stack exec myblog build
143144
144145# Get previous files
145−git fetch -all
146+git fetch --all
146147git checkout -b master --track origin/master
147148
148149# Overwrite existing files with new files
@@ -168,7 +169,13 @@ git stash pop
168169Earlier 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`.
169170
170171```
171−rsync -a --filter='P _site/' --delete-excluded _site/ .
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/ .
172179```
173180
174181The 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