replace mappend with <>
[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 match ( "static/*.markdown" .||. "static/*/*.markdown" ) $ do
49 route $ setExtension "html" `composeRoutes` gsubRoute "static/" (const "")
50 compile $ pandocCompiler
51 >>= loadAndApplyTemplate "templates/default.html" defaultContext
52 >>= relativizeUrls
53
54 match "static/*.html" $ do
55 route $ gsubRoute "static/" (const "")
56 compile $ do
57 getResourceBody
58 >>= loadAndApplyTemplate "templates/default.html" defaultContext
59 >>= relativizeUrls
60
61 match "posts/*.markdown" $ do
62 route $ setExtension "html"
63 compile defaultCompiler
64 --itemTpl <- loadBody "templates/photo.html"
65 --metadata <- getMetadata
66 --let m = M.lookup "photo" metadata
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 defaultContext
87
88 makeItem ""
89 >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
90 >>= loadAndApplyTemplate "templates/default.html" archiveCtx
91 >>= relativizeUrls
92
93 create ["rss.xml"] $ postFeed renderRss
94 create ["atom.xml"] $ postFeed renderAtom
95
96 -- always show the most recent blog post
97 create ["index.html"] $ do
98 route idRoute
99 compile $ do
100 mostRecent <- fmap head . recentFirst =<< loadAllSnapshots "posts/*.markdown" "non-relative"
101 makeItem (itemBody mostRecent) >>= relativizeUrls
102
103
104 tagsRules tags $ \tag pattern -> do
105 let title = "Posts tagged &ldquo;" ++ tag ++ "&rdquo;"
106
107 route idRoute
108 compile $ do
109 let ctx = constField "title" title <>
110 field "posts" (\_ -> postList pattern recentFirst) <>
111 defaultContext
112
113 makeItem ""
114 >>= loadAndApplyTemplate "templates/archive.html" ctx
115 >>= loadAndApplyTemplate "templates/default.html" ctx
116 >>= relativizeUrls
117
118 match "templates/*" $ compile templateCompiler
119
120
121 --------------------------------------------------------------------------------
122 postCtx :: Context String
123 postCtx =
124 dateField "date" "%B %e, %Y" <>
125 photoSnippet <>
126 flattrSnippet <>
127 licenseSnippet <>
128 defaultContext
129
130 -- If a post declares a certain key in the metadata header,
131 -- load the given template, otherwise ignore.
132 snippet :: String -> String -> Identifier -> Context String
133 snippet name key templatePath = field name $ \item -> do
134 metadata <- getMetadata (itemIdentifier item)
135 case M.lookup key metadata of
136 Just file -> itemBody <$> loadAndApplyTemplate templatePath postCtx item
137 _ -> return ""
138
139 photoSnippet = snippet "photo-snippet" "photo" "templates/photo.html"
140 flattrSnippet = snippet "flattr-snippet" "flattr" "templates/flattr.html"
141 licenseSnippet = snippet "license-snippet" "license" "templates/license.html"
142
143 postFeed renderer = do
144 route idRoute
145 compile $ do
146 let feedCtx = postCtx <> bodyField "description"
147 posts <- fmap (take 10) . recentFirst =<<
148 loadAllSnapshots "posts/*.markdown" "content"
149 renderer myFeedConfiguration feedCtx posts
150
151 --------------------------------------------------------------------------------
152 postList :: Pattern -> ([Item String] -> Compiler [Item String]) -> Compiler String
153 postList pattern sortFilter = do
154 posts <- sortFilter =<< loadAll (pattern .&&. hasNoVersion)
155 itemTpl <- loadBody "templates/post-item.html"
156 list <- applyTemplateList itemTpl postCtx posts
157 return list
158
159 customPandocCompiler :: Compiler (Item String)
160 customPandocCompiler =
161 pandocCompilerWith
162 (addRExt [Ext_pipe_tables] defaultHakyllReaderOptions)
163 (addWExt [Ext_pipe_tables] defaultHakyllWriterOptions)
164 where
165 addRExt es opts =
166 opts { readerExtensions = S.union (S.fromList es) (readerExtensions opts)
167 , readerSmart = True
168 }
169 addWExt es opts =
170 opts { writerExtensions = S.union (S.fromList es) (writerExtensions opts) }
171
172 defaultCompiler = customPandocCompiler
173 >>= loadAndApplyTemplate "templates/post.html" postCtx
174 >>= saveSnapshot "content"
175 >>= loadAndApplyTemplate "templates/default.html" postCtx
176 >>= saveSnapshot "non-relative"
177 >>= relativizeUrls