waletsec.github.io/site.hs at source · WaletSec/waletsec.github.io · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad
import Data.Char
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Semigroup
import Data.Traversable
import GHC.IO.Encoding (setLocaleEncoding, utf8)

import Data.Map (Map)
import qualified Data.Map.Strict as Map

import Hakyll

main :: IO ()
main = do
  setLocaleEncoding utf8
  hakyll do

    match "*.md" do
      route   $ setExtension "html"
      compile $ pandocCompiler
        >>= finalizeHtml datedCtx

    match "posts/*" do
      route $ setExtension "html"
      compile $ pandocCompiler
        >>= loadAndApplyTemplate "templates/post.html"  datedCtx
        >>= finalizeHtml datedCtx

    create ["archive.html"] do
      route idRoute
      compile do
        posts <- recentFirst =<< loadAll "posts/*"
        let
          archiveCtx =
            listField "posts" datedCtx (return posts) <>
            constField "title" "Archives"      <>
            defaultContext

        makeItem ""
          >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
          >>= finalizeHtml archiveCtx


    match "index.html" do
      route idRoute
      compile do
        posts <- recentFirst =<< loadAll "posts/*"
        let
          indexCtx =
            listField "posts" datedCtx (return posts) <>
            constField "title" "Home"        <>
            defaultContext

        getResourceBody
          >>= applyAsTemplate indexCtx
          >>= finalizeHtml indexCtx

    match "homebrew/**/*.md" do
      route $ setExtension "html"
      compile do
        metadata <- getMetadata =<< getUnderlying
        let system = fold $ lookupString "brew-system" metadata
            license = fold $ lookupString "brew-license" metadata
            string = systemLicenseString system license
            brewCtx = constField "systemandlicense" string <> datedCtx

        pandocCompiler
          >>= loadAndApplyTemplate "templates/homebrew.html" brewCtx
          >>= finalizeHtml brewCtx

    match "homebrew/index.html" do
      route $ setExtension "html"
      compile do
        indexes <- loadAll "homebrew/**/index.md"
        let ctx = mconcat
              [ listField "posts" datedCtx (return indexes)
              , constField "title" "Homebrew Material Index"
              , defaultContext
              ]

        getResourceBody
          >>= applyAsTemplate ctx
          >>= finalizeHtml ctx

    match "misc/*.html" do
      route idRoute
      compile $ getResourceBody
        >>= finalizeHtml datedCtx

    match ("images/*" .||. "js/*" .||. "*.html") do
      route   idRoute
      compile copyFileCompiler

    match "css/*" do
      route   idRoute
      compile compressCssCompiler

    match "templates/*" $ compile templateBodyCompiler


--------------------------------------------------------------------------------

finalizeHtml :: Context String -> Item String -> Compiler (Item String)
finalizeHtml ctx =
  loadAndApplyTemplate "templates/default.html" ctx
    >=> relativizeUrls

datedCtx :: Context String
datedCtx =
  dateField "date" "%B %-e, %Y" <>
  defaultContext

systemLicenseString :: String -> String -> String
systemLicenseString system license = let
  systemId = toLower <$> system
  systemName = fromMaybe system $ Map.lookup systemId knownSystems

  defaultLicense = if "dnd" `isPrefixOf` systemId
    then "under the Open Game License"
    else "with All Rights Reserved"
  licenseId = toLower <$> license
  licenseName = if null license
    then defaultLicense
    else "under " ++ (fromMaybe license $ Map.lookup licenseId knownLicenses)
  in unwords ["Content for the", systemName, "system; released", licenseName]

knownSystems :: Map String String
knownSystems = Map.fromList
  [ "dnd5e" .= "Dungeons & Dragons 5e"
  , "fate" .= "FATE"
  ]
  where (.=) = (,)

knownLicenses :: Map String String
knownLicenses = Map.fromList
  [ "ogl" .= "the Open Game License"
  , "cc" .= "CreativeCommons-Atrribution-ShareAlike (CC-BY-SA)"
  ]
  where (.=) = (,)