neuwirth/levineuwirth.org
neuwirth
/
levineuwirth.org
1
1
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Core build cleanups: guards, pattern unification, noResult hygiene 

- Library page no longer hard-depends on content/library.md; deleting
  it degrades to no intro block (AUDIT §2.8)
- primaryPortalOf accepts scalar comma-form tags via getTags, matching
  the tag system (§2.9)
- allContent gains me/ and memento-mori/ so their outgoing links join
  the backlinks graph; photography exclusion now documented (§2.10)
- Paginated tag pages partition AND sort by the same revision-aware
  display date — cross-page order is monotone again (§2.11)
- New stripPrefixRoute replaces gsubRoute at 17 call sites: prefix-only
  stripping, no mid-path mangling; route inventory verified identical
  (§2.15)
- random-pages uses canonical patterns (collection poems randomizable);
  pattern literals replaced with Patterns imports; duplicate local
  poetry patterns deleted; flat/collection poetry rules merged (§2.17)
- noResult instead of empty-list/fail for tagLinksField, dotsField,
  abstract/description/summary/bibliography/further-reading, plus the
  confidence-trend, overall-score, has-score, has-movements, and
  movement-audio fields — no more empty wrappers or [ERROR] log noise
  for legitimately-absent values (§2.17)
- tagItemCtx composes siteCtx, so monograms render on tag pages (§2.17)
- readingTime ceilings (399 words -> 2 min); authorSlugify comment
  fixed to match behavior, code untouched for URL stability; stale
  portal-count comments corrected (§2.17)

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
Levi Neuwirth 2026-06-10 11:13:08 -04:00
parent 945086421a
commit c8eeaaa9bc
6 changed files with 192 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
build/Contexts.hs
View File

