new post: hacking the wavedrum
[software/elephly-net.git] / site.hs
1 --------------------------------------------------------------------------------
2 {-# LANGUAGE OverloadedStrings #-}
3 import Control.Applicative ((<$>))
4 import Data.Monoid (mappend)
5 import Hakyll
6 import Data.Map as M
7 import Data.Maybe (fromMaybe)
8
9 config :: Configuration
10 config = defaultConfiguration
11 { deployCommand =
12 "rsync -Havz _site/ rekado@elephly.net:/srv/disk1/rekado/elephly.net" }
13
14 --------------------------------------------------------------------------------
15 main :: IO ()
16 main = hakyllWith config $ do
17 match "css/*" $ do
18 route idRoute
19 compile compressCssCompiler
20
21 match ( "js/libs/*"
22 .||. "js/hyphenator/*"
23 .||. "js/hyphenator/patterns/*"
24 .||. "js/*"
25 .||. "downies/*"
26 .||. "downies/music/*"
27 .||. "images/*"
28 .||. "images/posts/*"
29 .||. "images/posts/*/*"
30 .||. "favicon.ico"
31 ) $ do
32 route idRoute
33 compile copyFileCompiler
34
35 match ( "static/*.markdown" .||. "static/*/*.markdown" ) $ do
36 route $ setExtension "html" `composeRoutes` gsubRoute "static/" (const "")
37 compile $ pandocCompiler
38 >>= loadAndApplyTemplate "templates/default.html" defaultContext
39 >>= relativizeUrls
40
41 match "static/*.html" $ do
42 route $ gsubRoute "static/" (const "")
43 compile $ do
44 getResourceBody
45 >>= loadAndApplyTemplate "templates/default.html" defaultContext
46 >>= relativizeUrls
47
48 match "posts/*.markdown" $ do
49 route $ setExtension "html"
50 compile defaultCompiler
51 --itemTpl <- loadBody "templates/photo.html"
52 --metadata <- getMetadata
53 --let m = M.lookup "photo" metadata
54
55 -- direct links
56 match "posts/2010-03-28-elephly.markdown" $ version "direct" $ do
57 route $ constRoute "elephly.html"
58 compile defaultCompiler
59
60 match "posts/2010-03-23-fur-man.markdown" $ version "direct" $ do
61 route $ constRoute "fur-man.html"
62 compile defaultCompiler
63
64 -- blog post archive
65 create ["posts/index.html"] $ do
66 route idRoute
67 compile $ do
68 let archiveCtx =
69 field "posts" (\_ -> postList recentFirst) `mappend`
70 defaultContext
71
72 makeItem ""
73 >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
74 >>= loadAndApplyTemplate "templates/default.html" archiveCtx
75 >>= relativizeUrls
76
77 -- always show the most recent blog post
78 create ["index.html"] $ do
79 route idRoute
80 compile $ do
81 mostRecent <- fmap head . recentFirst =<< loadAllSnapshots "posts/*.markdown" "non-relative"
82 makeItem (itemBody mostRecent) >>= relativizeUrls
83
84 match "templates/*" $ compile templateCompiler
85
86
87 --------------------------------------------------------------------------------
88 postCtx :: Context String
89 postCtx =
90 dateField "date" "%B %e, %Y" `mappend`
91 photoSnippet `mappend`
92 flattrSnippet `mappend`
93 licenseSnippet `mappend`
94 defaultContext
95
96 -- If a post declares a photo in the metadata header,
97 -- build an image tag, otherwise ignore.
98 photoSnippet :: Context String
99 photoSnippet = field "photo-snippet" $ \item -> do
100 metadata <- getMetadata (itemIdentifier item)
101 case M.lookup "photo" metadata of
102 Just file -> itemBody <$> loadAndApplyTemplate "templates/photo.html" postCtx item
103 _ -> return ""
104
105 -- If a post declares a flattr id in the metadata header,
106 -- load the flattr snippet, otherwise ignore.
107 flattrSnippet :: Context String
108 flattrSnippet = field "flattr-snippet" $ \item -> do
109 metadata <- getMetadata (itemIdentifier item)
110 case M.lookup "flattr" metadata of
111 Just _ -> itemBody <$> loadAndApplyTemplate "templates/flattr.html" postCtx item
112 _ -> return ""
113
114 licenseSnippet :: Context String
115 licenseSnippet = field "license-snippet" $ \item -> do
116 metadata <- getMetadata (itemIdentifier item)
117 case M.lookup "license" metadata of
118 Just _ -> itemBody <$> loadAndApplyTemplate "templates/license.html" postCtx item
119 _ -> return ""
120
121
122 --------------------------------------------------------------------------------
123 postList :: ([Item String] -> Compiler [Item String]) -> Compiler String
124 postList sortFilter = do
125 posts <- sortFilter =<< loadAll ("posts/*.markdown" .&&. hasNoVersion)
126 itemTpl <- loadBody "templates/post-item.html"
127 list <- applyTemplateList itemTpl postCtx posts
128 return list
129
130 defaultCompiler = pandocCompiler
131 >>= loadAndApplyTemplate "templates/post.html" postCtx
132 >>= loadAndApplyTemplate "templates/default.html" postCtx
133 >>= saveSnapshot "non-relative"
134 >>= relativizeUrls