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