Browse Source

Trying to get declarative templates to work

wip2
keywordsalad 1 year ago
parent
commit
cdc9735f21
  1. 1
      .gitignore
  2. 3
      .gitmodules
  3. 1
      Brewfile
  4. 6
      Makefile
  5. 4
      README.md
  6. 5
      blog/2012-11-07-using-perforce-chronicle-for-application-configuration.md
  7. 7
      blog/2012-11-16-scm-backed-application-configuration-with-perforce.md
  8. 5
      blog/2012-11-20-app-config-app-in-action.md
  9. 5
      blog/2012-11-28-promoting-changes-with-app-config-app.md
  10. 5
      blog/2013-06-16-sterling-benchmarks.md
  11. 4
      blog/2013-06-17-sterling-with-memoization.md
  12. 4
      blog/2013-08-05-lessons-from-sterling.md
  13. 35
      commands.sh
  14. 13
      config.ini
  15. 1
      gh-pages
  16. 15
      index.html
  17. 0
      layouts/bare-content.html
  18. 25
      layouts/default.html
  19. 0
      layouts/drafts.html
  20. 5
      layouts/post.html
  21. 4
      layouts/skeleton.html
  22. 245
      logans-blog.cabal
  23. 2
      meta/robots.txt
  24. 0
      meta/sitemap.xml
  25. 7
      package.yaml
  26. 2
      pages/404.md
  27. 2
      pages/about-me.md
  28. 6
      pages/archives.md
  29. 7
      pages/blog.md
  30. 4
      pages/contact.md
  31. 7
      pages/drafts.md
  32. 7
      pages/index.md
  33. 7
      pages/resume.md
  34. 4
      partials/post.html
  35. 19
      partials/previous-posts.html
  36. 12
      partials/source-generated.html
  37. 8
      partials/teaser-list.html
  38. 0
      resume.md
  39. 43
      src/Site.hs
  40. 46
      src/Site/Common.hs
  41. 133
      src/Site/Compiler.hs
  42. 84
      src/Site/Compiler/Layout.hs
  43. 59
      src/Site/Compiler/Pandoc.hs
  44. 81
      src/Site/Config.hs
  45. 28
      src/Site/Configuration.hs
  46. 57
      src/Site/Context/Field.hs
  47. 23
      src/Site/Context/GitCommits.hs
  48. 4
      src/Site/Context/Post.hs
  49. 4
      src/Site/Context/Tag.hs
  50. 77
      src/Site/Metadata.hs
  51. 25
      src/Site/Route.hs
  52. 22
      src/Site/Rule.hs
  53. 31
      src/Site/Rule/Archive.hs
  54. 190
      src/Site/Rule/Blog.hs
  55. 23
      src/Site/Rule/Feed.hs
  56. 42
      src/Site/Rule/Index.hs
  57. 30
      src/Site/Rule/Page.hs
  58. 14
      src/Site/Rule/Robot.hs
  59. 33
      src/Site/Rule/Sitemap.hs
  60. 41
      src/Site/Util.hs
  61. 20
      templates/default.html
  62. 21
      test/Site/MetadataSpec.hs
  63. 34
      test/Site/RouteSpec.hs
  64. 81
      test/Site/SpecUtil.hs
  65. 22
      test/Site/UtilSpec.hs

1
.gitignore

@ -30,3 +30,4 @@ cabal.project.local~
project/
.bsp/
target/
_site/

3
.gitmodules

@ -1,3 +0,0 @@
[submodule "gh-pages"]
path = gh-pages
url = ssh://git@bitsof.thisfieldwas.green:2222/ThisFieldWasGreen/thisfieldwas.green.git

1
Brewfile

@ -3,4 +3,3 @@ tap "homebrew/core"
tap "sass/sass"
brew "haskell-stack"
brew "sass"
brew "make"

6
Makefile

@ -1,5 +1,3 @@
.ONESHELL:
build:
set -e; source commands.sh; build
.PHONY: build
@ -33,7 +31,5 @@ init:
.PHONY: init
test:
set -e
source commands.sh
test
set -e; source commands.sh; test
.PHONY: test

4
README.md

