Fix audit MEDs in feature modules

- Backlinks: handle Plain blocks (tight list items) and DefinitionList
  in link extraction — links in ordinary bullet lists were invisible to
  the backlinks system (AUDIT §3.3)
- Sidenotes: render note bodies with a KaTeX writer so footnote math
  reaches the client-side KaTeX pass instead of degrading to italics
  (§2.4)
- Archive: join manifest to provenance on normalised URLs like every
  other comparison in the system — an equivalent-form URL edit silently
  unpublished the page while links kept pointing at it (§3.6)
- Photography: flat singles get their basename as slug and root-level
  asset paths in map.json (§3.7); geo-precision now fails closed — an
  unrecognised value (typo'd "hidden") suppresses the pin instead of
  publishing rounded coordinates (§3.8)
- Stability: age is measured first-commit -> today, not the commit
  span, so quiet time stabilises a piece as documented (§3.4);
  history: entries are sorted newest-first by date regardless of
  authored order (§3.5); pinned pages format last-reviewed like the
  git branch (§3.10)

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
Levi Neuwirth 2026-06-10 09:43:25 -04:00
parent 902e43ea19
commit c68d03af31
5 changed files with 87 additions and 32 deletions

View File

@ -265,8 +265,17 @@ loadArchiveEntries = do
removed <- readRemovedUrls removed <- readRemovedUrls
validateManifestEntries manifest removed validateManifestEntries manifest removed
provByUrl <- readProvenances provByUrl <- readProvenances
-- Join on normalised URLs, like every other URL comparison in the
-- archive system: editing a manifest URL to a normalisation-
-- equivalent form (http->https, trailing slash, tracking params)
-- must keep matching its provenance — an exact-string join would
-- silently unpublish the page while ArchiveIndex's normalised
-- filter keeps links pointing at it. Key collisions can't occur:
-- validateManifestEntries rejects normalised duplicates.
let normKey = T.unpack . normalizeUrl . T.pack
provByNorm = Map.mapKeys normKey provByUrl
fmap catMaybes $ forM manifest $ \me -> fmap catMaybes $ forM manifest $ \me ->
case Map.lookup (meUrl me) provByUrl of case Map.lookup (normKey (meUrl me)) provByNorm of
Nothing -> return Nothing Nothing -> return Nothing
Just (slug, pv) -> do Just (slug, pv) -> do
let dir = "archive/" ++ slug let dir = "archive/" ++ slug

View File

@ -213,18 +213,28 @@ splitSentences = go []
-- For every internal link in a paragraph, emit an entry carrying the HTML -- For every internal link in a paragraph, emit an entry carrying the HTML
-- of the sentence containing the link (default display) and the HTML of -- of the sentence containing the link (default display) and the HTML of
-- the full paragraph (hover/popup context). -- the full paragraph (hover/popup context).
-- Recurses into Div, BlockQuote, BulletList, and OrderedList. -- Recurses into Div, BlockQuote, BulletList, OrderedList, and
-- DefinitionList. @Plain@ matters as much as @Para@: Pandoc renders
-- tight list items (the default @- item@ Markdown form) as @Plain@
-- blocks, so without it every link written in a tight list would be
-- invisible to the backlinks system.
extractLinksWithContext :: Pandoc -> [LinkEntry] extractLinksWithContext :: Pandoc -> [LinkEntry]
extractLinksWithContext (Pandoc _ blocks) = concatMap go blocks extractLinksWithContext (Pandoc _ blocks) = concatMap go blocks
where where
go :: Block -> [LinkEntry] go :: Block -> [LinkEntry]
go (Para inlines) = paraEntries inlines go (Para inlines) = paraEntries inlines
go (Plain inlines) = paraEntries inlines
go (BlockQuote bs) = concatMap go bs go (BlockQuote bs) = concatMap go bs
go (Div _ bs) = concatMap go bs go (Div _ bs) = concatMap go bs
go (BulletList items) = concatMap (concatMap go) items go (BulletList items) = concatMap (concatMap go) items
go (OrderedList _ items) = concatMap (concatMap go) items go (OrderedList _ items) = concatMap (concatMap go) items
go (DefinitionList defs) = concatMap defEntries defs
go _ = [] go _ = []
defEntries :: ([Inline], [[Block]]) -> [LinkEntry]
defEntries (term, bodies) =
paraEntries term ++ concatMap (concatMap go) bodies
paraEntries :: [Inline] -> [LinkEntry] paraEntries :: [Inline] -> [LinkEntry]
paraEntries inlines = paraEntries inlines =
let paraHtml = renderInlines inlines let paraHtml = renderInlines inlines

View File

@ -18,7 +18,8 @@ import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Text.Pandoc.Class (runPure) import Text.Pandoc.Class (runPure)
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Options (WriterOptions) import Text.Pandoc.Options (WriterOptions (..),
HTMLMathMethod (KaTeX))
import Text.Pandoc.Walk (walkM) import Text.Pandoc.Walk (walkM)
import Text.Pandoc.Writers.HTML (writeHtml5String) import Text.Pandoc.Writers.HTML (writeHtml5String)
@ -84,16 +85,25 @@ blocksToInlineHtml = T.concat . map renderOne
renderOne b = renderOne b =
blocksToHtml [b] blocksToHtml [b]
-- | Writer options for note bodies. Must agree with the math method in
-- 'Compilers.writerOpts' (KaTeX), or math inside a footnote silently
-- degrades to the writer default (PlainMath -> italics) and the
-- client-side KaTeX pass never sees it. Defined locally because
-- importing Compilers from here would create a module cycle
-- (Compilers -> Filters -> Filters.Sidenotes).
noteWriterOpts :: WriterOptions
noteWriterOpts = def { writerHTMLMathMethod = KaTeX "" }
-- | Render a list of inlines to HTML (no surrounding @<p>@). -- | Render a list of inlines to HTML (no surrounding @<p>@).
inlinesToHtml :: [Inline] -> Text inlinesToHtml :: [Inline] -> Text
inlinesToHtml inlines = inlinesToHtml inlines =
case runPure (writeHtml5String (def :: WriterOptions) (Pandoc mempty [Plain inlines])) of case runPure (writeHtml5String noteWriterOpts (Pandoc mempty [Plain inlines])) of
Left _ -> T.empty Left _ -> T.empty
Right t -> t Right t -> t
-- | Render a list of Pandoc blocks to an HTML fragment via a pure writer run. -- | Render a list of Pandoc blocks to an HTML fragment via a pure writer run.
blocksToHtml :: [Block] -> Text blocksToHtml :: [Block] -> Text
blocksToHtml blocks = blocksToHtml blocks =
case runPure (writeHtml5String (def :: WriterOptions) (Pandoc mempty blocks)) of case runPure (writeHtml5String noteWriterOpts (Pandoc mempty blocks)) of
Left _ -> T.empty Left _ -> T.empty
Right t -> t Right t -> t

View File

@ -27,7 +27,7 @@ import Data.Maybe (mapMaybe, fromMaybe, catMaybes)
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Set (Set) import Data.Set (Set)
import Data.Ord (Down (..), comparing) import Data.Ord (Down (..), comparing)
import System.FilePath (takeDirectory, takeFileName, replaceExtension) import System.FilePath (takeBaseName, takeDirectory, takeFileName, replaceExtension)
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import Data.Aeson (Value (..), (.=)) import Data.Aeson (Value (..), (.=))
import qualified Data.Aeson.KeyMap as KM import qualified Data.Aeson.KeyMap as KM
@ -305,10 +305,11 @@ stripIndexHtml r
-- * @exact@: 4 decimal places (~10 m) -- * @exact@: 4 decimal places (~10 m)
-- * @km@ : 2 decimal places (~1 km) -- * @km@ : 2 decimal places (~1 km)
-- * @city@ : 1 decimal place (~10 km) — default -- * @city@ : 1 decimal place (~10 km) — default
-- * other : treated as @city@ -- * other : treated as @city@ (defensive only — 'buildPin' validates
-- the precision and fails closed before consulting this function)
-- --
-- @hidden@ is handled at the call site by skipping the pin entirely; -- @hidden@ and unrecognised values are handled at the call site by
-- this function is not consulted in that case. -- skipping the pin entirely; this function is not consulted then.
roundCoord :: String -> Double -> Double roundCoord :: String -> Double -> Double
roundCoord prec x = roundCoord prec x =
let n = case prec of let n = case prec of
@ -336,7 +337,10 @@ parseGeo meta = case KM.lookup "geo" meta of
-- | Build a single pin object from a photo entry. Returns 'Nothing' -- | Build a single pin object from a photo entry. Returns 'Nothing'
-- when: -- when:
-- * the entry has no @geo:@ frontmatter, or -- * the entry has no @geo:@ frontmatter, or
-- * it has @geo-precision: hidden@, or -- * @geo-precision:@ is anything other than @exact@/@km@/@city@ —
-- @hidden@ and unrecognised values (typos, wrong case) alike.
-- Failing closed means a typo'd \"hidden\" can never publish
-- coordinates the author meant to suppress.
-- * the entry has no resolvable route (shouldn't happen for -- * the entry has no resolvable route (shouldn't happen for
-- photographyPattern items, but be defensive). -- photographyPattern items, but be defensive).
buildPin :: Item String -> Compiler (Maybe Value) buildPin :: Item String -> Compiler (Maybe Value)
@ -345,13 +349,21 @@ buildPin item = do
meta <- getMetadata ident meta <- getMetadata ident
mRoute <- getRoute ident mRoute <- getRoute ident
case (parseGeo meta, lookupString "geo-precision" meta, mRoute) of case (parseGeo meta, lookupString "geo-precision" meta, mRoute) of
(_, Just "hidden", _) -> return Nothing (Just (lat, lon), prec, Just r)
(Just (lat, lon), prec, Just r) -> | maybe True (`elem` ["exact", "km", "city"]) prec ->
let prec' = fromMaybe "city" prec let prec' = fromMaybe "city" prec
rLat = roundCoord prec' lat rLat = roundCoord prec' lat
rLon = roundCoord prec' lon rLon = roundCoord prec' lon
fp = toFilePath ident fp = toFilePath ident
slug = takeFileName (takeDirectory fp) -- Directory entries (<slug>/index.md) and series children
-- (<series>/<photo>.md) both key assets off the parent
-- directory; a flat single (content/photography/foo.md)
-- has no entry directory, so its slug is its basename and
-- its co-located assets route to /photography/ directly.
isFlat = takeDirectory fp == "content/photography"
&& takeFileName fp /= "index.md"
slug = if isFlat then takeBaseName fp
else takeFileName (takeDirectory fp)
title = fromMaybe slug (lookupString "title" meta) title = fromMaybe slug (lookupString "title" meta)
photo = lookupString "photo" meta photo = lookupString "photo" meta
-- Trim trailing "index.html" so the click-through URL -- Trim trailing "index.html" so the click-through URL
@ -359,7 +371,8 @@ buildPin item = do
url = "/" ++ stripIndexHtml r url = "/" ++ stripIndexHtml r
thumb = case photo of thumb = case photo of
Just p | not (null p) -> Just p | not (null p) ->
"/photography/" ++ slug ++ "/" ++ p if isFlat then "/photography/" ++ p
else "/photography/" ++ slug ++ "/" ++ p
_ -> "" _ -> ""
captured = lookupString "captured" meta captured = lookupString "captured" meta
in return $ Just $ Aeson.object $ in return $ Just $ Aeson.object $

