posts: add diagram for shared Guix profiles and store
[software/elephly-net.git] / site.hs
diff --git a/site.hs b/site.hs
index 0f897bd..f854817 100644 (file)
--- a/site.hs
+++ b/site.hs
@@ -1,42 +1,61 @@
 --------------------------------------------------------------------------------
 {-# LANGUAGE OverloadedStrings #-}
 import           Control.Applicative ((<$>))
-import           Data.Monoid         (mappend)
+import           Data.Monoid         ((<>))
 import           Hakyll
 import           Data.Map as M
+import qualified Data.Set as S
 import           Data.Maybe          (fromMaybe)
+import           Text.Pandoc.Options
 
 config :: Configuration
 config = defaultConfiguration
   { deployCommand =
-      "rsync -Havz _site/ rekado@elephly.net:/srv/disk1/rekado/elephly.net" }
+      "rsync -Havz _site/ rekado@elephly.net:/home/rekado/elephly.net" }
+
+myFeedConfiguration :: FeedConfiguration
+myFeedConfiguration = FeedConfiguration
+  { feedTitle       = "Rekado's website"
+  , feedDescription = "Music, words, and hacking"
+  , feedAuthorName  = "Rekado"
+  , feedAuthorEmail = "rekado+feed@elephly.net"
+  , feedRoot        = "http://elephly.net"
+  }
 
 --------------------------------------------------------------------------------
 main :: IO ()
 main = hakyllWith config $ do
-    match "css/*" $ do
-        route   idRoute
-        compile compressCssCompiler
+    tags <- buildTags "posts/*.markdown" (fromCapture "tags/*.html")
 
     match (    "js/libs/*"
           .||. "js/hyphenator/*"
           .||. "js/hyphenator/patterns/*"
           .||. "js/*"
+          .||. "css/*.woff"
           .||. "downies/*"
           .||. "downies/music/*"
           .||. "images/*"
           .||. "images/posts/*"
+          .||. "images/posts/*/*"
           .||. "favicon.ico"
+          .||. "rekado.pubkey"
           ) $ do
       route   idRoute
       compile copyFileCompiler
 
+    match "css/*" $ do
+        route   idRoute
+        compile compressCssCompiler
+
+    -- place static markdown files in site root
     match ( "static/*.markdown" .||. "static/*/*.markdown" ) $ do
-      route   $ setExtension "html" `composeRoutes` gsubRoute "static/" (const "")
+      route   $ setExtension "html"
+        `composeRoutes` gsubRoute "static/" (const "")
       compile $ pandocCompiler
         >>= loadAndApplyTemplate "templates/default.html" defaultContext
         >>= relativizeUrls
 
+    -- place static html files in site root
     match "static/*.html" $ do
       route   $ gsubRoute "static/" (const "")
       compile $ do
@@ -47,9 +66,6 @@ main = hakyllWith config $ do
     match "posts/*.markdown" $ do
       route   $ setExtension "html"
       compile defaultCompiler
-        --itemTpl <- loadBody "templates/photo.html" 
-        --metadata <- getMetadata
-        --let m = M.lookup "photo" metadata
 
     -- direct links
     match "posts/2010-03-28-elephly.markdown" $ version "direct" $  do
@@ -62,10 +78,14 @@ main = hakyllWith config $ do
 
     -- blog post archive
     create ["posts/index.html"] $ do
+      let title = "Archive"
+
       route   idRoute
       compile $ do
         let archiveCtx =
-              field "posts" (\_ -> postList recentFirst) `mappend`
+              constField "title" title <>
+              field "posts" (\_ -> postList "posts/*.markdown" recentFirst) <>
+              field "tags" (\_ -> renderTagList tags) <>
               defaultContext
 
         makeItem ""
@@ -73,61 +93,88 @@ main = hakyllWith config $ do
           >>= loadAndApplyTemplate "templates/default.html" archiveCtx
           >>= relativizeUrls
 
+    create ["rss.xml"] $ postFeed renderRss
+    create ["atom.xml"] $ postFeed renderAtom
+
     -- always show the most recent blog post
-    create ["index.html"] $ do
+    create ["posts/latest.html"] $ do
       route idRoute
       compile $ do
-        mostRecent <- (head . recentFirst) <$> loadAllSnapshots "posts/*.markdown" "non-relative"
+        mostRecent <- fmap head . recentFirst =<< loadAllSnapshots "posts/*.markdown" "non-relative"
         makeItem (itemBody mostRecent) >>= relativizeUrls
 
