posts: fix URL
[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:/home/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 ( "js/libs/*"
31 .||. "js/hyphenator/*"
32 .||. "js/hyphenator/patterns/*"
33 .||. "js/*"
34 .||. "css/*.woff"
35 .||. "downies/*"
36 .||. "downies/music/*"
37 .||. "images/*"
38 .||. "images/posts/*"
39 .||. "images/posts/*/*"
40 .||. "favicon.ico"
41 .||. "rekado.pubkey"
42 ) $ do
43 route idRoute
44 compile copyFileCompiler
45
46 match "css/*" $ do
47 route idRoute
48 compile compressCssCompiler
49
50 -- place static markdown files in site root
51 match ( "static/*.markdown" .||. "static/*/*.markdown" ) $ do
52 route $ setExtension "html"
53 `composeRoutes` gsubRoute "static/" (const "")
54 compile $ pandocCompiler
55 >>= loadAndApplyTemplate "templates/default.html" defaultContext
56 >>= relativizeUrls
57
58 -- place static html files in site root
59 match "static/*.html" $ do
60 route $ gsubRoute "static/" (const "")
61 compile $ do
62 getResourceBody
63 >>= loadAndApplyTemplate "templates/default.html" defaultContext
64 >>= relativizeUrls
65
66 match "posts/*.markdown" $ do
67 route $ setExtension "html"
68 compile defaultCompiler
69
70 -- direct links
71 match "posts/2010-03-28-elephly.markdown" $ version "direct" $ do
72 route $ constRoute "elephly.html"
73 compile defaultCompiler
74
75 match "posts/2010-03-23-fur-man.markdown" $ version "direct" $ do
76 route $ constRoute "fur-man.html"
77 compile defaultCompiler
78
79 -- blog post archive
80 create ["posts/index.html"] $ do
81 let title = "Archive"
82
83 route idRoute
84 compile $ do
85 let archiveCtx =
86 constField "title" title <>
87 field "posts" (\_ -> postList "posts/*.markdown" recentFirst) <>
88 field "tags" (\_ -> renderTagList tags) <>
89 defaultContext
90
91 makeItem ""
92 >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
93 >>= loadAndApplyTemplate "templates/default.html" archiveCtx
94 >>= relativizeUrls
95
96 create ["rss.xml"] $ postFeed renderRss
97 create ["atom.xml"] $ postFeed renderAtom
98
99 -- always show the most recent blog post
100 create ["posts/latest.html"] $ do
101 route idRoute
102 compile $ do
103 mostRecent <- fmap head . recentFirst =<< loadAllSnapshots "posts/*.markdown" "non-relative"
104 makeItem (itemBody mostRecent) >>= relativizeUrls
105
106
107 tagsRules tags $ \tag pattern -> do
108 let title = "Posts tagged &ldquo;" ++ tag ++ "&rdquo;"
109
110 route idRoute
111 compile $ do
112 let ctx = constField "title" title <>
113 field "posts" (\_ -> postList pattern recentFirst) <>
114 tagsField "tags" tags <>
115 defaultContext
116
117 makeItem ""
118 >>= loadAndApplyTemplate "templates/archive.html" ctx
119 >>= loadAndApplyTemplate "templates/default.html" ctx
120 >>= relativizeUrls
121
122 match "templates/*" $ compile templateCompiler
123
124
125 --------------------------------------------------------------------------------
126 postCtx :: Context String
127 postCtx = dateField "date" "%B %e, %Y"
128 <> photoSnippet
129 <> flattrSnippet
130 <> licenseSnippet
131 <> defaultContext
132
133 -- If a post declares a certain key in the metadata header,
134 -- load the given template, otherwise ignore.
135 snippet :: String -> String -> Identifier -> Context String
136 snippet name key templatePath = field name $ \item -> do
137 metadata <- getMetadata (itemIdentifier item)
138 case M.lookup key metadata of
139 Just file -> itemBody <$> loadAndApplyTemplate templatePath postCtx item
140 _ -> return ""
141
142 photoSnippet = snippet "photo-snippet" "photo" "templates/photo.html"
143 flattrSnippet = snippet "flattr-snippet" "flattr" "templates/flattr.html"
144 licenseSnippet = snippet "license-snippet" "license" "templates/license.html"
145
146 postFeed renderer = do
147 route idRoute
148 compile $ do
149 let feedCtx = postCtx <> bodyField "description"
150 posts <- fmap (take 10) . recentFirst =<<
151 loadAllSnapshots "posts/*.markdown" "content"
152 renderer myFeedConfiguration feedCtx posts
153
154 --------------------------------------------------------------------------------
155 postList :: Pattern -> ([Item String] -> Compiler [Item String]) -> Compiler String
156 postList pattern sortFilter = do
157 posts <- sortFilter =<< loadAll (pattern .&&. hasNoVersion)
158 itemTpl <- loadBody "templates/post-item.html"
159 list <- applyTemplateList itemTpl postCtx posts
160 return list
161
162 customPandocCompiler :: Compiler (Item String)
163 customPandocCompiler =
164 pandocCompilerWith
165 (addRExt [Ext_pipe_tables] defaultHakyllReaderOptions)
166 (addWExt [Ext_pipe_tables] defaultHakyllWriterOptions)
167 where
168 addRExt es opts =
169 opts { readerExtensions = S.union (S.fromList es) (readerExtensions opts)
170 , readerSmart = True
171 }
172 addWExt es opts =
173 opts { writerExtensions = S.union (S.fromList es) (writerExtensions opts) }
174
175 defaultCompiler = customPandocCompiler
176 >>= loadAndApplyTemplate "templates/post.html" postCtx
177 >>= saveSnapshot "content"
178 >>= loadAndApplyTemplate "templates/default.html" postCtx
179 >>= saveSnapshot "non-relative"
180 >>= relativizeUrls