128 lines
5.0 KiB
Haskell
128 lines
5.0 KiB
Haskell
{-# 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)$<a href="$author-url$">$author-name$</a>$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)
|