@ -176,10 +176,17 @@ pageScriptsField = listFieldWith "page-scripts" ctx $ \item -> do
-- | List context field exposing an item's own (non-expanded) tags as -- | List context field exposing an item's own (non-expanded) tags as
-- @tag-name@ / @tag-url@ objects. -- @tag-name@ / @tag-url@ objects.
-- --
-- Fails with 'noResult' when the item has no tags — same discipline
-- as the @Excluding@ variants below — so @$if(...)$@ gates are false
-- and templates don't emit empty tag-wrapper markup.
--
-- $for(essay-tags)$<a href="$tag-url$">$tag-name$</a>$endfor$ -- $for(essay-tags)$<a href="$tag-url$">$tag-name$</a>$endfor$
tagLinksField :: String -> Context a tagLinksField :: String -> Context a
tagLinksField fieldName = listFieldWith fieldName ctx $ \item -> tagLinksField fieldName = listFieldWith fieldName ctx $ \item -> do
map toItem <$> getTags (itemIdentifier item) ts <- getTags (itemIdentifier item)
if null ts
then noResult "no tags"
else return (map toItem ts)
where where
toItem t = Item (fromFilePath (t ++ "/index.html")) t toItem t = Item (fromFilePath (t ++ "/index.html")) t
ctx = field "tag-name" (return . itemBody) ctx = field "tag-name" (return . itemBody)
@ -351,7 +358,7 @@ abstractField :: Context String
abstractField = field "abstract" $ \item -> do abstractField = field "abstract" $ \item -> do
meta <- getMetadata (itemIdentifier item) meta <- getMetadata (itemIdentifier item)
case lookupString "abstract" meta of case lookupString "abstract" meta of
Nothing -> fail "no abstract" Nothing -> noResult "no abstract"
Just src -> do Just src -> do
let pandocResult = runPure $ do let pandocResult = runPure $ do
doc <- readMarkdown defaultHakyllReaderOptions (T.pack src) doc <- readMarkdown defaultHakyllReaderOptions (T.pack src)
@ -385,7 +392,7 @@ descriptionField :: Context String
descriptionField = field "description" $ \item -> do descriptionField = field "description" $ \item -> do
meta <- getMetadata (itemIdentifier item) meta <- getMetadata (itemIdentifier item)
case lookupString "abstract" meta of case lookupString "abstract" meta of
Nothing -> fail "no abstract" Nothing -> noResult "no abstract"
Just src -> do Just src -> do
let pandocResult = runPure $ do let pandocResult = runPure $ do
doc <- readMarkdown defaultHakyllReaderOptions (T.pack src) doc <- readMarkdown defaultHakyllReaderOptions (T.pack src)
@ -422,7 +429,7 @@ summaryField :: Context String
summaryField = field "summary" $ \item -> do summaryField = field "summary" $ \item -> do
meta <- getMetadata (itemIdentifier item) meta <- getMetadata (itemIdentifier item)
case lookupString "summary" meta of case lookupString "summary" meta of
Nothing -> fail "no summary" Nothing -> noResult "no summary"
Just src -> do Just src -> do
let pandocResult = runPure $ do let pandocResult = runPure $ do
doc <- readMarkdown defaultHakyllReaderOptions (T.pack src) doc <- readMarkdown defaultHakyllReaderOptions (T.pack src)
@ -468,11 +475,11 @@ bibliographyField = bibContent <> hasCitations
where where
bibContent = field "bibliography" $ \item -> do bibContent = field "bibliography" $ \item -> do
bib <- itemBody <$> loadSnapshot (itemIdentifier item) "bibliography" bib <- itemBody <$> loadSnapshot (itemIdentifier item) "bibliography"
if null bib then fail "no bibliography" else return bib if null bib then noResult "no bibliography" else return bib
hasCitations = field "has-citations" $ \item -> do hasCitations = field "has-citations" $ \item -> do
bib <- itemBody <$> (loadSnapshot (itemIdentifier item) "bibliography" bib <- itemBody <$> (loadSnapshot (itemIdentifier item) "bibliography"
:: Compiler (Item String)) :: Compiler (Item String))
if null bib then fail "no citations" else return "true" if null bib then noResult "no citations" else return "true"
-- | Further-reading field: loads the further-reading HTML saved by essayCompiler. -- | Further-reading field: loads the further-reading HTML saved by essayCompiler.
-- Returns noResult (making $if(further-reading-refs)$ false) when empty. -- Returns noResult (making $if(further-reading-refs)$ false) when empty.
@ -480,22 +487,26 @@ furtherReadingField :: Context String
furtherReadingField = field "further-reading-refs" $ \item -> do furtherReadingField = field "further-reading-refs" $ \item -> do
fr <- itemBody <$> (loadSnapshot (itemIdentifier item) "further-reading-refs" fr <- itemBody <$> (loadSnapshot (itemIdentifier item) "further-reading-refs"
:: Compiler (Item String)) :: Compiler (Item String))
if null fr then fail "no further reading" else return fr if null fr then noResult "no further reading" else return fr
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Epistemic fields -- Epistemic fields
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- | Render an integer 1–5 frontmatter key as filled/empty dot chars. -- | Render an integer 1–5 frontmatter key as filled/empty dot chars.
-- Returns @noResult@ when the key is absent or unparseable. -- Returns @noResult@ when the key is absent, unparseable, or below 1
-- (a zero would otherwise render five empty circles); values above 5
-- clamp to 5.
dotsField :: String -> String -> Context String dotsField :: String -> String -> Context String
dotsField ctxKey metaKey = field ctxKey $ \item -> do dotsField ctxKey metaKey = field ctxKey $ \item -> do
meta <- getMetadata (itemIdentifier item) meta <- getMetadata (itemIdentifier item)
case lookupString metaKey meta >>= readMaybe of case lookupString metaKey meta >>= readMaybe of
Nothing -> fail (ctxKey ++ ": not set") Nothing -> noResult (ctxKey ++ ": not set")
Just (n :: Int) -> Just (n :: Int)
let v = max 0 (min 5 n) | n < 1 -> noResult (ctxKey ++ ": value below the 1-5 scale")
in return (replicate v '\x25CF' ++ replicate (5 - v) '\x25CB') | otherwise ->
let v = min 5 n
in return (replicate v '\x25CF' ++ replicate (5 - v) '\x25CB')
-- | @$confidence-trend$@: ↑, ↓, or → derived from the last two entries -- | @$confidence-trend$@: ↑, ↓, or → derived from the last two entries
-- in the @confidence-history@ frontmatter list. Returns @noResult@ when -- in the @confidence-history@ frontmatter list. Returns @noResult@ when
@ -519,11 +530,11 @@ confidenceTrendField = field "confidence-trend" $ \item -> do
"[Marks] " ++ toFilePath (itemIdentifier item) ++ "[Marks] " ++ toFilePath (itemIdentifier item) ++
": confidence: proved is incompatible with confidence-history; ignoring history" ": confidence: proved is incompatible with confidence-history; ignoring history"
Nothing -> return () Nothing -> return ()
fail "confidence is proved; trend suppressed" noResult "confidence is proved; trend suppressed"
else case lookupStringList "confidence-history" meta of else case lookupStringList "confidence-history" meta of
Nothing -> fail "no confidence history" Nothing -> noResult "no confidence history"
Just xs -> case lastTwo xs of Just xs -> case lastTwo xs of
Nothing -> fail "no confidence history" Nothing -> noResult "no confidence history"
Just (prevS, curS) -> Just (prevS, curS) ->
let prev = readMaybe prevS :: Maybe Int let prev = readMaybe prevS :: Maybe Int
cur = readMaybe curS :: Maybe Int cur = readMaybe curS :: Maybe Int
@ -589,7 +600,7 @@ overallScoreField = field "overall-score" $ \item -> do
+ fromIntegral (ev - 1) / 4.0 * 0.4 + fromIntegral (ev - 1) / 4.0 * 0.4
score = max 0 (min 100 (round (raw * 100.0) :: Int)) score = max 0 (min 100 (round (raw * 100.0) :: Int))
in return (show score) in return (show score)
_ -> fail "overall-score: confidence or evidence not set" _ -> noResult "overall-score: confidence or evidence not set"
-- | @$confidence$@: numeric override that suppresses the @proved@ / -- | @$confidence$@: numeric override that suppresses the @proved@ /
-- @proven@ sentinel. When the frontmatter value is parseable as an -- @proven@ sentinel. When the frontmatter value is parseable as an
@ -1002,7 +1013,7 @@ compositionCtx =
hasScoreField = field "has-score" $ \item -> do hasScoreField = field "has-score" $ \item -> do
meta <- getMetadata (itemIdentifier item) meta <- getMetadata (itemIdentifier item)
let pages = fromMaybe [] (lookupStringList "score-pages" meta) let pages = fromMaybe [] (lookupStringList "score-pages" meta)
if null pages then fail "no score pages" else return "true" if null pages then noResult "no score pages" else return "true"
scorePageCountField = field "score-page-count" $ \item -> do scorePageCountField = field "score-page-count" $ \item -> do
meta <- getMetadata (itemIdentifier item) meta <- getMetadata (itemIdentifier item)
@ -1020,7 +1031,7 @@ compositionCtx =
hasMovementsField = field "has-movements" $ \item -> do hasMovementsField = field "has-movements" $ \item -> do
meta <- getMetadata (itemIdentifier item) meta <- getMetadata (itemIdentifier item)
if null (parseMovements meta) then fail "no movements" else return "true" if null (parseMovements meta) then noResult "no movements" else return "true"
movementsListField = listFieldWith "movements" movCtx $ \item -> do movementsListField = listFieldWith "movements" movCtx $ \item -> do
meta <- getMetadata (itemIdentifier item) meta <- getMetadata (itemIdentifier item)
@ -1038,9 +1049,9 @@ compositionCtx =
<> field "movement-page" (return . show . movPage . itemBody) <> field "movement-page" (return . show . movPage . itemBody)
<> field "movement-duration" (return . movDuration . itemBody) <> field "movement-duration" (return . movDuration . itemBody)
<> field "movement-audio" <> field "movement-audio"
(\i -> maybe (fail "no audio") return (movAudio (itemBody i))) (\i -> maybe (noResult "no audio") return (movAudio (itemBody i)))
<> field "has-audio" <> field "has-audio"
(\i -> maybe (fail "no audio") (const (return "true")) (\i -> maybe (noResult "no audio") (const (return "true"))
(movAudio (itemBody i))) (movAudio (itemBody i)))
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------