View File

@ -33,8 +33,11 @@ import Control.Exception (catch, IOException)
import Data.Aeson (Value (..)) import Data.Aeson (Value (..))
import qualified Data.Aeson.KeyMap as KM import qualified Data.Aeson.KeyMap as KM
import qualified Data.Vector as V import qualified Data.Vector as V
import Data.List (sortBy)
import Data.Maybe (catMaybes, fromMaybe, listToMaybe) import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
import Data.Ord (comparing, Down (..))
import Data.Time.Calendar (Day, diffDays) import Data.Time.Calendar (Day, diffDays)
import Data.Time.Clock (getCurrentTime, utctDay)
import Data.Time.Format (parseTimeM, formatTime, defaultTimeLocale) import Data.Time.Format (parseTimeM, formatTime, defaultTimeLocale)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as TIO import qualified Data.Text.IO as TIO
@ -85,14 +88,8 @@ gitDates fp = do
parseIso :: String -> Maybe Day parseIso :: String -> Maybe Day
parseIso = parseTimeM True defaultTimeLocale "%Y-%m-%d" parseIso = parseTimeM True defaultTimeLocale "%Y-%m-%d"
-- | Approximate day-span between the oldest and newest ISO date strings. -- | Derive stability label from commit dates (newest-first), judged as
daySpan :: String -> String -> Int -- of @today@.
daySpan oldest newest =
case (parseIso oldest, parseIso newest) of
(Just o, Just n) -> fromIntegral (abs (diffDays n o))
_ -> 0
-- | Derive stability label from commit dates (newest-first).
-- --
-- Thresholds (commit count + age in days since first commit): -- Thresholds (commit count + age in days since first commit):
-- --
@ -104,13 +101,18 @@ daySpan oldest newest =
-- --
-- These cliffs are deliberately conservative: a fast burst of commits -- These cliffs are deliberately conservative: a fast burst of commits
-- early in a piece's life looks volatile until enough time has passed -- early in a piece's life looks volatile until enough time has passed
-- to demonstrate it has settled. -- to demonstrate it has settled. Age is measured from the first commit
stabilityFromDates :: [String] -> String -- to /today/, not to the most recent commit — a piece written in a
stabilityFromDates [] = "volatile" -- one-week burst must be able to stabilise as quiet time accumulates.
stabilityFromDates dates@(newest : _) = stabilityFromDates :: Day -> [String] -> String
-- 'last' is safe: the (newest:_) pattern guarantees non-empty. stabilityFromDates _ [] = "volatile"
classify (length dates) (daySpan (last dates) newest) stabilityFromDates today dates =
classify (length dates) ageDays
where where
-- 'last' is safe: the [] case is handled above.
ageDays = case parseIso (last dates) of
Just firstDay -> fromIntegral (diffDays today firstDay)
Nothing -> 0
classify n age classify n age
| n <= 1 || age < volatileAge = "volatile" | n <= 1 || age < volatileAge = "volatile"
| n <= 5 && age < revisingAge = "revising" | n <= 5 && age < revisingAge = "revising"
@ -149,7 +151,9 @@ resolveStability item = do
ignored <- readIgnore ignored <- readIgnore
if srcPath `elem` ignored if srcPath `elem` ignored
then return $ fromMaybe "volatile" (lookupString "stability" meta) then return $ fromMaybe "volatile" (lookupString "stability" meta)
else stabilityFromDates <$> gitDates srcPath else do
today <- utctDay <$> getCurrentTime
stabilityFromDates today <$> gitDates srcPath
-- | Context field @$stability$@. -- | Context field @$stability$@.
-- Always resolves to a label; prefers frontmatter when the file is pinned. -- Always resolves to a label; prefers frontmatter when the file is pinned.
@ -166,7 +170,9 @@ lastReviewedField = field "last-reviewed" $ \item -> do
mDate <- unsafeCompiler $ do mDate <- unsafeCompiler $ do
ignored <- readIgnore ignored <- readIgnore
if srcPath `elem` ignored if srcPath `elem` ignored
then return $ lookupString "last-reviewed" meta -- Frontmatter convention is ISO; format it like the git
-- branch so pinned pages don't render a raw "2026-05-01".
then return $ fmtIso <$> lookupString "last-reviewed" meta
else fmap fmtIso . listToMaybe <$> gitDates srcPath else fmap fmtIso . listToMaybe <$> gitDates srcPath
case mDate of case mDate of
Nothing -> fail "no last-reviewed" Nothing -> fail "no last-reviewed"
@ -228,14 +234,21 @@ versionHistoryHeadCount = 3
-- | Load version-history entries for an item. -- | Load version-history entries for an item.
-- Priority: frontmatter @history:@ list → git log dates → empty. -- Priority: frontmatter @history:@ list → git log dates → empty.
--
-- Entries are sorted newest-first by ISO date regardless of authored
-- order: every consumer (primary/rest split, range fields) assumes the
-- head is the newest entry, and the @history:@ list may be authored in
-- either direction. Git dates already arrive newest-first; the sort is
-- idempotent there.
loadVersionHistory :: Item a -> Compiler [VHEntry] loadVersionHistory :: Item a -> Compiler [VHEntry]
loadVersionHistory item = do loadVersionHistory item = do
let srcPath = toFilePath (itemIdentifier item) let srcPath = toFilePath (itemIdentifier item)
meta <- getMetadata (itemIdentifier item) meta <- getMetadata (itemIdentifier item)
let fmEntries = parseFmHistory meta let newestFirst = sortBy (comparing (Down . vhDateIso))
fmEntries = newestFirst (parseFmHistory meta)
if not (null fmEntries) if not (null fmEntries)
then return fmEntries then return fmEntries
else unsafeCompiler (gitLogHistory srcPath) else unsafeCompiler (newestFirst <$> gitLogHistory srcPath)
-- | Wrap a list of 'VHEntry' as Hakyll Items with unique paths so the -- | Wrap a list of 'VHEntry' as Hakyll Items with unique paths so the
-- list field works correctly inside @$for$@. -- list field works correctly inside @$for$@.