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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
|
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (msum)
import Control.Monad.Fail (MonadFail)
import Data.Time (TimeLocale, formatTime, parseTimeM, defaultTimeLocale, UTCTime)
import Hakyll
import System.FilePath.Posix ((</>), (<.>), splitExtension, splitFileName, takeDirectory)
main :: IO ()
main = hakyllWith hakyllConfig $ do
match ("images/*" .||. "files/*" .||. "robots.txt" .||. "health") $ do
route idRoute
compile copyFileCompiler
match "css/*" $ do
route idRoute
-- WORKAROUND: compressCssCompiler removes copyright notices
compile copyFileCompiler
match (fromList ["about.md", "contact.md", "privacy.md"]) $ do
route $ setExtension "html" `composeRoutes` appendIndex
let context = dropIndexHtml "url" <> defaultContext
compile $ pandocCompiler
>>= loadAndApplyTemplate "templates/direct.html" context
>>= loadAndApplyTemplate "templates/default.html" context
>>= relativizeUrls
match "posts/*" $ do
route $ setExtension "html" `composeRoutes` appendIndex
compile $ pandocCompiler
>>= loadAndApplyTemplate "templates/post.html" postContext
>>= saveSnapshot "content"
>>= loadAndApplyTemplate "templates/default.html" postContext
>>= relativizeUrls
create ["posts.html"] $ do
route appendIndex
compile $ do
posts <- recentFirst =<< loadAll "posts/*"
let archiveContext =
listField "posts" postContext (return posts) <>
constField "title" "Blog" <>
dropIndexHtml "url" <>
defaultContext
makeItem ""
>>= loadAndApplyTemplate "templates/posts.html" archiveContext
>>= loadAndApplyTemplate "templates/default.html" archiveContext
>>= relativizeUrls
create ["feeds/posts.rss"] $ do
route idRoute
compileFeed renderRss rfc822DateTimeFormat
create ["feeds/posts.atom"] $ do
route idRoute
compileFeed renderAtom rfc3339DateTimeFormat
create ["sitemap.xml"] $ do
route idRoute
compile $ do
posts <- recentFirst =<< loadAll "posts/*"
singles <- loadAll (fromList ["about.md", "contact.md", "privacy.md", "posts.html"])
let
pages = posts <> singles
sitemapContext =
constField "root" root <>
listField "pages" postContext (return pages)
makeItem ""
>>= loadAndApplyTemplate "templates/sitemap.xml" sitemapContext
match "index.html" $ do
route idRoute
compile $ do
posts <- recentFirst =<< loadAll "posts/*"
let indexContext =
listField "posts" postContext (return posts) <>
defaultContext
getResourceBody
>>= applyAsTemplate indexContext
>>= loadAndApplyTemplate "templates/default.html" indexContext
-- >>= relativizeUrls
match "404.html" $ do
route idRoute
compile $ pandocCompiler
>>= loadAndApplyTemplate "templates/default.html" defaultContext
>>= relativizeUrls
match "templates/*" $ compile templateBodyCompiler
hakyllConfig :: Configuration
hakyllConfig = defaultConfiguration
{ previewPort = 8080
, deployCommand = "./deploy"
}
postContext :: Context String
postContext =
constField "root" root <>
dateField "date" "%-e %B %Y" <>
dateField "formalDate" "%Y-%m-%d" <>
dropIndexHtml "url" <>
defaultContext
appendIndex :: Routes
appendIndex =
customRoute $ append . splitExtension . toFilePath
where append (path, extension) = path </> "index" <.> extension
dropIndexHtml :: String -> Context a
dropIndexHtml key = mapContext transform (urlField key)
where
transform url = case splitFileName url of
(p, "index.html") -> takeDirectory p <> "/"
_ -> url
root :: String
root = "https://www.skreutz.com"
feedConfiguration :: FeedConfiguration
feedConfiguration = FeedConfiguration
{ feedTitle = "Stefan Kreutz' Blog"
, feedDescription = "Random bits from a passionate software engineer."
, feedAuthorName = "Stefan Kreutz"
, feedAuthorEmail = "mail@skreutz.com"
, feedRoot = root
}
type FeedRenderer = FeedConfiguration -> Context String -> [Item String] -> Compiler (Item String)
-- | Compile a feed of posts with a given time format.
compileFeed :: FeedRenderer -> [Char] -> Rules ()
compileFeed render format = compile $ do
let feedContext =
-- Format built-in fields @published@ and @updated@.
-- TODO: Consider to vendor hakyll.
updatedField format <>
dateField "published" format <>
bodyField "description" <>
postContext
posts <- fmap (take 100) . recentFirst =<<
loadAllSnapshots "posts/*" "content"
render feedConfiguration feedContext posts
-- | RFC 822 compliant date and time format.
--
-- This format string differs in two ways from
-- 'Data.Time.Format.rfc822DateFormat' from package time-1.10. First, it padds
-- days with zeros instead of spaces. Second, it uses the offset of the time
-- zone instead of its name because RFC 822 does not define common time zone
-- names like UTC. See
-- https://validator.w3.org/feed/docs/warning/ProblematicalRFC822Date.html
rfc822DateTimeFormat :: String
rfc822DateTimeFormat = "%a, %d %b %Y %H:%M:%S %z"
-- | RFC 3339 compliant date and time format.
rfc3339DateTimeFormat :: String
rfc3339DateTimeFormat = "%Y-%m-%dT%H:%M:%S%EZ"
-- | Format field @updated@.
--
-- Copied from Hakyll's 'dateFieldWith'. Falls back to field @published@.
updatedFieldWith
:: TimeLocale -- ^ Output time locale
-> String -- ^ Format to use on the date
-> Context a -- ^ Resulting context
updatedFieldWith locale format = field "updated" $ \i -> do
time <- getUpdatedUTC locale $ itemIdentifier i
return $ formatTime locale format time
-- | Format field @updated@.
--
-- Copied from Hakyll's 'dateField'. Falls back to field @published@.
updatedField
:: String -- ^ Format to use on the date
-> Context a -- ^ Resulting context
updatedField = updatedFieldWith defaultTimeLocale
-- | Parse field @updated@.
--
-- Copied from Hakyll's 'getItemUTC'. Falls back to field @published@.
getUpdatedUTC
:: (MonadMetadata m, MonadFail m)
=> TimeLocale -- ^ Output time locale
-> Identifier -- ^ Input page
-> m UTCTime -- ^ Parsed UTCTime
getUpdatedUTC locale id' = do
metadata <- getMetadata id'
let tryField k fmt = lookupString k metadata >>= parseTime' fmt
maybe empty' return $ msum $
[ tryField "updated" fmt | fmt <- formats ] ++
[ tryField "published" fmt | fmt <- formats ]
where
empty' = fail $ "getUpdatedUTC: could not parse time for " ++ show id'
parseTime' = parseTimeM True locale
formats =
[ "%a, %d %b %Y %H:%M:%S %Z"
, "%a, %d %b %Y %H:%M:%S"
, "%Y-%m-%dT%H:%M:%S%Z"
, "%Y-%m-%dT%H:%M:%S"
, "%Y-%m-%d %H:%M:%S%Z"
, "%Y-%m-%d %H:%M:%S"
, "%Y-%m-%d"
, "%B %e, %Y %l:%M %p"
, "%B %e, %Y"
, "%b %d, %Y"
]
|