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