trying to get my own tag clouds to work

5 months ago · daa91acb96
23 changed files with 338 additions and 204 deletions
--- a/config.ini
+++ b/config.ini
@ -1,7 +1,7 @@
 [Site]
 title = This Field Was Green
 description = ""
-root = https://thisfieldwas.green
+siteRoot = https://thisfieldwas.green
 authorName = Logan McGrath
 authorEmail = logan.mcgrath@thisfieldwas.green
 linkedInProfile = https://www.linkedin.com/in/loganmcgrath
--- a/green.cabal
+++ b/green.cabal
@ -43,6 +43,7 @@ library
      Green.Site.Pages
      Green.Site.Robots
      Green.Site.Sitemap
+      Green.Site.Tags
      Green.Site.Templates
      Green.Template
      Green.Template.Ast
@ -60,7 +61,6 @@ library
      Green.Template.Source.Lexer
      Green.Template.Source.Parser
      Green.Template.Source.Util
-      Green.Template.Tags
      Green.Util
  other-modules:
      Paths_green
@ -116,6 +116,7 @@ library
    , binary
    , bytestring
    , config-ini
+    , containers
    , data-default
    , directory
    , filepath
--- a/package.yaml
+++ b/package.yaml
@ -21,6 +21,7 @@ library:
    - binary
    - bytestring
    - config-ini
+    - containers
    - data-default
    - directory
    - filepath
--- a/site/_layouts/default.html
+++ b/site/_layouts/default.html
@ -4,7 +4,7 @@
    <div class="logo-icon"><a href="/"></a></div>
    <div class="logo-nav">
      <h1 class="logo"><a href="/">This Field Was Green</a></h1>
-      {{partial "main-nav"}}
+      {{>"main-nav"}}
    </div>
  </div>
 </header>
@ -17,7 +17,7 @@

 <footer class="page-footer">
  <div class="content-bound">
-    {{partial "main-nav"}}
+    {{>"main-nav"}}
    <p class="copyright">Copyright &copy; <span class="copyright-date">2012</span> Logan McGrath. All rights reserved.</p>
    <ul class="acks">
      <li>Site proudly generated by <a href="http://jaspervdj.be/hakyll">Hakyll</a>.</li>
--- a/site/_layouts/skeleton.html
+++ b/site/_layouts/skeleton.html
@ -1,5 +1,5 @@
 <!doctype html>
