From 96a7ef051667b7d647d9614eb49a20a92d1387e3 Mon Sep 17 00:00:00 2001 From: Levi Neuwirth Date: Sun, 12 Apr 2026 12:34:02 -0400 Subject: [PATCH] Initial commit for ozymandias --- .gitignore | 64 + Makefile | 75 + README.md | 106 ++ build/Authors.hs | 111 ++ build/Backlinks.hs | 324 ++++ build/Catalog.hs | 243 +++ build/Citations.hs | 224 +++ build/Commonplace.hs | 161 ++ build/Compilers.hs | 217 +++ build/Config.hs | 118 ++ build/Contexts.hs | 572 +++++++ build/Filters.hs | 49 + build/Filters/Code.hs | 29 + build/Filters/Dropcaps.hs | 15 + build/Filters/EmbedPdf.hs | 81 + build/Filters/Images.hs | 191 +++ build/Filters/Links.hs | 133 ++ build/Filters/Math.hs | 14 + build/Filters/Score.hs | 122 ++ build/Filters/Sidenotes.hs | 99 ++ build/Filters/Smallcaps.hs | 66 + build/Filters/Transclusion.hs | 75 + build/Filters/Typography.hs | 54 + build/Filters/Viz.hs | 189 +++ build/Filters/Wikilinks.hs | 87 + build/Main.hs | 12 + build/Pagination.hs | 48 + build/Patterns.hs | 100 ++ build/SimilarLinks.hs | 127 ++ build/Site.hs | 457 ++++++ build/Stability.hs | 215 +++ build/Stats.hs | 962 +++++++++++ build/Tags.hs | 108 ++ build/Utils.hs | 78 + cabal.project | 8 + cabal.project.freeze | 235 +++ content/about.md | 5 + content/blog/2026-04-12-hello.md | 10 + content/colophon.md | 17 + content/essays/feature-tour.md | 91 ++ content/fiction/short-demo.md | 13 + content/index.md | 14 + content/music/demo-piece/index.md | 28 + content/music/demo-piece/score-001.svg | 6 + content/music/demo-piece/score-002.svg | 6 + content/music/demo-piece/score-003.svg | 6 + content/music/index.md | 6 + content/poetry/ozymandias.md | 22 + content/search.md | 6 + data/annotations.json | 1 + data/bibliography.bib | 17 + data/chicago-notes.csl | 248 +++ ozymandias.cabal | 67 + pyproject.toml | 31 + site.yaml | 81 + static/css/annotations.css | 215 +++ static/css/base.css | 305 ++++ static/css/build.css | 165 ++ static/css/catalog.css | 119 ++ static/css/commonplace.css | 141 ++ static/css/components.css | 1451 +++++++++++++++++ static/css/gallery.css | 537 ++++++ static/css/home.css | 106 ++ static/css/images.css | 115 ++ static/css/layout.css | 242 +++ static/css/library.css | 133 ++ static/css/new.css | 149 ++ static/css/popups.css | 216 +++ static/css/print.css | 149 ++ static/css/reading.css | 122 ++ static/css/score-reader.css | 246 +++ static/css/selection-popup.css | 184 +++ static/css/sidenotes.css | 157 ++ static/css/syntax.css | 93 ++ static/css/typography.css | 715 ++++++++ static/css/viz.css | 86 + static/fonts/fira-sans-regular.woff2 | Bin 0 -> 15800 bytes static/fonts/fira-sans-semibold.woff2 | Bin 0 -> 16108 bytes static/fonts/jetbrains-mono-italic.woff2 | Bin 0 -> 19768 bytes static/fonts/jetbrains-mono-regular.woff2 | Bin 0 -> 18512 bytes static/fonts/spectral-bold-italic.woff2 | Bin 0 -> 23564 bytes static/fonts/spectral-bold.woff2 | Bin 0 -> 22264 bytes static/fonts/spectral-italic.woff2 | Bin 0 -> 21768 bytes static/fonts/spectral-regular.woff2 | Bin 0 -> 20540 bytes static/fonts/spectral-semibold-italic.woff2 | Bin 0 -> 23928 bytes static/fonts/spectral-semibold.woff2 | Bin 0 -> 22332 bytes static/images/link-icons/anthropic.svg | 1 + static/images/link-icons/apple.svg | 1 + static/images/link-icons/arxiv.svg | 14 + static/images/link-icons/document.svg | 3 + static/images/link-icons/doi.svg | 12 + static/images/link-icons/email.svg | 3 + static/images/link-icons/external.svg | 14 + static/images/link-icons/github.svg | 4 + static/images/link-icons/hacker-news.svg | 1 + static/images/link-icons/internet-archive.svg | 1 + static/images/link-icons/key.svg | 3 + static/images/link-icons/nasa.svg | 1 + static/images/link-icons/new-york-times.svg | 1 + static/images/link-icons/openai.svg | 1 + static/images/link-icons/orcid.svg | 3 + static/images/link-icons/person.svg | 3 + static/images/link-icons/reddit.svg | 1 + static/images/link-icons/substack.svg | 1 + static/images/link-icons/tensorflow.svg | 1 + static/images/link-icons/tiktok.svg | 1 + static/images/link-icons/twitter.svg | 1 + static/images/link-icons/wikipedia.svg | 1 + static/images/link-icons/worldcat.svg | 1 + static/images/link-icons/youtube.svg | 1 + static/js/annotations.js | 253 +++ static/js/citations.js | 86 + static/js/collapse.js | 115 ++ static/js/copy.js | 45 + static/js/gallery.js | 486 ++++++ static/js/katex-bootstrap.js | 40 + static/js/lightbox.js | 118 ++ static/js/nav.js | 37 + static/js/popups.js | 697 ++++++++ static/js/prism.min.js | 48 + static/js/random.js | 25 + static/js/reading.js | 19 + static/js/score-reader.js | 135 ++ static/js/search.js | 54 + static/js/selection-popup.js | 461 ++++++ static/js/semantic-search.js | 232 +++ static/js/settings.js | 173 ++ static/js/sidenotes.js | 174 ++ static/js/theme.js | 36 + static/js/toc.js | 124 ++ static/js/transclude.js | 152 ++ static/js/utils.js | 48 + static/js/viz.js | 158 ++ templates/author-index.html | 26 + templates/blog-index.html | 17 + templates/blog-post.html | 15 + templates/commonplace.html | 35 + templates/composition.html | 72 + templates/default.html | 35 + templates/essay-index.html | 16 + templates/essay.html | 17 + templates/home.html | 3 + templates/library.html | 89 + templates/music-catalog.html | 20 + templates/new.html | 54 + templates/page.html | 4 + templates/partials/footer.html | 13 + templates/partials/head.html | 41 + templates/partials/metadata.html | 39 + templates/partials/nav.html | 51 + templates/partials/page-footer.html | 62 + templates/partials/paginate-nav.html | 14 + templates/reading.html | 7 + templates/score-reader-default.html | 18 + templates/score-reader.html | 35 + templates/tag-index.html | 26 + tools/convert-images.sh | 39 + tools/download-model.sh | 89 + tools/embed.py | 237 +++ tools/refreeze.sh | 21 + tools/sign-site.sh | 54 + tools/subset-fonts.sh | 52 + tools/viz_theme.py | 114 ++ uv.lock | 1406 ++++++++++++++++ 164 files changed, 18601 insertions(+) create mode 100644 .gitignore create mode 100644 Makefile create mode 100644 README.md create mode 100644 build/Authors.hs create mode 100644 build/Backlinks.hs create mode 100644 build/Catalog.hs create mode 100644 build/Citations.hs create mode 100644 build/Commonplace.hs create mode 100644 build/Compilers.hs create mode 100644 build/Config.hs create mode 100644 build/Contexts.hs create mode 100644 build/Filters.hs create mode 100644 build/Filters/Code.hs create mode 100644 build/Filters/Dropcaps.hs create mode 100644 build/Filters/EmbedPdf.hs create mode 100644 build/Filters/Images.hs create mode 100644 build/Filters/Links.hs create mode 100644 build/Filters/Math.hs create mode 100644 build/Filters/Score.hs create mode 100644 build/Filters/Sidenotes.hs create mode 100644 build/Filters/Smallcaps.hs create mode 100644 build/Filters/Transclusion.hs create mode 100644 build/Filters/Typography.hs create mode 100644 build/Filters/Viz.hs create mode 100644 build/Filters/Wikilinks.hs create mode 100644 build/Main.hs create mode 100644 build/Pagination.hs create mode 100644 build/Patterns.hs create mode 100644 build/SimilarLinks.hs create mode 100644 build/Site.hs create mode 100644 build/Stability.hs create mode 100644 build/Stats.hs create mode 100644 build/Tags.hs create mode 100644 build/Utils.hs create mode 100644 cabal.project create mode 100644 cabal.project.freeze create mode 100644 content/about.md create mode 100644 content/blog/2026-04-12-hello.md create mode 100644 content/colophon.md create mode 100644 content/essays/feature-tour.md create mode 100644 content/fiction/short-demo.md create mode 100644 content/index.md create mode 100644 content/music/demo-piece/index.md create mode 100644 content/music/demo-piece/score-001.svg create mode 100644 content/music/demo-piece/score-002.svg create mode 100644 content/music/demo-piece/score-003.svg create mode 100644 content/music/index.md create mode 100644 content/poetry/ozymandias.md create mode 100644 content/search.md create mode 100644 data/annotations.json create mode 100644 data/bibliography.bib create mode 100644 data/chicago-notes.csl create mode 100644 ozymandias.cabal create mode 100644 pyproject.toml create mode 100644 site.yaml create mode 100644 static/css/annotations.css create mode 100644 static/css/base.css create mode 100644 static/css/build.css create mode 100644 static/css/catalog.css create mode 100644 static/css/commonplace.css create mode 100644 static/css/components.css create mode 100644 static/css/gallery.css create mode 100644 static/css/home.css create mode 100644 static/css/images.css create mode 100644 static/css/layout.css create mode 100644 static/css/library.css create mode 100644 static/css/new.css create mode 100644 static/css/popups.css create mode 100644 static/css/print.css create mode 100644 static/css/reading.css create mode 100644 static/css/score-reader.css create mode 100644 static/css/selection-popup.css create mode 100644 static/css/sidenotes.css create mode 100644 static/css/syntax.css create mode 100644 static/css/typography.css create mode 100644 static/css/viz.css create mode 100644 static/fonts/fira-sans-regular.woff2 create mode 100644 static/fonts/fira-sans-semibold.woff2 create mode 100644 static/fonts/jetbrains-mono-italic.woff2 create mode 100644 static/fonts/jetbrains-mono-regular.woff2 create mode 100644 static/fonts/spectral-bold-italic.woff2 create mode 100644 static/fonts/spectral-bold.woff2 create mode 100644 static/fonts/spectral-italic.woff2 create mode 100644 static/fonts/spectral-regular.woff2 create mode 100644 static/fonts/spectral-semibold-italic.woff2 create mode 100644 static/fonts/spectral-semibold.woff2 create mode 100644 static/images/link-icons/anthropic.svg create mode 100644 static/images/link-icons/apple.svg create mode 100644 static/images/link-icons/arxiv.svg create mode 100644 static/images/link-icons/document.svg create mode 100644 static/images/link-icons/doi.svg create mode 100644 static/images/link-icons/email.svg create mode 100644 static/images/link-icons/external.svg create mode 100644 static/images/link-icons/github.svg create mode 100644 static/images/link-icons/hacker-news.svg create mode 100644 static/images/link-icons/internet-archive.svg create mode 100644 static/images/link-icons/key.svg create mode 100644 static/images/link-icons/nasa.svg create mode 100644 static/images/link-icons/new-york-times.svg create mode 100644 static/images/link-icons/openai.svg create mode 100644 static/images/link-icons/orcid.svg create mode 100644 static/images/link-icons/person.svg create mode 100644 static/images/link-icons/reddit.svg create mode 100644 static/images/link-icons/substack.svg create mode 100644 static/images/link-icons/tensorflow.svg create mode 100644 static/images/link-icons/tiktok.svg create mode 100644 static/images/link-icons/twitter.svg create mode 100644 static/images/link-icons/wikipedia.svg create mode 100644 static/images/link-icons/worldcat.svg create mode 100644 static/images/link-icons/youtube.svg create mode 100644 static/js/annotations.js create mode 100644 static/js/citations.js create mode 100644 static/js/collapse.js create mode 100644 static/js/copy.js create mode 100644 static/js/gallery.js create mode 100644 static/js/katex-bootstrap.js create mode 100644 static/js/lightbox.js create mode 100644 static/js/nav.js create mode 100644 static/js/popups.js create mode 100644 static/js/prism.min.js create mode 100644 static/js/random.js create mode 100644 static/js/reading.js create mode 100644 static/js/score-reader.js create mode 100644 static/js/search.js create mode 100644 static/js/selection-popup.js create mode 100644 static/js/semantic-search.js create mode 100644 static/js/settings.js create mode 100644 static/js/sidenotes.js create mode 100644 static/js/theme.js create mode 100644 static/js/toc.js create mode 100644 static/js/transclude.js create mode 100644 static/js/utils.js create mode 100644 static/js/viz.js create mode 100644 templates/author-index.html create mode 100644 templates/blog-index.html create mode 100644 templates/blog-post.html create mode 100644 templates/commonplace.html create mode 100644 templates/composition.html create mode 100644 templates/default.html create mode 100644 templates/essay-index.html create mode 100644 templates/essay.html create mode 100644 templates/home.html create mode 100644 templates/library.html create mode 100644 templates/music-catalog.html create mode 100644 templates/new.html create mode 100644 templates/page.html create mode 100644 templates/partials/footer.html create mode 100644 templates/partials/head.html create mode 100644 templates/partials/metadata.html create mode 100644 templates/partials/nav.html create mode 100644 templates/partials/page-footer.html create mode 100644 templates/partials/paginate-nav.html create mode 100644 templates/reading.html create mode 100644 templates/score-reader-default.html create mode 100644 templates/score-reader.html create mode 100644 templates/tag-index.html create mode 100755 tools/convert-images.sh create mode 100755 tools/download-model.sh create mode 100644 tools/embed.py create mode 100755 tools/refreeze.sh create mode 100755 tools/sign-site.sh create mode 100755 tools/subset-fonts.sh create mode 100644 tools/viz_theme.py create mode 100644 uv.lock diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b5d53f0 --- /dev/null +++ b/.gitignore @@ -0,0 +1,64 @@ +dist-newstyle/ +_site/ +_cache/ +.DS_Store +.env + +# Editor backup/swap files +*~ +*.swp +*.swo + +# Python bytecode caches +**/__pycache__/ +*.pyc +*.pyo + +# LaTeX build artifacts (sitewide — covers paper/, any future TeX sources) +*.aux +*.bbl +*.blg +*.brf +*.fdb_latexmk +*.fls +*.glo +*.gls +*.idx +*.ilg +*.ind +*.lof +*.lot +*.nav +*.out +*.snm +*.synctex.gz +*.toc +*.vrb +# PGF/TikZ scratch outputs +pgftest*.pdf +pgftest*.log +pgftest*.aux +# LaTeX run logs (scoped to paper/ — bare *.log would be too broad sitewide) +paper/*.log + +# Data files that are generated at build time (not version-controlled) +data/embeddings.json +data/similar-links.json +data/backlinks.json +data/build-stats.json +data/build-start.txt +data/last-build-seconds.txt +data/semantic-index.bin +data/semantic-meta.json + +# IGNORE.txt is for the local build and need not be synced. +IGNORE.txt + +# Model files for client-side semantic search (~22 MB binary artifacts). +# Download with: make download-model +static/models/ + +# Generated WebP companions (produced by tools/convert-images.sh at build time). +# To intentionally commit a WebP, use: git add -f path/to/file.webp +static/**/*.webp +content/**/*.webp \ No newline at end of file diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..4a786d7 --- /dev/null +++ b/Makefile @@ -0,0 +1,75 @@ +.PHONY: build deploy sign download-model convert-images pdf-thumbs watch clean dev + +# Source .env for GITHUB_TOKEN and GITHUB_REPO if it exists. +# .env format: KEY=value (one per line, no `export` prefix, no quotes needed). +-include .env +export + +build: + @date +%s > data/build-start.txt + @./tools/convert-images.sh + @$(MAKE) -s pdf-thumbs + cabal run site -- build + pagefind --site _site + @if [ -d .venv ]; then \ + uv run python tools/embed.py || echo "Warning: embedding failed — data/similar-links.json not updated (build continues)"; \ + else \ + echo "Embedding skipped: run 'uv sync' to enable similar-links (build continues)"; \ + fi + > IGNORE.txt + @BUILD_END=$$(date +%s); \ + BUILD_START=$$(cat data/build-start.txt); \ + echo $$((BUILD_END - BUILD_START)) > data/last-build-seconds.txt + +sign: + @./tools/sign-site.sh + +# Download the quantized ONNX model for client-side semantic search. +# Run once; files are gitignored. Safe to re-run (skips existing files). +download-model: + @./tools/download-model.sh + +# Convert JPEG/PNG images to WebP companions (also runs automatically in build). +# Requires cwebp: pacman -S libwebp / apt install webp +convert-images: + @./tools/convert-images.sh + +# Generate first-page thumbnails for PDFs in static/papers/ (also runs in build). +# Requires pdftoppm: pacman -S poppler / apt install poppler-utils +# Thumbnails are written as static/papers/foo.thumb.png alongside each PDF. +# Skipped silently when pdftoppm is not installed or static/papers/ is empty. +pdf-thumbs: + @if command -v pdftoppm >/dev/null 2>&1; then \ + find static/papers -name '*.pdf' 2>/dev/null | while read pdf; do \ + thumb="$${pdf%.pdf}.thumb"; \ + if [ ! -f "$${thumb}.png" ] || [ "$$pdf" -nt "$${thumb}.png" ]; then \ + echo " pdf-thumb $$pdf"; \ + pdftoppm -r 100 -f 1 -l 1 -png -singlefile "$$pdf" "$$thumb"; \ + fi; \ + done; \ + else \ + echo "pdf-thumbs: pdftoppm not found — install poppler (skipping)"; \ + fi + +deploy: clean build sign + @test -n "$(VPS_USER)" || (echo "deploy: VPS_USER not set in .env" >&2; exit 1) + @test -n "$(VPS_HOST)" || (echo "deploy: VPS_HOST not set in .env" >&2; exit 1) + @test -n "$(VPS_PATH)" || (echo "deploy: VPS_PATH not set in .env" >&2; exit 1) + rsync -avz --delete _site/ $(VPS_USER)@$(VPS_HOST):$(VPS_PATH)/ + git push -u origin main + +watch: export SITE_ENV = dev +watch: + cabal run site -- watch + +clean: + cabal run site -- clean + +# Dev build includes any in-progress drafts under content/drafts/essays/. +# SITE_ENV=dev is read by build/Site.hs; drafts are otherwise invisible to +# every build (make build / make deploy / cabal run site -- build directly). +dev: export SITE_ENV = dev +dev: + cabal run site -- clean + cabal run site -- build + python3 -m http.server 8000 --directory _site diff --git a/README.md b/README.md new file mode 100644 index 0000000..86e3c39 --- /dev/null +++ b/README.md @@ -0,0 +1,106 @@ +# Ozymandias + +A full-featured static site framework built with [Hakyll](https://jaspervdj.be/hakyll/) and [Pandoc](https://pandoc.org/). Designed for long-form writing, research, music, and creative work. + +## What's included + +- **Sidenotes** — footnotes render in the margin on wide screens, inline on mobile. +- **Epistemic profiles** — tag essays with confidence, evidence quality, importance, and stability; readers see a compact credibility signal before committing to read. +- **Backlinks** — two-pass wikilink resolution with automatic backlink sections. +- **Score reader** — swipeable SVG score viewer for music compositions. +- **Typography** — dropcaps, smallcaps auto-detection, abbreviation tooltips, old-style figures. +- **Math** — KaTeX rendering for inline and display equations. +- **Citations** — Pandoc citeproc with Chicago Notes; bibliography and further-reading sections. +- **Search** — Pagefind client-side full-text search. +- **Semantic search** — optional embedding pipeline (sentence-transformers + FAISS) for "similar links." +- **Settings** — dark mode, text size, focus mode, reduce motion. +- **Wikilinks** — `[[Page Name]]` and `[[Page Name|display text]]` syntax. +- **Atom feeds** — site-wide and per-section (e.g., music-only). +- **Library** — configurable portal taxonomy that groups content by tag hierarchy. +- **Version history** — git-derived stability heuristic with manual history annotations. +- **Reading mode** — dedicated layout for poetry and fiction. +- **GPG signing** — optional per-page detached signatures. + +## Quickstart + +```sh +# Clone and enter the repo +git clone my-site && cd my-site + +# Edit your identity and navigation +$EDITOR site.yaml + +# Build and serve locally (requires GHC 9.6+, cabal, pagefind) +make dev +``` + +`make dev` builds with drafts visible and starts a local server on `:8000`. +For production: `make build` (one-shot build into `_site/`). + +## Prerequisites + +- **GHC 9.6+** and **cabal-install** — for the Haskell build pipeline. +- **Pagefind** — client-side search index (`npm i -g pagefind` or via your package manager). +- **cwebp** (optional) — for automatic WebP image conversion (`pacman -S libwebp` / `apt install webp`). +- **Python 3.12+ and uv** (optional) — for the embedding pipeline (`uv sync` to set up). + +## Configuration + +All site identity, navigation, and taxonomy live in `site.yaml`: + +```yaml +site-name: "My Site" +site-url: "https://example.com" +author-name: "Your Name" + +nav: + - { href: "/", label: "Home" } + - { href: "/library.html", label: "Library" } + +portals: + - { slug: "writing", name: "Writing" } + - { slug: "code", name: "Code" } +``` + +See the comments in `site.yaml` for the full schema. + +## Project structure + +``` +build/ Haskell source — Hakyll rules, Pandoc filters, compilers +templates/ Hakyll HTML templates and partials +static/ CSS, JS, fonts, images (copied to _site/) +content/ Markdown source — essays, blog, poetry, fiction, music +data/ Bibliography, annotations, citation style +tools/ Shell/Python build-time utilities +site.yaml Site-wide configuration +Makefile Build, deploy, dev targets +``` + +## Content types + +| Type | Path | Template | +|:------------|:---------------------------------|:----------------| +| Essay | `content/essays/*.md` | essay.html | +| Blog post | `content/blog/*.md` | blog-post.html | +| Poetry | `content/poetry/*.md` | reading.html | +| Fiction | `content/fiction/*.md` | reading.html | +| Composition | `content/music//index.md` | composition.html| +| Page | `content/*.md` | page.html | + +## Deployment + +The included `make deploy` target: +1. Runs `make clean && make build && make sign` +2. Rsyncs `_site/` to a VPS (configured via `.env`) +3. Pushes to the git remote + +Set `VPS_USER`, `VPS_HOST`, and `VPS_PATH` in `.env` (gitignored). + +## License + +The framework code (everything outside `content/`) is [MIT](LICENSE). The demo content under `content/` is public domain. Your own content is yours — add whatever license you choose. + +--- + +*"My name is Ozymandias, King of Kings; / Look on my Works, ye Mighty, and despair!"* — the name is a reminder that all frameworks are temporary, but the writing you put in them might not be. diff --git a/build/Authors.hs b/build/Authors.hs new file mode 100644 index 0000000..b139f22 --- /dev/null +++ b/build/Authors.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Author system — treats authors like tags. +-- +-- Author pages live at /authors/{slug}/index.html. +-- Items with no "authors" frontmatter key default to the site's +-- @author-name@ from @site.yaml@. +-- +-- Frontmatter format (name-only or name|url — url part is ignored now): +-- authors: +-- - "Jane Doe" +-- - "Alice Smith | https://alice.example" -- url ignored; link goes to /authors/alice-smith/ +module Authors + ( buildAllAuthors + , applyAuthorRules + ) where + +import Data.Maybe (fromMaybe) +import Hakyll +import qualified Config +import Pagination (sortAndGroup) +import Patterns (authorIndexable) +import Contexts (abstractField, tagLinksField) +import Utils (authorSlugify, authorNameOf) + + +-- --------------------------------------------------------------------------- +-- Slug helpers +-- +-- The slugify and nameOf helpers used to live here in their own +-- definitions; they now defer to 'Utils' so that they cannot drift from +-- the 'Contexts' versions on Unicode edge cases. +-- --------------------------------------------------------------------------- + +slugify :: String -> String +slugify = authorSlugify + +nameOf :: String -> String +nameOf = authorNameOf + + +-- --------------------------------------------------------------------------- +-- Constants +-- --------------------------------------------------------------------------- + +defaultAuthor :: String +defaultAuthor = Config.defaultAuthor + +-- | Content patterns indexed by author. Sourced from 'Patterns.authorIndexable' +-- so this stays in lockstep with Tags.hs and Backlinks.hs. +allContent :: Pattern +allContent = authorIndexable + + +-- --------------------------------------------------------------------------- +-- Tag-like helpers (mirror of Tags.hs) +-- --------------------------------------------------------------------------- + +-- | Returns all author names for an identifier. +-- Defaults to the site's configured @author-name@ when no "authors" key +-- is present. +getAuthors :: MonadMetadata m => Identifier -> m [String] +getAuthors ident = do + meta <- getMetadata ident + let entries = fromMaybe [] (lookupStringList "authors" meta) + return $ if null entries + then [defaultAuthor] + else map nameOf entries + +-- | Canonical identifier for an author's index page (page 1). +authorIdentifier :: String -> Identifier +authorIdentifier name = fromFilePath $ "authors/" ++ slugify name ++ "/index.html" + +-- | Paginated identifier: page 1 → authors/{slug}/index.html +-- page N → authors/{slug}/page/N/index.html +authorPageId :: String -> PageNumber -> Identifier +authorPageId slug 1 = fromFilePath $ "authors/" ++ slug ++ "/index.html" +authorPageId slug n = fromFilePath $ "authors/" ++ slug ++ "/page/" ++ show n ++ "/index.html" + + +-- --------------------------------------------------------------------------- +-- Build + rules +-- --------------------------------------------------------------------------- + +buildAllAuthors :: Rules Tags +buildAllAuthors = buildTagsWith getAuthors allContent authorIdentifier + +applyAuthorRules :: Tags -> Context String -> Rules () +applyAuthorRules authors baseCtx = tagsRules authors $ \name pat -> do + let slug = slugify name + paginate <- buildPaginateWith sortAndGroup pat (authorPageId slug) + paginateRules paginate $ \pageNum pat' -> do + route idRoute + compile $ do + items <- recentFirst =<< loadAll (pat' .&&. hasNoVersion) + let ctx = listField "items" itemCtx (return items) + <> paginateContext paginate pageNum + <> constField "author" name + <> constField "title" name + <> baseCtx + makeItem "" + >>= loadAndApplyTemplate "templates/author-index.html" ctx + >>= loadAndApplyTemplate "templates/default.html" ctx + >>= relativizeUrls + where + itemCtx = dateField "date" "%-d %B %Y" + <> tagLinksField "item-tags" + <> abstractField + <> defaultContext + + diff --git a/build/Backlinks.hs b/build/Backlinks.hs new file mode 100644 index 0000000..0f37ef5 --- /dev/null +++ b/build/Backlinks.hs @@ -0,0 +1,324 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Backlinks with context: build-time computation of which pages link to +-- each page, including the paragraph 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. +-- +-- 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. +-- +-- Dependency order (no cycles): +-- content "links" versions → data/backlinks.json → content default versions +module Backlinks + ( backlinkRules + , backlinksField + ) where + +import Data.List (nubBy, sortBy) +import Data.Ord (comparing) +import Data.Maybe (fromMaybe) +import qualified Data.Map.Strict as Map +import Data.Map.Strict (Map) +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TLE +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Encoding.Error as TE +import qualified Data.Aeson as Aeson +import Data.Aeson ((.=)) +import Text.Pandoc.Class (runPure) +import Text.Pandoc.Writers (writeHtml5String) +import Text.Pandoc.Definition (Block (..), Inline (..), Pandoc (..), + nullMeta) +import Text.Pandoc.Options (WriterOptions (..), HTMLMathMethod (..)) +import Text.Pandoc.Walk (query) +import Hakyll +import Compilers (readerOpts, writerOpts) +import Filters (preprocessSource) +import qualified Patterns as P + +-- --------------------------------------------------------------------------- +-- Link-with-context entry (intermediate, saved by the "links" pass) +-- --------------------------------------------------------------------------- + +data LinkEntry = LinkEntry + { leUrl :: T.Text -- internal URL (as found in the AST) + , leContext :: String -- HTML of the surrounding paragraph + } deriving (Show, Eq) + +instance Aeson.ToJSON LinkEntry where + toJSON e = Aeson.object ["url" .= leUrl e, "context" .= leContext e] + +instance Aeson.FromJSON LinkEntry where + parseJSON = Aeson.withObject "LinkEntry" $ \o -> + LinkEntry <$> o Aeson..: "url" <*> o Aeson..: "context" + +-- --------------------------------------------------------------------------- +-- 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 + } 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 + ] + +instance Aeson.FromJSON BacklinkSource where + parseJSON = Aeson.withObject "BacklinkSource" $ \o -> + BacklinkSource + <$> o Aeson..: "url" + <*> o Aeson..: "title" + <*> o Aeson..: "abstract" + <*> o Aeson..: "context" + +-- --------------------------------------------------------------------------- +-- Writer options for context rendering +-- --------------------------------------------------------------------------- + +-- | Minimal writer options for rendering paragraph context: no template +-- (fragment only), plain math fallback (context excerpts are previews, not +-- full renders, and KaTeX CSS may not be loaded on all target pages). +contextWriterOpts :: WriterOptions +contextWriterOpts = writerOpts + { writerTemplate = Nothing + , writerHTMLMathMethod = PlainMath + } + +-- --------------------------------------------------------------------------- +-- Context extraction +-- --------------------------------------------------------------------------- + +-- | URL filter: skip external links, pseudo-schemes, anchor-only fragments, +-- and static-asset paths. +isPageLink :: T.Text -> Bool +isPageLink u = + not (T.isPrefixOf "http://" u) && + not (T.isPrefixOf "https://" u) && + not (T.isPrefixOf "#" u) && + not (T.isPrefixOf "mailto:" u) && + not (T.isPrefixOf "tel:" u) && + not (T.null u) && + not (hasStaticExt u) + where + staticExts = [".pdf",".svg",".png",".jpg",".jpeg",".webp", + ".mp3",".mp4",".woff2",".woff",".ttf",".ico", + ".json",".asc",".xml",".gz",".zip"] + hasStaticExt x = any (`T.isSuffixOf` T.toLower x) staticExts + +-- | Render a list of inlines to an HTML fragment string. +-- Uses Plain (not Para) to avoid a wrapping

