~jack/jackkelly-name

ref: 8de6f1521045b2fbc086cb30d9fc901d7170ab5a jackkelly-name/src/Blog/Posts.hs -rw-r--r-- 2.8 KiB
8de6f152Jack Kelly Import site code from unified repo 2 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
module Blog.Posts (blogPosts, blogPostsPattern, blogPostContext, slug) where

import           Blog.Util (baseBlogContext, parseBlogDate)
import           Control.Applicative (empty)
import           Data.Aeson (Value(..))
import           Data.Char (toLower)
import           Data.Default (def)
import           Data.HashMap.Lazy ((!))
import           Data.List (sort)
import qualified Data.Map as Map
import qualified Data.Text as T
import           Data.Time (defaultTimeLocale, formatTime)
import           Hakyll
import           Site (sectionLabel)
import           System.FilePath ((</>))
import qualified Text.Pandoc as P

blogPostsPattern :: Pattern
blogPostsPattern = "blog/*.markdown"

blogPosts :: Tags -> Rules ()
blogPosts tags =
  match blogPostsPattern $ do
    route blogPostRoute
    compile $ do
      postContext <- blogPostContext tags

      let
        pageContext = labeledTitle <> postContext
        labeledTitle = field "title" $ \item ->
          getMetadataField (itemIdentifier item) "title"
          >>= maybe empty (pure . sectionLabel . ("Blog":) . pure)

      blogPostCompiler
        >>= saveSnapshot "content"
        >>= loadAndApplyTemplate "templates/blog/post.html" postContext
        >>= loadAndApplyTemplate "templates/default.html" pageContext
        >>= relativizeUrls

blogPostRoute :: Routes
blogPostRoute = metadataRoute routeFromMeta where
  routeFromMeta meta = constRoute path where
    path = "blog"
      </> "archives"
      </> dateP
      </> (slug . T.unpack) title
      </> "index.html"
    String title = meta ! "title"
    dateP = formatTime defaultTimeLocale "%Y/%m/%d" date
    date = parseBlogDate . T.unpack $ dateS
    String dateS = meta ! "date"

blogPostCompiler :: Compiler (Item String)
blogPostCompiler = pandocCompilerWith readerOptions writerOptions where
  readerOptions = def
    { P.readerExtensions =
        P.disableExtension P.Ext_implicit_figures P.pandocExtensions
    }
  writerOptions = def

blogPostContext :: Tags -> Compiler (Context String)
blogPostContext tags = do
  posts <- sort <$> getMatches blogPostsPattern

  let
    -- Build tables of previous/next posts in history
    prevs = Map.fromList $ zip (tail posts) posts
    nexts = Map.fromList . zip posts . tail $ posts

    lookupUrl dict ident = case Map.lookup ident dict of
      Nothing -> empty
      Just ident' -> maybe empty toUrl <$> getRoute ident'

  pure $ mconcat
    [ tagsField "tags" tags
    , dateField "date" "%B %e, %Y"
    , field "prev" $ lookupUrl prevs . itemIdentifier
    , field "next" $ lookupUrl nexts . itemIdentifier
    , teaserField "teaser" "content"
    , baseBlogContext
    ]

slug :: String -> String
slug = filter (not . (`elem` ("',!?()+:" :: String)))
  . replace "&. " '_'
  . map toLower
  where
    replace :: String -> Char -> String -> String
    replace from to xs = [ if x `elem` from then to else x | x <- xs ]