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