{-# LANGUAGE GHC2021 #-} {-# LANGUAGE OverloadedStrings #-} -- | Author system — treats authors like tags. -- -- Author pages live at /authors/{slug}/index.html. -- Items with no "authors" frontmatter key default to Levi Neuwirth. -- -- Frontmatter format (name-only or name|url — url part is ignored now): -- authors: -- - "Levi Neuwirth" -- - "Alice Smith | https://alice.example" -- url ignored; link goes to /authors/alice-smith/ module Authors ( buildAllAuthors , applyAuthorRules , authorLinksField ) where import Data.Char (isAlphaNum, toLower) import Data.Maybe (fromMaybe) import Hakyll import Hakyll.Core.Metadata (lookupStringList) import Pagination (sortAndGroup) import Tags (tagLinksField) -- --------------------------------------------------------------------------- -- Slug helpers -- --------------------------------------------------------------------------- -- | Lowercase, replace spaces with hyphens, strip anything else. slugify :: String -> String slugify = map (\c -> if c == ' ' then '-' else c) . filter (\c -> isAlphaNum c || c == ' ') . map toLower -- | Extract the author name from a "Name | url" entry, trimming whitespace. nameOf :: String -> String nameOf s = strip $ case break (== '|') s of { (n, _) -> n } where strip = reverse . dropWhile (== ' ') . reverse . dropWhile (== ' ') -- --------------------------------------------------------------------------- -- Constants -- --------------------------------------------------------------------------- defaultAuthor :: String defaultAuthor = "Levi Neuwirth" allContent :: Pattern allContent = ("content/essays/*.md" .||. "content/blog/*.md") .&&. hasNoVersion -- --------------------------------------------------------------------------- -- Tag-like helpers (mirror of Tags.hs) -- --------------------------------------------------------------------------- -- | Returns all author names for an identifier. -- Defaults to ["Levi Neuwirth"] when no "authors" key is present. getAuthors :: MonadMetadata m => Identifier -> m [String] getAuthors ident = do meta <- getMetadata ident let entries = fromMaybe [] (lookupStringList "authors" meta) return $ if null entries then [defaultAuthor] else map nameOf entries -- | Canonical identifier for an author's index page (page 1). authorIdentifier :: String -> Identifier authorIdentifier name = fromFilePath $ "authors/" ++ slugify name ++ "/index.html" -- | Paginated identifier: page 1 → authors/{slug}/index.html -- page N → authors/{slug}/page/N/index.html authorPageId :: String -> PageNumber -> Identifier authorPageId slug 1 = fromFilePath $ "authors/" ++ slug ++ "/index.html" authorPageId slug n = fromFilePath $ "authors/" ++ slug ++ "/page/" ++ show n ++ "/index.html" -- --------------------------------------------------------------------------- -- Build + rules -- --------------------------------------------------------------------------- buildAllAuthors :: Rules Tags buildAllAuthors = buildTagsWith getAuthors allContent authorIdentifier applyAuthorRules :: Tags -> Context String -> Rules () applyAuthorRules authors baseCtx = tagsRules authors $ \name pat -> do let slug = slugify name paginate <- buildPaginateWith sortAndGroup pat (authorPageId slug) paginateRules paginate $ \pageNum pat' -> do route idRoute compile $ do items <- recentFirst =<< loadAll (pat' .&&. hasNoVersion) let ctx = listField "items" itemCtx (return items) <> paginateContext paginate pageNum <> constField "author" name <> constField "title" name <> baseCtx makeItem "" >>= loadAndApplyTemplate "templates/author-index.html" ctx >>= loadAndApplyTemplate "templates/default.html" ctx >>= relativizeUrls where itemCtx = dateField "date" "%-d %B %Y" <> tagLinksField "item-tags" <> defaultContext -- --------------------------------------------------------------------------- -- Context field -- --------------------------------------------------------------------------- -- | Exposes each item's authors as @author-name@ / @author-url@ pairs. -- All links point to /authors/{slug}/, regardless of any URL in frontmatter. -- Defaults to Levi Neuwirth when no "authors" frontmatter key is present. -- -- Usage in templates: -- $for(author-links)$$author-name$$sep$, $endfor$ authorLinksField :: Context a authorLinksField = listFieldWith "author-links" ctx $ \item -> do meta <- getMetadata (itemIdentifier item) let entries = fromMaybe [] (lookupStringList "authors" meta) names = if null entries then [defaultAuthor] else map nameOf entries return $ map (\n -> Item (fromFilePath "") (n, "/authors/" ++ slugify n ++ "/")) names where ctx = field "author-name" (return . fst . itemBody) <> field "author-url" (return . snd . itemBody)