diff --git a/build/Archive.hs b/build/Archive.hs index 6940f54..693c83e 100644 --- a/build/Archive.hs +++ b/build/Archive.hs @@ -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 diff --git a/build/Backlinks.hs b/build/Backlinks.hs index 205355d..a6b3abc 100644 --- a/build/Backlinks.hs +++ b/build/Backlinks.hs @@ -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 diff --git a/build/Filters/Sidenotes.hs b/build/Filters/Sidenotes.hs index dfb6e41..a7a2bae 100644 --- a/build/Filters/Sidenotes.hs +++ b/build/Filters/Sidenotes.hs @@ -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 @

@). 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 diff --git a/build/Photography.hs b/build/Photography.hs index 9e8f5b5..95bef5c 100644 --- a/build/Photography.hs +++ b/build/Photography.hs @@ -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 (/index.md) and series children + -- (/.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 $ diff --git a/build/Stability.hs b/build/Stability.hs index 3b66b4d..17a38ba 100644 --- a/build/Stability.hs +++ b/build/Stability.hs @@ -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$@.