— callers add their own. +renderInlines :: [Inline] -> String +renderInlines inlines = + case runPure (writeHtml5String contextWriterOpts doc) of + Left _ -> "" + Right txt -> T.unpack txt + 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. +-- Recurses into Div, BlockQuote, BulletList, and OrderedList. +extractLinksWithContext :: Pandoc -> [LinkEntry] +extractLinksWithContext (Pandoc _ blocks) = concatMap go blocks + where + go :: Block -> [LinkEntry] + go (Para 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 _ = [] + + -- 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) + in if null urls then [] + else + let ctx = renderInlines inlines + in map (\u -> LinkEntry u ctx) urls + + getUrl :: Inline -> [T.Text] + getUrl (Link _ _ (url, _)) = [url] + getUrl _ = [] + +-- --------------------------------------------------------------------------- +-- Lightweight links compiler +-- --------------------------------------------------------------------------- + +-- | Compile a source file lightly: parse the Markdown (wikilinks preprocessed), +-- extract internal links with their paragraph context, and serialise as JSON. +linksCompiler :: Compiler (Item String) +linksCompiler = do + body <- getResourceBody + 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) + (extractLinksWithContext (itemBody pandocItem)) + makeItem . TL.unpack . TLE.decodeUtf8 . Aeson.encode $ entries + +-- --------------------------------------------------------------------------- +-- URL normalisation +-- --------------------------------------------------------------------------- + +-- | Normalise an internal URL as a map key: strip query string, fragment, +-- and trailing @.html@; ensure a leading slash; percent-decode the path +-- so that @\/essays\/caf%C3%A9@ and @\/essays\/café@ collide on the same +-- key. +normaliseUrl :: String -> String +normaliseUrl url = + let t = T.pack url + t1 = fst (T.breakOn "?" (fst (T.breakOn "#" t))) + t2 = if T.isPrefixOf "/" t1 then t1 else "/" `T.append` t1 + t3 = fromMaybe t2 (T.stripSuffix ".html" t2) + in percentDecode (T.unpack t3) + +-- | Decode percent-escapes (@%XX@) into raw bytes, then re-interpret the +-- resulting bytestring as UTF-8. Invalid escapes are passed through +-- verbatim so this is safe to call on already-decoded input. +percentDecode :: String -> String +percentDecode = T.unpack . TE.decodeUtf8With lenientDecode . pack . go + where + go [] = [] + go ('%':a:b:rest) + | Just hi <- hexDigit a + , Just lo <- hexDigit b + = fromIntegral (hi * 16 + lo) : go rest + go (c:rest) = fromIntegral (fromEnum c) : go rest + + hexDigit c + | c >= '0' && c <= '9' = Just (fromEnum c - fromEnum '0') + | c >= 'a' && c <= 'f' = Just (fromEnum c - fromEnum 'a' + 10) + | c >= 'A' && c <= 'F' = Just (fromEnum c - fromEnum 'A' + 10) + | otherwise = Nothing + + pack = BS.pack + lenientDecode = TE.lenientDecode + +-- --------------------------------------------------------------------------- +-- Content patterns (must match the rules in Site.hs — sourced from +-- Patterns.allContent so additions to the canonical list automatically +-- propagate to backlinks). +-- --------------------------------------------------------------------------- + +allContent :: Pattern +allContent = P.allContent + +-- --------------------------------------------------------------------------- +-- Hakyll rules +-- --------------------------------------------------------------------------- + +-- | Register the @version "links"@ rules for all content and the +-- @create ["data/backlinks.json"]@ rule. Call this from 'Site.rules'. +backlinkRules :: Rules () +backlinkRules = do + -- Pass 1: extract links + context from each content file. + match allContent $ version "links" $ + compile linksCompiler + + -- Pass 2: invert the map and write the backlinks JSON. + create ["data/backlinks.json"] $ do + route idRoute + compile $ do + items <- loadAll (allContent .&&. hasVersion "links") + :: Compiler [Item String] + pairs <- concat <$> mapM toSourcePairs items + makeItem . TL.unpack . TLE.decodeUtf8 . Aeson.encode + $ Map.fromListWith (++) [(k, [v]) | (k, v) <- pairs] + +-- | For one "links" item, produce @(normalised-target-url, BacklinkSource)@ +-- pairs — one per internal link found in the source file. +toSourcePairs :: Item String -> Compiler [(T.Text, BacklinkSource)] +toSourcePairs item = do + let ident0 = setVersion Nothing (itemIdentifier item) + mRoute <- getRoute ident0 + meta <- getMetadata ident0 + let srcUrl = maybe "" (\r -> "/" ++ r) mRoute + let title = fromMaybe "(untitled)" (lookupString "title" meta) + let abstract = fromMaybe "" (lookupString "abstract" meta) + case mRoute of + Nothing -> return [] + Just _ -> + case Aeson.decodeStrict (TE.encodeUtf8 (T.pack (itemBody item))) + :: Maybe [LinkEntry] of + Nothing -> return [] + Just entries -> + return [ ( T.pack (normaliseUrl (T.unpack (leUrl e))) + , BacklinkSource srcUrl title abstract (leContext e) + ) + | e <- entries ] + +-- --------------------------------------------------------------------------- +-- Context field +-- --------------------------------------------------------------------------- + +-- | Context field @$backlinks$@ that injects an HTML list of pages that link +-- to the current page, each with its paragraph context. +-- Returns @noResult@ (so @$if(backlinks)$@ is false) when there are none. +backlinksField :: Context String +backlinksField = field "backlinks" $ \item -> do + blItem <- load (fromFilePath "data/backlinks.json") :: Compiler (Item String) + case Aeson.decodeStrict (TE.encodeUtf8 (T.pack (itemBody blItem))) + :: Maybe (Map T.Text [BacklinkSource]) of + Nothing -> fail "backlinks: could not parse data/backlinks.json" + Just blMap -> do + mRoute <- getRoute (itemIdentifier item) + case mRoute of + Nothing -> fail "backlinks: item has no route" + Just r -> + let key = T.pack (normaliseUrl ("/" ++ r)) + sources = fromMaybe [] (Map.lookup key blMap) + sorted = sortBy (comparing blTitle) sources + in if null sorted + then fail "no backlinks" + else return (renderBacklinks sorted) + +-- --------------------------------------------------------------------------- +-- 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. +renderBacklinks :: [BacklinkSource] -> String +renderBacklinks sources = + "
    \n" + ++ concatMap renderOne sources + ++ "
