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
-- @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$
tagLinksField :: String -> Context a
tagLinksField fieldName = listFieldWith fieldName ctx $ \item ->
map toItem <$> getTags (itemIdentifier item)
tagLinksField fieldName = listFieldWith fieldName ctx $ \item -> do
ts <- getTags (itemIdentifier item)
if null ts
then noResult "no tags"
else return (map toItem ts)
where
toItem t = Item (fromFilePath (t ++ "/index.html")) t
ctx = field "tag-name" (return . itemBody)
@ -351,7 +358,7 @@ abstractField :: Context String
abstractField = field "abstract" $ \item -> do
meta <- getMetadata (itemIdentifier item)
case lookupString "abstract" meta of
Nothing -> fail "no abstract"
Nothing -> noResult "no abstract"
Just src -> do
let pandocResult = runPure $ do
doc <- readMarkdown defaultHakyllReaderOptions (T.pack src)
@ -385,7 +392,7 @@ descriptionField :: Context String
descriptionField = field "description" $ \item -> do
meta <- getMetadata (itemIdentifier item)
case lookupString "abstract" meta of
Nothing -> fail "no abstract"
Nothing -> noResult "no abstract"
Just src -> do
let pandocResult = runPure $ do
doc <- readMarkdown defaultHakyllReaderOptions (T.pack src)
@ -422,7 +429,7 @@ summaryField :: Context String
summaryField = field "summary" $ \item -> do
meta <- getMetadata (itemIdentifier item)
case lookupString "summary" meta of
Nothing -> fail "no summary"
Nothing -> noResult "no summary"
Just src -> do
let pandocResult = runPure $ do
doc <- readMarkdown defaultHakyllReaderOptions (T.pack src)
@ -468,11 +475,11 @@ bibliographyField = bibContent <> hasCitations
where
bibContent = field "bibliography" $ \item -> do
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
bib <- itemBody <$> (loadSnapshot (itemIdentifier item) "bibliography"
:: 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.
-- Returns noResult (making $if(further-reading-refs)$ false) when empty.
@ -480,22 +487,26 @@ furtherReadingField :: Context String
furtherReadingField = field "further-reading-refs" $ \item -> do
fr <- itemBody <$> (loadSnapshot (itemIdentifier item) "further-reading-refs"
:: 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
-- ---------------------------------------------------------------------------
-- | 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 ctxKey metaKey = field ctxKey $ \item -> do
meta <- getMetadata (itemIdentifier item)
case lookupString metaKey meta >>= readMaybe of
Nothing -> fail (ctxKey ++ ": not set")
Just (n :: Int) ->
let v = max 0 (min 5 n)
in return (replicate v '\x25CF' ++ replicate (5 - v) '\x25CB')
Nothing -> noResult (ctxKey ++ ": not set")
Just (n :: Int)
| n < 1 -> noResult (ctxKey ++ ": value below the 1-5 scale")
| otherwise ->
let v = min 5 n
in return (replicate v '\x25CF' ++ replicate (5 - v) '\x25CB')
-- | @$confidence-trend$@: ↑, ↓, or → derived from the last two entries
-- in the @confidence-history@ frontmatter list. Returns @noResult@ when
@ -519,11 +530,11 @@ confidenceTrendField = field "confidence-trend" $ \item -> do
"[Marks] " ++ toFilePath (itemIdentifier item) ++
": confidence: proved is incompatible with confidence-history; ignoring history"
Nothing -> return ()
fail "confidence is proved; trend suppressed"
noResult "confidence is proved; trend suppressed"
else case lookupStringList "confidence-history" meta of
Nothing -> fail "no confidence history"
Nothing -> noResult "no confidence history"
Just xs -> case lastTwo xs of
Nothing -> fail "no confidence history"
Nothing -> noResult "no confidence history"
Just (prevS, curS) ->
let prev = readMaybe prevS :: Maybe Int
cur = readMaybe curS :: Maybe Int
@ -589,7 +600,7 @@ overallScoreField = field "overall-score" $ \item -> do
+ fromIntegral (ev - 1) / 4.0 * 0.4
score = max 0 (min 100 (round (raw * 100.0) :: Int))
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@ /
-- @proven@ sentinel. When the frontmatter value is parseable as an
@ -1002,7 +1013,7 @@ compositionCtx =
hasScoreField = field "has-score" $ \item -> do
meta <- getMetadata (itemIdentifier item)
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
meta <- getMetadata (itemIdentifier item)
@ -1020,7 +1031,7 @@ compositionCtx =
hasMovementsField = field "has-movements" $ \item -> do
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
meta <- getMetadata (itemIdentifier item)
@ -1038,9 +1049,9 @@ compositionCtx =
<> field "movement-page" (return . show . movPage . itemBody)
<> field "movement-duration" (return . movDuration . itemBody)
<> field "movement-audio"
(\i -> maybe (fail "no audio") return (movAudio (itemBody i)))
(\i -> maybe (noResult "no audio") return (movAudio (itemBody i)))
<> field "has-audio"
(\i -> maybe (fail "no audio") (const (return "true"))
(\i -> maybe (noResult "no audio") (const (return "true"))
(movAudio (itemBody i)))
-- ---------------------------------------------------------------------------

3
build/Pagination.hs
View File

@ -12,6 +12,7 @@ module Pagination
) where
import Hakyll
import Patterns (blogPattern)
-- | 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).
blogPaginateRules :: Context String -> Context String -> Rules ()
blogPaginateRules itemCtx baseCtx = do
paginate <- buildPaginateWith sortAndGroup ("content/blog/*.md" .&&. hasNoVersion) blogPageId
paginate <- buildPaginateWith sortAndGroup (blogPattern .&&. hasNoVersion) blogPageId
paginateRules paginate $ \pageNum pat -> do
route idRoute
compile $ do

11
build/Patterns.hs
View File

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

52
build/Tags.hs
View File

@ -30,16 +30,18 @@ module Tags
) where
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.Ord (comparing)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Time.Clock (UTCTime)
import Data.Time.Format (defaultTimeLocale, parseTimeM)
import Hakyll
import Pagination (sortAndGroupAt)
import Patterns (tagIndexable)
import Contexts (abstractField, contentKindField,
recentFirstByDisplay, revisionDateFields,
tagLinksFieldExcludingScope)
import Contexts (Revision (..), abstractField, contentKindField,
getRevisions, recentFirstByDisplay, revisionDateFields,
siteCtx, tagLinksFieldExcludingScope)
-- ---------------------------------------------------------------------------
@ -293,6 +295,10 @@ sidecarContext sidecarSet tag
-- Provides the fields consumed by @templates/partials/item-card.html@
-- (@$item-kind$@, @$date-iso$@, @$date-created$@, @$abstract$@,
-- @$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 scope =
contentKindField
@ -301,7 +307,7 @@ tagItemCtx scope =
<> revisionDateFields
<> tagLinksFieldExcludingScope "item-tags" scope
<> abstractField
<> defaultContext
<> siteCtx
-- | Page identifier for a tag index page.
-- Page 1 → <tag>/index.html
@ -359,9 +365,39 @@ clientPaginatedRule tag pat sidecarSet saCtx baseCtx = do
>>= loadAndApplyTemplate "templates/default.html" ctx
>>= 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
-- 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
-> Pattern
-> Set Identifier
@ -369,7 +405,7 @@ serverPaginatedRule :: String
-> Context String -- ^ base (siteCtx)
-> Rules ()
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
route idRoute
compile $ do

10
build/Utils.hs
View File

@ -27,9 +27,9 @@ wordCount :: String -> Int
wordCount = length . words
-- | 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 s = max 1 (wordCount s `div` 200)
readingTime s = max 1 ((wordCount s + 199) `div` 200)
-- | Escape HTML special characters: @&@, @<@, @>@, @\"@, @\'@.
--
@ -62,7 +62,11 @@ trim :: String -> String
trim = dropWhileEnd isSpace . dropWhile isSpace
-- | 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"@).
-- Centralised here so 'Authors' and 'Contexts' cannot drift on Unicode