From 1a532f881b24867d4d1f54a1bbe894d92024e120 Mon Sep 17 00:00:00 2001 From: Levi Neuwirth Date: Fri, 17 Apr 2026 12:48:22 -0400 Subject: [PATCH] major visual changes - dingbats, footer, etc --- build/Backlinks.hs | 168 +++++-- build/Contexts.hs | 9 +- build/Dingbat.hs | 79 +++ build/Filters/Links.hs | 5 +- build/SimilarLinks.hs | 56 ++- build/Stability.hs | 112 ++++- cabal.project.freeze | 2 +- content/colophon.md | 2 +- content/{ => drafts}/essays/test-essay.md | 0 content/essays/scaling_outage.md | 10 +- levineuwirth.cabal | 1 + nginx/popup-proxy.conf | 103 ++++ static/css/components.css | 274 +++++++--- static/css/print.css | 3 +- static/css/typography.css | 104 +++- static/images/dingbats/ai.svg | 8 + static/images/dingbats/clef.svg | 7 + static/images/dingbats/fleuron.svg | 4 + static/images/dingbats/lozenge.svg | 4 + static/images/dingbats/memento.svg | 5 + static/images/dingbats/tech.svg | 15 + static/images/dingbats/trefoil.svg | 6 + static/images/link-icons/lesswrong.svg | 1 + static/images/link-icons/pdf.svg | 1 + static/js/popups.js | 578 ++++++++++++---------- templates/blog-post.html | 21 +- templates/default.html | 2 +- templates/partials/metadata.html | 2 +- templates/partials/page-footer.html | 62 ++- tools/add-popup-source.sh | 213 ++++++++ 30 files changed, 1408 insertions(+), 449 deletions(-) create mode 100644 build/Dingbat.hs rename content/{ => drafts}/essays/test-essay.md (100%) create mode 100644 nginx/popup-proxy.conf create mode 100644 static/images/dingbats/ai.svg create mode 100644 static/images/dingbats/clef.svg create mode 100644 static/images/dingbats/fleuron.svg create mode 100644 static/images/dingbats/lozenge.svg create mode 100644 static/images/dingbats/memento.svg create mode 100644 static/images/dingbats/tech.svg create mode 100644 static/images/dingbats/trefoil.svg create mode 100644 static/images/link-icons/lesswrong.svg create mode 100644 static/images/link-icons/pdf.svg create mode 100755 tools/add-popup-source.sh diff --git a/build/Backlinks.hs b/build/Backlinks.hs index 0f37ef5..b8636d7 100644 --- a/build/Backlinks.hs +++ b/build/Backlinks.hs @@ -1,24 +1,24 @@ {-# LANGUAGE GHC2021 #-} {-# LANGUAGE OverloadedStrings #-} -- | Backlinks with context: build-time computation of which pages link to --- each page, including the paragraph that contains each link. +-- each page, including the sentence that contains each link. -- -- Architecture (dependency-correct, no circular deps): -- -- 1. Each content file is compiled under @version "links"@: a lightweight --- pass that parses the source, walks the AST block-by-block, and for --- every internal link records the URL *and* the HTML of its surrounding --- paragraph. The result is serialised as a JSON array of --- @{url, context}@ objects. +-- pass that parses the source, walks the AST block-by-block, splits +-- each paragraph into sentences, and for every internal link records +-- the URL *and* the HTML of the sentence that contains it. The result +-- is serialised as a JSON array of @{url, context}@ objects. -- -- 2. A @create ["data/backlinks.json"]@ rule loads all "links" items, -- inverts the map, and serialises -- @target → [{url, title, abstract, context}]@ as JSON. -- -- 3. @backlinksField@ loads that JSON at page render time and injects --- an HTML list showing each source's title and context paragraph. --- The @load@ call establishes a proper Hakyll dependency so pages --- recompile when backlinks change. +-- an HTML list showing each source's title and a quoted sentence of +-- context. The @load@ call establishes a proper Hakyll dependency so +-- pages recompile when backlinks change. -- -- Dependency order (no cycles): -- content "links" versions → data/backlinks.json → content default versions @@ -56,34 +56,44 @@ import qualified Patterns as P -- --------------------------------------------------------------------------- data LinkEntry = LinkEntry - { leUrl :: T.Text -- internal URL (as found in the AST) - , leContext :: String -- HTML of the surrounding paragraph + { leUrl :: T.Text -- internal URL (as found in the AST) + , leSentence :: String -- HTML of the sentence containing the link + , leParagraph :: String -- HTML of the full surrounding paragraph } deriving (Show, Eq) instance Aeson.ToJSON LinkEntry where - toJSON e = Aeson.object ["url" .= leUrl e, "context" .= leContext e] + toJSON e = Aeson.object + [ "url" .= leUrl e + , "sentence" .= leSentence e + , "paragraph" .= leParagraph e + ] instance Aeson.FromJSON LinkEntry where parseJSON = Aeson.withObject "LinkEntry" $ \o -> - LinkEntry <$> o Aeson..: "url" <*> o Aeson..: "context" + LinkEntry + <$> o Aeson..: "url" + <*> o Aeson..: "sentence" + <*> o Aeson..: "paragraph" -- --------------------------------------------------------------------------- -- Backlink source record (stored in data/backlinks.json) -- --------------------------------------------------------------------------- data BacklinkSource = BacklinkSource - { blUrl :: String - , blTitle :: String - , blAbstract :: String - , blContext :: String -- raw HTML of the paragraph containing the link + { blUrl :: String + , blTitle :: String + , blAbstract :: String + , blSentence :: String -- raw HTML of the sentence containing the link + , blParagraph :: String -- raw HTML of the full paragraph (hover popup) } deriving (Show, Eq, Ord) instance Aeson.ToJSON BacklinkSource where toJSON bl = Aeson.object - [ "url" .= blUrl bl - , "title" .= blTitle bl - , "abstract" .= blAbstract bl - , "context" .= blContext bl + [ "url" .= blUrl bl + , "title" .= blTitle bl + , "abstract" .= blAbstract bl + , "sentence" .= blSentence bl + , "paragraph" .= blParagraph bl ] instance Aeson.FromJSON BacklinkSource where @@ -92,7 +102,8 @@ instance Aeson.FromJSON BacklinkSource where <$> o Aeson..: "url" <*> o Aeson..: "title" <*> o Aeson..: "abstract" - <*> o Aeson..: "context" + <*> o Aeson..: "sentence" + <*> o Aeson..: "paragraph" -- --------------------------------------------------------------------------- -- Writer options for context rendering @@ -138,8 +149,57 @@ renderInlines inlines = where doc = Pandoc nullMeta [Plain inlines] --- | Extract @(internal-url, context-html)@ pairs from a Pandoc document. --- Context is the HTML of the immediate surrounding paragraph. +-- | Split a list of inlines into sentences by terminator punctuation. +-- +-- A @Str@ whose last non-closing-punctuation character is @.@, @!@, or @?@ +-- ends a sentence when followed by @Space@, @SoftBreak@, @LineBreak@, or +-- end-of-list. Closing quote/bracket characters after the terminator +-- (e.g. @right-double-quote@, @)@, @]@) are tolerated. +-- +-- The splitter is deliberately simple: abbreviations like "e.g." or "Dr." +-- will cause occasional over-splitting. That is acceptable for backlink +-- previews, where a slightly short context is preferable to the complexity +-- of abbreviation detection. +splitSentences :: [Inline] -> [[Inline]] +splitSentences = go [] + where + go acc [] = if null acc then [] else [reverse acc] + go acc (tok : rest) + | isTerminator tok && leadingBreak rest = + reverse (tok : acc) : go [] (dropLeadingBreak rest) + | otherwise = + go (tok : acc) rest + + isTerminator :: Inline -> Bool + isTerminator (Str s) = endsWithTerminator s + isTerminator _ = False + + endsWithTerminator :: T.Text -> Bool + endsWithTerminator t = + case T.unsnoc (T.dropWhileEnd isClosingPunct t) of + Just (_, c) -> c == '.' || c == '!' || c == '?' + Nothing -> False + + isClosingPunct :: Char -> Bool + isClosingPunct c = c `elem` (")]\"'\x201D\x2019" :: String) + + leadingBreak :: [Inline] -> Bool + leadingBreak [] = True + leadingBreak (Space : _) = True + leadingBreak (SoftBreak : _) = True + leadingBreak (LineBreak : _) = True + leadingBreak _ = False + + dropLeadingBreak :: [Inline] -> [Inline] + dropLeadingBreak (Space : xs) = xs + dropLeadingBreak (SoftBreak : xs) = xs + dropLeadingBreak (LineBreak : xs) = xs + dropLeadingBreak xs = xs + +-- | Extract @LinkEntry@ records from a Pandoc document. +-- 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. extractLinksWithContext :: Pandoc -> [LinkEntry] extractLinksWithContext (Pandoc _ blocks) = concatMap go blocks @@ -152,15 +212,19 @@ extractLinksWithContext (Pandoc _ blocks) = concatMap go blocks go (OrderedList _ items) = concatMap (concatMap go) items go _ = [] - -- For a Para block: find all internal links it contains, and for each - -- return a LinkEntry with the paragraph's HTML as context. paraEntries :: [Inline] -> [LinkEntry] paraEntries inlines = - let urls = filter isPageLink (query getUrl inlines) + let paraHtml = renderInlines inlines + sentences = splitSentences inlines + in concatMap (sentenceEntries paraHtml) sentences + + sentenceEntries :: String -> [Inline] -> [LinkEntry] + sentenceEntries paraHtml sentence = + let urls = filter isPageLink (query getUrl sentence) in if null urls then [] else - let ctx = renderInlines inlines - in map (\u -> LinkEntry u ctx) urls + let sentHtml = renderInlines sentence + in map (\u -> LinkEntry u sentHtml paraHtml) urls getUrl :: Inline -> [T.Text] getUrl (Link _ _ (url, _)) = [url] @@ -178,9 +242,14 @@ linksCompiler = do let src = itemBody body let body' = itemSetBody (preprocessSource src) body pandocItem <- readPandocWith readerOpts body' - let entries = nubBy (\a b -> leUrl a == leUrl b && leContext a == leContext b) + let entries = nubBy sameEntry (extractLinksWithContext (itemBody pandocItem)) makeItem . TL.unpack . TLE.decodeUtf8 . Aeson.encode $ entries + where + sameEntry a b = + leUrl a == leUrl b && + leSentence a == leSentence b && + leParagraph a == leParagraph b -- --------------------------------------------------------------------------- -- URL normalisation @@ -269,7 +338,9 @@ toSourcePairs item = do Nothing -> return [] Just entries -> return [ ( T.pack (normaliseUrl (T.unpack (leUrl e))) - , BacklinkSource srcUrl title abstract (leContext e) + , BacklinkSource srcUrl title abstract + (leSentence e) + (leParagraph e) ) | e <- entries ] @@ -302,10 +373,14 @@ backlinksField = field "backlinks" $ \item -> do -- HTML rendering -- --------------------------------------------------------------------------- --- | Render backlink sources as an HTML list. --- Each item shows the source title as a link (always visible) and a ---
element containing the context paragraph (collapsed by default). --- @blContext@ is already HTML produced by the Pandoc writer — not escaped. +-- | Render backlink sources as an HTML list. Each item shows: +-- * the source title as a link (serif body face), +-- * a
of the sentence containing the link (default context), +-- * a small hoverable "¶" affordance that reveals the full paragraph in +-- a CSS-driven popup when hovered or keyboard-focused. +-- +-- 'blSentence' and 'blParagraph' are already HTML fragments produced by +-- the Pandoc writer, so they are emitted unescaped. renderBacklinks :: [BacklinkSource] -> String renderBacklinks sources = "