3
build/Pagination.hs
View File

@ -12,6 +12,7 @@ module Pagination
) where ) where
import Hakyll import Hakyll
import Patterns (blogPattern)
-- | Items per page across most paginated lists (e.g. the blog). -- | Items per page across most paginated lists (e.g. the blog).
@ -39,7 +40,7 @@ blogPageId n = fromFilePath $ "blog/page/" ++ show n ++ "/index.html"
-- @baseCtx@: site-level context (siteCtx). -- @baseCtx@: site-level context (siteCtx).
blogPaginateRules :: Context String -> Context String -> Rules () blogPaginateRules :: Context String -> Context String -> Rules ()
blogPaginateRules itemCtx baseCtx = do blogPaginateRules itemCtx baseCtx = do
paginate <- buildPaginateWith sortAndGroup ("content/blog/*.md" .&&. hasNoVersion) blogPageId paginate <- buildPaginateWith sortAndGroup (blogPattern .&&. hasNoVersion) blogPageId
paginateRules paginate $ \pageNum pat -> do paginateRules paginate $ \pageNum pat -> do
route idRoute route idRoute
compile $ do compile $ do

11
build/Patterns.hs
View File

@ -122,7 +122,14 @@ allWritings :: Pattern
allWritings = essayPattern .||. blogPattern .||. poetryPattern .||. fictionPattern allWritings = essayPattern .||. blogPattern .||. poetryPattern .||. fictionPattern
-- | Every content file the backlinks pass should index. Includes music -- | Every content file the backlinks pass should index. Includes music
-- landing pages and top-level standalone pages, in addition to writings. -- landing pages and top-level standalone pages, in addition to writings,
-- plus the two directory-form standalone essays (@content/me/index.md@
-- and @content/memento-mori/index.md@) — full essays rendered with
-- backlinks, whose outgoing links must be visible to the link graph.
--
-- Photography is deliberately excluded: photo pages do not render the
-- backlinks block (see 'Contexts.photographyCtx'), and caption-scale
-- entries would add link-graph noise with no consuming surface.
allContent :: Pattern allContent :: Pattern
allContent = allContent =
essayPattern essayPattern
@ -131,6 +138,8 @@ allContent =
.||. fictionPattern .||. fictionPattern
.||. musicPattern .||. musicPattern
.||. standalonePagesPattern .||. standalonePagesPattern
.||. "content/me/index.md"
.||. "content/memento-mori/index.md"
-- | Content shown on author index pages — essays + blog posts. -- | Content shown on author index pages — essays + blog posts.
-- (Poetry and fiction have their own dedicated indexes and are not -- (Poetry and fiction have their own dedicated indexes and are not

184
build/Site.hs
View File

@ -40,7 +40,7 @@ import Pagination (blogPaginateRules)
import Stats (statsRules) import Stats (statsRules)
-- | Home-page portal grid order. Canonical ordering authority for every -- | Home-page portal grid order. Canonical ordering authority for every
-- rendering of the eight portals (currently: the home page; future -- rendering of the portals (currently: the home page; future
-- consumers follow this list). Each entry is (display name, tag name); -- consumers follow this list). Each entry is (display name, tag name);
-- the tag name is the key to everything else — URL (@/\<tag\>/@), -- the tag name is the key to everything else — URL (@/\<tag\>/@),
-- sidecar path (@content\/tag-meta\/\<tag\>.md@), and the Tags.hs -- sidecar path (@content\/tag-meta\/\<tag\>.md@), and the Tags.hs
@ -73,13 +73,17 @@ libraryShelfMax = 5
libraryIntroId :: Identifier libraryIntroId :: Identifier
libraryIntroId = fromFilePath "content/library.md" libraryIntroId = fromFilePath "content/library.md"
-- Poems inside collection subdirectories, excluding their index pages. -- | Route that strips a literal prefix from the identifier's path.
collectionPoems :: Pattern -- Hakyll's 'gsubRoute' replaces /every/ occurrence of its pattern, so
collectionPoems = "content/poetry/*/*.md" .&&. complement "content/poetry/*/index.md" -- @gsubRoute "content/"@ would also mangle a co-located directory that
-- happened to be named @content@ deeper in the path
-- All poetry content (flat + collection), excluding collection index pages. -- (@content/essays/slug/content/data.csv@ → @essays/slug/data.csv@).
allPoetry :: Pattern -- This touches only the leading occurrence; identifiers that don't
allPoetry = "content/poetry/*.md" .||. collectionPoems -- start with the prefix pass through unchanged.
stripPrefixRoute :: String -> Routes
stripPrefixRoute prefix = customRoute $ \ident ->
let fp = toFilePath ident
in fromMaybe fp (stripPrefix prefix fp)
feedConfig :: FeedConfiguration feedConfig :: FeedConfiguration
feedConfig = FeedConfiguration feedConfig = FeedConfiguration
@ -168,18 +172,18 @@ rules = do
-- Per-page JS files — authored alongside content in content/**/*.js. -- Per-page JS files — authored alongside content in content/**/*.js.
-- Draft JS is handled by a separate dev-only rule below. -- Draft JS is handled by a separate dev-only rule below.
match ("content/**/*.js" .&&. complement "content/drafts/**") $ do match ("content/**/*.js" .&&. complement "content/drafts/**") $ do
route $ gsubRoute "content/" (const "") route $ stripPrefixRoute "content/"
compile copyFileCompiler compile copyFileCompiler
-- Per-page JS co-located with draft essays (dev-only). -- Per-page JS co-located with draft essays (dev-only).
when isDev $ match "content/drafts/**/*.js" $ do when isDev $ match "content/drafts/**/*.js" $ do
route $ gsubRoute "content/" (const "") route $ stripPrefixRoute "content/"
compile copyFileCompiler compile copyFileCompiler
-- CSS — must be matched before the broad static/** rule to avoid -- CSS — must be matched before the broad static/** rule to avoid
-- double-matching (compressCssCompiler vs. copyFileCompiler). -- double-matching (compressCssCompiler vs. copyFileCompiler).
match "static/css/*" $ do match "static/css/*" $ do
route $ gsubRoute "static/" (const "") route $ stripPrefixRoute "static/"
compile compressCssCompiler compile compressCssCompiler
-- All other static files (fonts, JS, images, …). Build-time -- All other static files (fonts, JS, images, …). Build-time
@ -192,7 +196,7 @@ rules = do
.&&. complement "static/**/*.exif.yaml" .&&. complement "static/**/*.exif.yaml"
.&&. complement "static/**/*.palette.yaml" .&&. complement "static/**/*.palette.yaml"
) $ do ) $ do
route $ gsubRoute "static/" (const "") route $ stripPrefixRoute "static/"
compile copyFileCompiler compile copyFileCompiler
-- Templates -- Templates
@ -299,7 +303,7 @@ rules = do
-- SVG score fragments co-located with me/index.md. -- SVG score fragments co-located with me/index.md.
match "content/me/scores/*.svg" $ do match "content/me/scores/*.svg" $ do
route $ gsubRoute "content/me/" (const "") route $ stripPrefixRoute "content/me/"
compile copyFileCompiler compile copyFileCompiler
-- memento-mori/index.md — lives in its own directory so co-located SVG -- memento-mori/index.md — lives in its own directory so co-located SVG
@ -315,7 +319,7 @@ rules = do
-- SVG score fragments co-located with memento-mori/index.md. -- SVG score fragments co-located with memento-mori/index.md.
match "content/memento-mori/scores/*.svg" $ do match "content/memento-mori/scores/*.svg" $ do
route $ gsubRoute "content/memento-mori/" (const "") route $ stripPrefixRoute "content/memento-mori/"
compile copyFileCompiler compile copyFileCompiler
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
@ -354,7 +358,7 @@ rules = do
.&&. complement "content/colophon.md" .&&. complement "content/colophon.md"
.&&. complement "content/current.md" .&&. complement "content/current.md"
.&&. complement "content/library.md") $ do .&&. complement "content/library.md") $ do
route $ gsubRoute "content/" (const "") route $ stripPrefixRoute "content/"
`composeRoutes` setExtension "html" `composeRoutes` setExtension "html"
compile $ pageCompiler compile $ pageCompiler
>>= loadAndApplyTemplate "templates/page.html" pageCtx >>= loadAndApplyTemplate "templates/page.html" pageCtx
@ -414,7 +418,7 @@ rules = do
.&&. complement "content/essays/*.md" .&&. complement "content/essays/*.md"
.&&. complement "content/essays/*/index.md" .&&. complement "content/essays/*/index.md"
.&&. complement "content/essays/**/*.dims.yaml") $ do .&&. complement "content/essays/**/*.dims.yaml") $ do
route $ gsubRoute "content/" (const "") route $ stripPrefixRoute "content/"
compile copyFileCompiler compile copyFileCompiler
-- Static assets co-located with draft essays (dev-only). -- Static assets co-located with draft essays (dev-only).
@ -422,14 +426,14 @@ rules = do
.&&. complement "content/drafts/essays/*.md" .&&. complement "content/drafts/essays/*.md"
.&&. complement "content/drafts/essays/*/index.md" .&&. complement "content/drafts/essays/*/index.md"
.&&. complement "content/drafts/essays/**/*.dims.yaml") $ do .&&. complement "content/drafts/essays/**/*.dims.yaml") $ do
route $ gsubRoute "content/" (const "") route $ stripPrefixRoute "content/"
compile copyFileCompiler compile copyFileCompiler
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Blog posts -- Blog posts
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
match "content/blog/*.md" $ do match "content/blog/*.md" $ do
route $ gsubRoute "content/blog/" (const "blog/") route $ stripPrefixRoute "content/"
`composeRoutes` setExtension "html" `composeRoutes` setExtension "html"
compile $ postCompiler compile $ postCompiler
>>= saveSnapshot "content" >>= saveSnapshot "content"
@ -440,19 +444,12 @@ rules = do
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Poetry -- Poetry
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Flat poems (e.g. content/poetry/sonnet-60.md) -- All poems — flat (content/poetry/sonnet-60.md) and collection
match "content/poetry/*.md" $ do -- (content/poetry/shakespeare-sonnets/sonnet-1.md) forms share one
route $ gsubRoute "content/poetry/" (const "poetry/") -- rule; collection index pages are excluded by 'P.poetryPattern'
`composeRoutes` setExtension "html" -- itself and matched separately below.
compile $ poetryCompiler match P.poetryPattern $ do
>>= saveSnapshot "content" route $ stripPrefixRoute "content/"
>>= loadAndApplyTemplate "templates/reading.html" poetryCtx
>>= loadAndApplyTemplate "templates/default.html" poetryCtx
>>= relativizeUrls
-- Collection poems (e.g. content/poetry/shakespeare-sonnets/sonnet-1.md)
match collectionPoems $ do
route $ gsubRoute "content/poetry/" (const "poetry/")
`composeRoutes` setExtension "html" `composeRoutes` setExtension "html"
compile $ poetryCompiler compile $ poetryCompiler
>>= saveSnapshot "content" >>= saveSnapshot "content"
@ -462,7 +459,7 @@ rules = do
-- Collection index pages (e.g. content/poetry/shakespeare-sonnets/index.md) -- Collection index pages (e.g. content/poetry/shakespeare-sonnets/index.md)
match "content/poetry/*/index.md" $ do match "content/poetry/*/index.md" $ do
route $ gsubRoute "content/poetry/" (const "poetry/") route $ stripPrefixRoute "content/"
`composeRoutes` setExtension "html" `composeRoutes` setExtension "html"
compile $ pageCompiler compile $ pageCompiler
>>= loadAndApplyTemplate "templates/default.html" pageCtx >>= loadAndApplyTemplate "templates/default.html" pageCtx
@ -472,7 +469,7 @@ rules = do
-- Fiction -- Fiction
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
match "content/fiction/*.md" $ do match "content/fiction/*.md" $ do
route $ gsubRoute "content/fiction/" (const "fiction/") route $ stripPrefixRoute "content/"
`composeRoutes` setExtension "html" `composeRoutes` setExtension "html"
compile $ fictionCompiler compile $ fictionCompiler
>>= saveSnapshot "content" >>= saveSnapshot "content"
@ -496,20 +493,20 @@ rules = do
-- Static assets (SVG score pages, audio, PDF) served unchanged. -- Static assets (SVG score pages, audio, PDF) served unchanged.
match "content/music/**/*.svg" $ do match "content/music/**/*.svg" $ do
route $ gsubRoute "content/" (const "") route $ stripPrefixRoute "content/"
compile copyFileCompiler compile copyFileCompiler
match "content/music/**/*.mp3" $ do match "content/music/**/*.mp3" $ do
route $ gsubRoute "content/" (const "") route $ stripPrefixRoute "content/"
compile copyFileCompiler compile copyFileCompiler
match "content/music/**/*.pdf" $ do match "content/music/**/*.pdf" $ do
route $ gsubRoute "content/" (const "") route $ stripPrefixRoute "content/"
compile copyFileCompiler compile copyFileCompiler
-- Landing page — full essay pipeline. -- Landing page — full essay pipeline.
match "content/music/*/index.md" $ do match "content/music/*/index.md" $ do
route $ gsubRoute "content/" (const "") route $ stripPrefixRoute "content/"
`composeRoutes` setExtension "html" `composeRoutes` setExtension "html"
compile $ compositionCompiler compile $ compositionCompiler
>>= saveSnapshot "content" >>= saveSnapshot "content"
@ -613,10 +610,10 @@ rules = do
route idRoute route idRoute
compile $ do compile $ do
let allContent = ( allEssays let allContent = ( allEssays
.||. "content/blog/*.md" .||. P.blogPattern
.||. "content/fiction/*.md" .||. P.fictionPattern
.||. allPoetry .||. P.poetryPattern
.||. "content/music/*/index.md" .||. P.musicPattern
) .&&. hasNoVersion ) .&&. hasNoVersion
items <- recentFirstByDisplay =<< loadAll allContent items <- recentFirstByDisplay =<< loadAll allContent
let itemCtx = contentKindField let itemCtx = contentKindField
@ -641,7 +638,7 @@ rules = do
-- Library — portal-grouped view over the /new.html dataset, deduplicated -- Library — portal-grouped view over the /new.html dataset, deduplicated
-- by primary portal. An item's primary portal is the top segment of the -- by primary portal. An item's primary portal is the top segment of the
-- first tag in its frontmatter 'tags:' list whose top segment matches a -- first tag in its frontmatter 'tags:' list whose top segment matches a
-- known portal (the eight in 'homePortals'). Items with no such tag are -- known portal (those in 'homePortals'). Items with no such tag are
-- silently dropped from the library (they remain on /new.html and on any -- silently dropped from the library (they remain on /new.html and on any
-- tag pages their frontmatter produces). -- tag pages their frontmatter produces).
-- --
@ -669,9 +666,11 @@ rules = do
-- Top segment of the first tag that names a known portal. -- Top segment of the first tag that names a known portal.
-- Nothing when no tag matches — item is excluded from library. -- Nothing when no tag matches — item is excluded from library.
-- Reads tags via 'getTags' (not lookupStringList) so the
-- scalar comma form ("tags: research, ai") is accepted with
-- the same semantics the tag pages use.
primaryPortalOf item = do primaryPortalOf item = do
meta <- getMetadata (itemIdentifier item) ts <- getTags (itemIdentifier item)
let ts = fromMaybe [] (lookupStringList "tags" meta)
return $ listToMaybe return $ listToMaybe
[ p | t <- ts [ p | t <- ts
, let p = takeWhile (/= '/') t , let p = takeWhile (/= '/') t
@ -694,13 +693,13 @@ rules = do
-- Load every content item once, then partition by primary portal -- Load every content item once, then partition by primary portal
-- so each shelf draws from a pre-filtered list rather than -- so each shelf draws from a pre-filtered list rather than
-- re-scanning the whole corpus nine times. -- re-scanning the whole corpus once per portal.
essays <- loadAll (allEssays .&&. hasNoVersion) essays <- loadAll (allEssays .&&. hasNoVersion)
posts <- loadAll ("content/blog/*.md" .&&. hasNoVersion) posts <- loadAll (P.blogPattern .&&. hasNoVersion)
fiction <- loadAll ("content/fiction/*.md" .&&. hasNoVersion) fiction <- loadAll (P.fictionPattern .&&. hasNoVersion)
poetry <- loadAll (allPoetry .&&. hasNoVersion) poetry <- loadAll (P.poetryPattern .&&. hasNoVersion)
music <- loadAll ("content/music/*/index.md" .&&. hasNoVersion) music <- loadAll (P.musicPattern .&&. hasNoVersion)
photos <- loadAll (P.photographyPattern .&&. hasNoVersion) photos <- loadAll (P.photographyPattern .&&. hasNoVersion)
let allContent = essays ++ posts ++ fiction ++ poetry ++ music ++ photos let allContent = essays ++ posts ++ fiction ++ poetry ++ music ++ photos
:: [Item String] :: [Item String]
tagged <- mapM (\i -> (,i) <$> primaryPortalOf i) allContent tagged <- mapM (\i -> (,i) <$> primaryPortalOf i) allContent
@ -708,21 +707,30 @@ rules = do
itemsByPortal = itemsByPortal =
Map.fromListWith (++) [(p, [i]) | (Just p, i) <- tagged] Map.fromListWith (++) [(p, [i]) | (Just p, i) <- tagged]
-- Eager snapshot load registers the library-intro dependency -- Existence-guarded, like the sidecar contexts in Tags.hs:
-- unconditionally, so a first-populate of content/library.md -- deleting content/library.md degrades to a library page with
-- re-renders the library page even when the gate was previously -- no intro block rather than failing the whole compile. When
-- false (see 'sidecarContext' in Tags.hs for the same pattern). -- the file exists, the eager snapshot load registers the
_ <- loadSnapshot libraryIntroId "body" :: Compiler (Item String) -- library-intro dependency unconditionally, so a first-populate
let libraryIntroFld = field "library-intro" $ \_ -> do -- of content/library.md re-renders the library page even when
html <- itemBody <$> loadSnapshot libraryIntroId "body" -- the gate was previously false (see 'sidecarContext' in
if all isSpace html -- Tags.hs for the same pattern).
then noResult "empty library intro" introIds <- getMatches "content/library.md"
else return html libraryIntroFld <-
if libraryIntroId `elem` introIds
then do
_ <- loadSnapshot libraryIntroId "body" :: Compiler (Item String)
return $ field "library-intro" $ \_ -> do
html <- itemBody <$> loadSnapshot libraryIntroId "body"
if all isSpace html
then noResult "empty library intro"
else return html
else return mempty
-- One shelf's context contribution: the @<slug>-entries@ -- One shelf's context contribution: the @<slug>-entries@
-- listField (or absent via noResult when the shelf is -- listField (or absent via noResult when the shelf is
-- empty) plus an optional @<slug>-has-more@ gate. -- empty) plus an optional @<slug>-has-more@ gate.
portalSection p = do let portalSection p = do
let portalItems = fromMaybe [] (Map.lookup p itemsByPortal) let portalItems = fromMaybe [] (Map.lookup p itemsByPortal)
sorted <- recentFirstByDisplay portalItems sorted <- recentFirstByDisplay portalItems
@ -803,10 +811,10 @@ rules = do
bibKwMap = invertKeywordsBib bibExtrasAll bibKwMap = invertKeywordsBib bibExtrasAll
writingIds <- getMatches $ (P.essayPattern writingIds <- getMatches $ (P.essayPattern
.||. "content/blog/*.md" .||. P.blogPattern
.||. "content/fiction/*.md" .||. P.fictionPattern
.||. P.poetryPattern .||. P.poetryPattern
.||. "content/music/*/index.md") .||. P.musicPattern)
.&&. hasNoVersion .&&. hasNoVersion
writingKwPairs <- forM writingIds $ \ident -> do writingKwPairs <- forM writingIds $ \ident -> do
@ -903,15 +911,17 @@ rules = do
>>= relativizeUrls >>= relativizeUrls
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Random page manifest — essays + blog posts only (no pagination/index pages) -- Random page manifest — essays, blog posts, fiction, and poetry (flat
-- and collection poems alike). No pagination/index pages; music and
-- photography landings are also excluded.
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
create ["random-pages.json"] $ do create ["random-pages.json"] $ do
route idRoute route idRoute
compile $ do compile $ do
essays <- loadAll (allEssays .&&. hasNoVersion) :: Compiler [Item String] essays <- loadAll (allEssays .&&. hasNoVersion) :: Compiler [Item String]
posts <- loadAll ("content/blog/*.md" .&&. hasNoVersion) :: Compiler [Item String] posts <- loadAll (P.blogPattern .&&. hasNoVersion) :: Compiler [Item String]
fiction <- loadAll ("content/fiction/*.md" .&&. hasNoVersion) :: Compiler [Item String] fiction <- loadAll (P.fictionPattern .&&. hasNoVersion) :: Compiler [Item String]
poetry <- loadAll ("content/poetry/*.md" .&&. hasNoVersion) :: Compiler [Item String] poetry <- loadAll (P.poetryPattern .&&. hasNoVersion) :: Compiler [Item String]
routes <- mapM (getRoute . itemIdentifier) (essays ++ posts ++ fiction ++ poetry) routes <- mapM (getRoute . itemIdentifier) (essays ++ posts ++ fiction ++ poetry)
let urls = [ "/" ++ r | Just r <- routes ] let urls = [ "/" ++ r | Just r <- routes ]
makeItem $ LBS.unpack (Aeson.encode urls) makeItem $ LBS.unpack (Aeson.encode urls)
@ -924,11 +934,11 @@ rules = do
create ["data/epistemic-meta.json"] $ do create ["data/epistemic-meta.json"] $ do
route idRoute route idRoute
compile $ do compile $ do
essays <- loadAll (allEssays .&&. hasNoVersion) :: Compiler [Item String] essays <- loadAll (allEssays .&&. hasNoVersion) :: Compiler [Item String]
posts <- loadAll ("content/blog/*.md" .&&. hasNoVersion) :: Compiler [Item String] posts <- loadAll (P.blogPattern .&&. hasNoVersion) :: Compiler [Item String]
fiction <- loadAll ("content/fiction/*.md" .&&. hasNoVersion) :: Compiler [Item String] fiction <- loadAll (P.fictionPattern .&&. hasNoVersion) :: Compiler [Item String]
poetry <- loadAll (allPoetry .&&. hasNoVersion) :: Compiler [Item String] poetry <- loadAll (P.poetryPattern .&&. hasNoVersion) :: Compiler [Item String]
music <- loadAll ("content/music/*/index.md" .&&. hasNoVersion) :: Compiler [Item String] music <- loadAll (P.musicPattern .&&. hasNoVersion) :: Compiler [Item String]
let items = essays ++ posts ++ fiction ++ poetry ++ music let items = essays ++ posts ++ fiction ++ poetry ++ music
pairs <- mapM epistemicEntry items pairs <- mapM epistemicEntry items
let metaMap = Map.fromList (catMaybes pairs) let metaMap = Map.fromList (catMaybes pairs)
@ -943,10 +953,10 @@ rules = do
posts <- fmap (take 30) . recentFirst posts <- fmap (take 30) . recentFirst
=<< loadAllSnapshots =<< loadAllSnapshots
( ( allEssays ( ( allEssays
.||. "content/blog/*.md" .||. P.blogPattern
.||. "content/fiction/*.md" .||. P.fictionPattern
.||. allPoetry .||. P.poetryPattern
.||. "content/music/*/index.md" .||. P.musicPattern
) )
.&&. hasNoVersion .&&. hasNoVersion
) )
@ -966,7 +976,7 @@ rules = do
compile $ do compile $ do
compositions <- recentFirst compositions <- recentFirst
=<< loadAllSnapshots =<< loadAllSnapshots
("content/music/*/index.md" .&&. hasNoVersion) (P.musicPattern .&&. hasNoVersion)
"content" "content"
let feedCtx = let feedCtx =
dateField "updated" "%Y-%m-%dT%H:%M:%SZ" dateField "updated" "%Y-%m-%dT%H:%M:%SZ"
@ -1006,10 +1016,10 @@ rules = do
entries <- recentFirst entries <- recentFirst
=<< loadAllSnapshots =<< loadAllSnapshots
( ( allEssays ( ( allEssays
.||. "content/blog/*.md" .||. P.blogPattern
.||. "content/fiction/*.md" .||. P.fictionPattern
.||. allPoetry .||. P.poetryPattern
.||. "content/music/*/index.md" .||. P.musicPattern
) )
.&&. hasNoVersion .&&. hasNoVersion
) )

52
build/Tags.hs
View File

@ -30,16 +30,18 @@ module Tags
) where ) where
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.List (intercalate, isPrefixOf, nub, sort) import Data.List (intercalate, isPrefixOf, nub, sort, sortBy)
import Data.Maybe (fromMaybe, isNothing, maybeToList) import Data.Maybe (fromMaybe, isNothing, maybeToList)
import Data.Ord (comparing)
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Time.Clock (UTCTime)
import Data.Time.Format (defaultTimeLocale, parseTimeM)
import Hakyll import Hakyll
import Pagination (sortAndGroupAt)
import Patterns (tagIndexable) import Patterns (tagIndexable)
import Contexts (abstractField, contentKindField, import Contexts (Revision (..), abstractField, contentKindField,
recentFirstByDisplay, revisionDateFields, getRevisions, recentFirstByDisplay, revisionDateFields,
tagLinksFieldExcludingScope) siteCtx, tagLinksFieldExcludingScope)
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
@ -293,6 +295,10 @@ sidecarContext sidecarSet tag
-- Provides the fields consumed by @templates/partials/item-card.html@ -- Provides the fields consumed by @templates/partials/item-card.html@
-- (@$item-kind$@, @$date-iso$@, @$date-created$@, @$abstract$@, -- (@$item-kind$@, @$date-iso$@, @$date-created$@, @$abstract$@,
-- @$item-tags$@) with tag-ribbon suppression scoped to the current tag. -- @$item-tags$@) with tag-ribbon suppression scoped to the current tag.
--
-- Composes 'siteCtx' (not bare 'defaultContext') so per-item fields
-- the card partial gates on — notably @$has-monogram$@ — fire here
-- the same way they do on /new.html and the library.
tagItemCtx :: String -> Context String tagItemCtx :: String -> Context String
tagItemCtx scope = tagItemCtx scope =
contentKindField contentKindField
@ -301,7 +307,7 @@ tagItemCtx scope =
<> revisionDateFields <> revisionDateFields
<> tagLinksFieldExcludingScope "item-tags" scope <> tagLinksFieldExcludingScope "item-tags" scope
<> abstractField <> abstractField
<> defaultContext <> siteCtx
-- | Page identifier for a tag index page. -- | Page identifier for a tag index page.
-- Page 1 → <tag>/index.html -- Page 1 → <tag>/index.html
@ -359,9 +365,39 @@ clientPaginatedRule tag pat sidecarSet saCtx baseCtx = do
>>= loadAndApplyTemplate "templates/default.html" ctx >>= loadAndApplyTemplate "templates/default.html" ctx
>>= relativizeUrls >>= relativizeUrls
-- | Display date of an identifier: the most-recent @revised:@ entry's
-- date when present and parseable, else the creation date. Mirrors
-- the (unexported) @itemDisplayUTC@ behind 'Contexts.recentFirstByDisplay',
-- but needs only 'MonadMetadata' — the paginate grouper runs in
-- 'Rules' over bare 'Identifier's, where no 'Item's exist yet.
identifierDisplayUTC :: (MonadMetadata m, MonadFail m)
=> Identifier -> m UTCTime
identifierDisplayUTC ident = do
meta <- getMetadata ident
case getRevisions meta of
(r:_) | Just utc <- (parseTimeM True defaultTimeLocale "%Y-%m-%d"
(revisionDateISO r) :: Maybe UTCTime)
-> return utc
_ -> getItemUTC defaultTimeLocale ident
-- | Partition identifiers into pages of @n@, most recent first by
-- /display/ date — the same revision-aware key
-- 'recentFirstByDisplay' sorts by within each rendered page — so
-- cross-page ordering is monotone. With creation-date partitioning
-- (plain @sortRecentFirst@), a recently revised old item stayed on a
-- late page but jumped to its top; now it migrates to the early page
-- where its displayed date says it belongs.
sortAndGroupByDisplayAt :: (MonadMetadata m, MonadFail m)
=> Int -> [Identifier] -> m [[Identifier]]
sortAndGroupByDisplayAt n ids = do
keyed <- mapM (\i -> (,) <$> identifierDisplayUTC i <*> pure i) ids
return $ paginateEvery n $ map snd $ sortBy (flip (comparing fst)) keyed
-- | Server-side pagination at 'tagPageSize' per page. Previous/next -- | Server-side pagination at 'tagPageSize' per page. Previous/next
-- navigation renders via @templates/partials/paginate-nav.html@; -- navigation renders via @templates/partials/paginate-nav.html@;
-- the count toggle operates within the current page only. -- the count toggle operates within the current page only. Pages are
-- partitioned and sorted by the same display-date key (see
-- 'sortAndGroupByDisplayAt').
serverPaginatedRule :: String serverPaginatedRule :: String
-> Pattern -> Pattern
-> Set Identifier -> Set Identifier
@ -369,7 +405,7 @@ serverPaginatedRule :: String
-> Context String -- ^ base (siteCtx) -> Context String -- ^ base (siteCtx)
-> Rules () -> Rules ()
serverPaginatedRule tag pat sidecarSet saCtx baseCtx = do serverPaginatedRule tag pat sidecarSet saCtx baseCtx = do
paginate <- buildPaginateWith (sortAndGroupAt tagPageSize) pat (tagPageId tag) paginate <- buildPaginateWith (sortAndGroupByDisplayAt tagPageSize) pat (tagPageId tag)
paginateRules paginate $ \pageNum pat' -> do paginateRules paginate $ \pageNum pat' -> do
route idRoute route idRoute
compile $ do compile $ do

