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