{-# LANGUAGE OverloadedStrings #-} {-| This module provides a standard way of building and generating blog posts. Check out the Blog example . You can also follow the [blogging tutorial here](https://elbenshira.com/pencil/tutorials/03-blogging/). To generate a blog for your website, first create a @blog/@ directory in your web page source directory. Then, name your blog posts in this format: > yyyy-mm-dd-title-of-blog-post.markdown Where @yyyy-mm-dd@ should be something like @2019-12-30@. This isn't used for anything other than to keep each post ordered in the directory, for your ease of viewing. Each post is expected to have a preamble that has at least @postTitle@ and @date@ defined. The date set in the preamble is used as the sort order of the blog posts. The other variables are optional. > You can mark a post as a draft via the @draft@ variable, so that it won't be loaded when you call 'loadPosts'. You can also set the post's tags using, as seen above in @tags@. Then, use 'loadPosts' to load the entire @blog/@ directory. In the example below, @layout.html@ defines the outer HTML structure (with global components like navigation), and @blog-post.html@ is a generic blog post container that renders @${postTitle}@ as a header, @${date}@, and @${body}@ for the post body. @ layout <- 'load' "layout.html" postLayout <- 'load' "blog-post.html" posts <- 'loadPosts' "blog/" render (fmap (layout <|| postLayout <|) posts) @ -} module Pencil.Blog ( loadPosts , postUrl , injectTitle -- * Tags -- | You can add tags to blog posts. , Tag , buildTagPages , buildTagPagesWith , injectTags ) where import Pencil.Config import Pencil.Env import Pencil.App import Pencil.Content import Control.Monad (foldM) import Control.Monad.Reader (asks) import qualified Data.HashMap.Strict as H import qualified Data.List as L import qualified Data.Text as T import qualified System.FilePath as FP -- | Loads the given directory as a series of blog posts, sorted by the @date@ -- preamble environment variable. Posts with @draft: true@ are filtered out. -- -- @ -- posts <- loadPosts "blog/" -- @ loadPosts :: FilePath -> PencilApp [Page] loadPosts fp = do posts <- loadDir False fp return $ (filterByVar True "draft" (VBool True /=) . sortByVar "date" dateOrdering) (fmap (rename postUrl) posts) -- | Rewrites file path for blog posts. -- -- > postUrl "/blog/2011-01-01-post-title.html" -- > -- "/blog/1-post-title.html/" -- postUrl :: FilePath -> FilePath postUrl fp = FP.replaceFileName fp (drop 11 (FP.takeBaseName fp)) ++ "/" -- | Given that the current @Page@ has a @postTitle@ in the environment, inject -- the post title into the @title@ environment variable, prefixed with the given -- title prefix. -- -- This is useful for generating the @\${title}\@ tags in your -- container layout. -- -- For example, if the page's preamble has @postTitle: "The Meaning of Life"@, -- then the snippet below will insert a @title@ variable with the value @"The -- Meaning of Life - My Awesome Website"@: -- -- @ -- injectTitle "My Awesome Website" post -- @ -- injectTitle :: T.Text -- ^ Title prefix -> Page -> Page injectTitle titlePrefix page = let title = case H.lookup "postTitle" (getPageEnv page) of Just (VText t) -> T.append (T.append t " - ") titlePrefix _ -> titlePrefix env' = insertText "title" title (getPageEnv page) in setPageEnv env' page -- | Like, you know, a hashtag. Wraps a text. type Tag = T.Text -- | Finds all the tags from the given pages, and generates a page for each tag -- found. Each tag page has a variable "posts" containing all pages that have -- the tag. -- -- Helper of 'buildTagPagesWith' defaulting to the variable name @posts@, and -- the tag index page file path @blog\/tags\/my-tag-name\/@. -- -- @ -- tagPages <- buildTagPages pages -- @ -- buildTagPages :: FilePath -> [Page] -> PencilApp (H.HashMap Tag Page) buildTagPages tagPageFp = buildTagPagesWith tagPageFp "posts" (\tag _ -> "blog/tags/" ++ T.unpack tag ++ "/") -- | Build the tag index pages. -- -- Given blog post @Page@s with @tags@ variables in its PREAMBLE, builds @Page@s that -- contain in its environment the list of @Page@s that were tagged with that -- particular tag. Returns a map of tag of the tag index page. -- -- @ -- tagPages <- buildTagPagesWith -- "tag-list.html" -- "posts" -- (\\tag _ -> "blog\/tags\/" ++ 'Data.Text.unpack' tag ++ "\/") -- posts -- @ buildTagPagesWith :: FilePath -- ^ Partial to load for the Tag index pages -> T.Text -- ^ Variable name inserted into Tag index pages for the list of -- Pages tagged with the specified tag -> (Tag -> FilePath -> FilePath) -- ^ Function to generate the URL of the tag pages -> [Page] -> PencilApp (H.HashMap Tag Page) buildTagPagesWith tagPageFp pagesVar fpf pages = do env <- asks getEnv let tagMap = groupByElements "tags" pages -- Build a mapping of tag to the tag list Page foldM (\acc (tag, taggedPosts) -> do tagPage <- rename (fpf tag) <$> load tagPageFp -- Generate the URL that this tag page will use. let url = T.pack $ "/" ++ getFilePath tagPage tagEnv <- (insertPages pagesVar taggedPosts . insertText "tag" tag . insertText "this.url" url . merge (getPageEnv tagPage)) env return $ H.insert tag (setPageEnv tagEnv tagPage) acc ) H.empty (H.toList tagMap) -- | Injects the tag map (usually generated by 'buildTagPages' or -- 'buildTagPagesWith') into the page's environment as the variable @tags@, -- which is an @VEnvList@. injectTags :: H.HashMap Tag Page -> Page -> Page injectTags tagMap page = -- Build up an env list of tag to that tag page's env. This is so that we can -- have access to the URL of the tag index pages. let envs = case H.lookup "tags" (getPageEnv page) of Just (VArray tags) -> L.foldl' (\acc envData -> case envData of VText tag -> case H.lookup tag tagMap of Just tagIndexPage -> getPageEnv tagIndexPage : acc _ -> acc _ -> acc) [] tags _ -> [] -- Overwrite the VArray "tags" variable in the post Page with VEnvList of the -- loaded Tag index pages. This is so that when we render the blog posts, we -- have access to the URL of the Tag index. env' = if null envs then getPageEnv page else insert "tags" (VEnvList envs) (getPageEnv page) in setPageEnv env' page