sitepipe-0.1.0: app/Main.hs

{-# language OverloadedStrings #-}
{-# language DuplicateRecordFields #-}
module Main where

import SitePipe
import qualified Data.Map as M
import Data.Text.Lens
import qualified Data.Text as T
import qualified Text.Mustache as MT
import qualified Text.Mustache.Types as MT

main :: IO ()
main = siteWithGlobals funcs $ do
  posts <- fmap processPostTags <$> resourceLoader markdownReader ["posts/*.md"]
  let tags = byTags posts
  writeTemplate "templates/index.html" [mkIndexEnv posts tags]
  writeTemplate "templates/base.html" (over (key "tags" . _Array . traverse) stripHTMLSuffix <$> posts)
  writeTemplate "templates/tag.html" (stripPostsHTMLSuffix <$> tags)
  staticAssets

funcs :: MT.Value
funcs = MT.object
  ["truncate" MT.~> MT.overText (T.take 30)
  ]

stripHTMLSuffix :: Value -> Value
stripHTMLSuffix obj = obj
  & key "url" . _String . unpacked %~ setExt ""

stripPostsHTMLSuffix :: Value -> Value
stripPostsHTMLSuffix tag = tag
  & key "posts" . _Array . traversed . key "url" . _String . unpacked %~ setExt ""

mkIndexEnv :: [Value] -> [Value] -> Value
mkIndexEnv posts tags =
  object [ "posts" .= (stripHTMLSuffix <$> posts)
         , "tags" .= (stripHTMLSuffix <$> tags)
         , "url" .= ("/index.html" :: String)
         ]

staticAssets :: SiteM ()
staticAssets = copyFiles
    [ "css/*.css"
    , "js/"
    , "images/"
    ]

processPostTags :: Value -> Value
processPostTags post = post & key "tags" . _Array . traverse %~ mkSimpleTag
  where
    mkSimpleTag (String t) = makeTag (T.unpack t, [])
    mkSimpleTag x = x

byTags :: [Value] -> [Value]
byTags postList = makeTag <$> M.toList tagMap
  where
    tagMap = M.unionsWith mappend (fmap toMap postList)
    toMap post = M.fromList (zip (post ^.. key "tags" . values . key "tag" . _String . unpacked) $ repeat [post])

makeTag :: (String, [Value]) -> Value
makeTag (tagname, posts) = object
  [ "tag" .= tagname
  , "url" .= ("/tag/" ++ tagname ++ ".html")
  , "posts" .= posts
  ]