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:
parent
902e43ea19
commit
c68d03af31
|
|
@ -265,8 +265,17 @@ loadArchiveEntries = do
|
|||
removed <- readRemovedUrls
|
||||
validateManifestEntries manifest removed
|
||||
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 ->
|
||||
case Map.lookup (meUrl me) provByUrl of
|
||||
case Map.lookup (normKey (meUrl me)) provByNorm of
|
||||
Nothing -> return Nothing
|
||||
Just (slug, pv) -> do
|
||||
let dir = "archive/" ++ slug
|
||||
|
|
|
|||
|
|
@ -213,18 +213,28 @@ splitSentences = go []
|
|||
-- 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
|
||||
-- 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 _ blocks) = concatMap go blocks
|
||||
where
|
||||
go :: Block -> [LinkEntry]
|
||||
go (Para inlines) = paraEntries inlines
|
||||
go (Plain inlines) = paraEntries inlines
|
||||
go (BlockQuote bs) = concatMap go bs
|
||||
go (Div _ bs) = concatMap go bs
|
||||
go (BulletList items) = concatMap (concatMap go) items
|
||||
go (OrderedList _ items) = concatMap (concatMap go) items
|
||||
go (DefinitionList defs) = concatMap defEntries defs
|
||||
go _ = []
|
||||
|
||||
defEntries :: ([Inline], [[Block]]) -> [LinkEntry]
|
||||
defEntries (term, bodies) =
|
||||
paraEntries term ++ concatMap (concatMap go) bodies
|
||||
|
||||
paraEntries :: [Inline] -> [LinkEntry]
|
||||
paraEntries inlines =
|
||||
let paraHtml = renderInlines inlines
|
||||
|
|
|
|||
|
|
@ -18,7 +18,8 @@ import Data.Text (Text)
|
|||
import qualified Data.Text as T
|
||||
import Text.Pandoc.Class (runPure)
|
||||
import Text.Pandoc.Definition
|
||||
import Text.Pandoc.Options (WriterOptions)
|
||||
import Text.Pandoc.Options (WriterOptions (..),
|
||||
HTMLMathMethod (KaTeX))
|
||||
import Text.Pandoc.Walk (walkM)
|
||||
import Text.Pandoc.Writers.HTML (writeHtml5String)
|
||||
|
||||
|
|
@ -84,16 +85,25 @@ blocksToInlineHtml = T.concat . map renderOne
|
|||
renderOne 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>@).
|
||||
inlinesToHtml :: [Inline] -> Text
|
||||
inlinesToHtml inlines =
|
||||
case runPure (writeHtml5String (def :: WriterOptions) (Pandoc mempty [Plain inlines])) of
|
||||
case runPure (writeHtml5String noteWriterOpts (Pandoc mempty [Plain inlines])) of
|
||||
Left _ -> T.empty
|
||||
Right t -> t
|
||||
|
||||
-- | Render a list of Pandoc blocks to an HTML fragment via a pure writer run.
|
||||
blocksToHtml :: [Block] -> Text
|
||||
blocksToHtml blocks =
|
||||
case runPure (writeHtml5String (def :: WriterOptions) (Pandoc mempty blocks)) of
|
||||
case runPure (writeHtml5String noteWriterOpts (Pandoc mempty blocks)) of
|
||||
Left _ -> T.empty
|
||||
Right t -> t
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ import Data.Maybe (mapMaybe, fromMaybe, catMaybes)
|
|||
import qualified Data.Set as Set
|
||||
import Data.Set (Set)
|
||||
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 Data.Aeson (Value (..), (.=))
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
|
|
@ -305,10 +305,11 @@ stripIndexHtml r
|
|||
-- * @exact@: 4 decimal places (~10 m)
|
||||
-- * @km@ : 2 decimal places (~1 km)
|
||||
-- * @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;
|
||||
-- this function is not consulted in that case.
|
||||
-- @hidden@ and unrecognised values are handled at the call site by
|
||||
-- skipping the pin entirely; this function is not consulted then.
|
||||
roundCoord :: String -> Double -> Double
|
||||
roundCoord prec x =
|
||||
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'
|
||||
-- when:
|
||||
-- * 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
|
||||
-- photographyPattern items, but be defensive).
|
||||
buildPin :: Item String -> Compiler (Maybe Value)
|
||||
|
|
@ -345,13 +349,21 @@ buildPin item = do
|
|||
meta <- getMetadata ident
|
||||
mRoute <- getRoute ident
|
||||
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
|
||||
rLat = roundCoord prec' lat
|
||||
rLon = roundCoord prec' lon
|
||||
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)
|
||||
photo = lookupString "photo" meta
|
||||
-- Trim trailing "index.html" so the click-through URL
|
||||
|
|
@ -359,7 +371,8 @@ buildPin item = do
|
|||
url = "/" ++ stripIndexHtml r
|
||||
thumb = case photo of
|
||||
Just p | not (null p) ->
|
||||
"/photography/" ++ slug ++ "/" ++ p
|
||||
if isFlat then "/photography/" ++ p
|
||||
else "/photography/" ++ slug ++ "/" ++ p
|
||||
_ -> ""
|
||||
captured = lookupString "captured" meta
|
||||
in return $ Just $ Aeson.object $
|
||||
|
|
|
|||
|
|
@ -33,8 +33,11 @@ import Control.Exception (catch, IOException)
|
|||
import Data.Aeson (Value (..))
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
import qualified Data.Vector as V
|
||||
import Data.List (sortBy)
|
||||
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
|
||||
import Data.Ord (comparing, Down (..))
|
||||
import Data.Time.Calendar (Day, diffDays)
|
||||
import Data.Time.Clock (getCurrentTime, utctDay)
|
||||
import Data.Time.Format (parseTimeM, formatTime, defaultTimeLocale)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as TIO
|
||||
|
|
@ -85,14 +88,8 @@ gitDates fp = do
|
|||
parseIso :: String -> Maybe Day
|
||||
parseIso = parseTimeM True defaultTimeLocale "%Y-%m-%d"
|
||||
|
||||
-- | Approximate day-span between the oldest and newest ISO date strings.
|
||||
daySpan :: String -> String -> Int
|
||||
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).
|
||||
-- | Derive stability label from commit dates (newest-first), judged as
|
||||
-- of @today@.
|
||||
--
|
||||
-- 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
|
||||
-- early in a piece's life looks volatile until enough time has passed
|
||||
-- to demonstrate it has settled.
|
||||
stabilityFromDates :: [String] -> String
|
||||
stabilityFromDates [] = "volatile"
|
||||
stabilityFromDates dates@(newest : _) =
|
||||
-- 'last' is safe: the (newest:_) pattern guarantees non-empty.
|
||||
classify (length dates) (daySpan (last dates) newest)
|
||||
-- to demonstrate it has settled. Age is measured from the first commit
|
||||
-- to /today/, not to the most recent commit — a piece written in a
|
||||
-- one-week burst must be able to stabilise as quiet time accumulates.
|
||||
stabilityFromDates :: Day -> [String] -> String
|
||||
stabilityFromDates _ [] = "volatile"
|
||||
stabilityFromDates today dates =
|
||||
classify (length dates) ageDays
|
||||
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
|
||||
| n <= 1 || age < volatileAge = "volatile"
|
||||
| n <= 5 && age < revisingAge = "revising"
|
||||
|
|
@ -149,7 +151,9 @@ resolveStability item = do
|
|||
ignored <- readIgnore
|
||||
if srcPath `elem` ignored
|
||||
then return $ fromMaybe "volatile" (lookupString "stability" meta)
|
||||
else stabilityFromDates <$> gitDates srcPath
|
||||
else do
|
||||
today <- utctDay <$> getCurrentTime
|
||||
stabilityFromDates today <$> gitDates srcPath
|
||||
|
||||
-- | Context field @$stability$@.
|
||||
-- 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
|
||||
ignored <- readIgnore
|
||||
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
|
||||
case mDate of
|
||||
Nothing -> fail "no last-reviewed"
|
||||
|
|
@ -228,14 +234,21 @@ versionHistoryHeadCount = 3
|
|||
|
||||
-- | Load version-history entries for an item.
|
||||
-- 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 = do
|
||||
let srcPath = toFilePath (itemIdentifier item)
|
||||
meta <- getMetadata (itemIdentifier item)
|
||||
let fmEntries = parseFmHistory meta
|
||||
let newestFirst = sortBy (comparing (Down . vhDateIso))
|
||||
fmEntries = newestFirst (parseFmHistory meta)
|
||||
if not (null 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
|
||||
-- list field works correctly inside @$for$@.
|
||||
|
|
|
|||
Loading…
Reference in New Issue