+
+    tagsRules tags $ \tag pattern -> do
+      let title = "Posts tagged &ldquo;" ++ tag ++ "&rdquo;"
+
+      route idRoute
+      compile $ do
+        let ctx = constField "title" title <>
+                  field "posts" (\_ -> postList pattern recentFirst) <>
+                  tagsField "tags" tags <>
+                  defaultContext
+
+        makeItem ""
+            >>= loadAndApplyTemplate "templates/archive.html" ctx
+            >>= loadAndApplyTemplate "templates/default.html" ctx
+            >>= relativizeUrls
+
     match "templates/*" $ compile templateCompiler
 
 
 --------------------------------------------------------------------------------
 postCtx :: Context String
-postCtx =
-    dateField "date" "%B %e, %Y" `mappend`
-    photoSnippet `mappend`
-    flattrSnippet `mappend`
-    licenseSnippet `mappend`
-    defaultContext
-
--- If a post declares a photo in the metadata header,
--- build an image tag, otherwise ignore.
-photoSnippet :: Context String
-photoSnippet = field "photo-snippet" $ \item -> do
+postCtx = dateField "date" "%B %e, %Y"
+          <> photoSnippet
+          <> flattrSnippet
+          <> licenseSnippet
+          <> defaultContext
+
+-- If a post declares a certain key in the metadata header,
+-- load the given template, otherwise ignore.
+snippet :: String -> String -> Identifier -> Context String
+snippet name key templatePath = field name $ \item -> do
     metadata <- getMetadata (itemIdentifier item)
-    case M.lookup "photo" metadata of
-      Just file -> itemBody <$> loadAndApplyTemplate "templates/photo.html" postCtx item
+    case M.lookup key metadata of
+      Just file -> itemBody <$> loadAndApplyTemplate templatePath postCtx item
       _         -> return ""
 
--- If a post declares a flattr id in the metadata header,
--- load the flattr snippet, otherwise ignore.
-flattrSnippet :: Context String
-flattrSnippet = field "flattr-snippet" $ \item -> do
-    metadata <- getMetadata (itemIdentifier item)
-    case M.lookup "flattr" metadata of
-      Just _ -> itemBody <$> loadAndApplyTemplate "templates/flattr.html" postCtx item
-      _      -> return ""
-
-licenseSnippet :: Context String
-licenseSnippet = field "license-snippet" $ \item -> do
-    metadata <- getMetadata (itemIdentifier item)
-    case M.lookup "license" metadata of
-      Just _ -> itemBody <$> loadAndApplyTemplate "templates/license.html" postCtx item
-      _      -> return ""
+photoSnippet   = snippet "photo-snippet" "photo" "templates/photo.html"
+flattrSnippet  = snippet "flattr-snippet" "flattr" "templates/flattr.html"
+licenseSnippet = snippet "license-snippet" "license" "templates/license.html"
 
+postFeed renderer = do
+  route idRoute
+  compile $ do
+    let feedCtx = postCtx <> bodyField "description"
+    posts <- fmap (take 10) . recentFirst =<<
+      loadAllSnapshots "posts/*.markdown" "content"
+    renderer myFeedConfiguration feedCtx posts
 
 --------------------------------------------------------------------------------
-postList :: ([Item String] -> [Item String]) -> Compiler String
-postList sortFilter = do
-  posts   <- sortFilter <$> loadAll ("posts/*.markdown" .&&. hasNoVersion)
+postList :: Pattern -> ([Item String] -> Compiler [Item String]) -> Compiler String
+postList pattern sortFilter = do
+  posts   <- sortFilter =<< loadAll (pattern .&&. hasNoVersion)
   itemTpl <- loadBody "templates/post-item.html"
   list    <- applyTemplateList itemTpl postCtx posts
   return list
 
-defaultCompiler = pandocCompiler
+customPandocCompiler :: Compiler (Item String)
+customPandocCompiler =
+    pandocCompilerWith
+      (addRExt [Ext_pipe_tables] defaultHakyllReaderOptions)
+      (addWExt [Ext_pipe_tables] defaultHakyllWriterOptions)
+  where
+    addRExt es opts =
+      opts { readerExtensions = S.union (S.fromList es) (readerExtensions opts)
+           , readerSmart = True
+           }
+    addWExt es opts =
+      opts { writerExtensions = S.union (S.fromList es) (writerExtensions opts) }
+
+defaultCompiler = customPandocCompiler
   >>= loadAndApplyTemplate "templates/post.html"    postCtx
+  >>= saveSnapshot "content"
   >>= loadAndApplyTemplate "templates/default.html" postCtx
   >>= saveSnapshot "non-relative"
   >>= relativizeUrls