" + where + renderOne bl = + "
  • " + ++ "" + ++ escapeHtml (blTitle bl) ++ "" + ++ ( if null (blContext bl) then "" + else "
    " + ++ "context" + ++ "
    " ++ blContext bl ++ "
    " + ++ "
    " ) + ++ "
    • \n" diff --git a/build/Catalog.hs b/build/Catalog.hs new file mode 100644 index 0000000..85039a8 --- /dev/null +++ b/build/Catalog.hs @@ -0,0 +1,243 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Music catalog: featured works + grouped-by-category listing. +-- Renders HTML directly (same pattern as Backlinks.hs) to avoid the +-- complexity of nested listFieldWith. +module Catalog + ( musicCatalogCtx + ) where + +import Data.Char (isSpace, toLower) +import Data.List (groupBy, isPrefixOf, sortBy) +import Data.Maybe (fromMaybe) +import Data.Ord (comparing) +import Data.Aeson (Value (..)) +import qualified Data.Aeson.KeyMap as KM +import qualified Data.Vector as V +import qualified Data.Text as T +import Hakyll +import Contexts (siteCtx) + +-- --------------------------------------------------------------------------- +-- Entry type +-- --------------------------------------------------------------------------- + +data CatalogEntry = CatalogEntry + { ceTitle :: String + , ceUrl :: String + , ceYear :: Maybe String + , ceDuration :: Maybe String + , ceInstrumentation :: Maybe String + , ceCategory :: String -- defaults to "other" + , ceFeatured :: Bool + , ceHasScore :: Bool + , ceHasRecording :: Bool + } + +-- --------------------------------------------------------------------------- +-- Category helpers +-- --------------------------------------------------------------------------- + +categoryOrder :: [String] +categoryOrder = ["orchestral","chamber","solo","vocal","choral","electronic","other"] + +categoryLabel :: String -> String +categoryLabel "orchestral" = "Orchestral" +categoryLabel "chamber" = "Chamber" +categoryLabel "solo" = "Solo" +categoryLabel "vocal" = "Vocal" +categoryLabel "choral" = "Choral" +categoryLabel "electronic" = "Electronic" +categoryLabel _ = "Other" + +categoryRank :: String -> Int +categoryRank c = fromMaybe (length categoryOrder) + (lookup c (zip categoryOrder [0..])) + +-- --------------------------------------------------------------------------- +-- Parsing helpers +-- --------------------------------------------------------------------------- + +-- | @featured: true@ in YAML becomes Bool True in Aeson; also accept the +-- string "true" in case the author quotes it. +isFeatured :: Metadata -> Bool +isFeatured meta = + case KM.lookup "featured" meta of + Just (Bool True) -> True + Just (String "true") -> True + _ -> False + +-- | True if a @recording@ key is present, or any movement has an @audio@ key. +hasRecordingMeta :: Metadata -> Bool +hasRecordingMeta meta = + KM.member "recording" meta || anyMovHasAudio meta + where + anyMovHasAudio m = + case KM.lookup "movements" m of + Just (Array v) -> any movHasAudio (V.toList v) + _ -> False + movHasAudio (Object o) = KM.member "audio" o + movHasAudio _ = False + +-- | Parse a year: accepts Number (e.g. @year: 2019@) or String. +parseYear :: Metadata -> Maybe String +parseYear meta = + case KM.lookup "year" meta of + Just (Number n) -> Just $ show (floor (fromRational (toRational n) :: Double) :: Int) + Just (String t) -> Just (T.unpack t) + _ -> Nothing + +parseCatalogEntry :: Item String -> Compiler (Maybe CatalogEntry) +parseCatalogEntry item = do + meta <- getMetadata (itemIdentifier item) + mRoute <- getRoute (itemIdentifier item) + case mRoute of + Nothing -> return Nothing + Just r -> do + let title = fromMaybe "(untitled)" (lookupString "title" meta) + url = "/" ++ r + year = parseYear meta + dur = lookupString "duration" meta + instr = lookupString "instrumentation" meta + cat = fromMaybe "other" (lookupString "category" meta) + return $ Just CatalogEntry + { ceTitle = title + , ceUrl = url + , ceYear = year + , ceDuration = dur + , ceInstrumentation = instr + , ceCategory = cat + , ceFeatured = isFeatured meta + , ceHasScore = not (null (fromMaybe [] (lookupStringList "score-pages" meta))) + , ceHasRecording = hasRecordingMeta meta + } + +-- --------------------------------------------------------------------------- +-- HTML rendering +-- --------------------------------------------------------------------------- +-- +-- Trust model: per the site convention (see also Stats.hs:pageLink), +-- frontmatter @title@ values are author-controlled trusted HTML and may +-- contain inline markup such as @...@. They are emitted +-- pre-escaped — but we still escape every other interpolated frontmatter +-- value (year, duration, instrumentation) and sanitize hrefs through +-- 'safeHref', so a stray @<@ in those fields cannot break the markup. + +-- | Defense-in-depth href sanitiser. Mirrors 'Stats.isSafeUrl'. +safeHref :: String -> String +safeHref u = + let norm = map toLower (dropWhile isSpace u) + in if not ("//" `isPrefixOf` norm) + && any (`isPrefixOf` norm) ["/", "https://", "mailto:", "#"] + then escAttr u + else "#" + +escAttr :: String -> String +escAttr = concatMap esc + where + esc '&' = "&" + esc '<' = "<" + esc '>' = ">" + esc '"' = """ + esc '\'' = "'" + esc c = [c] + +escText :: String -> String +escText = concatMap esc + where + esc '&' = "&" + esc '<' = "<" + esc '>' = ">" + esc c = [c] + +renderIndicators :: CatalogEntry -> String +renderIndicators e = concatMap render + [ (ceHasScore e, "◼") + , (ceHasRecording e, "♪") + ] + where + render (True, s) = s + render (False, _) = "" + +renderEntry :: CatalogEntry -> String +renderEntry e = concat + [ "
  • " + , "
    " + , "" + , ceTitle e + , "" + , renderIndicators e + , maybe "" (\y -> "" ++ escText y ++ "") (ceYear e) + , maybe "" (\d -> "" ++ escText d ++ "") (ceDuration e) + , "
    " + , maybe "" (\i -> "
    " ++ escText i ++ "
    ") (ceInstrumentation e) + , "
    • " + ] + +renderCategorySection :: String -> [CatalogEntry] -> String +renderCategorySection cat entries = concat + [ "
    " + , "

    ", escText (categoryLabel cat), "

    " + , "
      " + , concatMap renderEntry entries + , "
    " + , "
    " + ] + +-- --------------------------------------------------------------------------- +-- Load all compositions (excluding the catalog index itself) +-- --------------------------------------------------------------------------- + +loadEntries :: Compiler [CatalogEntry] +loadEntries = do + items <- loadAll ("content/music/*/index.md" .&&. hasNoVersion) + mItems <- mapM parseCatalogEntry items + return [e | Just e <- mItems] + +-- --------------------------------------------------------------------------- +-- Context fields +-- --------------------------------------------------------------------------- + +-- | @$featured-works$@: HTML list of featured entries; noResult when none. +featuredWorksField :: Context String +featuredWorksField = field "featured-works" $ \_ -> do + entries <- loadEntries + let featured = filter ceFeatured entries + if null featured + then fail "no featured works" + else return $ + "
      " + ++ concatMap renderEntry featured + ++ "
    " + +-- | @$has-featured$@: present when at least one composition is featured. +hasFeaturedField :: Context String +hasFeaturedField = field "has-featured" $ \_ -> do + entries <- loadEntries + if any ceFeatured entries then return "true" else fail "no featured works" + +-- | @$catalog-by-category$@: HTML for all category sections. +-- Sorted by canonical category order; if no compositions exist yet, +-- returns a placeholder paragraph. +catalogByCategoryField :: Context String +catalogByCategoryField = field "catalog-by-category" $ \_ -> do + entries <- loadEntries + if null entries + then return "

    Works forthcoming.

    " + else do + let sorted = sortBy (comparing (categoryRank . ceCategory)) entries + grouped = groupBy (\a b -> ceCategory a == ceCategory b) sorted + return $ concatMap renderGroup grouped + where + -- groupBy on a non-empty list yields non-empty sublists, but pattern + -- matching is total whereas 'head' is not. + renderGroup [] = "" + renderGroup g@(e : _) = renderCategorySection (ceCategory e) g + +musicCatalogCtx :: Context String +musicCatalogCtx = + constField "catalog" "true" + <> hasFeaturedField + <> featuredWorksField + <> catalogByCategoryField + <> siteCtx diff --git a/build/Citations.hs b/build/Citations.hs new file mode 100644 index 0000000..f7fbc8e --- /dev/null +++ b/build/Citations.hs @@ -0,0 +1,224 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Citation processing pipeline. +-- +-- Steps: +-- 1. Skip if the document contains no Cite nodes and frKeys is empty. +-- 2. Inject default bibliography / CSL metadata if absent. +-- 3. Inject nocite entries for further-reading keys. +-- 4. Run Pandoc's citeproc to resolve references and generate bibliography. +-- 5. Walk the AST and replace Cite nodes with numbered superscripts. +-- 6. Extract the citeproc bibliography div from the body, reorder by +-- first-appearance, split into cited / further-reading sections, +-- and render to an HTML string for the template's $bibliography$ field. +-- +-- Returns (Pandoc without refs div, bibliography HTML). +-- The bibliography HTML is empty when there are no citations. +-- +-- NOTE: processCitations with in-text CSL leaves Cite nodes as Cite nodes +-- in the AST — it only populates their inline content and creates the refs +-- div. The HTML writer later wraps them in . We must +-- therefore match Cite nodes (not Span nodes) in our transform pass. +-- +-- NOTE: Hakyll strips YAML frontmatter before passing to readPandocWith, so +-- the Pandoc Meta is empty. further-reading keys are passed explicitly by the +-- caller (read from Hakyll's own metadata via lookupStringList). +-- +-- NOTE: Does not import Contexts to avoid cycles. +module Citations (applyCitations) where + +import Data.List (intercalate, nub, partition, sortBy) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Ord (comparing) +import Data.Text (Text) +import qualified Data.Text as T +import Text.Pandoc +import Text.Pandoc.Citeproc (processCitations) +import Text.Pandoc.Walk + + +-- --------------------------------------------------------------------------- +-- Public API +-- --------------------------------------------------------------------------- + +-- | Process citations in a Pandoc document. +-- @frKeys@: further-reading citation keys (read from Hakyll metadata by +-- the caller, since Hakyll strips YAML frontmatter before parsing). +-- Returns @(body, citedHtml, furtherHtml)@ where @body@ has Cite nodes +-- replaced with numbered superscripts and no bibliography div, +-- @citedHtml@ is the inline-cited references HTML, and @furtherHtml@ is +-- the further-reading-only references HTML (each empty when absent). +applyCitations :: [Text] -> Text -> Pandoc -> IO (Pandoc, Text, Text) +applyCitations frKeys bibPath doc + | not (hasCitations frKeys doc) = return (doc, "", "") + | otherwise = do + let doc1 = injectMeta frKeys bibPath doc + processed <- runIOorExplode $ processCitations doc1 + let (body, citedHtml, furtherHtml) = transformAndExtract frKeys processed + return (body, citedHtml, furtherHtml) + + +-- --------------------------------------------------------------------------- +-- Detection +-- --------------------------------------------------------------------------- + +-- | True if the document has inline [@key] cites or a further-reading list. +hasCitations :: [Text] -> Pandoc -> Bool +hasCitations frKeys doc = + not (null (query collectCites doc)) + || not (null frKeys) + where + collectCites (Cite {}) = [()] + collectCites _ = [] + + +-- --------------------------------------------------------------------------- +-- Metadata injection +-- --------------------------------------------------------------------------- + +-- | Inject default bibliography / CSL paths and nocite for further-reading. +injectMeta :: [Text] -> Text -> Pandoc -> Pandoc +injectMeta frKeys bibPath (Pandoc meta blocks) = + let meta1 = if null frKeys then meta + else insertMeta "nocite" (nociteVal frKeys) meta + meta2 = case lookupMeta "bibliography" meta1 of + Nothing -> insertMeta "bibliography" + (MetaString bibPath) meta1 + Just _ -> meta1 + meta3 = case lookupMeta "csl" meta2 of + Nothing -> insertMeta "csl" + (MetaString "data/chicago-notes.csl") meta2 + Just _ -> meta2 + in Pandoc meta3 blocks + where + -- Each key becomes its own Cite node (matching what pandoc parses from + -- nocite: "@key1 @key2" in YAML frontmatter). + nociteVal keys = MetaInlines (intercalate [Space] (map mkCiteNode keys)) + mkCiteNode k = [Cite [Citation k [] [] AuthorInText 1 0] [Str ("@" <> k)]] + +-- | Insert a key/value pair into Pandoc Meta. +insertMeta :: Text -> MetaValue -> Meta -> Meta +insertMeta k v (Meta m) = Meta (Map.insert k v m) + + +-- --------------------------------------------------------------------------- +-- Transform pass +-- --------------------------------------------------------------------------- + +-- | Number citation Cite nodes and extract the bibliography div. +transformAndExtract :: [Text] -> Pandoc -> (Pandoc, Text, Text) +transformAndExtract frKeys doc@(Pandoc meta _) = + let citeOrder = collectCiteOrder doc -- keys, first-appearance order + keyNums = Map.fromList (zip citeOrder [1 :: Int ..]) + -- Replace Cite nodes with numbered superscript markers + doc' = walk (transformInline keyNums) doc + -- Pull bibliography div out of body and render to HTML + (bodyBlocks, citedHtml, furtherHtml) = extractBibliography citeOrder frKeys + (pandocBlocks doc') + in (Pandoc meta bodyBlocks, citedHtml, furtherHtml) + where + pandocBlocks (Pandoc _ bs) = bs + +-- | Collect citation keys in order of first appearance (body only). +-- NOTE: after processCitations, Cite nodes remain as Cite in the AST; +-- they are not converted to Span nodes with in-text CSL. +-- We query only blocks (not metadata) so that nocite Cite nodes injected +-- into the 'nocite' meta field are not mistakenly treated as inline citations. +collectCiteOrder :: Pandoc -> [Text] +collectCiteOrder (Pandoc _ blocks) = nub (query extractKeys blocks) + where + extractKeys (Cite citations _) = map citationId citations + extractKeys _ = [] + +-- | Replace a Cite node with a numbered superscript marker. +transformInline :: Map Text Int -> Inline -> Inline +transformInline keyNums (Cite citations _) = + let keys = map citationId citations + nums = mapMaybe (`Map.lookup` keyNums) keys + in case (keys, nums) of + -- Both lists are guaranteed non-empty by the @null nums@ check + -- below, but pattern-match to keep this total instead of + -- relying on @head@. + (firstKey : _, firstNum : _) -> + RawInline "html" (markerHtml keys firstKey firstNum nums) + _ -> + Str "" +transformInline _ x = x + +markerHtml :: [Text] -> Text -> Int -> [Int] -> Text +markerHtml keys firstKey firstNum nums = + let label = "[" <> T.intercalate "," (map tshow nums) <> "]" + allIds = T.intercalate " " (map ("ref-" <>) keys) + in " tshow firstNum <> "\">" + <> " firstKey <> "\" class=\"cite-link\"" + <> " data-cite-keys=\"" <> allIds <> "\">" + <> label <> "" + where tshow = T.pack . show + + +-- --------------------------------------------------------------------------- +-- Bibliography extraction + rendering +-- --------------------------------------------------------------------------- + +-- | Separate the @refs@ div from body blocks and render it to HTML. +-- Returns @(bodyBlocks, citedHtml, furtherHtml)@. +extractBibliography :: [Text] -> [Text] -> [Block] -> ([Block], Text, Text) +extractBibliography citeOrder frKeys blocks = + let (bodyBlocks, refDivs) = partition (not . isRefsDiv) blocks + (citedHtml, furtherHtml) = case refDivs of + [] -> ("", "") + (d:_) -> renderBibDiv citeOrder frKeys d + in (bodyBlocks, citedHtml, furtherHtml) + where + isRefsDiv (Div ("refs", _, _) _) = True + isRefsDiv _ = False + +-- | Render the citeproc @refs@ Div into two HTML strings: +-- @(citedHtml, furtherHtml)@ — each is empty when there are no entries +-- in that section. Headings are rendered in the template, not here. +renderBibDiv :: [Text] -> [Text] -> Block -> (Text, Text) +renderBibDiv citeOrder _frKeys (Div _ children) = + let keyIndex = Map.fromList (zip citeOrder [0 :: Int ..]) + (citedEntries, furtherEntries) = + partition (isCited keyIndex) children + sorted = sortBy (comparing (entryOrder keyIndex)) citedEntries + numbered = zipWith addNumber [1..] sorted + citedHtml = renderEntries "csl-bib-body cite-refs" numbered + furtherHtml + | null furtherEntries = "" + | otherwise = renderEntries "csl-bib-body further-reading-refs" furtherEntries + in (citedHtml, furtherHtml) +renderBibDiv _ _ _ = ("", "") + +isCited :: Map Text Int -> Block -> Bool +isCited keyIndex (Div (rid, _, _) _) = Map.member (stripRefPrefix rid) keyIndex +isCited _ _ = False + +entryOrder :: Map Text Int -> Block -> Int +entryOrder keyIndex (Div (rid, _, _) _) = + fromMaybe maxBound $ Map.lookup (stripRefPrefix rid) keyIndex +entryOrder _ _ = maxBound + +-- | Prepend [N] marker to a bibliography entry block. +addNumber :: Int -> Block -> Block +addNumber n (Div attrs@(divId, _, _) content) = + Div attrs + ( Plain [ RawInline "html" + (" divId <> "\">[" <> T.pack (show n) <> "]") ] + : content ) +addNumber _ b = b + +-- | Strip the @ref-@ prefix that citeproc adds to div IDs. +stripRefPrefix :: Text -> Text +stripRefPrefix t = fromMaybe t (T.stripPrefix "ref-" t) + +-- | Render a list of blocks as an HTML string (used for bibliography sections). +renderEntries :: Text -> [Block] -> Text +renderEntries cls entries = + case runPure (writeHtml5String wOpts (Pandoc nullMeta entries)) of + Left _ -> "" + Right html -> "
    cls <> "\">\n" <> html <> "
    \n" + where + wOpts = def { writerWrapText = WrapNone } diff --git a/build/Commonplace.hs b/build/Commonplace.hs new file mode 100644 index 0000000..62ac381 --- /dev/null +++ b/build/Commonplace.hs @@ -0,0 +1,161 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Commonplace book: loads data/commonplace.yaml and renders +-- themed and chronological HTML views for /commonplace. +module Commonplace + ( commonplaceCtx + ) where + +import Data.Aeson (FromJSON (..), withObject, (.:), (.:?), (.!=)) +import Data.List (nub, sortBy) +import Data.Ord (comparing, Down (..)) +import qualified Data.ByteString.Char8 as BS +import qualified Data.Yaml as Y +import Hakyll hiding (escapeHtml, renderTags) +import Contexts (siteCtx) +import Utils (escapeHtml) + +-- --------------------------------------------------------------------------- +-- Entry type +-- --------------------------------------------------------------------------- + +data CPEntry = CPEntry + { cpText :: String + , cpAttribution :: String + , cpSource :: Maybe String + , cpSourceUrl :: Maybe String + , cpTags :: [String] + , cpCommentary :: Maybe String + , cpDateAdded :: String + } + +instance FromJSON CPEntry where + parseJSON = withObject "CPEntry" $ \o -> CPEntry + <$> o .: "text" + <*> o .: "attribution" + <*> o .:? "source" + <*> o .:? "source-url" + <*> o .:? "tags" .!= [] + <*> o .:? "commentary" + <*> o .:? "date-added" .!= "" + +-- --------------------------------------------------------------------------- +-- HTML rendering +-- --------------------------------------------------------------------------- + +-- | Escape HTML, then replace newlines with
    for multi-line verse. +renderText :: String -> String +renderText = concatMap tr . escapeHtml . stripTrailingNL + where + tr '\n' = "
    \n" + tr c = [c] + stripTrailingNL = reverse . dropWhile (== '\n') . reverse + +renderAttribution :: CPEntry -> String +renderAttribution e = + "

    \x2014\x202f" + ++ escapeHtml (cpAttribution e) + ++ maybe "" renderSource (cpSource e) + ++ "

    " + where + renderSource src = case cpSourceUrl e of + Just url -> ", " + ++ escapeHtml src ++ "" + Nothing -> ", " ++ escapeHtml src + +renderTags :: [String] -> String +renderTags [] = "" +renderTags ts = + "
    " + ++ concatMap (\t -> "" ++ escapeHtml t ++ "") ts + ++ "
    " + +renderEntry :: CPEntry -> String +renderEntry e = concat + [ "
    " + , "

    " + , renderText (cpText e) + , "

    " + , renderAttribution e + , maybe "" renderCommentary (cpCommentary e) + , renderTags (cpTags e) + , "
    " + ] + where + renderCommentary c = + "

    " ++ escapeHtml c ++ "

    " + +-- --------------------------------------------------------------------------- +-- Themed view +-- --------------------------------------------------------------------------- + +-- | All distinct tags in first-occurrence order (preserves YAML ordering). +allTags :: [CPEntry] -> [String] +allTags = nub . concatMap cpTags + +renderTagSection :: String -> [CPEntry] -> String +renderTagSection tag entries = concat + [ "
    " + , "

    " ++ escapeHtml tag ++ "

    " + , concatMap renderEntry entries + , "
    " + ] + +renderThemedView :: [CPEntry] -> String +renderThemedView [] = + "
    " + ++ "

    No entries yet.

    " + ++ "
    " +renderThemedView entries = + "
    " + ++ concatMap renderSection (allTags entries) + ++ (if null untagged then "" + else renderTagSection "miscellany" untagged) + ++ "
    " + where + renderSection t = + let es = filter (elem t . cpTags) entries + in if null es then "" else renderTagSection t es + untagged = filter (null . cpTags) entries + +-- --------------------------------------------------------------------------- +-- Chronological view +-- --------------------------------------------------------------------------- + +renderChronoView :: [CPEntry] -> String +renderChronoView entries = + "" + where + sorted = sortBy (comparing (Down . cpDateAdded)) entries + +-- --------------------------------------------------------------------------- +-- Load entries from data/commonplace.yaml +-- --------------------------------------------------------------------------- + +loadCommonplace :: Compiler [CPEntry] +loadCommonplace = do + rawItem <- load (fromFilePath "data/commonplace.yaml") :: Compiler (Item String) + let raw = itemBody rawItem + case Y.decodeEither' (BS.pack raw) of + Left err -> fail ("commonplace.yaml: " ++ show err) + Right entries -> return entries + +-- --------------------------------------------------------------------------- +-- Context +-- --------------------------------------------------------------------------- + +commonplaceCtx :: Context String +commonplaceCtx = + constField "commonplace" "true" + <> themedField + <> chronoField + <> siteCtx + where + themedField = field "cp-themed-html" $ \_ -> + renderThemedView <$> loadCommonplace + chronoField = field "cp-chrono-html" $ \_ -> + renderChronoView <$> loadCommonplace diff --git a/build/Compilers.hs b/build/Compilers.hs new file mode 100644 index 0000000..dfd3640 --- /dev/null +++ b/build/Compilers.hs @@ -0,0 +1,217 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE OverloadedStrings #-} +module Compilers + ( essayCompiler + , postCompiler + , pageCompiler + , poetryCompiler + , fictionCompiler + , compositionCompiler + , readerOpts + , writerOpts + ) where + +import Hakyll +import Text.Pandoc.Definition (Pandoc (..), Block (..), + Inline (..)) +import Text.Pandoc.Options (ReaderOptions (..), WriterOptions (..), + HTMLMathMethod (..)) +import Text.Pandoc.Extensions (enableExtension, Extension (..)) +import qualified Data.Text as T +import Data.Maybe (fromMaybe) +import System.FilePath (takeDirectory) +import Utils (wordCount, readingTime, escapeHtml) +import Filters (applyAll, preprocessSource) +import qualified Citations +import qualified Filters.Score as Score +import qualified Filters.Viz as Viz + +-- --------------------------------------------------------------------------- +-- Reader / writer options +-- --------------------------------------------------------------------------- + +readerOpts :: ReaderOptions +readerOpts = defaultHakyllReaderOptions + +-- | Reader options with hard_line_breaks enabled — every source newline within +-- a paragraph becomes a
    . Used for poetry so stanza lines render as-is. +poetryReaderOpts :: ReaderOptions +poetryReaderOpts = readerOpts + { readerExtensions = enableExtension Ext_hard_line_breaks + (readerExtensions readerOpts) } + +writerOpts :: WriterOptions +writerOpts = defaultHakyllWriterOptions + { writerHTMLMathMethod = KaTeX "" + , writerHighlightStyle = Nothing + , writerNumberSections = False + , writerTableOfContents = False + } + +-- --------------------------------------------------------------------------- +-- Inline stringification (local, avoids depending on Text.Pandoc.Shared) +-- --------------------------------------------------------------------------- + +stringify :: [Inline] -> T.Text +stringify = T.concat . map inlineToText + where + inlineToText (Str t) = t + inlineToText Space = " " + inlineToText SoftBreak = " " + inlineToText LineBreak = " " + inlineToText (Emph ils) = stringify ils + inlineToText (Strong ils) = stringify ils + inlineToText (Strikeout ils) = stringify ils + inlineToText (Superscript ils) = stringify ils + inlineToText (Subscript ils) = stringify ils + inlineToText (SmallCaps ils) = stringify ils + inlineToText (Quoted _ ils) = stringify ils + inlineToText (Cite _ ils) = stringify ils + inlineToText (Code _ t) = t + inlineToText (RawInline _ t) = t + inlineToText (Link _ ils _) = stringify ils + inlineToText (Image _ ils _) = stringify ils + inlineToText (Note _) = "" + inlineToText (Span _ ils) = stringify ils + inlineToText _ = "" + +-- --------------------------------------------------------------------------- +-- TOC extraction +-- --------------------------------------------------------------------------- + +-- | Collect (level, identifier, title-text) for h2/h3 headings. +collectHeadings :: Pandoc -> [(Int, T.Text, String)] +collectHeadings (Pandoc _ blocks) = concatMap go blocks + where + go (Header lvl (ident, _, _) inlines) + | lvl == 2 || lvl == 3 + = [(lvl, ident, T.unpack (stringify inlines))] + go _ = [] + +-- --------------------------------------------------------------------------- +-- TOC tree +-- --------------------------------------------------------------------------- + +data TOCNode = TOCNode T.Text String [TOCNode] + +buildTree :: [(Int, T.Text, String)] -> [TOCNode] +buildTree = go 2 + where + go _ [] = [] + go lvl ((l, i, t) : rest) + | l == lvl = + let (childItems, remaining) = span (\(l', _, _) -> l' > lvl) rest + children = go (lvl + 1) childItems + in TOCNode i t children : go lvl remaining + | l < lvl = [] + | otherwise = go lvl rest -- skip unexpected deeper items at this level + +renderTOC :: [TOCNode] -> String +renderTOC [] = "" +renderTOC nodes = "
      \n" ++ concatMap renderNode nodes ++ "
    \n" + where + renderNode (TOCNode i t children) = + "
  • " + ++ Utils.escapeHtml t ++ "" ++ renderTOC children ++ "
    • \n" + +-- | Build a TOC HTML string from a Pandoc document. +buildTOC :: Pandoc -> String +buildTOC doc = renderTOC (buildTree (collectHeadings doc)) + +-- --------------------------------------------------------------------------- +-- Compilers +-- --------------------------------------------------------------------------- + +-- | Shared compiler pipeline parameterised on reader options. +-- Saves toc/word-count/reading-time/bibliography snapshots. +essayCompilerWith :: ReaderOptions -> Compiler (Item String) +essayCompilerWith rOpts = do + -- Raw Markdown source (used for word count / reading time). + body <- getResourceBody + let src = itemBody body + + -- Apply source-level preprocessors (wikilinks, etc.) before parsing. + let body' = itemSetBody (preprocessSource src) body + + -- Parse to Pandoc AST. + pandocItem <- readPandocWith rOpts body' + + -- Get further-reading keys from Hakyll metadata (YAML frontmatter is stripped + -- before being passed to readPandocWith, so we read it from Hakyll instead). + ident <- getUnderlying + meta <- getMetadata ident + let frKeys = map T.pack $ fromMaybe [] (lookupStringList "further-reading" meta) + let bibPath = T.pack $ fromMaybe "data/bibliography.bib" (lookupString "bibliography" meta) + + -- Run citeproc, transform citation spans → superscripts, extract bibliography. + (pandocWithCites, bibHtml, furtherHtml) <- unsafeCompiler $ + Citations.applyCitations frKeys bibPath (itemBody pandocItem) + + -- Inline SVG score fragments and data visualizations (both read files + -- relative to the source file's directory). + filePath <- getResourceFilePath + let srcDir = takeDirectory filePath + pandocWithScores <- unsafeCompiler $ + Score.inlineScores srcDir pandocWithCites + pandocWithViz <- unsafeCompiler $ + Viz.inlineViz srcDir pandocWithScores + + -- Apply remaining AST-level filters (sidenotes, smallcaps, links, etc.). + -- applyAll touches the filesystem via Images.apply (webp existence + -- check), so it runs through unsafeCompiler. + pandocFiltered <- unsafeCompiler $ applyAll srcDir pandocWithViz + let pandocItem' = itemSetBody pandocFiltered pandocItem + + -- Build TOC from the filtered AST. + let toc = buildTOC pandocFiltered + + -- Write HTML. + let htmlItem = writePandocWith writerOpts pandocItem' + + -- Save snapshots keyed to this item's identifier. + _ <- saveSnapshot "toc" (itemSetBody toc htmlItem) + _ <- saveSnapshot "word-count" (itemSetBody (show (wordCount src)) htmlItem) + _ <- saveSnapshot "reading-time" (itemSetBody (show (readingTime src)) htmlItem) + _ <- saveSnapshot "bibliography" (itemSetBody (T.unpack bibHtml) htmlItem) + _ <- saveSnapshot "further-reading-refs" (itemSetBody (T.unpack furtherHtml) htmlItem) + + return htmlItem + +-- | Compiler for essays. +essayCompiler :: Compiler (Item String) +essayCompiler = essayCompilerWith readerOpts + +-- | Compiler for blog posts: same pipeline as essays. +postCompiler :: Compiler (Item String) +postCompiler = essayCompiler + +-- | Compiler for poetry: enables hard_line_breaks so each source line becomes +-- a
    , preserving verse line endings without manual trailing-space markup. +poetryCompiler :: Compiler (Item String) +poetryCompiler = essayCompilerWith poetryReaderOpts + +-- | Compiler for fiction: same pipeline as essays; visual differences are +-- handled entirely by the reading template and reading.css. +fictionCompiler :: Compiler (Item String) +fictionCompiler = essayCompiler + +-- | Compiler for music composition landing pages: full essay pipeline +-- (TOC, sidenotes, score fragments, citations, smallcaps, etc.). +compositionCompiler :: Compiler (Item String) +compositionCompiler = essayCompiler + +-- | Compiler for simple pages: filters applied, no TOC snapshot. +pageCompiler :: Compiler (Item String) +pageCompiler = do + body <- getResourceBody + let src = itemBody body + body' = itemSetBody (preprocessSource src) body + filePath <- getResourceFilePath + let srcDir = takeDirectory filePath + pandocItem <- readPandocWith readerOpts body' + pandocFiltered <- unsafeCompiler $ applyAll srcDir (itemBody pandocItem) + let pandocItem' = itemSetBody pandocFiltered pandocItem + let htmlItem = writePandocWith writerOpts pandocItem' + _ <- saveSnapshot "word-count" (itemSetBody (show (wordCount src)) htmlItem) + _ <- saveSnapshot "reading-time" (itemSetBody (show (readingTime src)) htmlItem) + return htmlItem diff --git a/build/Config.hs b/build/Config.hs new file mode 100644 index 0000000..a907594 --- /dev/null +++ b/build/Config.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Site-wide configuration loaded from @site.yaml@ at the project root. +-- +-- The config is exposed as top-level pure values via @unsafePerformIO@ + +-- @NOINLINE@. This is safe because: +-- 1. The config is a build-time input that never changes during a build. +-- 2. The static site generator is single-shot — no concurrency. +-- 3. NOINLINE prevents GHC from duplicating the value. +-- +-- 'Main.main' forces 'siteConfig' before Hakyll starts so a missing or +-- malformed @site.yaml@ fails loudly with a parse error rather than +-- crashing midway through a build. +module Config + ( SiteConfig(..) + , NavLink(..) + , Portal(..) + , siteConfig + , siteHost + , defaultAuthor + ) where + +import Data.Aeson (FromJSON(..), withObject, (.:), (.:?), (.!=)) +import Data.Yaml (decodeFileThrow) +import Data.Text (Text) +import qualified Data.Text as T +import System.IO.Unsafe (unsafePerformIO) + +-- --------------------------------------------------------------------------- +-- Types +-- --------------------------------------------------------------------------- + +data SiteConfig = SiteConfig + { siteName :: Text + , siteUrl :: Text + , siteDescription :: Text + , siteLanguage :: Text + , authorName :: Text + , authorEmail :: Text + , feedTitle :: Text + , feedDescription :: Text + , license :: Text + , sourceUrl :: Text + , gpgFingerprint :: Text + , gpgPubkeyUrl :: Text + , navLinks :: [NavLink] + , portals :: [Portal] + } deriving (Show) + +data NavLink = NavLink + { navHref :: Text + , navLabel :: Text + } deriving (Show) + +data Portal = Portal + { portalSlug :: Text + , portalName :: Text + } deriving (Show) + +-- --------------------------------------------------------------------------- +-- JSON instances +-- --------------------------------------------------------------------------- + +instance FromJSON SiteConfig where + parseJSON = withObject "SiteConfig" $ \o -> SiteConfig + <$> o .: "site-name" + <*> o .: "site-url" + <*> o .: "site-description" + <*> o .:? "site-language" .!= "en" + <*> o .: "author-name" + <*> o .: "author-email" + <*> o .:? "feed-title" .!= "" + <*> o .:? "feed-description" .!= "" + <*> o .:? "license" .!= "" + <*> o .:? "source-url" .!= "" + <*> o .:? "gpg-fingerprint" .!= "" + <*> o .:? "gpg-pubkey-url" .!= "/gpg/pubkey.asc" + <*> o .:? "nav" .!= [] + <*> o .:? "portals" .!= [] + +instance FromJSON NavLink where + parseJSON = withObject "NavLink" $ \o -> NavLink + <$> o .: "href" + <*> o .: "label" + +instance FromJSON Portal where + parseJSON = withObject "Portal" $ \o -> Portal + <$> o .: "slug" + <*> o .: "name" + +-- --------------------------------------------------------------------------- +-- Global config value +-- --------------------------------------------------------------------------- + +-- | Loaded from @site.yaml@ at the project root on first access. +-- @NOINLINE@ prevents GHC from duplicating the I/O. If @site.yaml@ is +-- missing or invalid, evaluation throws a parse exception. +{-# NOINLINE siteConfig #-} +siteConfig :: SiteConfig +siteConfig = unsafePerformIO (decodeFileThrow "site.yaml") + +-- | The site's hostname, derived from 'siteUrl'. Used by 'Filters.Links' +-- to distinguish self-links from external links. +siteHost :: Text +siteHost = extractHost (siteUrl siteConfig) + where + extractHost url + | Just rest <- T.stripPrefix "https://" url = hostOf rest + | Just rest <- T.stripPrefix "http://" url = hostOf rest + | otherwise = T.toLower url + hostOf rest = + let withPort = T.takeWhile (\c -> c /= '/' && c /= '?' && c /= '#') rest + in T.toLower (T.takeWhile (/= ':') withPort) + +-- | Default author name as a 'String', for Hakyll metadata APIs that use +-- 'String' rather than 'Text'. +defaultAuthor :: String +defaultAuthor = T.unpack (authorName siteConfig) diff --git a/build/Contexts.hs b/build/Contexts.hs new file mode 100644 index 0000000..974c6cf --- /dev/null +++ b/build/Contexts.hs @@ -0,0 +1,572 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE OverloadedStrings #-} +module Contexts + ( siteCtx + , essayCtx + , postCtx + , pageCtx + , poetryCtx + , fictionCtx + , compositionCtx + , contentKindField + , abstractField + , tagLinksField + , authorLinksField + ) where + +import Data.Aeson (Value (..)) +import qualified Data.Aeson.KeyMap as KM +import qualified Data.Vector as V +import Data.List (intercalate, isPrefixOf) +import Data.Maybe (fromMaybe) +import Data.Time.Calendar (toGregorian) +import Data.Time.Clock (getCurrentTime, utctDay) +import Data.Time.Format (formatTime, defaultTimeLocale) +import System.FilePath (takeDirectory, takeFileName) +import Text.Read (readMaybe) +import qualified Data.Text as T +import qualified Config +import Text.Pandoc (runPure, readMarkdown, writeHtml5String, Pandoc(..), Block(..), Inline(..)) +import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..)) +import Hakyll hiding (trim) +import Backlinks (backlinksField) +import SimilarLinks (similarLinksField) +import Stability (stabilityField, lastReviewedField, versionHistoryField) +import Utils (authorSlugify, authorNameOf, trim) + +-- --------------------------------------------------------------------------- +-- Affiliation field +-- --------------------------------------------------------------------------- + +-- | Parses the @affiliation@ frontmatter key and exposes each entry as +-- @affiliation-name@ / @affiliation-url@ pairs. +-- +-- Accepts a scalar string or a YAML list. Each entry may use pipe syntax: +-- @"Brown University | https://cs.brown.edu"@ +-- Entries without a URL still produce a row; @affiliation-url@ fails +-- (evaluates to noResult), so @$if(affiliation-url)$@ works in templates. +-- +-- Usage: +-- $for(affiliation-links)$ +-- $if(affiliation-url)$$affiliation-name$ +-- $else$$affiliation-name$$endif$$sep$ · $endfor$ +affiliationField :: Context a +affiliationField = listFieldWith "affiliation-links" ctx $ \item -> do + meta <- getMetadata (itemIdentifier item) + let entries = case lookupStringList "affiliation" meta of + Just xs -> xs + Nothing -> maybe [] (:[]) (lookupString "affiliation" meta) + return $ map (Item (fromFilePath "") . parseEntry) entries + where + ctx = field "affiliation-name" (return . fst . itemBody) + <> field "affiliation-url" (\i -> let u = snd (itemBody i) + in if null u then noResult "no url" else return u) + parseEntry s = case break (== '|') s of + (name, '|' : url) -> (trim name, trim url) + (name, _) -> (trim name, "") + +-- --------------------------------------------------------------------------- +-- Build time field +-- --------------------------------------------------------------------------- + +-- | Resolves to the time the current item was compiled, formatted as +-- "Saturday, November 15th, 2025 15:05:55" (UTC). +buildTimeField :: Context String +buildTimeField = field "build-time" $ \_ -> + unsafeCompiler $ do + t <- getCurrentTime + let (_, _, d) = toGregorian (utctDay t) + prefix = formatTime defaultTimeLocale "%A, %B " t + suffix = formatTime defaultTimeLocale ", %Y %H:%M:%S" t + return (prefix ++ show d ++ ordSuffix d ++ suffix) + where + ordSuffix n + | n `elem` [11,12,13] = "th" + | n `mod` 10 == 1 = "st" + | n `mod` 10 == 2 = "nd" + | n `mod` 10 == 3 = "rd" + | otherwise = "th" + +-- --------------------------------------------------------------------------- +-- Content kind field +-- --------------------------------------------------------------------------- + +-- | @$item-kind$@: human-readable content type derived from the item's route. +-- Used on the New page to label each entry (Essay, Post, Poem, etc.). +contentKindField :: Context String +contentKindField = field "item-kind" $ \item -> do + r <- getRoute (itemIdentifier item) + return $ case r of + Nothing -> "Page" + Just r' + | "essays/" `isPrefixOf` r' -> "Essay" + | "blog/" `isPrefixOf` r' -> "Post" + | "poetry/" `isPrefixOf` r' -> "Poem" + | "fiction/" `isPrefixOf` r' -> "Fiction" + | "music/" `isPrefixOf` r' -> "Composition" + | otherwise -> "Page" + +-- --------------------------------------------------------------------------- +-- Site-wide context +-- --------------------------------------------------------------------------- + +-- | @$page-scripts$@ — list field providing @$script-src$@ for each entry +-- in the @js:@ frontmatter key (accepts a scalar string or a YAML list). +-- Returns an empty list when absent; $for iterates zero times, emitting nothing. +-- NOTE: do not use fail here — $for does not catch noResult the way $if does. +-- +-- Each child Item is keyed on @#js-@ so that two +-- pages referencing the same script path (e.g. @shared.js@) do not collide +-- in Hakyll's item store. +pageScriptsField :: Context String +pageScriptsField = listFieldWith "page-scripts" ctx $ \item -> do + meta <- getMetadata (itemIdentifier item) + let scripts = case lookupStringList "js" meta of + Just xs -> xs + Nothing -> maybe [] (:[]) (lookupString "js" meta) + parent = toFilePath (itemIdentifier item) + return $ zipWith + (\i s -> Item (fromFilePath (parent ++ "#js-" ++ show (i :: Int))) s) + [0 ..] + scripts + where + ctx = field "script-src" (return . itemBody) + +-- --------------------------------------------------------------------------- +-- Tag links field +-- --------------------------------------------------------------------------- + +-- | List context field exposing an item's own (non-expanded) tags as +-- @tag-name@ / @tag-url@ objects. +-- +-- $for(essay-tags)$$tag-name$$endfor$ +tagLinksField :: String -> Context a +tagLinksField fieldName = listFieldWith fieldName ctx $ \item -> + map toItem <$> getTags (itemIdentifier item) + where + toItem t = Item (fromFilePath (t ++ "/index.html")) t + ctx = field "tag-name" (return . itemBody) + <> field "tag-url" (\i -> return $ "/" ++ itemBody i ++ "/") + +-- --------------------------------------------------------------------------- +-- Author links field +-- --------------------------------------------------------------------------- +-- +-- 'authorSlugify' and 'authorNameOf' are imported from 'Utils' so that +-- they cannot drift from the copies in 'Authors'. + +-- | Exposes each item's authors as @author-name@ / @author-url@ pairs. +-- Defaults to the site's configured @author-name@ when no "authors" +-- frontmatter key is present. +-- +-- Entries that produce an empty name (e.g. @"| https://url"@) or an empty +-- slug (e.g. all-punctuation names) are dropped, so the field never emits +-- a @/authors//@ link. +-- +-- $for(author-links)$$author-name$$sep$, $endfor$ +authorLinksField :: Context a +authorLinksField = listFieldWith "author-links" ctx $ \item -> do + meta <- getMetadata (itemIdentifier item) + let entries = fromMaybe [] (lookupStringList "authors" meta) + rawNames = if null entries then [Config.defaultAuthor] else map authorNameOf entries + validNames = filter (\n -> not (null n) && not (null (authorSlugify n))) rawNames + names = if null validNames then [Config.defaultAuthor] else validNames + return $ map (\n -> Item (fromFilePath "") (n, "/authors/" ++ authorSlugify n ++ "/")) names + where + ctx = field "author-name" (return . fst . itemBody) + <> field "author-url" (return . snd . itemBody) + +-- --------------------------------------------------------------------------- +-- Abstract field +-- --------------------------------------------------------------------------- + +-- | Renders the abstract using Pandoc to support Markdown and LaTeX math. +-- Strips the outer @

    @ wrapping. A single-paragraph abstract becomes a +-- bare @Plain@ so the rendered HTML is unwrapped inlines. A multi-paragraph +-- abstract (author used a blank line in the YAML literal block) is flattened +-- to a single @Plain@ with @LineBreak@ separators between what were +-- originally paragraph boundaries — the visual break is preserved without +-- emitting stray @

    @ tags inside the metadata block. Mixed block content +-- (e.g. an abstract containing a blockquote) falls through unchanged. +abstractField :: Context String +abstractField = field "abstract" $ \item -> do + meta <- getMetadata (itemIdentifier item) + case lookupString "abstract" meta of + Nothing -> fail "no abstract" + Just src -> do + let pandocResult = runPure $ do + doc <- readMarkdown defaultHakyllReaderOptions (T.pack src) + let doc' = case doc of + Pandoc m [Para ils] -> Pandoc m [Plain ils] + Pandoc m blocks + | all isPara blocks && not (null blocks) -> + let joined = intercalate [LineBreak] + [ils | Para ils <- blocks] + in Pandoc m [Plain joined] + _ -> doc + let wOpts = defaultHakyllWriterOptions { writerHTMLMathMethod = MathML } + writeHtml5String wOpts doc' + case pandocResult of + Left err -> fail $ "Pandoc error rendering abstract: " ++ show err + Right html -> return (T.unpack html) + where + isPara (Para _) = True + isPara _ = False + +siteCtx :: Context String +siteCtx = + constField "site-title" (T.unpack (Config.siteName Config.siteConfig)) + <> constField "site-url" (T.unpack (Config.siteUrl Config.siteConfig)) + <> constField "site-description" (T.unpack (Config.siteDescription Config.siteConfig)) + <> constField "site-language" (T.unpack (Config.siteLanguage Config.siteConfig)) + <> constField "author-name" (T.unpack (Config.authorName Config.siteConfig)) + <> constField "author-email" (T.unpack (Config.authorEmail Config.siteConfig)) + <> constField "license" (T.unpack (Config.license Config.siteConfig)) + <> optionalConstField "source-url" (T.unpack (Config.sourceUrl Config.siteConfig)) + <> optionalConstField "gpg-fingerprint" (T.unpack (Config.gpgFingerprint Config.siteConfig)) + <> optionalConstField "gpg-pubkey-url" (T.unpack (Config.gpgPubkeyUrl Config.siteConfig)) + <> navLinksField + <> portalsField + <> buildTimeField + <> pageScriptsField + <> abstractField + <> defaultContext + where + optionalConstField name value + | null value = field name (\_ -> fail (name ++ " is empty")) + | otherwise = constField name value + + navLinksField = listField "nav-links" navCtx (return navItems) + navItems = zipWith + (\i nl -> Item (fromFilePath ("nav-" ++ show (i :: Int))) nl) + [0 :: Int ..] + (Config.navLinks Config.siteConfig) + navCtx = field "href" (return . T.unpack . Config.navHref . itemBody) + <> field "label" (return . T.unpack . Config.navLabel . itemBody) + + portalsField = listField "portals" portalCtx (return portalItems) + portalItems = zipWith + (\i p -> Item (fromFilePath ("portal-" ++ show (i :: Int))) p) + [0 :: Int ..] + (Config.portals Config.siteConfig) + portalCtx = field "portal-slug" (return . T.unpack . Config.portalSlug . itemBody) + <> field "portal-name" (return . T.unpack . Config.portalName . itemBody) + +-- --------------------------------------------------------------------------- +-- Helper: load a named snapshot as a context field +-- --------------------------------------------------------------------------- + +-- | @snapshotField name snap@ creates a context field @name@ whose value is +-- the body of the snapshot @snap@ saved for the current item. +snapshotField :: String -> Snapshot -> Context String +snapshotField name snap = field name $ \item -> + itemBody <$> loadSnapshot (itemIdentifier item) snap + +-- --------------------------------------------------------------------------- +-- Essay context +-- --------------------------------------------------------------------------- + +-- | Bibliography field: loads the citation HTML saved by essayCompiler. +-- Returns noResult (making $if(bibliography)$ false) when empty. +-- Also provides $has-citations$ for conditional JS loading. +bibliographyField :: Context String +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 + 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" + +-- | Further-reading field: loads the further-reading HTML saved by essayCompiler. +-- Returns noResult (making $if(further-reading-refs)$ false) when empty. +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 + +-- --------------------------------------------------------------------------- +-- Epistemic fields +-- --------------------------------------------------------------------------- + +-- | Render an integer 1–5 frontmatter key as filled/empty dot chars. +-- Returns @noResult@ when the key is absent or unparseable. +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') + +-- | @$confidence-trend$@: ↑, ↓, or → derived from the last two entries +-- in the @confidence-history@ frontmatter list. Returns @noResult@ when +-- there is no history or only a single entry. +-- +-- The arrow flips when the absolute change crosses 'trendThreshold' +-- (currently 5 percentage points). Smaller swings count as flat. +confidenceTrendField :: Context String +confidenceTrendField = field "confidence-trend" $ \item -> do + meta <- getMetadata (itemIdentifier item) + case lookupStringList "confidence-history" meta of + Nothing -> fail "no confidence history" + Just xs -> case lastTwo xs of + Nothing -> fail "no confidence history" + Just (prevS, curS) -> + let prev = readMaybe prevS :: Maybe Int + cur = readMaybe curS :: Maybe Int + in case (prev, cur) of + (Just p, Just c) + | c - p > trendThreshold -> return "\x2191" -- ↑ + | p - c > trendThreshold -> return "\x2193" -- ↓ + | otherwise -> return "\x2192" -- → + _ -> return "\x2192" + where + trendThreshold :: Int + trendThreshold = 5 + + -- Total replacement for @(xs !! (length xs - 2), last xs)@: returns + -- the last two elements of a list, in order, or 'Nothing' when the + -- list has fewer than two entries. + lastTwo :: [a] -> Maybe (a, a) + lastTwo [] = Nothing + lastTwo [_] = Nothing + lastTwo [a, b] = Just (a, b) + lastTwo (_ : rest) = lastTwo rest + +-- | @$overall-score$@: weighted composite of confidence (60 %) and +-- evidence quality (40 %), expressed as an integer on a 0–100 scale. +-- +-- Importance is intentionally excluded from the score: it answers +-- "should you read this?", not "should you trust it?", and folding +-- the two together inflated the number and muddied its meaning. +-- It still appears in the footer as an independent orientation +-- signal — just not as a credibility input. +-- +-- The 1–5 evidence scale is rescaled as @(ev − 1) / 4@ rather than +-- plain @ev / 5@. The naive form left a hidden +6 floor (since +-- @1/5 = 0.2@) and a midpoint of 0.6 instead of 0.5; the rescale +-- makes evidence=1 contribute zero and evidence=3 contribute exactly +-- half, so a "true midpoint" entry (conf=50, ev=3) lands on 50. +-- +-- Returns @noResult@ when confidence or evidence is absent, so +-- @$if(overall-score)$@ guards the template safely. +-- +-- Formula: raw = conf/100 · 0.6 + (ev − 1)/4 · 0.4 (0–1) +-- score = clamp₀₋₁₀₀(round(raw · 100)) +overallScoreField :: Context String +overallScoreField = field "overall-score" $ \item -> do + meta <- getMetadata (itemIdentifier item) + let readInt s = readMaybe s :: Maybe Int + case ( readInt =<< lookupString "confidence" meta + , readInt =<< lookupString "evidence" meta + ) of + (Just conf, Just ev) -> + let raw :: Double + raw = fromIntegral conf / 100.0 * 0.6 + + 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" + +-- | All epistemic context fields composed. +epistemicCtx :: Context String +epistemicCtx = + dotsField "importance-dots" "importance" + <> dotsField "evidence-dots" "evidence" + <> overallScoreField + <> confidenceTrendField + <> stabilityField + <> lastReviewedField + +-- --------------------------------------------------------------------------- +-- Essay context +-- --------------------------------------------------------------------------- + +essayCtx :: Context String +essayCtx = + authorLinksField + <> affiliationField + <> snapshotField "toc" "toc" + <> snapshotField "word-count" "word-count" + <> snapshotField "reading-time" "reading-time" + <> bibliographyField + <> furtherReadingField + <> backlinksField + <> similarLinksField + <> epistemicCtx + <> versionHistoryField + <> dateField "date-created" "%-d %B %Y" + <> dateField "date-modified" "%-d %B %Y" + <> constField "math" "true" + <> tagLinksField "essay-tags" + <> siteCtx + +-- --------------------------------------------------------------------------- +-- Post context +-- --------------------------------------------------------------------------- + +postCtx :: Context String +postCtx = + authorLinksField + <> affiliationField + <> backlinksField + <> similarLinksField + <> dateField "date" "%-d %B %Y" + <> dateField "date-iso" "%Y-%m-%d" + <> constField "math" "true" + <> siteCtx + +-- --------------------------------------------------------------------------- +-- Page context +-- --------------------------------------------------------------------------- + +pageCtx :: Context String +pageCtx = authorLinksField <> affiliationField <> siteCtx + +-- --------------------------------------------------------------------------- +-- Reading contexts (fiction + poetry) +-- --------------------------------------------------------------------------- + +-- | Base reading context: essay fields + the "reading" flag (activates +-- reading.css / reading.js via head.html and body class via default.html). +readingCtx :: Context String +readingCtx = essayCtx <> constField "reading" "true" + +-- | Poetry context: reading mode + "poetry" flag for CSS body class. +poetryCtx :: Context String +poetryCtx = readingCtx <> constField "poetry" "true" + +-- | Fiction context: reading mode + "fiction" flag for CSS body class. +fictionCtx :: Context String +fictionCtx = readingCtx <> constField "fiction" "true" + +-- --------------------------------------------------------------------------- +-- Composition context (music landing pages + score reader) +-- --------------------------------------------------------------------------- + +data Movement = Movement + { movName :: String + , movPage :: Int + , movDuration :: String + , movAudio :: Maybe String + } + +-- | Parse the @movements@ frontmatter key. Returns parsed movements and a +-- list of human-readable warnings for any entries that failed to parse. +-- Callers can surface the warnings via 'unsafeCompiler' so silent typos +-- don't strip movements without diagnostic. +parseMovementsWithWarnings :: Metadata -> ([Movement], [String]) +parseMovementsWithWarnings meta = + case KM.lookup "movements" meta of + Just (Array v) -> + let results = zipWith parseIndexed [1 :: Int ..] (V.toList v) + in ( [m | Right m <- results] + , [w | Left w <- results] + ) + _ -> ([], []) + where + parseIndexed i value = + case parseOne value of + Just m -> Right m + Nothing -> Left $ + "movement #" ++ show i ++ " is missing a required field " + ++ "(name, page, or duration) — entry skipped" + + parseOne (Object o) = Movement + <$> (getString =<< KM.lookup "name" o) + <*> (getInt =<< KM.lookup "page" o) + <*> (getString =<< KM.lookup "duration" o) + <*> pure (getString =<< KM.lookup "audio" o) + parseOne _ = Nothing + + getString (String t) = Just (T.unpack t) + getString _ = Nothing + + getInt (Number n) = Just (floor (fromRational (toRational n) :: Double)) + getInt _ = Nothing + +parseMovements :: Metadata -> [Movement] +parseMovements = fst . parseMovementsWithWarnings + +-- | Extract the composition slug from an item's identifier. +-- "content/music/symphonic-dances/index.md" → "symphonic-dances" +compSlug :: Item a -> String +compSlug = takeFileName . takeDirectory . toFilePath . itemIdentifier + +-- | Context for music composition landing pages and the score reader. +-- Extends essayCtx with composition-specific fields: +-- $slug$ — URL slug (e.g. "symphonic-dances") +-- $score-url$ — absolute URL of the score reader page +-- $has-score$ — present when score-pages frontmatter is non-empty +-- $score-page-count$ — total number of score pages +-- $score-pages$ — list of {score-page-url} items +-- $has-movements$ — present when movements frontmatter is non-empty +-- $movements$ — list of {movement-name, movement-page, +-- movement-duration, movement-audio, has-audio} +-- All other frontmatter keys (instrumentation, duration, premiere, +-- commissioned-by, pdf, abstract, etc.) are available via defaultContext. +compositionCtx :: Context String +compositionCtx = + constField "composition" "true" + <> slugField + <> scoreUrlField + <> hasScoreField + <> scorePageCountField + <> scorePagesListField + <> hasMovementsField + <> movementsListField + <> essayCtx + where + slugField = field "slug" (return . compSlug) + + scoreUrlField = field "score-url" $ \item -> + return $ "/music/" ++ compSlug item ++ "/score/" + + 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" + + scorePageCountField = field "score-page-count" $ \item -> do + meta <- getMetadata (itemIdentifier item) + let pages = fromMaybe [] (lookupStringList "score-pages" meta) + return $ show (length pages) + + scorePagesListField = listFieldWith "score-pages" spCtx $ \item -> do + meta <- getMetadata (itemIdentifier item) + let slug = compSlug item + base = "/music/" ++ slug ++ "/" + pages = fromMaybe [] (lookupStringList "score-pages" meta) + return $ map (\p -> Item (fromFilePath p) (base ++ p)) pages + where + spCtx = field "score-page-url" (return . itemBody) + + hasMovementsField = field "has-movements" $ \item -> do + meta <- getMetadata (itemIdentifier item) + if null (parseMovements meta) then fail "no movements" else return "true" + + movementsListField = listFieldWith "movements" movCtx $ \item -> do + meta <- getMetadata (itemIdentifier item) + let (mvs, warnings) = parseMovementsWithWarnings meta + ident = toFilePath (itemIdentifier item) + unsafeCompiler $ mapM_ + (\w -> putStrLn $ "[Movements] " ++ ident ++ ": " ++ w) + warnings + return $ zipWith + (\idx mv -> Item (fromFilePath ("mv" ++ show (idx :: Int))) mv) + [1..] mvs + where + movCtx = + field "movement-name" (return . movName . itemBody) + <> 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))) + <> field "has-audio" + (\i -> maybe (fail "no audio") (const (return "true")) + (movAudio (itemBody i))) diff --git a/build/Filters.hs b/build/Filters.hs new file mode 100644 index 0000000..9f00073 --- /dev/null +++ b/build/Filters.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE GHC2021 #-} +-- | Re-exports all Pandoc AST filter modules and provides a single +-- @applyAll@ combinator that chains them in the correct order. +module Filters + ( applyAll + , preprocessSource + ) where + +import Text.Pandoc.Definition (Pandoc) + +import qualified Filters.Sidenotes as Sidenotes +import qualified Filters.Typography as Typography +import qualified Filters.Links as Links +import qualified Filters.Smallcaps as Smallcaps +import qualified Filters.Dropcaps as Dropcaps +import qualified Filters.Math as Math +import qualified Filters.Wikilinks as Wikilinks +import qualified Filters.Transclusion as Transclusion +import qualified Filters.EmbedPdf as EmbedPdf +import qualified Filters.Code as Code +import qualified Filters.Images as Images + +-- | Apply all AST-level filters in pipeline order. +-- Run on the Pandoc document after reading, before writing. +-- +-- 'Filters.Images.apply' is the only IO-performing filter (it probes the +-- filesystem for @.webp@ companions before deciding whether to emit +-- @@). It runs first — i.e. innermost in the composition — and +-- every downstream filter stays pure. @srcDir@ is the directory of the +-- source Markdown file, passed through to Images for relative-path +-- resolution of co-located assets. +applyAll :: FilePath -> Pandoc -> IO Pandoc +applyAll srcDir doc = do + imagesDone <- Images.apply srcDir doc + pure + . Sidenotes.apply + . Typography.apply + . Links.apply + . Smallcaps.apply + . Dropcaps.apply + . Math.apply + . Code.apply + $ imagesDone + +-- | Apply source-level preprocessors to the raw Markdown string. +-- Order matters: EmbedPdf must run before Transclusion, because the +-- transclusion parser would otherwise treat {{pdf:...}} as a broken slug. +preprocessSource :: String -> String +preprocessSource = Transclusion.preprocess . EmbedPdf.preprocess . Wikilinks.preprocess diff --git a/build/Filters/Code.hs b/build/Filters/Code.hs new file mode 100644 index 0000000..39f1dce --- /dev/null +++ b/build/Filters/Code.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Prepend "language-" to fenced-code-block class names so that +-- Prism.js can find and highlight them. +-- +-- Pandoc (with writerHighlightStyle = Nothing) outputs +-- 

    
+--   Prism.js requires
+--     
    
+--
+--   We transform the AST before writing rather than post-processing HTML,
+--   so the class appears on both 
     and  via Pandoc's normal output.
+module Filters.Code (apply) where
+
+import qualified Data.Text            as T
+import           Text.Pandoc.Definition
+import           Text.Pandoc.Walk     (walk)
+
+apply :: Pandoc -> Pandoc
+apply = walk addLangPrefix
+
+addLangPrefix :: Block -> Block
+addLangPrefix (CodeBlock (ident, classes, kvs) code) =
+    CodeBlock (ident, map prefix classes, kvs) code
+  where
+    prefix c
+        | "language-" `T.isPrefixOf` c = c
+        | otherwise                     = "language-" <> c
+addLangPrefix x = x
diff --git a/build/Filters/Dropcaps.hs b/build/Filters/Dropcaps.hs
new file mode 100644
index 0000000..e2e6461
--- /dev/null
+++ b/build/Filters/Dropcaps.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE GHC2021 #-}
+-- | Dropcap support.
+--
+--   The dropcap on the opening paragraph is implemented entirely in CSS
+--   via @#markdownBody > p:first-of-type::first-letter@, so no AST
+--   transformation is required.  This module is a placeholder for future
+--   work (e.g. adding a @.lead-paragraph@ class when the first block is
+--   not a Para, or decorative initial-capital images).
+module Filters.Dropcaps (apply) where
+
+import Text.Pandoc.Definition (Pandoc)
+
+-- | Identity — dropcaps are handled by CSS.
+apply :: Pandoc -> Pandoc
+apply = id
diff --git a/build/Filters/EmbedPdf.hs b/build/Filters/EmbedPdf.hs
new file mode 100644
index 0000000..f2a11f9
--- /dev/null
+++ b/build/Filters/EmbedPdf.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE GHC2021 #-}
+-- | Source-level preprocessor for inline PDF embeds.
+--
+--   Rewrites block-level @{{pdf:...}}@ directives to raw HTML that renders the
+--   named file inside a vendored PDF.js viewer iframe.
+--
+--   Syntax (must be the sole content of a line after trimming):
+--
+-- > {{pdf:/papers/foo.pdf}}          — embed from page 1
+-- > {{pdf:/papers/foo.pdf#5}}        — start at page 5  (bare integer)
+-- > {{pdf:/papers/foo.pdf#page=5}}   — start at page 5  (explicit form)
+--
+--   The file path must be root-relative (begins with @/@).
+--   PDF.js is expected to be vendored at @/pdfjs/web/viewer.html@.
+module Filters.EmbedPdf (preprocess) where
+
+import Data.Char (isDigit)
+import Data.List (isPrefixOf, isSuffixOf)
+import qualified Utils as U
+
+-- | Apply PDF-embed substitution to the raw Markdown source string.
+preprocess :: String -> String
+preprocess = unlines . map processLine . lines
+
+processLine :: String -> String
+processLine line =
+    case parseDirective (U.trim line) of
+        Nothing                    -> line
+        Just (filePath, pageHash)  -> renderEmbed filePath pageHash
+
+-- | Parse a @{{pdf:/path/to/file.pdf}}@ or @{{pdf:/path.pdf#N}}@ directive.
+--   Returns @(filePath, pageHash)@ where @pageHash@ is either @""@ or @"#page=N"@.
+parseDirective :: String -> Maybe (String, String)
+parseDirective s
+    | not ("{{pdf:" `isPrefixOf` s) = Nothing
+    | not ("}}"     `isSuffixOf` s) = Nothing
+    | otherwise =
+        let inner        = take (length s - 2) (drop 6 s)  -- strip "{{pdf:" and "}}"
+            (path, frag) = break (== '#') inner
+        in  if null path
+                then Nothing
+                else Just (path, parsePageHash frag)
+
+-- | Convert the fragment part of the directive (e.g. @#5@ or @#page=5@) to a
+--   PDF.js-compatible @#page=N@ hash, or @""@ if absent/invalid.
+parsePageHash :: String -> String
+parsePageHash ('#' : rest)
+    | "page=" `isPrefixOf` rest =
+        let n = takeWhile isDigit (drop 5 rest)
+        in  if null n then "" else "#page=" ++ n
+    | all isDigit rest && not (null rest) = "#page=" ++ rest
+parsePageHash _ = ""
+
+-- | Render the HTML for a PDF embed.
+renderEmbed :: String -> String -> String
+renderEmbed filePath pageHash =
+    let viewerUrl = "/pdfjs/web/viewer.html?file=" ++ encodeQueryValue filePath ++ pageHash
+    in  "
    "
+     ++ ""
+     ++ "
    "
+
+-- | Percent-encode characters that would break a query-string value.
+--   Slashes are left unencoded so root-relative paths remain readable and
+--   work correctly with PDF.js's internal fetch.  @#@ is encoded for
+--   defense-in-depth even though the directive parser already splits on it
+--   before this function is called.
+encodeQueryValue :: String -> String
+encodeQueryValue = concatMap enc
+  where
+    enc ' ' = "%20"
+    enc '&' = "%26"
+    enc '?' = "%3F"
+    enc '+' = "%2B"
+    enc '"' = "%22"
+    enc '#' = "%23"
+    enc c   = [c]
+
diff --git a/build/Filters/Images.hs b/build/Filters/Images.hs
new file mode 100644
index 0000000..f81ccc2
--- /dev/null
+++ b/build/Filters/Images.hs
@@ -0,0 +1,191 @@
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE OverloadedStrings #-}
+-- | Image filter: lazy loading, lightbox markers, and WebP  wrappers.
+--
+--   For local raster images (JPG, JPEG, PNG, GIF) whose @.webp@ companion
+--   exists on disk at build time, emits a @@ element with a WebP
+--   @@ and the original format as the @@ fallback. When the
+--   webp companion is absent (cwebp not installed, @convert-images.sh@ not
+--   yet run, or a single file missed), the filter emits a plain @@ so
+--   the image still renders. This matters because browsers do NOT fall back
+--   from a 404'd @@ inside @@ to the nested @@ — the
+--   source is selected up front and a broken one leaves the area blank.
+--
+--   @tools/convert-images.sh@ produces the companion .webp files at build
+--   time. When cwebp is not installed the script is a no-op, and this
+--   filter degrades gracefully to plain @@.
+--
+--   SVG files and external URLs are passed through with only lazy loading
+--   (and lightbox markers for standalone images).
+module Filters.Images (apply) where
+
+import           Data.Char            (toLower)
+import           Data.List            (isPrefixOf)
+import           Data.Text            (Text)
+import qualified Data.Text            as T
+import           System.Directory     (doesFileExist)
+import           System.FilePath      (replaceExtension, takeExtension, ())
+import           Text.Pandoc.Definition
+import           Text.Pandoc.Walk     (walkM)
+import qualified Utils                as U
+
+-- | Apply image attribute injection and WebP wrapping to the entire document.
+--
+--   @srcDir@ is the directory of the source Markdown file, used to resolve
+--   relative image paths when probing for the corresponding @.webp@
+--   companion file. Absolute paths (leading @/@) are resolved against
+--   @static/@ instead, matching the layout @convert-images.sh@ writes to.
+apply :: FilePath -> Pandoc -> IO Pandoc
+apply srcDir = walkM (transformInline srcDir)
+
+-- ---------------------------------------------------------------------------
+-- Core transformation
+-- ---------------------------------------------------------------------------
+
+transformInline :: FilePath -> Inline -> IO Inline
+transformInline srcDir (Link lAttr ils lTarget) = do
+    -- Recurse into link contents; images inside a link get no lightbox marker.
+    ils' <- mapM (wrapLinkedImg srcDir) ils
+    pure (Link lAttr ils' lTarget)
+transformInline srcDir (Image attr alt target) =
+    renderImg srcDir attr alt target True
+transformInline _ x = pure x
+
+wrapLinkedImg :: FilePath -> Inline -> IO Inline
+wrapLinkedImg srcDir (Image iAttr alt iTarget) =
+    renderImg srcDir iAttr alt iTarget False
+wrapLinkedImg _ x = pure x
+
+-- | Dispatch on image type:
+--   * Local raster with webp companion on disk → @@ with WebP @@
+--   * Local raster without companion → plain @@ (graceful degradation)
+--   * Everything else (SVG, URL) → plain @@ with loading/lightbox attrs
+renderImg :: FilePath -> Attr -> [Inline] -> Target -> Bool -> IO Inline
+renderImg srcDir attr alt target@(src, _) lightbox
+    | isLocalRaster (T.unpack src) = do
+        hasWebp <- doesFileExist (webpPhysicalPath srcDir src)
+        if hasWebp
+            then pure $ RawInline (Format "html")
+                                  (renderPicture attr alt target lightbox)
+            else pure $ Image (addLightbox lightbox (addAttr "loading" "lazy" attr))
+                              alt target
+    | otherwise =
+        pure $ Image (addLightbox lightbox (addAttr "loading" "lazy" attr)) alt target
+  where
+    addLightbox True  a = addAttr "data-lightbox" "true" a
+    addLightbox False a = a
+
+-- | Physical on-disk path of the @.webp@ companion for a Markdown image src.
+--
+--   Absolute paths (@/images/foo.jpg@) resolve under @static/@ because that
+--   is where Hakyll's static-asset rule writes them from. Relative paths
+--   resolve against the source file's directory, where Pandoc already
+--   expects co-located assets to live.
+webpPhysicalPath :: FilePath -> Text -> FilePath
+webpPhysicalPath srcDir src =
+    let s = T.unpack src
+        physical = if "/" `isPrefixOf` s
+                   then "static" ++ s
+                   else srcDir  s
+    in replaceExtension physical ".webp"
+
+-- ---------------------------------------------------------------------------
+--  rendering
+-- ---------------------------------------------------------------------------
+
+-- | Emit a @@ element with a WebP @@ and an @@ fallback.
+renderPicture :: Attr -> [Inline] -> Target -> Bool -> Text
+renderPicture (ident, classes, kvs) alt (src, title) lightbox =
+    T.concat
+        [ ""
+        , ""
+        , ""
+        , ""
+        ]
+  where
+    webpSrc   = replaceExtension (T.unpack src) ".webp"
+    -- Strip attrs we handle explicitly above (id/class/alt/title) and the
+    -- attrs we always emit ourselves (loading, data-lightbox), so they don't
+    -- appear twice on the .
+    passedKvs = filter
+        (\(k, _) -> k `notElem`
+            ["loading", "data-lightbox", "id", "class", "alt", "title", "src"])
+        kvs
+
+attrId :: Text -> Text
+attrId t = if T.null t then "" else " id=\"" <> esc t <> "\""
+
+attrClasses :: [Text] -> Text
+attrClasses [] = ""
+attrClasses cs = " class=\"" <> T.intercalate " " (map esc cs) <> "\""
+
+attrAlt :: [Inline] -> Text
+attrAlt ils = let t = stringify ils
+              in  if T.null t then "" else " alt=\"" <> esc t <> "\""
+
+attrTitle :: Text -> Text
+attrTitle t = if T.null t then "" else " title=\"" <> esc t <> "\""
+
+renderKvs :: [(Text, Text)] -> Text
+renderKvs = T.concat . map (\(k, v) -> " " <> k <> "=\"" <> esc v <> "\"")
+
+-- ---------------------------------------------------------------------------
+-- Helpers
+-- ---------------------------------------------------------------------------
+
+-- | True for local (non-URL) images with a raster format we can convert.
+isLocalRaster :: FilePath -> Bool
+isLocalRaster src = not (isUrl src) && lowerExt src `elem` [".jpg", ".jpeg", ".png", ".gif"]
+
+isUrl :: String -> Bool
+isUrl s = any (`isPrefixOf` s) ["http://", "https://", "//", "data:"]
+
+-- | Extension of a path, lowercased (e.g. ".JPG" → ".jpg").
+--   Returns the empty string for paths with no extension.
+lowerExt :: FilePath -> String
+lowerExt = map toLower . takeExtension
+
+-- | Prepend a key=value pair if not already present.
+addAttr :: Text -> Text -> Attr -> Attr
+addAttr k v (i, cs, kvs)
+    | any ((== k) . fst) kvs = (i, cs, kvs)
+    | otherwise               = (i, cs, (k, v) : kvs)
+
+-- | Plain-text content of a list of inlines (for alt text).
+stringify :: [Inline] -> Text
+stringify = T.concat . map go
+  where
+    go (Str t)            = t
+    go Space              = " "
+    go SoftBreak          = " "
+    go LineBreak          = " "
+    go (Emph ils)         = stringify ils
+    go (Strong ils)       = stringify ils
+    go (Strikeout ils)    = stringify ils
+    go (Superscript ils)  = stringify ils
+    go (Subscript ils)    = stringify ils
+    go (SmallCaps ils)    = stringify ils
+    go (Underline ils)    = stringify ils
+    go (Quoted _ ils)     = stringify ils
+    go (Cite _ ils)       = stringify ils
+    go (Code _ t)         = t
+    go (Math _ t)         = t
+    go (RawInline _ _)    = ""
+    go (Link _ ils _)     = stringify ils
+    go (Image _ ils _)    = stringify ils
+    go (Span _ ils)       = stringify ils
+    go (Note _)           = ""
+
+-- | HTML-escape a text value for use in attribute values.
+--   Defers to the canonical 'Utils.escapeHtmlText'.
+esc :: Text -> Text
+esc = U.escapeHtmlText
diff --git a/build/Filters/Links.hs b/build/Filters/Links.hs
new file mode 100644
index 0000000..fa1ba66
--- /dev/null
+++ b/build/Filters/Links.hs
@@ -0,0 +1,133 @@
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE OverloadedStrings #-}
+-- | External link classification.
+--
+--   Walks all @Link@ inlines and:
+--   * Adds @class="link-external"@ to any link whose URL starts with
+--     @http://@ or @https://@ and is not on the site's own domain.
+--   * Adds @data-link-icon@ / @data-link-icon-type@ attributes for
+--     per-domain brand icons (see 'domainIcon' for the full list).
+--   * Adds @target="_blank" rel="noopener noreferrer"@ to external links.
+module Filters.Links (apply) where
+
+import           Data.Text            (Text)
+import qualified Data.Text            as T
+import           Text.Pandoc.Definition
+import           Text.Pandoc.Walk     (walk)
+
+import           Config               (siteHost)
+
+-- | Apply link classification to the entire document.
+--   Two passes: PDF links first (rewrites href to viewer URL), then external
+--   link classification (operates on http/https, so no overlap).
+apply :: Pandoc -> Pandoc
+apply = walk classifyLink . walk classifyPdfLink
+
+-- | Rewrite root-relative PDF links to open via the vendored PDF.js viewer.
+--   Preserves the original path in @data-pdf-src@ so the popup thumbnail
+--   provider can locate the corresponding @.thumb.png@ file.
+--   Skips links that are already pointing at the viewer (idempotent).
+--
+--   Handles fragment identifiers (e.g. @/papers/foo.pdf#page=5@): the
+--   fragment is stripped before the @.pdf@ suffix check and re-attached
+--   after the viewer URL so PDF.js's anchor handling works.
+classifyPdfLink :: Inline -> Inline
+classifyPdfLink (Link (ident, classes, kvs) ils (url, title))
+    | "/" `T.isPrefixOf` url
+    , let (path, fragment) = T.break (== '#') url
+    , ".pdf" `T.isSuffixOf` T.toLower path
+    , "pdf-link" `notElem` classes =
+        let viewerUrl = "/pdfjs/web/viewer.html?file="
+                        <> encodeQueryValue path <> fragment
+            classes'  = classes ++ ["pdf-link"]
+            kvs'      = kvs ++ [("data-pdf-src", path)]
+        in  Link (ident, classes', kvs') ils (viewerUrl, title)
+classifyPdfLink x = x
+
+classifyLink :: Inline -> Inline
+classifyLink (Link (ident, classes, kvs) ils (url, title))
+    | isExternal url =
+        let icon     = domainIcon url
+            classes' = classes ++ ["link-external"]
+            kvs'     = kvs
+                       ++ [("target",             "_blank")]
+                       ++ [("rel",                "noopener noreferrer")]
+                       ++ [("data-link-icon",      icon)]
+                       ++ [("data-link-icon-type", "svg")]
+        in  Link (ident, classes', kvs') ils (url, title)
+classifyLink x = x
+
+-- ---------------------------------------------------------------------------
+-- Helpers
+-- ---------------------------------------------------------------------------
+
+-- | True if the URL points outside the site's domain.
+--
+--   Uses a strict hostname comparison rather than substring matching, so
+--   that a hostile lookalike like @evil-example.com.attacker.com@ is
+--   correctly classified as external (and gets @rel=noopener noreferrer@
+--   plus @target=_blank@ applied).
+isExternal :: Text -> Bool
+isExternal url =
+    case extractHost url of
+        Nothing   -> False
+        Just host ->
+            not (host == siteHost || ("." <> siteHost) `T.isSuffixOf` host)
+
+-- | Extract the lowercased hostname from an absolute http(s) URL.
+--   Returns 'Nothing' for non-http(s) URLs (relative paths, mailto:, etc.).
+extractHost :: Text -> Maybe Text
+extractHost url
+    | Just rest <- T.stripPrefix "https://" url = Just (hostOf rest)
+    | Just rest <- T.stripPrefix "http://"  url = Just (hostOf rest)
+    | otherwise                                  = Nothing
+  where
+    hostOf rest =
+        let withPort = T.takeWhile (\c -> c /= '/' && c /= '?' && c /= '#') rest
+            host     = T.takeWhile (/= ':') withPort
+        in  T.toLower host
+
+-- | Icon name for the link, matching a file in /images/link-icons/.svg.
+domainIcon :: Text -> Text
+domainIcon url
+    -- Scholarly / reference
+    | "wikipedia.org"       `T.isInfixOf` url = "wikipedia"
+    | "arxiv.org"           `T.isInfixOf` url = "arxiv"
+    | "doi.org"             `T.isInfixOf` url = "doi"
+    | "worldcat.org"        `T.isInfixOf` url = "worldcat"
+    | "orcid.org"           `T.isInfixOf` url = "orcid"
+    | "archive.org"         `T.isInfixOf` url = "internet-archive"
+    -- Code / software
+    | "github.com"          `T.isInfixOf` url = "github"
+    | "tensorflow.org"      `T.isInfixOf` url = "tensorflow"
+    -- AI companies
+    | "anthropic.com"       `T.isInfixOf` url = "anthropic"
+    | "openai.com"          `T.isInfixOf` url = "openai"
+    -- Social / media
+    | "twitter.com"         `T.isInfixOf` url = "twitter"
+    | "x.com"               `T.isInfixOf` url = "twitter"
+    | "reddit.com"          `T.isInfixOf` url = "reddit"
+    | "youtube.com"         `T.isInfixOf` url = "youtube"
+    | "youtu.be"            `T.isInfixOf` url = "youtube"
+    | "tiktok.com"          `T.isInfixOf` url = "tiktok"
+    | "substack.com"        `T.isInfixOf` url = "substack"
+    | "news.ycombinator.com" `T.isInfixOf` url = "hacker-news"
+    -- News
+    | "nytimes.com"         `T.isInfixOf` url = "new-york-times"
+    -- Institutions
+    | "nasa.gov"            `T.isInfixOf` url = "nasa"
+    | "apple.com"           `T.isInfixOf` url = "apple"
+    | otherwise                                = "external"
+
+-- | Percent-encode characters that would break a @?file=@ query-string value.
+--   Slashes are intentionally left unencoded so root-relative paths remain
+--   readable and work correctly with PDF.js's internal fetch.
+encodeQueryValue :: Text -> Text
+encodeQueryValue = T.concatMap enc
+  where
+    enc ' ' = "%20"
+    enc '&' = "%26"
+    enc '?' = "%3F"
+    enc '+' = "%2B"
+    enc '"' = "%22"
+    enc c   = T.singleton c
diff --git a/build/Filters/Math.hs b/build/Filters/Math.hs
new file mode 100644
index 0000000..b44a4e7
--- /dev/null
+++ b/build/Filters/Math.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE GHC2021 #-}
+-- | Math filter placeholder.
+--
+--   The spec calls for converting simple LaTeX to Unicode at build time.
+--   For now, all math (inline and display) is handled client-side by KaTeX,
+--   which is loaded conditionally on pages that contain math.  Server-side
+--   KaTeX rendering is a Phase 3 task.
+module Filters.Math (apply) where
+
+import Text.Pandoc.Definition (Pandoc)
+
+-- | Identity — math rendering is handled by KaTeX.
+apply :: Pandoc -> Pandoc
+apply = id
diff --git a/build/Filters/Score.hs b/build/Filters/Score.hs
new file mode 100644
index 0000000..85ba031
--- /dev/null
+++ b/build/Filters/Score.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE OverloadedStrings #-}
+-- | Inline SVG score fragments into the Pandoc AST.
+--
+-- Fenced-div syntax in Markdown:
+--
+-- > :::score-fragment{score-name="Main Theme, mm. 1–8" score-caption="The opening gesture."}
+-- > ![](scores/main-theme.svg)
+-- > :::
+--
+-- The filter reads the referenced SVG from disk (path resolved relative to
+-- the source file's directory), replaces hardcoded black fills/strokes with
+-- @currentColor@ for dark-mode compatibility, and emits a @\@ with
+-- the appropriate exhibit attributes for gallery.js TOC integration.
+module Filters.Score (inlineScores) where
+
+import           Control.Exception      (IOException, try)
+import           Data.Maybe             (listToMaybe)
+import qualified Data.Text              as T
+import qualified Data.Text.IO           as TIO
+import           System.Directory       (doesFileExist)
+import           System.FilePath        (())
+import           System.IO              (hPutStrLn, stderr)
+import           Text.Pandoc.Definition
+import           Text.Pandoc.Walk       (walkM)
+import qualified Utils                  as U
+
+-- | Walk the Pandoc AST and inline all score-fragment divs.
+--   @baseDir@ is the directory of the source file; image paths in the
+--   fenced-div are resolved relative to it.
+inlineScores :: FilePath -> Pandoc -> IO Pandoc
+inlineScores baseDir = walkM (inlineScore baseDir)
+
+inlineScore :: FilePath -> Block -> IO Block
+inlineScore baseDir (Div (_, cls, attrs) blocks)
+    | "score-fragment" `elem` cls = do
+        let mName    = lookup "score-name"    attrs
+            mCaption = lookup "score-caption" attrs
+            mPath    = findImagePath blocks
+        case mPath of
+            Nothing   -> return $ Div ("", cls, attrs) blocks
+            Just path -> do
+                let fullPath = baseDir  T.unpack path
+                exists <- doesFileExist fullPath
+                if not exists
+                    then do
+                        hPutStrLn stderr $
+                            "[Score] missing SVG: " ++ fullPath
+                            ++ " (referenced from a score-fragment in " ++ baseDir ++ ")"
+                        return (errorBlock mName ("Missing score: " <> path))
+                    else do
+                        result <- try (TIO.readFile fullPath) :: IO (Either IOException T.Text)
+                        case result of
+                            Left e -> do
+                                hPutStrLn stderr $
+                                    "[Score] read error on " ++ fullPath ++ ": " ++ show e
+                                return (errorBlock mName ("Could not read score: " <> path))
+                            Right svgRaw -> do
+                                let html = buildHtml mName mCaption (processColors svgRaw)
+                                return $ RawBlock (Format "html") html
+inlineScore _ block = return block
+
+-- | Render an inline error block in place of a missing or unreadable score.
+--   Mirrors the convention in 'Filters.Viz.errorBlock' so build failures are
+--   visible to the author without aborting the entire site build.
+errorBlock :: Maybe T.Text -> T.Text -> Block
+errorBlock mName message =
+    RawBlock (Format "html") $ T.concat
+        [ "
     " data-exhibit-name=\"" <> escHtml n <> "\"") mName
+        , ">"
+        , "
    "
+        , escHtml message
+        , "
    "
+        , "
    "
+        ]
+
+-- | Extract the image src from the first Para that contains an Image inline.
+findImagePath :: [Block] -> Maybe T.Text
+findImagePath blocks = listToMaybe
+    [ src
+    | Para inlines       <- blocks
+    , Image _ _ (src, _) <- inlines
+    ]
+
+-- | Replace hardcoded black fill/stroke values with @currentColor@ so the
+--   SVG inherits the CSS @color@ property in both light and dark modes.
+--
+--   6-digit hex patterns are at the bottom of the composition chain
+--   (applied first) so they are replaced before the 3-digit shorthand,
+--   preventing partial matches (e.g. @#000@ matching the prefix of @#000000@).
+processColors :: T.Text -> T.Text
+processColors
+    -- 3-digit hex and keyword patterns (applied after 6-digit replacements)
+    = T.replace "fill=\"#000\""       "fill=\"currentColor\""
+    . T.replace "fill=\"black\""      "fill=\"currentColor\""
+    . T.replace "stroke=\"#000\""    "stroke=\"currentColor\""
+    . T.replace "stroke=\"black\""   "stroke=\"currentColor\""
+    . T.replace "fill:#000"          "fill:currentColor"
+    . T.replace "fill:black"         "fill:currentColor"
+    . T.replace "stroke:#000"       "stroke:currentColor"
+    . T.replace "stroke:black"      "stroke:currentColor"
+    -- 6-digit hex patterns (applied first — bottom of the chain)
+    . T.replace "fill=\"#000000\""    "fill=\"currentColor\""
+    . T.replace "stroke=\"#000000\"" "stroke=\"currentColor\""
+    . T.replace "fill:#000000"       "fill:currentColor"
+    . T.replace "stroke:#000000"    "stroke:currentColor"
+
+buildHtml :: Maybe T.Text -> Maybe T.Text -> T.Text -> T.Text
+buildHtml mName mCaption svgContent = T.concat
+    [ "
     " data-exhibit-name=\"" <> escHtml n <> "\"") mName
+    , " data-exhibit-type=\"score\">"
+    , "
    "
+    , svgContent
+    , "
    "
+    , maybe "" (\c -> "
    " <> escHtml c <> "
    ") mCaption
+    , "
    "
+    ]
+
+escHtml :: T.Text -> T.Text
+escHtml = U.escapeHtmlText
diff --git a/build/Filters/Sidenotes.hs b/build/Filters/Sidenotes.hs
new file mode 100644
index 0000000..dfb6e41
--- /dev/null
+++ b/build/Filters/Sidenotes.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE OverloadedStrings #-}
+-- | Convert Pandoc @Note@ inlines to inline sidenote HTML.
+--
+--   Each footnote becomes:
+--   * A @@ anchor in the body text.
+--   * An @