-<html lang="en">
+<html lang="en" prefix="og: https://ogp.me/ns#"{{#if post}} prefix="article: https://ogp.me/ns/article#"{{#end}}>
 <head>

 <meta charset="utf-8">
@ -7,10 +7,29 @@
 <meta name="viewport" content="width=device-width, initial-scale=1">

 <title>{{siteTitle}}{{#if title}} - {{title}}{{#end}}</title>
+<meta rel="canonical" href="{{siteRoot}}{{url}}">
+{{#if author}}<link rel="author" href="{{siteRoot}}" content="{{author}}">{{#end}}
+{{#if description}}<meta name="description" content="{{description}}">{{#end}}
+{{#if keywords}}<meta name="keywords" content="{{keywords | join ', '}}">{{#end}}

-{{#if author}}<link rel="author" href='/' content="{{author}}">{{#end}}
-<link rel="icon" href="/images/grass.svg">
+<meta property="og:site_name" content="{{siteTitle}}">
+<meta property="og:title" content="{{title}}">
+{{#if description}}<meta property="og:description" content="{{description}}">{{#end}}
+<meta property="og:url" content="{{url}}">
+{{#if image}}<meta property="og:image" content="{{image}}">{{#end}}
+
+{{#if type-}}
+  <meta property="og:type" content="{{type}}">
+{{#else if post-}}
+  <meta property="og:type" content="article">
+  {{#if published}}<meta property="article:published_time" content="{{published}}">{{#end}}
+  {{#if updated}}<meta property="article:modified_time" content="{{updated}}">{{#end}}
+  {{#if author}}<meta property="article:author" content="{{author}}">{{#end}}
+  {{#if section}}<meta property="article:section" content="{{categories | join ', '}}">{{#end}}
+  {{#if tags}}<meta property="article:tag" content="{{tags | join ', '}}">{{#end}}
+{{#end}}

+<link rel="icon" href="/images/grass.svg">
 <link rel="stylesheet" href="/css/main.css">
 <script src="/js/main.js"></script>

--- a/site/_pages/contact.md
+++ b/site/_pages/contact.md
@ -4,4 +4,4 @@ layout: page
 ---
 I live in a tiramisù and have pudding in my ears. Please contact me via [{{authorEmail}}](mailto:{{authorEmail}}) and I shall free my eyes to read and reply heartily; my fingers typing though they have been soaking like biscuits in espresso and cream. I welcome conversations and questions about what I do and I might even ask a few questions of my own, but I do not know how I came to be floating in mascarpone.

-{{partial "employment"}}
+{{>"employment"}}
--- a/site/_templates/post-header.html
+++ b/site/_templates/post-header.html
@ -18,7 +18,7 @@
  {{-#end}}
  {{-#if tags}}
    <p class="post-tags">
-      Tags: {{tagLinks}}
+      Tags: {{#for tags}}{{name}}{{#end}}
    </p>
  {{-#end}}
 </header>
--- a/site/_templates/posts-under-category.html
+++ b/site/_templates/posts-under-category.html
@ -1 +1 @@
-{{partial "post-list"}}
+{{>"post-list"}}
--- a/site/_templates/posts-under-tag.html
+++ b/site/_templates/posts-under-tag.html
@ -1 +1 @@
-{{partial "post-list"}}
+{{>"post-list"}}
--- a/site/archives.html
+++ b/site/archives.html
@ -5,4 +5,4 @@ layout: page

 Here you can find all my previous posts:

-{{partial "post-list"}}
+{{>"post-list"}}
--- a/site/drafts.html
+++ b/site/drafts.html
@ -4,4 +4,4 @@ layout: page
 ---

 Here you can find all my drafts:
-{{partial "post-list"}}
+{{>"post-list"}}
--- a/site/index.html
+++ b/site/index.html
@ -109,7 +109,7 @@ layout: page
  </ul>
 </section>

-{{partial "employment"}}
+{{>"employment"}}

 <section class="personal-stuff">
  <aside class="meatball-jellybean">
--- a/src/Green/Config.hs
+++ b/src/Green/Config.hs
@ -81,7 +81,7 @@ instance Show SiteConfig where
  show config =
    intercalate "\n" $
      [ "SiteConfig:",
-        "  Root: " <> show (config ^. siteRoot),
+        "  SiteRoot: " <> show (config ^. siteRoot),
        "  Title: " <> show (config ^. siteTitle),
        "  Description: " <> show (config ^. siteDescription),
        "  AuthorName: " <> show (config ^. siteAuthorName),
@ -136,7 +136,7 @@ parseConfigIni env timeLocale time iniText = parseIniFile iniText do

  section "Site" do
    SiteConfig env
-      <$> fieldOf "root" string
+      <$> fieldOf "siteRoot" string
      <*> fieldOf "title" string
      <*> (fieldOf "description" string <|> return "")
      <*> fieldOf "authorName" string
--- a/src/Green/Site/Blog.hs
+++ b/src/Green/Site/Blog.hs
@ -1,18 +1,27 @@
 module Green.Site.Blog where

+-- import qualified Data.HashMap.Strict as HashMap
+
+import Control.Monad (forM_)
 import Green.Common
 import Green.Compiler (loadExistingSnapshots)
 import Green.Route
+import Green.Site.Tags
 import Green.Template
 import Green.Template.Custom
 import qualified Hakyll as H

 blog :: Context String -> Rules ()
-blog context = do
+blog siteContext = do
  categories <- buildCategories "_posts/**" makeCategoryId
  tags <- buildTags "_posts/**" makeTagId
+  let context =
+        tagCloudField "categoryCloud" categories
+          <> tagCloudField "tagCloud" tags
+          <> postContext categories tags
+          <> siteContext

-  blogHome categories tags context
+  blogHome context
  posts context
  archives context

@ -22,23 +31,16 @@ blog context = do
  draftsIndex context
  drafts context

-blogHome :: Tags -> Tags -> Context String -> Rules ()
-blogHome categories tags context =
+blogHome :: Context String -> Rules ()
+blogHome context =
  match "blog.html" do
    route indexRoute
    compile do
-      categoryCloud <- renderTagCloud categories
-      tagCloud <- renderTagCloud tags
      recentPosts <- recentPostsContext
-      let blogContext =
-            constField "categoryCloud" categoryCloud
-              <> constField "tagCloud" tagCloud
-              <> recentPosts
-              <> postContext
-              <> context
+      let context' = recentPosts <> context
      getResourceBody
-        >>= contentCompiler blogContext
-        >>= layoutCompiler blogContext
+        >>= contentCompiler context'
+        >>= layoutCompiler context'
        >>= relativizeUrls

 archives :: Context String -> Rules ()
@ -47,13 +49,12 @@ archives context = do
    route indexRoute
    compile do
      publishedPosts <- H.recentFirst =<< loadPublishedPosts
-      let archivesContext =
+      let context' =
            constField "posts" (itemListValue context publishedPosts)
-              <> postContext
              <> context
      getResourceBody
-        >>= contentCompiler archivesContext
-        >>= layoutCompiler archivesContext
+        >>= contentCompiler context'
+        >>= layoutCompiler context'
        >>= relativizeUrls

 draftsIndex :: Context String -> Rules ()
@ -64,12 +65,13 @@ draftsIndex context = do
      draftPosts <- H.recentFirst =<< loadDraftPosts
      let draftsContext =
            constField "posts" (itemListValue context draftPosts)
-              <> postContext
              <> context
      getResourceBody
        >>= contentCompiler draftsContext
        >>= layoutCompiler draftsContext
        >>= relativizeUrls
+  where
+    loadDraftPosts = loadExistingSnapshots "_drafts/**" "_draftPosts"

 posts :: Context String -> Rules ()
 posts context = do
@ -77,12 +79,10 @@ posts context = do
    route postsRoute
    compile $
      getResourceBody
-        >>= contentCompiler postsContext
+        >>= contentCompiler context
        >>= snapshotCompiler [publishedPostsSnapshot]
-        >>= layoutCompiler postsContext
+        >>= layoutCompiler context
        >>= relativizeUrls
-  where
-    postsContext = postContext <> context

 postsRoute :: Routes
 postsRoute =
@ -97,12 +97,52 @@ drafts context = do
    route draftsRoute
    compile $
      getResourceBody
-        >>= contentCompiler draftsContext
+        >>= contentCompiler context
        >>= snapshotCompiler [draftPostsSnapshot]
-        >>= layoutCompiler draftsContext
+        >>= layoutCompiler context
        >>= relativizeUrls
-  where
-    draftsContext = postContext <> context
+
+categoriesPages :: TagCloud -> Context String -> Rules ()
+categoriesPages categories context =
+  forM_ (tagCloudTags categories) \category ->
+    rulesExtraDependencies [tagCloudDependency categories] do
+      create [tagId category] do
+        route indexRoute
+        compile do
+          categoryPosts <- H.recentFirst =<< H.loadAll (fromList $ tagIds category)
+          let tagsContext =
+                constField "category" (tagContext category)
+                  <> constField "title" ("Posted under " ++ tagName category)
+                  <> constField "posts" (itemListValue context categoryPosts)
+                  <> constField "layout" ("page" :: String)
+                  <> context
+          template <- loadBody "_templates/posts-under-category.html"
+          makeItem ""
+            >>= applyTemplate template tagsContext
+            >>= pandocCompiler
+            >>= layoutCompiler tagsContext
+            >>= relativizeUrls
+
+tagsPages :: TagCloud -> Context String -> Rules ()
+tagsPages tags context =
+  forM_ (tagCloudTags tags) \tag ->
+    rulesExtraDependencies [tagCloudDependency tags] do
+      create [tagId tag] do
+        route indexRoute
+        compile do
+          tagPosts <- H.recentFirst =<< H.loadAll (fromList $ tagIds tag)
+          let tagsContext =
+                constField "tag" (tagContext tag)
+                  <> constField "title" ("Posted under " ++ tagName tag)
+                  <> constField "posts" (itemListValue context tagPosts)
+                  <> constField "layout" ("page" :: String)
+                  <> context
+          template <- loadBody "_templates/posts-under-tag.html"
+          makeItem ""
+            >>= applyTemplate template tagsContext
+            >>= pandocCompiler
+            >>= layoutCompiler tagsContext
+            >>= relativizeUrls

 draftsRoute :: Routes
 draftsRoute =
@ -111,52 +151,25 @@ draftsRoute =
    `composeRoutes` setExtension "html"
    `composeRoutes` indexRoute

-categoriesPages :: Tags -> Context String -> Rules ()
-categoriesPages categories context =
-  H.tagsRules categories \category pat -> do
-    route indexRoute
-    compile do
-      categoryPosts <- H.recentFirst =<< H.loadAll pat
-      let categoryContext =
-            constField "category" category
-              <> constField "title" ("Posts under \"" ++ category ++ "\"")
-              <> constField "posts" (itemListValue context categoryPosts)
-              <> constField "layout" ("page" :: String)
-              <> postContext
-              <> context
-      dummy <- makeItem ""
-      template <- loadBody "_templates/posts-under-category.html"
-      applyTemplate template categoryContext dummy
-        >>= pandocCompiler
-        >>= layoutCompiler categoryContext
-        >>= relativizeUrls
-
-tagsPages :: Tags -> Context String -> Rules ()
-tagsPages tags context =
-  H.tagsRules tags \tag pat -> do
-    route indexRoute
-    compile do
-      tagPosts <- H.recentFirst =<< H.loadAll pat
-      let tagsContext =
-            constField "tag" tag
-              <> constField "title" ("Posts tagged \"" ++ tag ++ "\"")
-              <> constField "posts" (itemListValue context tagPosts)
-              <> constField "layout" ("page" :: String)
-              <> postContext
-              <> context
-      dummy <- makeItem ""
-      template <- loadBody "_templates/posts-under-tag.html"
-      applyTemplate template tagsContext dummy
-        >>= pandocCompiler
-        >>= layoutCompiler tagsContext
-        >>= relativizeUrls
+dateRoute :: Routes
+dateRoute = gsubRoute datePattern (H.replaceAll "-" (const "/"))
+  where
+    datePattern = "[0-9]{4}-[0-9]{2}-[0-9]{2}-"

-postContext :: Context String
-postContext =
-  categoryLinksField "categoryLinks"
-    <> tagLinksField "tagLinks"
+postContext :: TagCloud -> TagCloud -> Context String
+postContext categories tags =
+  tagsField "categories" categories
+    <> tagsField "tags" tags
    <> postHeaderField "postHeader"

+postHeaderField :: String -> Context String
+postHeaderField key = functionField key f
+  where
+    defaults = defaultKeys ["headerLevel", "latestPost"]
+    f (fields :: Context String) = do
+      tplWithContext (fields <> defaults) do
+        itemBody <$> loadAndApplyTemplate' (fromFilePath "_templates/post-header.html")
+
 recentPostsContext :: Compiler (Context String)
 recentPostsContext = do
  recentPosts <- fmap (take 5) . H.recentFirst =<< loadPublishedPosts
@ -172,24 +185,8 @@ teaserContext = teaserField "teaser" publishedPostsSnapshot
 loadPublishedPosts :: Compiler [Item String]
 loadPublishedPosts = loadExistingSnapshots "_posts/**" publishedPostsSnapshot

-loadDraftPosts :: Compiler [Item String]
-loadDraftPosts = loadExistingSnapshots "_drafts/**" draftPostsSnapshot
-
 publishedPostsSnapshot :: String
 publishedPostsSnapshot = "_publishedPosts"

 draftPostsSnapshot :: String
 draftPostsSnapshot = "_draftPosts"
-
-dateRoute :: Routes
-dateRoute = gsubRoute datePattern (H.replaceAll "-" (const "/"))
-  where
-    datePattern = "[0-9]{4}-[0-9]{2}-[0-9]{2}-"
-
-postHeaderField :: String -> Context String
-postHeaderField key = functionField key f
-  where
-    defaults = defaultKeys ["headerLevel", "latestPost"]
-    f (fields :: Context String) = do
-      tplWithContext (fields <> defaults) do
-        itemBody <$> loadAndApplyTemplate' (fromFilePath "_templates/post-header.html")
--- a/src/Green/Site/Tags.hs
+++ b/src/Green/Site/Tags.hs
@ -0,0 +1,132 @@
+module Green.Site.Tags where
+
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
+import Green.Common
+import Green.Template.Context
+import Hakyll (MonadMetadata, Tags, buildTagsWith)
+import qualified Hakyll as H
+import System.FilePath
+
+sanitizeTerm :: String -> String
+sanitizeTerm = subSuspiciousDots . subWindowsBaddies
+  where
+    subWindowsBaddies =
+      mconcat . fmap \case
+        '\\' -> "/"
+        '*' -> "$splat$"
+        '<' -> "$lt$"
+        '>' -> "$gt$"
+        '?' -> "$eh$"
+        '|' -> "$or$"
+        ':' -> "$dots$"
+        ';' -> "$semi$"
+        '"' -> "$quot$"
+        x -> [x]
+    subSuspiciousDots = joinPath . fmap go . splitDirectories
+      where
+        go path
+          | path == ".." = "__"
+          | path == "." = "_"
+          | last path == '.' = init path ++ "_"
+          | otherwise = path
+
+makeTagId :: String -> Identifier
+makeTagId = H.fromCapture "tags/*.html" . sanitizeTerm
+
+makeCategoryId :: String -> Identifier
+makeCategoryId = H.fromCapture "categories/*.html" . sanitizeTerm
+
+getCategory :: (MonadMetadata m) => Identifier -> m [String]
+getCategory = (filter isCategory <$>) . H.getCategory
+  where
+    isCategory = not . (`elem` sourceDirs)
+    sourceDirs = ["_posts", "_drafts"]
+
+buildTags :: (MonadMetadata m) => Pattern -> (String -> Identifier) -> m TagCloud
+buildTags pattern' makeId = toTagCloud <$> H.buildTags pattern' makeId
+
+buildCategories :: (MonadMetadata m) => Pattern -> (String -> Identifier) -> m TagCloud
+buildCategories pattern' makeId = toTagCloud <$> buildTagsWith getCategory pattern' makeId
+
+data TagCloud = TagCloud
+  { tagCloudMinCount :: Int,
+    tagCloudMaxCount :: Int,
+    tagCloudTags :: [Tag],
+    tagCloudById :: HashMap FilePath [Tag],
+    tagCloudDependency :: Dependency
+  }
+
+data Tag = Tag
+  { tagName :: String,
+    tagId :: Identifier,
+    tagCount :: Int,
+    tagWeight :: Double,
+    tagIds :: [Identifier]
+  }
+
+toTagCloud :: Tags -> TagCloud
+toTagCloud tags =
+  TagCloud
+    { tagCloudMinCount = minCount,
+      tagCloudMaxCount = maxCount,
+      tagCloudTags = tags',
+      tagCloudById = tagsById,
+      tagCloudDependency = H.tagsDependency tags
+    }
+  where
+    tagsMap = H.tagsMap tags
+    tagsMakeId = H.tagsMakeId tags
+    minCount = minimum $ length . snd <$> tagsMap
+    maxCount = maximum $ length . snd <$> tagsMap
+    tags' = uncurry toTag <$> tagsMap
+    toTag name ids =
+      Tag
+        { tagName = name,
+          tagId = tagsMakeId name,
+          tagCount = count,
+          tagWeight = weight,
+          tagIds = ids
+        }
+      where
+        weight = fromIntegral (count - minCount) / fromIntegral (maxCount - minCount)
+        count = length ids
+    tagsById =
+      HashMap.fromListWith (<>)
+        . mconcat
+        . fmap (\tag -> (,[tag]) . toFilePath <$> tagIds tag)
+        $ tags'
+
+tagCloudField :: String -> TagCloud -> Context String
+tagCloudField key tags = constField key (f :: Context String)
+  where
+    f =
+      hashMapField . HashMap.fromList $
+        [ ("minCount", intoValue minCount :: ContextValue String),
+          ("maxCount", intoValue maxCount),
+          ("tags", intoValue tags')
+        ]
+    minCount = tagCloudMinCount tags
+    maxCount = tagCloudMinCount tags
+    tags' = tagContext <$> tagCloudTags tags
+
+tagContext :: Tag -> Context String
+tagContext Tag {tagName, tagId, tagCount, tagWeight, tagIds} =
+  hashMapField $
+    HashMap.fromList
+      [ ("name", intoValue tagName :: ContextValue String),
+        ("path", intoValue . toFilePath $ tagId),
+        ("count", intoValue tagCount),
+        ("weight", intoValue tagWeight),
+        ("items", intoValue . fmap toFilePath $ tagIds)
+      ]
+
+tagsField :: String -> TagCloud -> Context String
+tagsField key tags = field key f
+  where
+    f item = return tagItems
+      where
+        id' = toFilePath $ itemIdentifier item
+        tagsById = tagCloudById tags
+        itemTags = fromMaybe [] $ HashMap.lookup id' tagsById
+        tagItems = tagContext <$> itemTags
--- a/src/Green/Template.hs
+++ b/src/Green/Template.hs
@ -5,7 +5,6 @@ module Green.Template
    module Green.Template.Field,
    module Green.Template.Pandoc,
    module Green.Template.Source.Parser,
-    module Green.Template.Tags,
  )
 where

@ -15,4 +14,3 @@ import Green.Template.Context
 import Green.Template.Field
 import Green.Template.Pandoc
 import Green.Template.Source.Parser
-import Green.Template.Tags
--- a/src/Green/Template/Ast.hs
+++ b/src/Green/Template/Ast.hs
@ -36,6 +36,7 @@ data Block
  = TextBlock String SourcePos
  | ExpressionBlock Expression SourcePos
  | CommentBlock String SourcePos
+  | IncludeBlock Expression SourcePos
  | ChromeBlock Expression [Block] SourcePos
  | AltBlock
      (NonEmpty ApplyBlock)
@ -48,6 +49,7 @@ getBlockName = \case
  TextBlock {} -> "TextBlock"
  ExpressionBlock {} -> "ExpressionBlock"
  CommentBlock {} -> "CommentBlock"
+  IncludeBlock {} -> "IncludeBlock"
  ChromeBlock {} -> "ApplyBlock"
  AltBlock {} -> "AltBlock"

@ -56,6 +58,7 @@ getBlockPos = \case
  TextBlock _ pos -> pos
  ExpressionBlock _ pos -> pos
  CommentBlock _ pos -> pos
+  IncludeBlock _ pos -> pos
  ChromeBlock _ _ pos -> pos
  AltBlock _ _ pos -> pos

@ -64,6 +67,7 @@ getBlockTag = \case
  TextBlock {} -> 1
  ExpressionBlock {} -> 2
  CommentBlock {} -> 3
+  IncludeBlock {} -> 4
  ChromeBlock {} -> 4
  AltBlock {} -> 5

@ -76,6 +80,7 @@ instance Binary Block where
      3 -> CommentBlock <$> get
      4 -> ChromeBlock <$> get <*> get
      5 -> AltBlock <$> get <*> get
+      6 -> IncludeBlock <$> get
      _ -> error $ "Unrecognized block tag " ++ show tag
    binaryPos <- get :: Get BinaryPos
    return $ f (unBinaryPos binaryPos)
@ -88,6 +93,7 @@ instance Binary Block where
      CommentBlock text _ -> put text
      ChromeBlock expression blocks _ -> put expression >> put blocks
      AltBlock blocks default' _ -> put blocks >> put default'
+      IncludeBlock expression _ -> put expression
    put $ BinaryPos (getBlockPos block)

 newtype BinaryPos = BinaryPos SourcePos
@ -268,6 +274,12 @@ instance PrettyPrint Block where
          prettyText comment,
          pp pos
        ]
+    IncludeBlock expression pos ->
+      intercalate "\n" $
+        [ "IncludeBlock",
+          pl "expression" expression,
+          pp pos
+        ]
    ChromeBlock expression blocks pos ->
      intercalate "\n" $
        [ "ChromeBlock",
--- a/src/Green/Template/Compiler.hs
+++ b/src/Green/Template/Compiler.hs
@ -9,6 +9,7 @@ import Green.Template.Ast
 import Green.Template.Context hiding (field)
 import Green.Template.Source.Parser (parse)
 import Hakyll.Core.Compiler.Internal
+import Text.Parsec (SourcePos)

 -- | Compiles an item as a template.
 getResourceTemplate :: Compiler (Item Template)
@ -62,6 +63,7 @@ applyBlock = \case
  TextBlock t _ -> return $ intoValue t
  ExpressionBlock e _ -> eval e
  CommentBlock {} -> return EmptyValue
+  IncludeBlock e pos -> evalApply (NameExpression "partial" pos) e
  ChromeBlock e bs _ -> intoValue <$> applyGuard e bs [] Nothing
  AltBlock (ApplyBlock e bs _ :| alts) mdef _ -> intoValue <$> applyGuard e bs alts mdef
  where
@ -81,18 +83,12 @@ applyBlock = \case

 eval :: Expression -> TemplateRunner a (ContextValue a)
 eval = \case
-  NameExpression name pos -> do
-    (context, item, trace) <- liftA3 (,,) tplContext tplItem tplTrace
-    s <- get
-    lift $
-      evalStateT (unContext context name) s `compilerCatch` \case
-        CompilationFailure ne -> compilerThrow (NonEmpty.toList ne)
-        CompilationNoResult ss -> return $ UndefinedValue name item (show pos : trace) ss
+  NameExpression name pos -> evalName name pos
  StringExpression s _ -> return $ intoValue s
  IntExpression n _ -> return $ intoValue n
  DoubleExpression x _ -> return $ intoValue x
  BoolExpression b _ -> return $ intoValue b
-  ApplyExpression f x _ -> apply f x
+  ApplyExpression f x _ -> evalApply f x
  AccessExpression target field pos ->
    eval target >>= \case
      ContextValue target' ->
@ -102,16 +98,26 @@ eval = \case
            x -> tplFail $ "invalid field " ++ show x ++ " near " ++ show (getExpressionPos field)
          >>= unContext target'
      x -> tplFail $ "invalid context " ++ show x ++ " near " ++ show pos
-  FilterExpression x f _ -> apply f x
+  FilterExpression x f _ -> evalApply f x
  ContextExpression pairs _ -> do
    pairs' <- mapM (sequence . second eval) pairs
    return $ ContextValue (intoContext pairs')
  ListExpression xs _ -> intoValue <$> mapM eval xs
-  where
-    apply f x =
-      eval f >>= \case
-        FunctionValue f' -> f' (ThunkValue $ eval x)
-        x' -> fail $ "invalid function " ++ show x' ++ " in " ++ show (getExpressionPos f)
+
+evalName :: String -> SourcePos -> TemplateRunner a (ContextValue a)
+evalName name pos = do
+  (context, item, trace) <- liftA3 (,,) tplContext tplItem tplTrace
+  s <- get
+  lift $
+    evalStateT (unContext context name) s `compilerCatch` \case
+      CompilationFailure ne -> compilerThrow (NonEmpty.toList ne)
+      CompilationNoResult ss -> return $ UndefinedValue name item (show pos : trace) ss
+
+evalApply :: Expression -> Expression -> TemplateRunner a (ContextValue a)
+evalApply f x =
+  eval f >>= \case
+    FunctionValue f' -> f' (ThunkValue $ eval x)
+    x' -> fail $ "invalid function " ++ show x' ++ " in " ++ show (getExpressionPos f)

 stringify :: ContextValue String -> TemplateRunner String String
 stringify = \case
--- a/src/Green/Template/Context.hs
+++ b/src/Green/Template/Context.hs
@ -13,6 +13,7 @@ import qualified Data.Text as T
 import qualified Data.Vector as Vector
 import Green.Common
 import Green.Template.Ast
+import Hakyll.Core.Compiler.Internal (CompilerErrors (..), compilerTry)
 import Prelude hiding (lookup)

 newtype Context a = Context {unContext :: ContextFunction a}
@ -41,6 +42,24 @@ templateRunner context item =
      tplCallStack = ["item " ++ itemFilePath item]
    }

+tplTry :: TemplateRunner a b -> TemplateRunner a (Either (CompilerErrors String) b)
+tplTry f =
+  get >>= lift . compilerTry . runStateT f >>= \case
+    Right (x, s2) -> do
+      put s2
+      return $ Right x
+    Left e -> return $ Left e
+
+tplMaybe :: TemplateRunner a b -> TemplateRunner a (Maybe b)
+tplMaybe f = tplTry f >>= \case
+  Right x -> return $ Just x
+  Left _ -> return Nothing
+
+tplCatch :: TemplateRunner a b -> (CompilerErrors String -> TemplateRunner a b) -> TemplateRunner a b
+tplCatch f g = tplTry f >>= \case
+  Right x -> return x
+  Left e -> g e
+
 tplItem :: TemplateRunner a (Item a)
 tplItem = gets $ head . tplItemStack

@ -324,6 +343,7 @@ instance IntoValue (TemplateRunner a (ContextValue a)) a where
 -- | Extract a concrete value of type @v@ from a @ContextValue a@.
 class FromValue v a where
  fromValue :: ContextValue a -> TemplateRunner a v
+  tryFromValue :: ContextValue a -> TemplateRunner a (Maybe v)

 class FromValue' (flag :: Bool) v a where
  fromValue' :: Proxy flag -> ContextValue a -> TemplateRunner a v
--- a/src/Green/Template/Custom/GitField.hs
+++ b/src/Green/Template/Custom/GitField.hs
@ -23,16 +23,16 @@ gitCommits :: SiteConfig -> Context a
 gitCommits config =
  mconcat
    [ constField "gitWebUrl" (config ^. siteGitWebUrl),
-      field "gitSha1" (gitSha1Compiler root),
-      field "gitMessage" (gitMessageCompiler root),
+      field "gitSha1" (gitSha1Compiler siteSrc),
+      field "gitMessage" (gitMessageCompiler siteSrc),
      field "gitBranch" gitBranchCompiler,
-      gitFileField root "gitFilePath" gitFilePath,
-      gitFileField root "gitFileName" (takeFileName . gitFilePath),
-      gitFileField root "isFromSource" gitFileIsFromSource,
-      gitFileField root "isChanged" gitFileIsChanged
+      gitFileField siteSrc "gitFilePath" gitFilePath,
+      gitFileField siteSrc "gitFileName" (takeFileName . gitFilePath),
+      gitFileField siteSrc "isFromSource" gitFileIsFromSource,
+      gitFileField siteSrc "isChanged" gitFileIsChanged
    ]
  where
-    root = config ^. siteProviderDirectory
+    siteSrc = config ^. siteProviderDirectory

 gitSha1Compiler :: String -> Item a -> TemplateRunner a String
 gitSha1Compiler = gitLogField "%h"
@ -43,24 +43,24 @@ gitMessageCompiler = gitLogField "%s"
 type LogFormat = String

 gitLogField :: LogFormat -> String -> Item a -> TemplateRunner a String
-gitLogField format root item =
+gitLogField format siteSrc item =
  lift $ unsafeCompiler do
-    maybeResult <- gitLog format (Just $ root </> toFilePath (itemIdentifier item))
+    maybeResult <- gitLog format (Just $ siteSrc </> toFilePath (itemIdentifier item))
    case maybeResult of
      Just result -> return result
      Nothing -> fromJust <$> gitLog format Nothing

 gitFileField :: (IntoValue v a) => String -> String -> (GitFile -> v) -> Context a
-gitFileField root key f = field key $ fmap f . gitFileCompiler root
+gitFileField siteSrc key f = field key $ fmap f . gitFileCompiler siteSrc

 gitFileCompiler :: String -> Item a -> TemplateRunner a GitFile
-gitFileCompiler root item =
+gitFileCompiler siteSrc item =
  lift $
    GitFile gitFilePath
      <$> unsafeCompiler (doesFileExist gitFilePath)
      <*> unsafeCompiler (isChanged gitFilePath)
  where
-    gitFilePath = root </> toFilePath (itemIdentifier item)
+    gitFilePath = siteSrc </> toFilePath (itemIdentifier item)
    isChanged filePath = do
      let args = ["diff", "HEAD", filePath]
      (exitCode, stdout, _stderr) <- readProcessWithExitCode "git" args ""
--- a/src/Green/Template/Field.hs
+++ b/src/Green/Template/Field.hs
@ -27,6 +27,7 @@ defaultFields =
      withField,
      metadataField,
      titleFromFileField "title",
+      joinField "join",
      missingField
    ]

@ -169,3 +170,12 @@ metadataPriorityField :: String -> [String] -> Context a
 metadataPriorityField key priorityKeys = field key f
  where
    f item = lift $ foldl (<|>) (noResult "") (flip getMetadataField item <$> priorityKeys)
+
+joinField :: String -> Context String
+joinField key = functionField2 key f
+  where
+    f (separator :: ContextValue String) (items :: [ContextValue String]) =
+      tplWithCall (key ++ " with separator " ++ show separator) do
+        separator' <- fromValue separator :: TemplateRunner String String
+        items' <- mapM fromValue items
+        return $ intercalate separator' items'
--- a/src/Green/Template/Source/Parser.hs
+++ b/src/Green/Template/Source/Parser.hs
@ -24,6 +24,7 @@ block =
  tryOne
    [ offBlock,
      commentBlock,
+      includeBlock,
      chromeBlock,
      altBlock,
      expressionBlock,
@ -43,6 +44,17 @@ commentBlock = labeled "CommentBlock" $
    closeBlock
    return $ CommentBlock value

+includeBlock :: Parser Block
+includeBlock = labeled "IncludeBlock" $
+  withPosition do
+    -- {{>
+    withTag IncludeBlockToken
+    -- ..."this/file" + ext...
+    e <- expression
+    -- }}
+    closeBlock
+    return $ IncludeBlock e
+
 offBlock :: Parser Block
 offBlock = labeled "OffBlock" $
  withPosition do
--- a/src/Green/Template/Tags.hs
+++ b/src/Green/Template/Tags.hs
@ -1,74 +0,0 @@
-module Green.Template.Tags
-  ( module Green.Template.Tags,
-    Tags,
-    buildTags,
-    getTags,
-  )
-where
-
-import Green.Common
-import Green.Template.Context
-import Hakyll (MonadMetadata, Tags, buildTags, getTags, renderTagCloudWith)
-import qualified Hakyll
-
-makeTagId :: String -> Identifier
-makeTagId = Hakyll.fromCapture "tags/*.html"
-
-tagsField :: String -> Context a
-tagsField key = field key $ lift . getTags . itemIdentifier
-
-tagLinksFieldWith :: String -> (Identifier -> Compiler [String]) -> Context a
-tagLinksFieldWith key f = field key f'
-  where
-    f' item = lift do
-      tags <- f $ itemIdentifier item
-      links <- mapM makeLink' tags
-      return $ intercalate ", " links
-    makeLink' tag =
-      getRoute (makeTagId tag) >>= \case
-        Just url -> return $ "<a class=\"tag\" href=\"/" ++ url ++ "\">" ++ tag ++ "</a>"
-        Nothing -> return $ "<span class=\"tag\">" ++ tag ++ "</span>"
-
-tagLinksField :: String -> Context a
-tagLinksField key = tagLinksFieldWith key getTags
-
-categoryLinksField :: String -> Context a
-categoryLinksField key = tagLinksFieldWith key getCategory
-
-makeCategoryId :: String -> Identifier
-makeCategoryId = Hakyll.fromCapture "categories/*.html"
-
-categoriesField :: String -> Context a
-categoriesField key = field key $ lift . getCategory . itemIdentifier
-
-getCategory :: (MonadMetadata m) => Identifier -> m [String]
-getCategory = (filter isCategory <$>) . Hakyll.getCategory
-  where
-    isCategory = not . (`elem` sourceDirs)
-    sourceDirs = ["_posts", "_drafts"]
-
-buildCategories :: (MonadMetadata m) => Pattern -> (String -> Identifier) -> m Tags
-buildCategories = Hakyll.buildTagsWith getCategory
-
-renderTagCloud :: Tags -> Compiler String
-renderTagCloud = renderTagCloudWith makeLink unwords minSize maxSize
-  where
-    minSize = 1.0
-    maxSize = 2.0
-
-makeLink :: Double -> Double -> String -> String -> Int -> Int -> Int -> String
-makeLink _minSize _maxSize tag url count minCount maxCount =
-  mconcat
-    [ "<a",
-      " data-count=\"" ++ show count ++ "\"",
-      " class=\"tag\"",
-      " style=\""
-        ++ mconcat
-          [ ";--count:" ++ show count,
-            ";--min-count:" ++ show minCount,
-            ";--max-count:" ++ show maxCount
-          ]
-        ++ "\"",
-      " href=\"" ++ url ++ "\"",
-      ">" ++ tag ++ "</a>"
-    ]