forked from ucsd-progsys/liquidhaskell-blog
-
Notifications
You must be signed in to change notification settings - Fork 0
/
blog.hs
192 lines (168 loc) · 6.74 KB
/
blog.hs
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
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
import Text.Pandoc
import Data.Maybe (fromMaybe)
import Data.Monoid (mappend)
import Hakyll
import System.FilePath ( (</>), (<.>)
, splitExtension, splitFileName
, takeDirectory )
import Data.Typeable
tagItems :: Tags -> [Item String]
tagItems tags = [ Item "tag" s | (s,_) <- tagsMap tags]
where
f = tagsMakeId tags
tagCtx :: Context String
tagCtx = field "tag" (return . itemBody)
--------------------------------------------------------------------------------
main :: IO ()
main = hakyll $ do
copyStatic
makePosts >>= makeBlog
makeAbout
makeArchive
makeIndex
makeTemplates
makeAtom
copyStatic =
match "static/*/*" $ do
route idRoute
compile copyFileCompiler
makePosts = do
-- build up tags
tags <- buildTags "posts/*" (fromCapture "tags/*.html")
makeTags tags
match "posts/*" $ do
route $ setExtension "html" `composeRoutes`
dateFolders `composeRoutes`
dropPostsPrefix `composeRoutes`
appendIndex
compile $ pandocCompiler
>>= loadAndApplyTemplate "templates/post.html" (postCtxWithTags tags)
>>= saveSnapshot "content"
>>= loadAndApplyTemplate "templates/default.html" (postCtxWithTags tags)
>>= relativizeUrls
return tags
makeTags tags =
tagsRules tags $ \tag pattern -> do
let title = "Posts tagged \"" ++ tag ++ "\""
route idRoute
compile $ do
posts <- recentFirst =<< loadAll pattern
let ctx = constField "title" title
`mappend` listField "posts" postCtx (return posts)
`mappend` pageCtx
makeItem ""
>>= loadAndApplyTemplate "templates/tags.html" ctx
>>= loadAndApplyTemplate "templates/default.html" ctx
>>= relativizeUrls
makeAbout =
match "about.md" $ do
route $ setExtension "html"
compile $ pandocCompiler
>>= loadAndApplyTemplate "templates/page.html" siteCtx
>>= loadAndApplyTemplate "templates/default.html" siteCtx
>>= relativizeUrls
makeBlog tags =
match "blog.md" $ do
let tags' = tagItems tags
route $ setExtension "html"
compile $ do
posts <- (fmap (take 5) . recentFirst) =<< loadAll "posts/*"
let blogCtx = listField "posts" postCtx (return posts) `mappend`
listField "tags" tagCtx (return tags') `mappend`
pageCtx
pandocCompiler
>>= loadAndApplyTemplate "templates/blog.html" blogCtx
>>= loadAndApplyTemplate "templates/default.html" blogCtx
>>= relativizeUrls
makeArchive =
match "archive.md" $ do
route $ setExtension "html"
compile $ do
posts <- recentFirst =<< loadAll "posts/*"
let ctx = listField "posts" postCtx (return posts) `mappend`
pageCtx
pandocCompiler
>>= loadAndApplyTemplate "templates/archive.html" ctx
>>= loadAndApplyTemplate "templates/default.html" ctx
>>= relativizeUrls
makeIndex =
match "index.md" $ do
route $ setExtension "html"
compile $
pandocCompiler -- makeItem ""
>>= loadAndApplyTemplate "templates/index.html" pageCtx
>>= loadAndApplyTemplate "templates/default.html" pageCtx
>>= relativizeUrls
makeTemplates =
match "templates/*" $ compile templateCompiler
makeAtom =
create ["atom.xml"] $ do
route idRoute
compile $ do
let feedCtx = postCtx `mappend` bodyField "description"
posts <- fmap (take 10) . recentFirst =<<
loadAllSnapshots "posts/*" "content"
renderAtom myFeedConfiguration feedCtx posts
myFeedConfiguration :: FeedConfiguration
myFeedConfiguration = FeedConfiguration
{ feedTitle = "LiquidHaskell Blog"
, feedDescription = "This feed provides recipes for safe code!"
, feedAuthorName = "Ranjit Jhala"
, feedAuthorEmail = "rjhala@eng.ucsd.edu"
, feedRoot = "https://ucsd-progsys.github.io/liquidhaskell-blog"
}
appendIndex :: Routes
appendIndex = customRoute $ (\(p, e) -> p </> "index" <.> e) . splitExtension . toFilePath
transform :: String -> String
transform url = case splitFileName url of
(p, "index.html") -> takeDirectory p
_ -> url
dropIndexHtml :: String -> Context a
dropIndexHtml key = mapContext transform (urlField key)
where
transform url = case splitFileName url of
(p, "index.html") -> takeDirectory p
_ -> url
dateFolders :: Routes
dateFolders =
gsubRoute "/[0-9]{4}-[0-9]{2}-[0-9]{2}-" $ replaceAll "-" (const "/")
dropPostsPrefix :: Routes
dropPostsPrefix = gsubRoute "posts/" $ const ""
--------------------------------------------------------------------------------
postCtxWithTags :: Tags -> Context String
postCtxWithTags tags =
tagsField "tags" tags `mappend`
postCtx
postCtx :: Context String
postCtx =
dateField "date" "%b %e, %Y" `mappend`
dropIndexHtml "url" `mappend`
siteCtx
pageCtx :: Context String
pageCtx =
constField "demo" "SimpleRefinements.hs" `mappend`
dropIndexHtml "url" `mappend`
siteCtx
-- http://goto.ucsd.edu:8090/index.html#?demo=ANF.hs
siteCtx :: Context String
siteCtx =
-- constField "baseUrl" "http://localhost:8000" `mappend`
constField "baseUrl" "https://ucsd-progsys.github.io/liquidhaskell-blog" `mappend`
constField "demoUrl" "http://goto.ucsd.edu:8090/index.html#?demo=" `mappend`
constField "tutorialUrl" "http://ucsd-progsys.github.io/lh-workshop" `mappend`
constField "bookUrl" "http://ucsd-progsys.github.io/liquidhaskell-tutorial" `mappend`
constField "codeUrl" "http://www.github.com/ucsd-progsys/liquidhaskell" `mappend`
constField "site_name" "LiquidHaskell" `mappend`
constField "site_description" "LiquidHaskell Blog" `mappend`
constField "site_username" "Ranjit Jhala" `mappend`
constField "twitter_username" "ranjitjhala" `mappend`
constField "github_username" "ucsd-progsys" `mappend`
constField "google_username" "rjhala@eng.ucsd.edu" `mappend`
constField "google_userid" "u/0/106612421534244742464" `mappend`
-- constField "demo" "SimpleRefinements.hs" `mappend`
constField "headerImg" "sea.jpg" `mappend`
constField "summary" "todo" `mappend`
constField "disqus_short_name" "liquidhaskell" `mappend`
defaultContext