render tags on archive page
[software/elephly-net.git] / site.hs
1 --------------------------------------------------------------------------------
2 {-# LANGUAGE OverloadedStrings #-}
3 import Control.Applicative ((<$>))
4 import Data.Monoid ((<>))
5 import Hakyll
6 import Data.Map as M
7 import qualified Data.Set as S
8 import Data.Maybe (fromMaybe)
9 import Text.Pandoc.Options
10
11 config :: Configuration
12 config = defaultConfiguration
13 { deployCommand =
14 "rsync -Havz _site/ rekado@elephly.net:/srv/disk1/rekado/elephly.net" }
15
16 myFeedConfiguration :: FeedConfiguration
17 myFeedConfiguration = FeedConfiguration
18 { feedTitle = "Rekado's website"
19 , feedDescription = "Music, words, and hacking"
20 , feedAuthorName = "Rekado"
21 , feedAuthorEmail = "rekado+feed@elephly.net"
22 , feedRoot = "http://elephly.net"
23 }
24
25 --------------------------------------------------------------------------------
26 main :: IO ()
27 main = hakyllWith config $ do
28 tags <- buildTags "posts/*.markdown" (fromCapture "tags/*.html")
29
30 match "css/*" $ do
31 route idRoute
32 compile compressCssCompiler
33
34 match ( "js/libs/*"
35 .||. "js/hyphenator/*"
36 .||. "js/hyphenator/patterns/*"
37 .||. "js/*"
38 .||. "downies/*"
39 .||. "downies/music/*"
40 .||. "images/*"
41 .||. "images/posts/*"
42 .||. "images/posts/*/*"
43 .||. "favicon.ico"
44 ) $ do
45 route idRoute
46 compile copyFileCompiler
47
48 -- place static markdown files in site root
49 match ( "static/*.markdown" .||. "static/*/*.markdown" ) $ do
50 route $ setExtension "html"
51 `composeRoutes` gsubRoute "static/" (const "")
52 compile $ pandocCompiler
53 >>= loadAndApplyTemplate "templates/default.html" defaultContext
54 >>= relativizeUrls
55
56 -- place static html files in site root
57 match "static/*.html" $ do
58 route $ gsubRoute "static/" (const "")
59 compile $ do
60 getResourceBody
61 >>= loadAndApplyTemplate "templates/default.html" defaultContext
62 >>= relativizeUrls
63
64 match "posts/*.markdown" $ do
65 route $ setExtension "html"
66 compile defaultCompiler
67
68 -- direct links
69 match "posts/2010-03-28-elephly.markdown" $ version "direct" $ do
70 route $ constRoute "elephly.html"
71 compile defaultCompiler
72
73 match "posts/2010-03-23-fur-man.markdown" $ version "direct" $ do
74 route $ constRoute "fur-man.html"
75 compile defaultCompiler
76
77 -- blog post archive
78 create ["posts/index.html"] $ do
79 let title = "Archive"
80
81 route idRoute
82 compile $ do
83 let archiveCtx =
84 constField "title" title <>
85 field "posts" (\_ -> postList "posts/*.markdown" recentFirst) <>
86 field "tags" (\_ -> renderTagList tags) <>
87 defaultContext
88
89 makeItem ""
90 >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
91 >>= loadAndApplyTemplate "templates/default.html" archiveCtx
92 >>= relativizeUrls
93
94 create ["rss.xml"] $ postFeed renderRss
95 create ["atom.xml"] $ postFeed renderAtom
96
97 -- always show the most recent blog post
98 create ["index.html"] $ do
99 route idRoute
100 compile $ do
101 mostRecent <- fmap head . recentFirst =<< loadAllSnapshots "posts/*.markdown" "non-relative"
102 makeItem (itemBody mostRecent) >>= relativizeUrls
103
104
105 tagsRules tags $ \tag pattern -> do
106 let title = "Posts tagged &ldquo;" ++ tag ++ "&rdquo;"
107
108 route idRoute
109 compile $ do
110 let ctx = constField "title" title <>
111 field "posts" (\_ -> postList pattern recentFirst) <>
112 tagsField "tags" tags <>
113 defaultContext
114
115 makeItem ""
116 >>= loadAndApplyTemplate "templates/archive.html" ctx
117 >>= loadAndApplyTemplate "templates/default.html" ctx
118 >>= relativizeUrls
119
120 match "templates/*" $ compile templateCompiler
121
122
123 --------------------------------------------------------------------------------
124 postCtx :: Context String
125 postCtx = dateField "date" "%B %e, %Y"
126 <> photoSnippet
127 <> flattrSnippet
128 <> licenseSnippet
129 <> defaultContext
130
131 -- If a post declares a certain key in the metadata header,
132 -- load the given template, otherwise ignore.
133 snippet :: String -> String -> Identifier -> Context String
134 snippet name key templatePath = field name $ \item -> do
135 metadata <- getMetadata (itemIdentifier item)
136 case M.lookup key metadata of
137 Just file -> itemBody <$> loadAndApplyTemplate templatePath postCtx item
138 _ -> return ""
139
140 photoSnippet = snippet "photo-snippet" "photo" "templates/photo.html"
141 flattrSnippet = snippet "flattr-snippet" "flattr" "templates/flattr.html"
142 licenseSnippet = snippet "license-snippet" "license" "templates/license.html"
143
144 postFeed renderer = do
145 route idRoute
146 compile $ do
147 let feedCtx = postCtx <> bodyField "description"
148 posts <- fmap (take 10) . recentFirst =<<
149 loadAllSnapshots "posts/*.markdown" "content"
150 renderer myFeedConfiguration feedCtx posts
151
152 --------------------------------------------------------------------------------
153 postList :: Pattern -> ([Item String] -> Compiler [Item String]) -> Compiler String
154 postList pattern sortFilter = do
155 posts <- sortFilter =<< loadAll (pattern .&&. hasNoVersion)
156 itemTpl <- loadBody "templates/post-item.html"
157 list <- applyTemplateList itemTpl postCtx posts
158 return list
159
160 customPandocCompiler :: Compiler (Item String)
161 customPandocCompiler =
162 pandocCompilerWith
163 (addRExt [Ext_pipe_tables] defaultHakyllReaderOptions)
164 (addWExt [Ext_pipe_tables] defaultHakyllWriterOptions)
165 where
166 addRExt es opts =
167 opts { readerExtensions = S.union (S.fromList es) (readerExtensions opts)
168 , readerSmart = True
169 }
170 addWExt es opts =
171 opts { writerExtensions = S.union (S.fromList es) (writerExtensions opts) }
172
173 defaultCompiler = customPandocCompiler
174 >>= loadAndApplyTemplate "templates/post.html" postCtx
175 >>= saveSnapshot "content"
176 >>= loadAndApplyTemplate "templates/default.html" postCtx
177 >>= saveSnapshot "non-relative"
178 >>= relativizeUrls