10
build/Utils.hs
View File

@ -27,9 +27,9 @@ wordCount :: String -> Int
wordCount = length . words wordCount = length . words
-- | Estimate reading time in minutes (assumes 200 words per minute). -- | Estimate reading time in minutes (assumes 200 words per minute).
-- Minimum is 1 minute. -- Rounds up — 399 words is 2 minutes, not 1. Minimum is 1 minute.
readingTime :: String -> Int readingTime :: String -> Int
readingTime s = max 1 (wordCount s `div` 200) readingTime s = max 1 ((wordCount s + 199) `div` 200)
-- | Escape HTML special characters: @&@, @<@, @>@, @\"@, @\'@. -- | Escape HTML special characters: @&@, @<@, @>@, @\"@, @\'@.
-- --
@ -62,7 +62,11 @@ trim :: String -> String
trim = dropWhileEnd isSpace . dropWhile isSpace trim = dropWhileEnd isSpace . dropWhile isSpace
-- | Lowercase a string, drop everything that isn't alphanumeric or -- | Lowercase a string, drop everything that isn't alphanumeric or
-- space, then replace runs of spaces with single hyphens. -- space, then replace each space with a hyphen. Note that a run of
-- spaces therefore becomes a run of hyphens (@"A B" → "a--b"@) —
-- deliberately left as-is, since every slug on the site is generated
-- by this one function and collapsing runs now would move existing
-- author URLs.
-- --
-- Used for author URL slugs (e.g. @"Levi Neuwirth" → "levi-neuwirth"@). -- Used for author URL slugs (e.g. @"Levi Neuwirth" → "levi-neuwirth"@).
-- Centralised here so 'Authors' and 'Contexts' cannot drift on Unicode -- Centralised here so 'Authors' and 'Contexts' cannot drift on Unicode