@ -14,11 +14,9 @@ make init
If this error occurs:
`hakyll> <command line>: can't load framework: Cocoa (not found)`
Follow [this workaround][] to build `macos11ghcwa.dylib` and then re-run the
Follow [this workaround](https://github.com/yairchu/macos11-haskell-workaround/) to build `macos11ghcwa.dylib` and then re-run the
command with the path to the library:
```
DYLD_INSERT_LIBRARIES="<PATH_TO>/macos11ghcwa.dylib" stack install hakyll
```
[this workaround]: https://github.com/yairchu/macos11-haskell-workaround/

5
blog/2012-11-07-using-perforce-chronicle-for-application-configuration.md

@ -1,11 +1,10 @@
---
content-templates: post
templates: default, skeleton
layout: post
title: "Using Perforce Chronicle for application configuration"
author: "Logan McGrath"
date: 2012-11-07T13:54:00-05:00
published: 2012-11-07T13:54:00-05:00
tags: Perforce, Configuration Management
published: true
---
Following Paul Hammant's post [App-config workflow using SCM][] and subsequent

7
blog/2012-11-16-scm-backed-application-configuration-with-perforce.md

@ -1,12 +1,11 @@
---
content-templates: post
templates: default, skeleton
layout: post
title: "SCM-Backed Application Configuration with Perforce"
author: "Logan McGrath"
date: 2012-11-16T07:00:00-05:00
published: 2012-11-16T07:00:00-05:00
comments: false
published: true
tags: SCM, [Perforce, Sinatra, AngularJS
tags: SCM, Perforce, Sinatra, AngularJS
---
Continuing from my [last post][], I've [forked][] Paul Hammant's original

5
blog/2012-11-20-app-config-app-in-action.md

@ -1,11 +1,10 @@
---
content-templates: post
templates: default, skeleton
layout: post
title: "App-Config-App in Action"
author: "Logan McGrath"
date: 2012-11-20T07:00:00-05:00
published: 2012-11-20T07:00:00-05:00
comments: false
published: true
tags: AngularJS, Perforce, SCM, Sinatra, Configuration Management
---

5
blog/2012-11-28-promoting-changes-with-app-config-app.md

@ -1,11 +1,10 @@
---
content-templates: post
templates: default, skeleton
layout: post
title: "Promoting changes with App-Config-App"
author: "Logan McGrath"
date: 2012-11-28T13:04:00-05:00
published: 2012-11-28T13:04:00-05:00
comments: false
published: true
tags: AngularJS, Perforce, SCM, Sinatra, Configuration Management
---

5
blog/2013-06-16-sterling-benchmarks.md

@ -1,10 +1,9 @@
---
content-templates: post
templates: default, skeleton
layout: post
title: "Sterling Benchmarks"
date: 2013-06-16T21:12:00-07:00
published: 2013-06-16T21:12:00-07:00
comments: false
published: false
tags: Functional Programming, Sterling, Language Design
---

4
blog/2013-06-17-sterling-with-memoization.md

@ -1,11 +1,9 @@
---
content-templates: post
templates: default, skeleton
layout: post
title: "Sterling With Memoization"
author: "Logan McGrath"
date: 2013-06-17T04:26:00-07:00
comments: false
published: false
tags: Sterling, Functional Programming, Language Design
---

4
blog/2013-08-05-lessons-from-sterling.md

@ -1,11 +1,9 @@
---
content-templates: post
templates: default, skeleton
layout: post
title: "Lessons from Sterling"
author: "Logan McGrath"
date: 2013-08-05T09:37:00-07:00
comments: false
published: false
tags: Sterling, Functional Programming, Language Design
---

35
commands.sh

@ -13,29 +13,18 @@ init () {
exit 1
fi
if [[ "$PATH" != *"$new_make_path"* ]]; then
echo
echo "A new version of make has been installed."
echo "Configure your \$PATH and rerun the command:"
echo
echo "export PATH=$new_make_path:\$PATH"
echo
exit 1
fi
echo
echo "Setup completed successfully"
echo
}
build () {
if [[ "$PATH" != *"$new_make_path"* ]]; then
echo "ERROR: Run `make init` first"
exit 1
if ! command -v stack &> /dev/null; then
init
fi
stack build
stack exec site build
stack exec logans-blog-exe build
}
clean () {
@ -45,7 +34,7 @@ clean () {
clean_all () {
clean
stack clean
rm -rf gh-pages/*
rm -rf _site/*
}
rebuild () {
@ -80,7 +69,7 @@ rebuild_all () {
watch () {
build
stack exec site watch
stack exec logans-blog-exe watch
}
publish () {
@ -94,18 +83,18 @@ publish () {
test_sync "main"
build
if [ ! -d _site ] || [ -z "$(ls -A _site)" ]; then
git clone --branch _site "$(git config --get remote.origin.url)" _site
fi
sha="$(git log -1 HEAD --pretty=format:%h)"
pushd ./gh-pages
test_sync "gh-pages"
pushd ./_site
test_sync "_site"
git add .
git commit -m "Build on $(date) generated from $sha"
git push origin "gh-pages"
git push origin "_site"
scp -r * thisfieldwas.green:/var/www/thisfieldwas.green/
popd
git add .
git commit -m "Update gh-pages generated from $sha"
git push origin main
}
test_sync () {

13
config.ini

@ -0,0 +1,13 @@
[site]
title = This Field Was Green
root = https://thisfieldwas.green
authorName = Logan McGrath
authorEmail = blog@thisfieldwas.green
gitWebUrl = https://bitsof.thisfieldwas.green/ThisFieldWasGreen/thisfieldwas.green
[hakyll]
destinationDirectory = _site
allowedFiles = .nojekyll
[feed]
description = ""

1
gh-pages

@ -1 +0,0 @@
Subproject commit 8da2b68dff5f0a5cbc5df201da55464b75d3d214

15
index.html

@ -1,15 +0,0 @@
---
templates: default, skeleton
---
<header class="banner">
<h1>This Field Was Green</h1>
<div class="logo"></div>
<h2>Logan McGrath's Online CV</h2>
</header>
<nav>
<a href="$route-to("index.html")$">Home</a>
<a href="$route-to("archives.html")$">Blog</a>
<a href="$route-to("about-me.md")$">About</a>
<a href="$route-to("resume.md")$">Resume</a>
<a href="$route-to("contact.md")$">Contact</a>
</nav>

0
templates/bare-content.html → layouts/bare-content.html

25
layouts/default.html

@ -0,0 +1,25 @@
---
layout: skeleton
---
<header>
<div class="logo">
<a href='$route-to("pages/index.md")$'><span class="logo-icon"></span></a>
<a href='$route-to("pages/index.md")$'>This Field Was Green</a>
</div>
<nav>
<a href='$route-to("pages/index.md")$'>Home</a>
<a href='$route-to("pages/blog.md")$'>Posts</a>
<a href='$route-to("pages/about-me.md")$'>About</a>
<a href='$route-to("pages/resume.md")$'>Resume</a>
<a href='$route-to("pages/contact.md")$'>Contact</a>
</nav>
</header>
<main>
<article>
<h1>$title$</h1>
$body$
</article>
</main>
$partial("partials/footer.html")$

0
templates/drafts.html → layouts/drafts.html

5
layouts/post.html

@ -0,0 +1,5 @@
---
layout: default
---
$partial("partials/post.html")$

4
templates/skeleton.html → layouts/skeleton.html

@ -8,9 +8,9 @@
$if(author)$<link rel="author" content="$author$">$endif$
<link rel="icon" href="/images/grass.svg">
<link rel="stylesheet" href="/css/main.css">
<script type="text/javascript" src="/js/main.js"></script>
<script src="/js/main.js"></script>
</head>
<body class="$bodyClass$">
<body class="$body-class$">
$body$
</body>
</html>

245
logans-blog.cabal

@ -1,10 +1,10 @@
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.33.0.
-- This file has been generated from package.yaml by hpack version 0.34.4.
--
-- see: https://github.com/sol/hpack
--
-- hash: 191703dc414ab1bd287bf779382554643ec3f1e3cbb5ac267f2ac16e38626088
-- hash: 4ff263d23fd9ae32c51eec9bb05b7a07df4dc4cd9c279246a0661dfcafc8268b
name: logans-blog
version: 0.1.0.0
@ -28,9 +28,11 @@ library
Site
Site.Common
Site.Compiler
Site.Configuration
Site.Compiler.Layout
Site.Compiler.Pandoc
Site.Config
Site.Context.Field
Site.Context.Git
Site.Context.GitCommits
Site.Context.Post
Site.Context.Tag
Site.Metadata
@ -39,7 +41,6 @@ library
Site.Rule.Archive
Site.Rule.Blog
Site.Rule.Feed
Site.Rule.Index
Site.Rule.Js
Site.Rule.Page
Site.Rule.Robot
@ -50,13 +51,55 @@ library
Paths_logans_blog
hs-source-dirs:
src
default-extensions: BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies TypeSynonymInstances ViewPatterns
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-type-patterns
default-extensions:
BangPatterns
BinaryLiterals
BlockArguments
ConstraintKinds
DataKinds
DefaultSignatures
DeriveDataTypeable
DeriveFoldable
DeriveFunctor
DeriveGeneric
DeriveTraversable
DerivingStrategies
DoAndIfThenElse
EmptyDataDecls
ExistentialQuantification
FlexibleContexts
FlexibleInstances
FunctionalDependencies
GADTs
GeneralizedNewtypeDeriving
InstanceSigs
KindSignatures
LambdaCase
MultiParamTypeClasses
MultiWayIf
NamedFieldPuns
OverloadedStrings
PartialTypeSignatures
PatternGuards
PatternSynonyms
PolyKinds
RankNTypes
RecordWildCards
ScopedTypeVariables
StandaloneDeriving
TemplateHaskell
TupleSections
TypeFamilies
TypeSynonymInstances
ViewPatterns
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Werror -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-type-patterns
build-depends:
MissingH ==1.4.*
, aeson ==1.5.*
, base >=4.7 && <5
, binary ==0.8.*
, bytestring ==0.*
, config-ini ==0.2.*
, containers ==0.6.*
, directory ==1.3.*
, filepath ==1.4.*
@ -64,12 +107,16 @@ library
, hjsmin ==0.2.*
, hspec ==2.7.*
, language-javascript ==0.7.*
, microlens ==0.4.*
, microlens-th ==0.4.*
, mtl ==2.2.*
, pandoc ==2.11.*
, pandoc-types ==1.22.*
, process ==1.6.*
, tagsoup ==0.14.*
, text ==1.2.*
, time ==1.9.*
, transformers ==0.5.*
, unordered-containers ==0.2.*
, utf8-string ==1.0.*
, vector ==0.12.*
@ -81,13 +128,95 @@ executable logans-blog-exe
Paths_logans_blog
hs-source-dirs:
app
default-extensions: BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies TypeSynonymInstances ViewPatterns BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies TypeSynonymInstances ViewPatterns
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-type-patterns -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-type-patterns
default-extensions:
BangPatterns
BinaryLiterals
BlockArguments
ConstraintKinds
DataKinds
DefaultSignatures
DeriveDataTypeable
DeriveFoldable
DeriveFunctor
DeriveGeneric
DeriveTraversable
DerivingStrategies
DoAndIfThenElse
EmptyDataDecls
ExistentialQuantification
FlexibleContexts
FlexibleInstances
FunctionalDependencies
GADTs
GeneralizedNewtypeDeriving
InstanceSigs
KindSignatures
LambdaCase
MultiParamTypeClasses
MultiWayIf
NamedFieldPuns
OverloadedStrings
PartialTypeSignatures
PatternGuards
PatternSynonyms
PolyKinds
RankNTypes
RecordWildCards
ScopedTypeVariables
StandaloneDeriving
TemplateHaskell
TupleSections
TypeFamilies
TypeSynonymInstances
ViewPatterns
BangPatterns
BinaryLiterals
BlockArguments
ConstraintKinds
DataKinds
DefaultSignatures
DeriveDataTypeable
DeriveFoldable
DeriveFunctor
DeriveGeneric
DeriveTraversable
DerivingStrategies
DoAndIfThenElse
EmptyDataDecls
ExistentialQuantification
FlexibleContexts
FlexibleInstances
FunctionalDependencies
GADTs
GeneralizedNewtypeDeriving
InstanceSigs
KindSignatures
LambdaCase
MultiParamTypeClasses
MultiWayIf
NamedFieldPuns
OverloadedStrings
PartialTypeSignatures
PatternGuards
PatternSynonyms
PolyKinds
RankNTypes
RecordWildCards
ScopedTypeVariables
StandaloneDeriving
TemplateHaskell
TupleSections
TypeFamilies
TypeSynonymInstances
ViewPatterns
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Werror -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-type-patterns -threaded -rtsopts -with-rtsopts=-N -Wall -Werror -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-type-patterns
build-depends:
MissingH ==1.4.*
, aeson ==1.5.*
, base >=4.7 && <5
, binary ==0.8.*
, bytestring ==0.*
, config-ini ==0.2.*
, containers ==0.6.*
, directory ==1.3.*
, filepath ==1.4.*
@ -96,12 +225,16 @@ executable logans-blog-exe
, hspec ==2.7.*
, language-javascript ==0.7.*
, logans-blog
, microlens ==0.4.*
, microlens-th ==0.4.*
, mtl ==2.2.*
, pandoc ==2.11.*
, pandoc-types ==1.22.*
, process ==1.6.*
, tagsoup ==0.14.*
, text ==1.2.*
, time ==1.9.*
, transformers ==0.5.*
, unordered-containers ==0.2.*
, utf8-string ==1.0.*
, vector ==0.12.*
@ -111,18 +244,100 @@ test-suite logans-blog-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
Site.MetadataSpec
Site.UtilSpec
Site.RouteSpec
Site.SpecUtil
Paths_logans_blog
hs-source-dirs:
test
default-extensions: BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies TypeSynonymInstances ViewPatterns BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies TypeSynonymInstances ViewPatterns
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-type-patterns -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-type-patterns
default-extensions:
BangPatterns
BinaryLiterals
BlockArguments
ConstraintKinds
DataKinds
DefaultSignatures
DeriveDataTypeable
DeriveFoldable
DeriveFunctor
DeriveGeneric
DeriveTraversable
DerivingStrategies
DoAndIfThenElse
EmptyDataDecls
ExistentialQuantification
FlexibleContexts
FlexibleInstances
FunctionalDependencies
GADTs
GeneralizedNewtypeDeriving
InstanceSigs
KindSignatures
LambdaCase
MultiParamTypeClasses
MultiWayIf
NamedFieldPuns
OverloadedStrings
PartialTypeSignatures
PatternGuards
PatternSynonyms
PolyKinds
RankNTypes
RecordWildCards
ScopedTypeVariables
StandaloneDeriving
TemplateHaskell
TupleSections
TypeFamilies
TypeSynonymInstances
ViewPatterns
BangPatterns
BinaryLiterals
BlockArguments
ConstraintKinds
DataKinds
DefaultSignatures
DeriveDataTypeable
DeriveFoldable
DeriveFunctor
DeriveGeneric
DeriveTraversable
DerivingStrategies
DoAndIfThenElse
EmptyDataDecls
ExistentialQuantification
FlexibleContexts
FlexibleInstances
FunctionalDependencies
GADTs
GeneralizedNewtypeDeriving
InstanceSigs
KindSignatures
LambdaCase
MultiParamTypeClasses
MultiWayIf
NamedFieldPuns
OverloadedStrings
PartialTypeSignatures
PatternGuards
PatternSynonyms
PolyKinds
RankNTypes
RecordWildCards
ScopedTypeVariables
StandaloneDeriving
TemplateHaskell
TupleSections
TypeFamilies
TypeSynonymInstances
ViewPatterns
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Werror -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-type-patterns -threaded -rtsopts -with-rtsopts=-N -Wall -Werror -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-type-patterns
build-depends:
MissingH ==1.4.*
, aeson ==1.5.*
, base >=4.7 && <5
, binary ==0.8.*
, bytestring ==0.*
, config-ini ==0.2.*
, containers ==0.6.*
, directory ==1.3.*
, filepath ==1.4.*
@ -131,12 +346,16 @@ test-suite logans-blog-test
, hspec ==2.7.*
, language-javascript ==0.7.*
, logans-blog
, microlens ==0.4.*
, microlens-th ==0.4.*
, mtl ==2.2.*
, pandoc ==2.11.*
, pandoc-types ==1.22.*
, process ==1.6.*
, tagsoup ==0.14.*
, text ==1.2.*
, time ==1.9.*
, transformers ==0.5.*
, unordered-containers ==0.2.*
, utf8-string ==1.0.*
, vector ==0.12.*

2
robots.txt → meta/robots.txt

@ -1,4 +1,4 @@
# Generated from commit $gitSha1$
# Generated from commit $git-sha1$
User-agent: *
Disallow: $site-root$/drafts/*
Sitemap: $site-root$/sitemap.xml

0
templates/sitemap.xml → meta/sitemap.xml

7
package.yaml

@ -14,7 +14,9 @@ description: Please see the README at <https://github.com/ThisFieldWasGreen/this
dependencies:
- base >= 4.7 && < 5
- aeson == 1.5.*
- binary == 0.8.*
- bytestring == 0.*
- config-ini == 0.2.*
- containers == 0.6.*
- directory == 1.3.*
- filepath == 1.4.*
@ -22,13 +24,17 @@ dependencies:
- hjsmin == 0.2.*
- hspec == 2.7.*
- language-javascript == 0.7.*
- microlens == 0.4.*
- microlens-th == 0.4.*
- MissingH == 1.4.*
- mtl == 2.2.*
- pandoc == 2.11.*
- pandoc-types == 1.22.*
- process == 1.6.*
- tagsoup == 0.14.*
- text == 1.2.*
- time == 1.9.*
- transformers == 0.5.*
- unordered-containers == 0.2.*
- utf8-string == 1.0.*
- vector == 0.12.*
@ -83,6 +89,7 @@ ghc-options: &ghc-options
- -rtsopts
- -with-rtsopts=-N
- -Wall
- -Werror
- -Wcompat
- -Widentities
- -Wincomplete-patterns

2
404.md → pages/404.md

@ -1,5 +1,7 @@
---
layout: default
title: "404 Not Found"
page-type: static
---
The resource you were looking for does not exist.

2
about-me.md → pages/about-me.md

@ -1,10 +1,10 @@
---
layout: default
title: "About"
date: 2015-01-23T11:42:00 PST
comments: false
sharing: true
footer: true
page-type: static
---
## About

6
templates/archives.html → pages/archives.md

@ -1,2 +1,8 @@
---
layout: default
title: "These Posts Were Green"
---
Here you can find all my previous posts:
$partial("partials/post-list.html")$

7
pages/blog.md

@ -0,0 +1,7 @@
---
layout: default
title: "This Blog Was Green"
---
$latest-post$
$partial("partials/previous-posts.html")$

4
contact.md → pages/contact.md

@ -1,5 +1,7 @@
---
title: Contact
layout: default
title: "Contact"
page-type: static
---
I live in a small hut in the mountains of Kumano Kodō on Kii Hantō and would not

7
pages/drafts.md

@ -0,0 +1,7 @@
---
layout: default
title: "These Drafts Are Still Green"
---
Here you can find all my drafts:
$partial("partials/post-list.html")$

7
pages/index.md

@ -0,0 +1,7 @@
---
layout: default
title: "Logan McGrath's Online CV"
page-type: static
---
TODO finish this

7
pages/resume.md

@ -0,0 +1,7 @@
---
layout: default
title: "Logan McGrath's Online CV"
page-type: static
---
TODO finish this

4
templates/post.html → partials/post.html

@ -1,12 +1,12 @@
<article class="post">
<header>
<h1>$title$</h1>
<em class="published">
<p class="published">
Posted on $date$
$if(author)$
by $author$
$endif$
</em>
</p>
</header>
$body$
</article>

19
partials/previous-posts.html

@ -0,0 +1,19 @@
<article class="previous-posts">
<header>
<h1>Previous Posts</h1>
</header>
$for(previous-posts)$
<section>
<header>
<h1>$title$</h1>
<p class="published">
Posted on $date$
$if(author)$
by $author$
$endif$
</p>
</header>
$demote-headers-by("1", teaser)$
</section>
$endfor$
</article>

12
partials/source-generated.html

@ -1,13 +1,13 @@
<p class="generated-from">
This page was generated
$if(isGenerated)$
$if(is-generated)$
from commit
$else$
from file <code><a href="$githubUrl$/blob/$gitSha1$/$path$">$path$</a></code>
at commit
from file <code><a href="$git-web-url$/blob/$git-sha1$/$path$">$path$</a></code>
and commit
$endif$
<a class="commit-link" href="$githubUrl$/commit/$gitSha1$">[$gitSha1$] $gitMessage$</a>
$if(isChanged)$
with local modifications
<a class="commit-link" href="$git-web-url$/commit/$git-sha1$">[$git-sha1$] $git-message$</a>
$if(is-changed)$
including local modifications
$endif$
</p>

8
partials/teaser-list.html

@ -1,11 +1,9 @@
<section class="teaser-list">
<header>
<h1>Previous Posts</h1>
</header>
$for(otherPosts)$
<h2>Previous Posts</h2>
$for(other-posts)$
<h3>$title$</h3>
$if(teaser)$
$teaser$
</article> $comment("teaser slices off closing tag")$
$endif$
<a href="$url$" class="read-more">Read more...</a>
$endfor$

0
resume.md

43
src/Site.hs

@ -1,29 +1,30 @@
module Site where
module Site (site) where
import Hakyll
import Site.Configuration
import Site.Context.Field
import Site.Context.Git
import qualified Data.Text as T
import Site.Common
import Site.Rule
import Site.Util
import System.Environment (getEnvironment)
site :: IO ()
site = do
env <- getEnvironment
hakyllWith hakyllConfiguration do
tags <- buildTags "blog/*" $ fromCapture "tags/*.html"
let baseCtx =
constField "bodyClass" "default"
<> tagsField "tags" tags
<> cleanIndexPaths "url"
<> mconcat gitCommitFields
<> imgField
<> includeCodeField
<> youtubeField
<> routeToField
<> commentField
<> siteRootField
<> defaultContext
configIniText <- T.pack <$> readFile "config.ini"
siteConfig <- case parseConfigIni env configIniText of
Left e -> fail e
Right config -> return $ config & siteContext %~ initContext config
hakyllWith (siteConfig ^. siteHakyllConfiguration) (rules siteConfig)
rules env baseCtx
initContext :: SiteConfig -> Context String -> Context String
initContext config context =
constField "body-class" "default"
<> constField "site-root" (config ^. siteRoot)
<> cleanIndexPaths "url"
<> gitCommits (config ^. siteGitWebUrl)
<> imgField
<> includeCodeField
<> youtubeField
<> routeToField
<> commentField
<> siteRootField config
<> demoteHeadersByField
<> context

46
src/Site/Common.hs

@ -1,24 +1,44 @@
module Site.Common
( module Hakyll,
( module Control.Applicative,
module Control.Monad,
module Data.Bool,
module Data.Foldable,
module Data.Functor,
module Data.Maybe,
module Hakyll,
module Lens.Micro,
module Lens.Micro.TH,
module Site.Config,
module Site.Compiler,
-- Control.Monad
join,
(>=>),
(<=<),
-- Data.Bool
bool,
-- Data.Functor
(<&>),
-- Data.Maybe
fromJust,
fromMaybe,
isJust,
module Site.Compiler.Layout,
module Site.Compiler.Pandoc,
module Site.Context.Field,
module Site.Context.GitCommits,
module Site.Context.Post,
module Site.Context.Tag,
module Site.Metadata,
module Site.Route,
module Site.Util,
)
where
import Control.Applicative ((<|>))
import Control.Monad (join, (<=<), (>=>))
import Data.Bool (bool)
import Data.Foldable (sequenceA_)
import Data.Functor ((<&>))
import Data.Maybe (fromJust, fromMaybe, isJust)
import Hakyll
import Lens.Micro hiding ((<&>))
import Lens.Micro.TH
import Site.Compiler
import Site.Compiler.Layout
import Site.Compiler.Pandoc
import Site.Config
import Site.Context.Field
import Site.Context.GitCommits
import Site.Context.Post
import Site.Context.Tag
import Site.Metadata
import Site.Route
import Site.Util

133
src/Site/Compiler.hs

@ -1,142 +1,19 @@
module Site.Compiler where
import Control.Monad.Except (catchError, (>=>))
import qualified Data.Aeson.Types as AT
import Data.List (foldl')
import Data.Maybe (isJust)
import Debug.Trace
import Control.Monad.Except (catchError)
import Hakyll
( Compiler,
Context,
Identifier,
Item (itemBody, itemIdentifier),
MonadMetadata (getMatches, getMetadata),
Pattern,
Snapshot,
applyAsTemplate,
defaultHakyllReaderOptions,
defaultHakyllWriterOptions,
fromFilePath,
getResourceBody,
loadAndApplyTemplate,
loadSnapshot,
pandocCompilerWithTransformM,
readPandocWith,
toFilePath,
writePandocWith,
)
import Site.Metadata
import Text.Pandoc.Highlighting (pygments)
import qualified Text.Pandoc.Options as Opt
applyContentTemplates ::
-- | the metadata config
PageMetadataConfig ->
-- | template context
Context String ->
-- | the item being compiled
Item String ->
-- | the newly constructed compiler
Compiler (Item String)
applyContentTemplates config =
applyTemplatesFromMetadata config contentTemplates
applyPageTemplates ::
-- | the metadata config
PageMetadataConfig ->
-- | template context
Context String ->
-- | the item being compiled
Item String ->
-- | the newly constructed compiler
Compiler (Item String)
applyPageTemplates config =
applyTemplatesFromMetadata config templates
applyTemplatesFromMetadata ::
-- | the metadata config
PageMetadataConfig ->
-- | the key to read templates from
(PageMetadata -> [String]) ->
-- | template context
Context String ->
-- | the item being compiled
Item String ->
-- | the newly constructed compiler
Compiler (Item String)
applyTemplatesFromMetadata config f ctx item = do
let id' = itemIdentifier item
metadata <- getMetadata id'
pageMetadata <- case AT.parse (parsePageMetadata config) metadata of
AT.Error s -> fail s
AT.Success pm -> return pm
applyTemplatesFromList (f pageMetadata) ctx item
applyTemplatesFromList ::
-- | the list of templates to apply
[String] ->
-- | template context
Context String ->
-- | the item being compiled
Item String ->
-- | the newly constructed compiler
Compiler (Item String)
applyTemplatesFromList templates ctx =
foldl' (>=>) pure templates'
where
templates' = toTemplate' <$> templates
toTemplate' t = loadAndApplyTemplate (templateId t) ctx
templateId t = fromFilePath $ "templates/" ++ t ++ ".html"
-- | Load an item snapshot if it exists.
maybeLoadSnapshot :: Identifier -> Snapshot -> Compiler (Maybe (Item String))
maybeLoadSnapshot id' snapshot =
catchError
(Just <$> loadSnapshot id' snapshot)
\_ -> return Nothing
-- | Loads all item snapshots that exist for items matching a given pattern
-- and snapshot name.
loadExistingSnapshots :: Pattern -> Snapshot -> Compiler [Item String]
loadExistingSnapshots pat snapshot = do
matching <- getMatches pat
results <- mapM (flip maybeLoadSnapshot $ snapshot) matching
results <- mapM (`maybeLoadSnapshot` snapshot) matching
return [x | Just x <- results]
pandocCompilerForCodeInsertion :: Item String -> Compiler (Item String)
pandocCompilerForCodeInsertion content = do
itemPandoc <- readPandocWith defaultHakyllReaderOptions content
itemPandoc' <- traverse return itemPandoc
return $ writePandocWith defaultHakyllWriterOptions itemPandoc'
interpolateResourceBody :: [(String, String)] -> Context String -> Compiler (Item String)
interpolateResourceBody env ctx =
getResourceBody
>>= applyAsTemplate ctx . maybeDebug env
>>= pandocCompilerForCodeInsertion
maybeDebug :: [(String, String)] -> Item String -> Item String
maybeDebug env item =
let sep = "=================================================\n"
y = toFilePath (itemIdentifier item) ++ sep
z = itemBody item ++ sep
in if isJust (lookup "SITE_DEBUG" env)
then trace (sep ++ y ++ z) item
else item
customPandocCompiler :: Compiler (Item String)
customPandocCompiler =
pandocCompilerWithTransformM readerOpts writerOpts return
readerOpts :: Opt.ReaderOptions
readerOpts =
defaultHakyllReaderOptions
{ Opt.readerExtensions = defaultExtensions <> customExtensions
}
where
defaultExtensions = Opt.readerExtensions defaultHakyllReaderOptions
customExtensions = Opt.extensionsFromList []
writerOpts :: Opt.WriterOptions
writerOpts =
defaultHakyllWriterOptions
{ Opt.writerHTMLMathMethod = Opt.MathJax "",
Opt.writerHighlightStyle = Just pygments
}

84
src/Site/Compiler/Layout.hs

@ -0,0 +1,84 @@
module Site.Compiler.Layout where
import Control.Monad ((<=<))
import Data.Binary as B
import Data.ByteString.Lazy as LBS
import GHC.Generics hiding (to)
import Hakyll
import Lens.Micro
import Lens.Micro.TH
import Site.Config
data Layout = Layout
{ _layoutStack :: [Item Template],
_layoutScripts :: [Item String],
_layoutStylesheets :: [Item String]
}
deriving stock (Generic)
makeLenses ''Layout
instance Binary Layout where
get = Layout <$> get <*> get <*> get
put layout =
put (layout ^. layoutStack)
>> put (layout ^. layoutScripts)
>> put (layout ^. layoutStylesheets)
instance Writable Layout where
write p = LBS.writeFile p . B.encode . itemBody
layoutContext :: SimpleGetter Layout (Context String)
layoutContext = to \layout ->
listField "scripts" context (return $ layout ^. layoutScripts)
<> listField "stylesheets" context (return $ layout ^. layoutStylesheets)
where
context = bodyField "src"
applyLayoutFromMetadata :: SiteConfig -> Item String -> Compiler (Item String)
applyLayoutFromMetadata config item = do
metadata <- getMetadata $ itemIdentifier item
maybeLayout <- sequence (loadLayout . fromLayoutName <$> lookupString "layout" metadata)
body <- getResourceBody
let f layout = applyLayout config layout body
maybe (return body) f maybeLayout
applyLayout :: SiteConfig -> Item Layout -> Item String -> Compiler (Item String)
applyLayout config layout = go templates
where
templates = itemBody <$> layout ^. to itemBody . layoutStack
context = bodyField "body" <> config ^. siteContext
go (t : ts) = go ts <=< applyTemplate t context
go [] = return
loadLayout :: Identifier -> Compiler (Item Layout)
loadLayout = load
layoutCompiler :: Compiler (Item Layout)
layoutCompiler = do
metadata <- getMetadata =<< getUnderlying
template <- makeItem =<< compileTemplateItem =<< getResourceBody
parent <- sequence (loadLayout . fromLayoutName <$> lookupString "layout" metadata)
let parentScripts = parentItems layoutScripts parent
scripts = parentScripts ++ toUrlItems (lookupStringList "scripts" metadata)
parentStylesheets = parentItems layoutStylesheets parent
stylesheets = parentStylesheets ++ toUrlItems (lookupStringList "stylesheets" metadata)
parentStack = parentItems layoutStack parent
stack = template : parentStack
makeItem
Layout
{ _layoutStack = stack,
_layoutScripts = scripts,
_layoutStylesheets = stylesheets
}
where
toUrlItems = maybe [] (fmap toUrlItem)
toUrlItem filePath = Item (fromFilePath filePath) (toUrl filePath)
parentItems lens' = maybe [] (^. to itemBody . lens')
fromLayoutName :: String -> Identifier
fromLayoutName name = fromFilePath ("layouts/" ++ name ++ ".html")

59
src/Site/Compiler/Pandoc.hs

@ -0,0 +1,59 @@
module Site.Compiler.Pandoc
( interpolateResourceBody,
compilePandocWith,
interpolateItem,
)
where
import Control.Monad ((>=>))
import Debug.Trace
import Hakyll
import Lens.Micro
import Site.Config
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (pygments)
import qualified Text.Pandoc.Options as Opt
pandocCompilerForCodeInsertion :: Item String -> Compiler (Item String)
pandocCompilerForCodeInsertion = compilePandocWith return
compilePandocWith :: (Item Pandoc -> Compiler (Item Pandoc)) -> Item String -> Compiler (Item String)
compilePandocWith f =
readPandocWith readerOpts
>=> f
>=> traverse return
>=> return . writePandocWith writerOpts
interpolateResourceBody :: SiteConfig -> Compiler (Item String)
interpolateResourceBody config =
interpolateItem config =<< getResourceBody
interpolateItem :: SiteConfig -> Item String -> Compiler (Item String)
interpolateItem config =
applyAsTemplate (config ^. siteContext) . printDebug config
>=> pandocCompilerForCodeInsertion
printDebug :: SiteConfig -> Item String -> Item String
printDebug config item =
let sep = "=================================================\n"
y = toFilePath (itemIdentifier item) ++ sep
z = itemBody item ++ sep
in if config ^. siteDebug
then trace (sep ++ y ++ z) item
else item
readerOpts :: Opt.ReaderOptions
readerOpts =
defaultHakyllReaderOptions
{ Opt.readerExtensions = defaultExtensions <> customExtensions
}
where
defaultExtensions = Opt.readerExtensions defaultHakyllReaderOptions
customExtensions = Opt.extensionsFromList []
writerOpts :: Opt.WriterOptions
writerOpts =
defaultHakyllWriterOptions
{ Opt.writerHTMLMathMethod = Opt.MathJax "",
Opt.writerHighlightStyle = Just pygments
}

81
src/Site/Config.hs

@ -0,0 +1,81 @@
module Site.Config where
import Control.Applicative ((<|>))
import Data.Ini.Config
import Data.Maybe (isJust)
import Data.String (IsString)
import Data.Text (Text)
import Hakyll
import Hakyll.Core.Configuration as HC
import Lens.Micro.TH
import System.FilePath
data SiteConfig = SiteConfig
{ _siteEnv :: [(String, String)],
_siteRoot :: String,
_siteTitle :: String,
_siteAuthorName :: String,
_siteAuthorEmail :: String,
_siteGitWebUrl :: String,
_sitePreview :: Bool,
_siteDebug :: Bool,
_siteHakyllConfiguration :: Configuration,
_siteFeedConfiguration :: FeedConfiguration,
_siteContext :: Context String
}
makeLenses ''SiteConfig
hasEnvFlag :: String -> [(String, String)] -> Bool
hasEnvFlag f e = isJust (lookup f e)
parseConfigIni :: [(String, String)] -> Text -> Either String SiteConfig
parseConfigIni env iniText = parseIniFile iniText do
feedDescription <- section "feed" $ fieldOf "description" string
hakyllConfiguration <- section "hakyll" do
destinationDir <- fieldOf "destinationDirectory" string
allowedFiles <- fieldOfStrings "allowedFiles"
return
HC.defaultConfiguration
{ destinationDirectory = destinationDir,
ignoreFile = customIgnoreFile allowedFiles
}
section "site" do
root <- fieldOf "root" string
title <- fieldOf "title" string
authorName <- fieldOf "authorName" string
authorEmail <- fieldOf "authorEmail" string
preview <- fieldDefOf "preview" flag False <|> pure (hasEnvFlag "SITE_PREVIEW" env)
debug <- fieldDefOf "debug" flag False <|> pure (hasEnvFlag "SITE_DEBUG" env)
gitWebUrl <- fieldOf "gitWebUrl" string
return
SiteConfig
{ _siteEnv = env,
_siteRoot = root,
_siteTitle = title,
_siteAuthorName = authorName,
_siteAuthorEmail = authorEmail,
_siteGitWebUrl = gitWebUrl,
_sitePreview = preview,
_siteDebug = debug,
_siteHakyllConfiguration = hakyllConfiguration,
_siteFeedConfiguration =
FeedConfiguration
{ feedTitle = title,
feedDescription = feedDescription,
feedAuthorName = authorName,
feedAuthorEmail = authorEmail,
feedRoot = root
},
_siteContext = defaultContext
}
where
customIgnoreFile allowedFiles path =
ignoreFile defaultConfiguration path && fileName `notElem` allowedFiles
where
fileName = takeFileName path
fieldOfStrings :: IsString a => Text -> SectionParser [a]
fieldOfStrings k = fieldDefOf k (listWithSeparator "," string) []

28
src/Site/Configuration.hs

@ -1,28 +0,0 @@
module Site.Configuration where
import Hakyll
import System.FilePath (takeFileName)
hakyllConfiguration :: Configuration
hakyllConfiguration =
defaultConfiguration
{ destinationDirectory = "gh-pages",
ignoreFile = customIgnoreFile
}
customIgnoreFile :: FilePath -> Bool
customIgnoreFile path =
ignoreFile defaultConfiguration path && fileName `notElem` allowedFiles
where
fileName = takeFileName path
allowedFiles = [".nojekyll"]
feedConfig :: String -> FeedConfiguration
feedConfig siteRoot =
FeedConfiguration
{ feedTitle = "This Field Was Green",
feedDescription = "",
feedAuthorName = "Logan McGrath",
feedAuthorEmail = "blog@thisfieldwas.green",
feedRoot = siteRoot
}

57
src/Site/Context/Field.hs

@ -1,26 +1,38 @@
module Site.Context.Field where
module Site.Context.Field
( siteRootField,
includeCodeField,
imgField,
youtubeField,
routeToField,
commentField,
demoteHeadersByField,
)
where
import Site.Common
import Control.Monad ((>=>))
import Hakyll hiding (demoteHeaders)
import Lens.Micro
import Site.Config (SiteConfig, siteRoot)
import Site.Util
siteRootField :: Context String
siteRootField = field "site-root" siteRoot
where
siteRoot = fmap (toSiteRoot . fromJust) . getRoute . itemIdentifier
siteRootField :: SiteConfig -> Context String
siteRootField config = constField "site-root" (config ^. siteRoot)
includeCodeField :: Context String
includeCodeField = functionField "include-code" f
includeCodeField = functionField fieldName f
where
f [lexer, contentsPath] _ = fmap wrapCode body
fieldName = "include-code"
f [lexer, contentsPath] _ = wrapCode <$> body
where
wrapCode code = "``` " ++ lexer ++ "\n" ++ code ++ "\n```"
body = loadSnapshotBody item "code"
item = fromFilePath $ "code/" ++ contentsPath
f _ item = error $ "codeIncludeField needs a filepath and a lexer " ++ show (itemIdentifier item)
f _ item = error $ fieldName ++ " needs a filepath and a lexer " ++ show (itemIdentifier item)
imgField :: Context String
imgField = functionField "img" f
imgField = functionField fieldName f
where
fieldName = "img"
f [path] = f [path, "untitled"]
f [path, title] = f [path, title, title]
f [path, title, alt] =
@ -30,13 +42,13 @@ imgField = functionField "img" f
<> constField "img-title" title
<> constField "img-alt" alt
)
>=> relativizeUrls
>=> return . itemBody
f _ = \item -> error $ "imgField needs an image source and optionally a title " ++ show (itemIdentifier item)
f _ = \item -> error $ fieldName ++ " needs an image source and optionally a title " ++ show (itemIdentifier item)
youtubeField :: Context String
youtubeField = functionField "youtube" f
youtubeField = functionField fieldName f
where
fieldName = "youtube"
f [videoId] = f [videoId, "YouTube video player"]
f [videoId, title] =
loadAndApplyTemplate
@ -44,21 +56,28 @@ youtubeField = functionField "youtube" f
( constField "youtube-id" videoId
<> constField "youtube-title" title
)
>=> relativizeUrls
>=> return . itemBody
f _ = \item -> error $ "youtubeField needs a youtube video id and optionally a title " ++ show (itemIdentifier item)
f _ = \item -> error $ fieldName ++ " needs a youtube video id and optionally a title " ++ show (itemIdentifier item)
routeToField :: Context String
routeToField = functionField "route-to" f
routeToField = functionField fieldName f
where
fieldName = "route-to"
f [filePath] item = do
getRoute id' >>= \case
Just r -> return ("/" ++ stripSuffix "index.html" r)
Nothing -> error $ "routeField in " ++ show fromId ++ ": no route to " ++ show id'
Just route' -> return $ "/" ++ stripSuffix "index.html" route'
Nothing -> error $ fieldName ++ " in " ++ show fromId ++ ": no route to " ++ show id'
where
id' = fromFilePath filePath
fromId = itemIdentifier item
f _ item = error $ "routeField needs a filePath " ++ show (itemIdentifier item)
f _ item = error $ fieldName ++ " needs a filePath " ++ show (itemIdentifier item)
commentField :: Context String
commentField = functionField "comment" \_ _ -> return ""
demoteHeadersByField :: Context String
demoteHeadersByField = functionField fieldName f
where
fieldName = "demote-headers-by"
f [amount, content] _ = return $ demoteHeadersBy (read amount :: Int) content
f _ item = error $ fieldName ++ " requires a reduction amount and content " ++ show (itemIdentifier item)

23
src/Site/Context/Git.hs → src/Site/Context/GitCommits.hs

@ -1,19 +1,20 @@
module Site.Context.Git (gitCommitFields) where
module Site.Context.GitCommits (gitCommits) where
import Site.Common
import Data.Bool (bool)
import Data.Maybe (fromJust, isJust)
import Hakyll
import System.Directory (doesFileExist)
import System.Exit
import System.Process
gitCommitFields :: [Context String]
gitCommitFields =
[ constField "githubUrl" "https://github.com/ThisFieldWasGreen/thisfieldwasgreen.github.io",
field "gitSha1" gitSha1Compiler,
field "gitMessage" gitMessageCompiler,
field "isChanged" isChangedCompiler,
field "isGenerated" isGeneratedCompiler,
field "gitBranch" gitBranchCompiler
]
gitCommits :: String -> Context String
gitCommits gitWebUrl =
constField "git-web-url" gitWebUrl
<> field "git-sha1" gitSha1Compiler
<> field "git-message" gitMessageCompiler
<> field "is-changed" isChangedCompiler
<> field "is-generated" isGeneratedCompiler
<> field "git-branch" gitBranchCompiler
itemSourcePath :: Item a -> FilePath
itemSourcePath item = toFilePath (itemIdentifier item)

4
src/Site/Context/Post.hs

@ -2,6 +2,6 @@ module Site.Context.Post where
import Hakyll
postCtx :: Context String
postCtx =
postContext :: Context String
postContext =
dateField "date" "%B %e, %Y"

4
src/Site/Context/Tag.hs

@ -2,5 +2,5 @@ module Site.Context.Tag where
import Hakyll
buildTagsCtx :: Tags -> Context String
buildTagsCtx = tagsField "tags"
buildTagsContext :: Tags -> Context String
buildTagsContext = tagsField "tags"

77
src/Site/Metadata.hs

@ -1,76 +1,9 @@
module Site.Metadata where
import Control.Applicative ((<|>))
import Data.Aeson
import Data.Aeson.Types
import Data.String.Utils as S
import qualified Data.Text as T
import Data.Time
( UTCTime,
defaultTimeLocale,
iso8601DateFormat,
parseTimeM,
)
import GHC.Generics
import Hakyll
data PageMetadata =