diff --git a/.gitignore b/.gitignore
index b5d53f0..d6826c1 100644
--- a/.gitignore
+++ b/.gitignore
@@ -58,7 +58,41 @@ IGNORE.txt
# Download with: make download-model
static/models/
+# Vendored Leaflet + leaflet.markercluster (~150 KB total, pinned in
+# tools/download-leaflet.sh). Used by the /photography/map/ page only.
+# Downloaded by `make build` when content/photography/ exists.
+static/leaflet/
+
# 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
+content/**/*.webp
+
+# Photography sidecars (produced by tools/extract-exif.py and
+# tools/extract-palette.py at build time; consumed by Hakyll). Recreated
+# from the photo file on every `make build`, so they don't belong in
+# version control — committing them would just produce churn.
+content/photography/**/*.exif.yaml
+content/photography/**/*.palette.yaml
+
+# Image-dimension sidecars (produced by tools/extract-dimensions.py at
+# build time; consumed by build/Filters/Images.hs to emit width / height
+# attrs on every for CLS prevention). Same churn-avoidance reasons
+# as the photography sidecars above; recreated on every `make build`.
+**/*.dims.yaml
+
+# Photography: defense-in-depth — refuse to commit RAW or oversize
+# originals. Per the photography section's design, only ≤2400px
+# web-optimized JPEGs are committed; originals stay outside the repo.
+# To intentionally commit one of these formats (rare), use
+# `git add -f path/to/file`.
+content/photography/**/*.cr2
+content/photography/**/*.cr3
+content/photography/**/*.nef
+content/photography/**/*.arw
+content/photography/**/*.dng
+content/photography/**/*.raf
+content/photography/**/*.orf
+content/photography/**/*.tif
+content/photography/**/*.tiff
+content/photography/**/*.psd
\ No newline at end of file
diff --git a/Makefile b/Makefile
index 6dfb37f..6e44449 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-.PHONY: build deploy sign download-model convert-images pdf-thumbs watch clean dev
+.PHONY: build deploy sign download-model download-leaflet 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).
@@ -9,6 +9,18 @@ build:
@date +%s > data/build-start.txt
@./tools/convert-images.sh
@$(MAKE) -s pdf-thumbs
+ @if [ -d content/photography ]; then ./tools/download-leaflet.sh; fi
+ # Photography pipeline: when content/photography/ exists, generate
+ # per-photo EXIF + palette sidecars and per-image dimension sidecars
+ # (the latter site-wide for CLS prevention). Gated on .venv presence,
+ # matching the embed.py pattern — failures are non-fatal.
+ @if [ -d .venv ]; then \
+ uv run python tools/extract-exif.py || echo "Warning: EXIF extraction failed (build continues with frontmatter only)"; \
+ uv run python tools/extract-palette.py || echo "Warning: palette extraction failed (build continues with frontmatter only)"; \
+ uv run python tools/extract-dimensions.py || echo "Warning: dimension extraction failed (build continues without width/height attrs)"; \
+ else \
+ echo "Photography sidecars skipped: run 'uv sync' to enable EXIF + palette + dimension extraction (build continues with frontmatter only)"; \
+ fi
cabal run site -- build
pagefind --site _site
@if [ -d .venv ]; then \
@@ -29,6 +41,13 @@ sign:
download-model:
@./tools/download-model.sh
+# Vendor Leaflet + leaflet.markercluster into static/leaflet/.
+# Used only by /photography/map/. Runs automatically as part of `build`
+# when content/photography/ exists (skips when files already present).
+# Files are gitignored; sha256-verified against tools/leaflet-checksums.sha256.
+download-leaflet:
+ @./tools/download-leaflet.sh
+
# Convert JPEG/PNG images to WebP companions (also runs automatically in build).
# Requires cwebp: pacman -S libwebp / apt install webp
convert-images:
diff --git a/README.md b/README.md
index 86e3c39..e4cbd81 100644
--- a/README.md
+++ b/README.md
@@ -8,6 +8,7 @@ A full-featured static site framework built with [Hakyll](https://jaspervdj.be/h
- **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.
+- **Photography** — opt-in section with masonry / grid / chronological / map / contact-sheet views, EXIF + palette auto-extraction, geo-precision-aware Leaflet map, and a darkroom-mode lightbox. Activates automatically when `content/photography/` exists.
- **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.
@@ -15,7 +16,7 @@ A full-featured static site framework built with [Hakyll](https://jaspervdj.be/h
- **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).
+- **Atom feeds** — site-wide and per-section (e.g., music-only, photography-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.
@@ -79,14 +80,17 @@ 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 |
+| 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 |
+| Photo | `content/photography//index.md` | photography.html |
+| Page | `content/*.md` | page.html |
+
+The photography section is opt-in: leave `content/photography/` absent and zero photo rules run, no leaflet is downloaded, no sidecars are generated. To turn it on, create the directory with an `index.md` (the section landing) and a first photo entry. Add `{ slug: "photography", name: "Photography" }` to `site.yaml`'s `portals` to surface a library shelf. Each photo entry can specify a JPEG file, EXIF and palette sidecars are auto-generated at build time (Pillow + colorthief), and a geo-precision-rounded `map.json` feeds the Leaflet view at `/photography/map/`.
## Deployment
diff --git a/build/Compilers.hs b/build/Compilers.hs
index dfd3640..aec84b3 100644
--- a/build/Compilers.hs
+++ b/build/Compilers.hs
@@ -7,6 +7,7 @@ module Compilers
, poetryCompiler
, fictionCompiler
, compositionCompiler
+ , photographyCompiler
, readerOpts
, writerOpts
) where
@@ -200,6 +201,25 @@ fictionCompiler = essayCompiler
compositionCompiler :: Compiler (Item String)
compositionCompiler = essayCompiler
+-- | Compiler for photography pages: body prose runs through the same
+-- source preprocessors and AST filters as other content (so wikilinks,
+-- smallcaps, sidenotes, image @@ wrapping, etc. all work in
+-- caption / process-note prose), but skips TOC, word-count,
+-- reading-time, citations, and further-reading. Visual content has no
+-- meaningful word count, and the epistemic / bibliography surfaces in
+-- 'essayCtx' don't apply here.
+photographyCompiler :: Compiler (Item String)
+photographyCompiler = 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
+ return (writePandocWith writerOpts pandocItem')
+
-- | Compiler for simple pages: filters applied, no TOC snapshot.
pageCompiler :: Compiler (Item String)
pageCompiler = do
diff --git a/build/Contexts.hs b/build/Contexts.hs
index 974c6cf..d205d4a 100644
--- a/build/Contexts.hs
+++ b/build/Contexts.hs
@@ -8,23 +8,30 @@ module Contexts
, poetryCtx
, fictionCtx
, compositionCtx
+ , photographyCtx
, contentKindField
, abstractField
, tagLinksField
, authorLinksField
+ , affiliationField
) where
import Data.Aeson (Value (..))
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Key as AK
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Vector as V
import Data.List (intercalate, isPrefixOf)
import Data.Maybe (fromMaybe)
+import qualified Data.Scientific as Sci
import Data.Time.Calendar (toGregorian)
-import Data.Time.Clock (getCurrentTime, utctDay)
-import Data.Time.Format (formatTime, defaultTimeLocale)
-import System.FilePath (takeDirectory, takeFileName)
+import Data.Time.Clock (UTCTime, getCurrentTime, utctDay)
+import Data.Time.Format (formatTime, defaultTimeLocale, parseTimeM)
+import System.Directory (doesFileExist)
+import System.FilePath (takeDirectory, takeFileName, ())
import Text.Read (readMaybe)
import qualified Data.Text as T
+import qualified Data.Yaml as Y
import qualified Config
import Text.Pandoc (runPure, readMarkdown, writeHtml5String, Pandoc(..), Block(..), Inline(..))
import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..))
@@ -99,12 +106,13 @@ contentKindField = field "item-kind" $ \item -> do
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"
+ | "essays/" `isPrefixOf` r' -> "Essay"
+ | "blog/" `isPrefixOf` r' -> "Post"
+ | "poetry/" `isPrefixOf` r' -> "Poem"
+ | "fiction/" `isPrefixOf` r' -> "Fiction"
+ | "music/" `isPrefixOf` r' -> "Composition"
+ | "photography/" `isPrefixOf` r' -> "Photo"
+ | otherwise -> "Page"
-- ---------------------------------------------------------------------------
-- Site-wide context
@@ -570,3 +578,394 @@ compositionCtx =
<> field "has-audio"
(\i -> maybe (fail "no audio") (const (return "true"))
(movAudio (itemBody i)))
+
+-- ---------------------------------------------------------------------------
+-- Photography context
+-- ---------------------------------------------------------------------------
+
+-- | Extract the photo entry's slug from its identifier.
+--
+-- * Flat single @content/photography/.md@ → @@
+-- * Directory @content/photography//index.md@ → @@
+--
+-- The slug is the URL segment under @/photography/@ and the directory
+-- name into which co-located assets (the photo, EXIF + palette
+-- sidecars) are copied by the asset rule.
+photoSlug :: Item a -> String
+photoSlug item =
+ let fp = toFilePath (itemIdentifier item)
+ fname = takeFileName fp
+ in if fname == "index.md"
+ then takeFileName (takeDirectory fp)
+ else takeWhile (/= '.') fname
+
+-- ---------------------------------------------------------------------------
+-- Sidecar reader
+-- ---------------------------------------------------------------------------
+--
+-- @{photo}.exif.yaml@ and @{photo}.palette.yaml@ are produced by the
+-- Python tools at @make build@ time (see @tools/extract-exif.py@ and
+-- @tools/extract-palette.py@). They live alongside the photo file
+-- under @content/photography//@ and back-fill metadata that the
+-- author chose not to write in frontmatter.
+--
+-- Read strategy: 'unsafeCompiler' + 'doesFileExist'. Sidecars are NOT
+-- registered as Hakyll items, so this read bypasses the dependency
+-- tracker. That is acceptable because:
+--
+-- * The Python tools always run before @cabal run site -- build@
+-- (the Makefile orders them that way).
+-- * Re-running the EXIF / palette extractor invalidates only those
+-- fields' rendered output; rebuilding @make build@ from scratch
+-- covers the dependency-edge case for free.
+--
+-- Resolution rule for every sidecar-backed field: frontmatter wins;
+-- if frontmatter is absent OR empty, fall back to sidecar; if neither
+-- supplies a value, return 'noResult' so the consuming template's
+-- @$if(...)$@ guard suppresses the row.
+
+-- | Compute the sidecar path for a photo entry.
+--
+-- @suffix@ is @".exif.yaml"@ or @".palette.yaml"@.
+-- Returns @Nothing@ when the entry has no @photo:@ frontmatter or
+-- when the entry is flat-form (no co-located asset directory).
+photoSidecarPath :: String -> Item a -> Compiler (Maybe FilePath)
+photoSidecarPath suffix item = do
+ meta <- getMetadata (itemIdentifier item)
+ let fp = toFilePath (itemIdentifier item)
+ isDir = takeFileName fp == "index.md"
+ case (isDir, lookupString "photo" meta) of
+ (True, Just photo) | not (null photo) ->
+ return $ Just $ takeDirectory fp photo ++ suffix
+ _ -> return Nothing
+
+-- | Load a sidecar YAML file as an Aeson Object (same shape Hakyll
+-- uses for frontmatter). Returns 'KM.empty' when the file is
+-- missing or fails to parse — sidecars are advisory, never fatal.
+loadSidecar :: FilePath -> IO Aeson.Object
+loadSidecar path = do
+ exists <- doesFileExist path
+ if not exists
+ then return KM.empty
+ else do
+ decoded <- Y.decodeFileEither path
+ case decoded of
+ Right (Object obj) -> return obj
+ _ -> return KM.empty
+
+-- | Read a sidecar object for a given suffix. Returns the empty object
+-- when the entry has no resolvable sidecar path or when the file is
+-- absent / malformed.
+readPhotoSidecar :: String -> Item a -> Compiler Aeson.Object
+readPhotoSidecar suffix item = do
+ mPath <- photoSidecarPath suffix item
+ case mPath of
+ Nothing -> return KM.empty
+ Just path -> unsafeCompiler (loadSidecar path)
+
+-- | Coerce a YAML scalar value to a plain String for template
+-- interpolation. Integers render without a trailing @.0@; structures
+-- and arrays return 'Nothing' (callers needing those should branch
+-- on 'Value' directly).
+yamlAsString :: Value -> Maybe String
+yamlAsString (String t) =
+ let s = T.unpack t
+ in if null (trim s) then Nothing else Just (trim s)
+yamlAsString (Number n) =
+ case Sci.floatingOrInteger n :: Either Double Integer of
+ Right i -> Just (show i)
+ Left d -> Just (show d)
+yamlAsString _ = Nothing
+
+-- | Look up a key in a sidecar object, coercing scalar values to
+-- String. Returns 'Nothing' for missing keys, empty strings, and
+-- structural values (arrays / nested objects).
+sidecarLookupString :: String -> Aeson.Object -> Maybe String
+sidecarLookupString key obj = yamlAsString =<< KM.lookup (AK.fromString key) obj
+
+-- | Generic frontmatter > EXIF-sidecar fallback field.
+--
+-- @key@ is the YAML key — same name on both sides. Frontmatter
+-- wins when present and non-empty; otherwise the matching key in
+-- @{photo}.exif.yaml@. 'noResult' fires when neither supplies a
+-- value, so the consuming template's @$if(key)$@ guard suppresses
+-- the row.
+exifBackedField :: String -> Context String
+exifBackedField key = field key $ \item -> do
+ meta <- getMetadata (itemIdentifier item)
+ case lookupString key meta of
+ Just v | not (null (trim v)) -> return (trim v)
+ _ -> do
+ obj <- readPhotoSidecar ".exif.yaml" item
+ case sidecarLookupString key obj of
+ Just v -> return v
+ Nothing -> noResult ("no " ++ key ++ " in frontmatter or EXIF sidecar")
+
+-- | Canonical URL for a known license name.
+--
+-- The frontmatter @license:@ string is normalized — lowercased, with
+-- internal whitespace collapsed — before lookup, so any of these all
+-- resolve identically:
+--
+-- * @"CC BY-SA 4.0"@
+-- * @"cc by-sa 4.0"@
+-- * @" CC BY-SA 4.0 "@
+--
+-- For licenses not in this table (e.g. a custom license, or "All
+-- Rights Reserved" which has no URL), the author can supply their
+-- own @license-url:@ frontmatter field; the field-level resolver
+-- (@licenseUrlField@) prefers explicit @license-url@ and falls back
+-- to this lookup only when the author hasn't provided one.
+canonicalLicenseUrl :: String -> Maybe String
+canonicalLicenseUrl raw =
+ case unwords (words (map (\c -> if c == '_' then ' ' else toLowerC c) raw)) of
+ "cc by 4.0" -> Just "https://creativecommons.org/licenses/by/4.0/"
+ "cc by-sa 4.0" -> Just "https://creativecommons.org/licenses/by-sa/4.0/"
+ "cc by-nc 4.0" -> Just "https://creativecommons.org/licenses/by-nc/4.0/"
+ "cc by-nc-sa 4.0" -> Just "https://creativecommons.org/licenses/by-nc-sa/4.0/"
+ "cc by-nd 4.0" -> Just "https://creativecommons.org/licenses/by-nd/4.0/"
+ "cc by-nc-nd 4.0" -> Just "https://creativecommons.org/licenses/by-nc-nd/4.0/"
+ "cc0" -> Just "https://creativecommons.org/publicdomain/zero/1.0/"
+ "cc0 1.0" -> Just "https://creativecommons.org/publicdomain/zero/1.0/"
+ "public domain" -> Just "https://creativecommons.org/publicdomain/mark/1.0/"
+ _ -> Nothing
+ where
+ toLowerC c
+ | c >= 'A' && c <= 'Z' = toEnum (fromEnum c + 32)
+ | otherwise = c
+
+-- | Context for photography pages and photo cards.
+--
+-- Frontmatter fields win when present; auto-extracted EXIF + palette
+-- sidecars produced by @tools/extract-exif.py@ /
+-- @tools/extract-palette.py@ fill in the gaps.
+--
+-- Photography pages do not include the essay context's epistemic,
+-- bibliography, backlinks, similar-links, TOC, word-count, or
+-- reading-time fields — none of those apply to visual content.
+--
+-- Exposed template variables:
+-- @$photography$@ — flag, gates @photography.css@ in head.html
+-- and the @data-page-type@ body attribute used
+-- by the darkroom-mode lightbox
+-- @$slug$@ — URL slug under @/photography/@
+-- @$photo-url$@ — absolute URL of the photo file. Built as
+-- @/photography//@ when the entry
+-- is directory-form; @noResult@ for flat
+-- singles (templates use the @photo@
+-- frontmatter directly there).
+-- @$captured-display$@, @$captured-iso$@ — capture date in
+-- human-readable and ISO forms; @noResult@
+-- when @captured:@ is absent. Distinct from
+-- the publication @date:@ shown in card lists.
+-- @$photography-tags$@ — listField of @{tag-name, tag-url}@.
+-- @$palette-swatches$@ — listField of @{swatch}@ (hex string).
+-- @noResult@ when the @palette:@ frontmatter
+-- is absent or empty so the template's
+-- @$if(palette-swatches)$@ gate suppresses an
+-- empty strip.
+photographyCtx :: Context String
+photographyCtx =
+ constField "photography" "true"
+ <> slugField
+ <> photoUrlField
+ <> photoWebpUrlField
+ -- EXIF-backed fields. Each prefers frontmatter and falls back to
+ -- @{photo}.exif.yaml@ produced by @tools/extract-exif.py@. Sidecars
+ -- absent on film scans (no EXIF on a film negative) is fine —
+ -- noResult propagates and the template's @$if(...)$@ gate hides
+ -- the row.
+ <> exifBackedField "camera"
+ <> exifBackedField "lens"
+ <> exifBackedField "exposure"
+ <> exifBackedField "shutter"
+ <> exifBackedField "aperture"
+ <> exifBackedField "iso"
+ <> exifBackedField "focal-length"
+ -- Pixel dimensions for CLS-prevention width/height attrs on every
+ -- . Read from the EXIF sidecar produced by extract-exif.py;
+ -- frontmatter wins if the author wants to override (e.g., to
+ -- declare a different rendered size).
+ <> exifBackedField "width"
+ <> exifBackedField "height"
+ <> capturedDisplayField
+ <> capturedIsoField
+ <> paletteSwatchesField
+ <> licenseUrlField
+ <> photoLinksField
+ <> tagLinksField "photography-tags"
+ <> authorLinksField
+ <> affiliationField
+ <> dateField "date" "%-d %B %Y"
+ <> dateField "date-iso" "%Y-%m-%d"
+ <> siteCtx
+ where
+ slugField :: Context String
+ slugField = field "slug" (return . photoSlug)
+
+ -- Build @/photography//@ when both the directory-form
+ -- entry and a @photo:@ frontmatter key are present. Flat singles
+ -- have no co-located asset directory, so @noResult@ there — the
+ -- template falls back to interpreting the @photo:@ frontmatter
+ -- as a literal URL.
+ photoUrlField :: Context String
+ photoUrlField = field "photo-url" $ \item -> do
+ meta <- getMetadata (itemIdentifier item)
+ let fp = toFilePath (itemIdentifier item)
+ isDir = takeFileName fp == "index.md"
+ case (isDir, lookupString "photo" meta) of
+ (True, Just photo) ->
+ return $ "/photography/" ++ photoSlug item ++ "/" ++ photo
+ _ -> noResult "no co-located photo (flat single, or photo: key absent)"
+
+ -- WebP companion URL, mirroring 'photoUrlField'. Returns 'noResult'
+ -- when the @.webp@ companion doesn't exist on disk at compile time
+ -- (cwebp not installed, conversion not yet run, or this image
+ -- failed to convert) so the template's @$if(photo-webp-url)$@
+ -- guard suppresses the @@ — the @@ then degrades
+ -- to a plain @@ on the original-format src. Browsers do NOT
+ -- fall back from a 404'd @@ to the nested @@; the
+ -- file-existence check at build time is load-bearing.
+ photoWebpUrlField :: Context String
+ photoWebpUrlField = field "photo-webp-url" $ \item -> do
+ meta <- getMetadata (itemIdentifier item)
+ let fp = toFilePath (itemIdentifier item)
+ isDir = takeFileName fp == "index.md"
+ case (isDir, lookupString "photo" meta) of
+ (True, Just photo) | not (null photo) -> do
+ let entryDir = takeDirectory fp
+ webpDisk = entryDir photoToWebp photo
+ exists <- unsafeCompiler (doesFileExist webpDisk)
+ if exists
+ then return $ "/photography/" ++ photoSlug item
+ ++ "/" ++ photoToWebp photo
+ else noResult "no webp companion on disk"
+ _ -> noResult "no co-located photo (flat single, or photo: key absent)"
+ where
+ photoToWebp :: String -> String
+ photoToWebp p =
+ let dotIdx = lastDotIndex p
+ in case dotIdx of
+ Just i -> take i p ++ ".webp"
+ Nothing -> p ++ ".webp"
+
+ lastDotIndex :: String -> Maybe Int
+ lastDotIndex s = go (length s - 1)
+ where
+ go i
+ | i < 0 = Nothing
+ | s !! i == '/' = Nothing -- crossed a path boundary
+ | s !! i == '.' = Just i
+ | otherwise = go (i - 1)
+
+ -- Resolve the @captured:@ ISO date with frontmatter > sidecar
+ -- precedence. Centralised so the display and ISO fields stay in
+ -- agreement on which source they read from.
+ resolveCapturedIso :: Item a -> Compiler (Maybe String)
+ resolveCapturedIso item = do
+ meta <- getMetadata (itemIdentifier item)
+ case lookupString "captured" meta of
+ Just v | not (null (trim v)) -> return (Just (trim v))
+ _ -> do
+ obj <- readPhotoSidecar ".exif.yaml" item
+ return (sidecarLookupString "captured" obj)
+
+ -- @captured:@ as "15 March 2026". Reads frontmatter, falls back to
+ -- the EXIF sidecar's @captured:@ key. Returns @noResult@ when
+ -- absent so @$if(captured-display)$@ gates the metadata row.
+ capturedDisplayField :: Context String
+ capturedDisplayField = field "captured-display" $ \item -> do
+ mIso <- resolveCapturedIso item
+ case mIso of
+ Nothing -> noResult "no captured date in frontmatter or EXIF sidecar"
+ Just iso ->
+ case parseTimeM True defaultTimeLocale "%Y-%m-%d" iso
+ :: Maybe UTCTime of
+ Just t -> return (formatTime defaultTimeLocale "%-d %B %Y" t)
+ Nothing -> noResult "captured date does not parse as YYYY-MM-DD"
+
+ -- ISO form passed through unchanged (after a parse-validate round-trip
+ -- so a malformed value in either source doesn't reach the template).
+ capturedIsoField :: Context String
+ capturedIsoField = field "captured-iso" $ \item -> do
+ mIso <- resolveCapturedIso item
+ case mIso of
+ Nothing -> noResult "no captured date in frontmatter or EXIF sidecar"
+ Just iso ->
+ case parseTimeM True defaultTimeLocale "%Y-%m-%d" iso
+ :: Maybe UTCTime of
+ Just t -> return (formatTime defaultTimeLocale "%Y-%m-%d" t)
+ Nothing -> noResult "captured date does not parse as YYYY-MM-DD"
+
+ -- @palette:@ list field. Frontmatter wins; otherwise pull the
+ -- list from @{photo}.palette.yaml@ (the @palette:@ key, an array
+ -- of hex strings produced by @tools/extract-palette.py@). Each
+ -- swatch exposes @$swatch$@.
+ paletteSwatchesField :: Context String
+ paletteSwatchesField = listFieldWith "palette-swatches" swCtx $ \item -> do
+ meta <- getMetadata (itemIdentifier item)
+ let fmEntries = fromMaybe [] (lookupStringList "palette" meta)
+ fmVisible = filter (not . null . trim) fmEntries
+ swatches <- if null fmVisible
+ then do
+ obj <- readPhotoSidecar ".palette.yaml" item
+ case KM.lookup "palette" obj of
+ Just (Array vec) ->
+ return [ trim s
+ | val <- V.toList vec
+ , Just s <- [yamlAsString val]
+ , not (null (trim s)) ]
+ _ -> return []
+ else return fmVisible
+ if null swatches
+ then noResult "no palette swatches in frontmatter or palette sidecar"
+ else return $ zipWith
+ (\i s -> Item (fromFilePath ("palette-" ++ show i)) s)
+ ([0 ..] :: [Int])
+ swatches
+ where
+ swCtx = field "swatch" (return . itemBody)
+
+ -- @$license-url-resolved$@: an explicit @license-url:@ frontmatter
+ -- value when present, otherwise a canonical URL looked up from the
+ -- @license:@ string for known licenses (CC variants, CC0, public
+ -- domain). Returns @noResult@ when neither is set, so
+ -- @$if(license-url-resolved)$@ gates the link wrapper.
+ --
+ -- Frontmatter @license:@ itself flows through @defaultContext@ as
+ -- @$license$@; the template renders the license name as link text
+ -- and uses @$license-url-resolved$@ as @href@.
+ licenseUrlField :: Context String
+ licenseUrlField = field "license-url-resolved" $ \item -> do
+ meta <- getMetadata (itemIdentifier item)
+ case lookupString "license-url" meta of
+ Just u | not (null (trim u)) -> return (trim u)
+ _ -> case lookupString "license" meta of
+ Nothing -> noResult "no license"
+ Just l -> case canonicalLicenseUrl l of
+ Just u -> return u
+ Nothing -> noResult "license not in canonical lookup"
+
+ -- @links:@ frontmatter — outbound links to other surfaces where
+ -- the photograph appears or can be acquired (Wikimedia Commons,
+ -- Flickr, exhibition catalog, print-sale page, etc.). Each entry
+ -- uses the same @"Name | URL"@ pipe syntax as @authors:@ /
+ -- @affiliation:@ — the existing site convention.
+ --
+ -- Each item exposes @$link-name$@ and @$link-url$@. Entries
+ -- without a URL are dropped (no point linking to nothing). Returns
+ -- @noResult@ on empty so @$if(photo-links)$@ guards the wrapper.
+ photoLinksField :: Context String
+ photoLinksField = listFieldWith "photo-links" lkCtx $ \item -> do
+ meta <- getMetadata (itemIdentifier item)
+ let entries = fromMaybe [] (lookupStringList "links" meta)
+ parsed = filter (not . null . snd) (map parseEntry entries)
+ if null parsed
+ then noResult "no outbound links"
+ else return $ map (Item (fromFilePath "")) parsed
+ where
+ lkCtx = field "link-name" (return . fst . itemBody)
+ <> field "link-url" (return . snd . itemBody)
+ parseEntry s = case break (== '|') s of
+ (name, '|' : url) -> (trim name, trim url)
+ (name, _) -> (trim name, "")
diff --git a/build/Filters/Images.hs b/build/Filters/Images.hs
index f81ccc2..7cf7e27 100644
--- a/build/Filters/Images.hs
+++ b/build/Filters/Images.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE OverloadedStrings #-}
--- | Image filter: lazy loading, lightbox markers, and WebP wrappers.
+-- | Image filter: lazy loading, lightbox markers, WebP
+-- wrappers, and CLS-preventing width/height attrs.
--
-- For local raster images (JPG, JPEG, PNG, GIF) whose @.webp@ companion
-- exists on disk at build time, emits a @@ element with a WebP
@@ -17,16 +18,29 @@
--
-- SVG files and external URLs are passed through with only lazy loading
-- (and lightbox markers for standalone images).
+--
+-- Width / height attrs are looked up from @{image}.dims.yaml@ sidecars
+-- produced by @tools/extract-dimensions.py@ at build time, on the same
+-- path-resolution rules as the WebP companion check (absolute paths
+-- under @static/@, relative under the source-file directory). When a
+-- sidecar is missing the filter emits an attr-free rather than
+-- guessing — partial dimensions are worse than no dimensions, since
+-- the browser would then size the image wrong on first paint.
module Filters.Images (apply) where
import Data.Char (toLower)
+import Data.Default (def)
import Data.List (isPrefixOf)
import Data.Text (Text)
import qualified Data.Text as T
+import qualified Data.Aeson.KeyMap as KM
+import qualified Data.Scientific as Sci
+import qualified Data.Yaml as Y
+import Text.Pandoc.Definition
+import qualified Text.Pandoc as Pandoc
+import Text.Pandoc.Walk (walkM)
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.
@@ -35,13 +49,76 @@ import qualified Utils as U
-- 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.
+--
+-- Two-pass walk:
+--
+-- 1. Block-level pass (@transformBlock@) intercepts standalone
+-- figures so we can synthesize the entire @@ ourselves
+-- when WebP wrapping kicks in. Without this pass, replacing the
+-- inner @Image@ with a @RawInline@ would break Pandoc's
+-- alt-vs-caption comparison and we'd lose the
+-- @aria-hidden="true"@ hint on identical-text figcaptions.
+-- 2. Inline-level pass (@transformInline@) handles every remaining
+-- @Image@ — inline-in-prose, inside @Link@s, etc. Pandoc's writer
+-- still applies its accessibility heuristics for figures we
+-- didn't synthesize (notably the no-WebP case).
apply :: FilePath -> Pandoc -> IO Pandoc
-apply srcDir = walkM (transformInline srcDir)
+apply srcDir doc = do
+ doc' <- walkM (transformBlock srcDir) doc
+ walkM (transformInline srcDir) doc'
-- ---------------------------------------------------------------------------
--- Core transformation
+-- Core transformations
-- ---------------------------------------------------------------------------
+-- | Block-level pass. Currently only acts on the simple-figure shape
+-- that Pandoc's Markdown reader produces for @@ standalone:
+--
+-- @Figure attr caption [Plain [Image imgAttr alt target]]@
+--
+-- When the image has a WebP companion on disk, we replace the whole
+-- Figure with a @RawBlock@ containing the equivalent HTML — but with
+-- the @@ wrapper inside and a manually-emitted
+-- @aria-hidden="true"@ on the figcaption when alt text equals the
+-- caption text. Anything more exotic (multi-image figures, mixed
+-- block content inside the figure, no-WebP images) is left to
+-- Pandoc's default emission, which is already correct for those
+-- cases.
+transformBlock :: FilePath -> Block -> IO Block
+transformBlock srcDir b@(Figure figAttr caption [Plain [Image imgAttr alt target]]) = do
+ let src = T.unpack (fst target)
+ if not (isLocalRaster src)
+ then pure b
+ else do
+ hasWebp <- doesFileExist (webpPhysicalPath srcDir (fst target))
+ if not hasWebp
+ then pure b -- Pandoc handles aria-hidden naturally on the no-WebP path.
+ else synthesizeFigure srcDir figAttr caption imgAttr alt target
+transformBlock _ b = pure b
+
+-- | Build a @@ block from an Image and its surrounding
+-- metadata. Used only on the WebP branch; the no-WebP branch leaves
+-- Pandoc to emit the figure naturally.
+--
+-- Aria-hiding rule: when the caption's plain-text content equals the
+-- alt text and both are non-empty, mark the @@ with
+-- @aria-hidden="true"@. Screen readers then announce the alt
+-- (via the @@) and skip the figcaption (which would just
+-- duplicate it). Non-matching captions render as visible content.
+--
+-- Caption inline rendering goes through Pandoc's HTML writer, so
+-- formatting (italic, links, code, etc.) is preserved.
+synthesizeFigure :: FilePath -> Attr -> Caption -> Attr -> [Inline] -> Target -> IO Block
+synthesizeFigure srcDir figAttr caption imgAttr alt target = do
+ dims <- readDims srcDir (fst target)
+ let pictureHtml = renderPicture imgAttr alt target True dims
+ capInlines = captionInlines caption
+ capText = stringify capInlines
+ altText = stringify alt
+ useAriaHide = capText == altText && not (T.null altText)
+ pure $ RawBlock (Format "html") $
+ renderFigure figAttr pictureHtml (renderFigcaption capInlines useAriaHide)
+
transformInline :: FilePath -> Inline -> IO Inline
transformInline srcDir (Link lAttr ils lTarget) = do
-- Recurse into link contents; images inside a link get no lightbox marker.
@@ -60,21 +137,41 @@ wrapLinkedImg _ x = pure x
-- * 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
+--
+-- In all three branches, when a @{image}.dims.yaml@ sidecar is
+-- present, @width@ and @height@ attrs are emitted on the rendered
+-- @@. The sidecar lookup is skipped for non-local sources
+-- (HTTP URLs, data URIs) since there's no local file to measure.
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
+renderImg srcDir attr alt target@(src, _) lightbox = do
+ let s = T.unpack src
+ isRaster = isLocalRaster s
+ local = not (isUrl s)
+ dims <- if local then readDims srcDir src else pure Nothing
+ if isRaster
+ then do
+ hasWebp <- doesFileExist (webpPhysicalPath srcDir src)
+ if hasWebp
+ then pure $ RawInline (Format "html")
+ (renderPicture attr alt target lightbox dims)
+ else pure $ Image (commonAttrs dims) alt target
+ else
+ pure $ Image (commonAttrs dims) alt target
where
+ commonAttrs dims =
+ withDims dims
+ $ addAttr "decoding" "async"
+ $ addLightbox lightbox
+ $ addAttr "loading" "lazy" attr
+
addLightbox True a = addAttr "data-lightbox" "true" a
addLightbox False a = a
+ withDims Nothing a = a
+ withDims (Just (w, h)) a =
+ addAttr "width" (T.pack (show w))
+ (addAttr "height" (T.pack (show h)) a)
+
-- | Physical on-disk path of the @.webp@ companion for a Markdown image src.
--
-- Absolute paths (@/images/foo.jpg@) resolve under @static/@ because that
@@ -89,13 +186,49 @@ webpPhysicalPath srcDir src =
else srcDir s
in replaceExtension physical ".webp"
+-- | Physical on-disk path of the @.dims.yaml@ sidecar for a Markdown
+-- image src. Same path-resolution rules as 'webpPhysicalPath'; the
+-- sidecar lives next to the original image with the literal
+-- extension @.dims.yaml@ appended.
+dimsPhysicalPath :: FilePath -> Text -> FilePath
+dimsPhysicalPath srcDir src =
+ let s = T.unpack src
+ physical = if "/" `isPrefixOf` s
+ then "static" ++ s
+ else srcDir s
+ in physical ++ ".dims.yaml"
+
+-- | Read the @{image}.dims.yaml@ sidecar and return @(width, height)@
+-- when present and parseable. Returns 'Nothing' on absent file,
+-- parse error, missing keys, or non-integer values — all of which
+-- cause the filter to emit no width/height attrs (rather than a
+-- guess that would size the image wrong on first paint).
+readDims :: FilePath -> Text -> IO (Maybe (Int, Int))
+readDims srcDir src = do
+ let path = dimsPhysicalPath srcDir src
+ exists <- doesFileExist path
+ if not exists
+ then pure Nothing
+ else do
+ decoded <- Y.decodeFileEither path
+ pure $ case decoded of
+ Right (Y.Object obj) -> do
+ w <- intValue =<< KM.lookup "width" obj
+ h <- intValue =<< KM.lookup "height" obj
+ Just (w, h)
+ _ -> Nothing
+ where
+ intValue :: Y.Value -> Maybe Int
+ intValue (Y.Number n) = Sci.toBoundedInteger n
+ intValue _ = Nothing
+
-- ---------------------------------------------------------------------------
-- rendering
-- ---------------------------------------------------------------------------
-- | Emit a @@ element with a WebP @@ and an @@ fallback.
-renderPicture :: Attr -> [Inline] -> Target -> Bool -> Text
-renderPicture (ident, classes, kvs) alt (src, title) lightbox =
+renderPicture :: Attr -> [Inline] -> Target -> Bool -> Maybe (Int, Int) -> Text
+renderPicture (ident, classes, kvs) alt (src, title) lightbox dims =
T.concat
[ ""
, ""
@@ -105,7 +238,9 @@ renderPicture (ident, classes, kvs) alt (src, title) lightbox =
, " src=\"", esc src, "\""
, attrAlt alt
, attrTitle title
+ , dimsAttrs dims
, " loading=\"lazy\""
+ , " decoding=\"async\""
, if lightbox then " data-lightbox=\"true\"" else ""
, renderKvs passedKvs
, ">"
@@ -114,13 +249,81 @@ renderPicture (ident, classes, kvs) alt (src, title) lightbox =
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 .
+ -- attrs we always emit ourselves (loading, decoding, data-lightbox,
+ -- width, height), so they don't appear twice on the .
passedKvs = filter
(\(k, _) -> k `notElem`
- ["loading", "data-lightbox", "id", "class", "alt", "title", "src"])
+ [ "loading", "decoding", "data-lightbox"
+ , "id", "class", "alt", "title", "src"
+ , "width", "height"
+ ])
kvs
+ dimsAttrs Nothing = ""
+ dimsAttrs (Just (w, h)) =
+ " width=\"" <> T.pack (show w)
+ <> "\" height=\"" <> T.pack (show h) <> "\""
+
+-- ---------------------------------------------------------------------------
+-- synthesis (Block walk, WebP path only)
+-- ---------------------------------------------------------------------------
+
+-- | Build a @@ HTML element wrapping pre-rendered inner
+-- content (typically a @@) and a pre-rendered figcaption.
+-- Preserves any id / classes / kvs from the surrounding Pandoc
+-- 'Figure' attr.
+renderFigure :: Attr -> Text -> Text -> Text
+renderFigure (figId, figClasses, figKvs) inner figcaption =
+ T.concat
+ [ "\n"
+ , inner
+ , "\n"
+ , figcaption
+ , "\n"
+ ]
+
+-- | Build a @@ element. When @ariaHidden@ is true, emits
+-- @aria-hidden="true"@ — used when the caption text exactly
+-- duplicates the image alt (so screen readers don't announce the
+-- same content twice). Caption inlines render through Pandoc's HTML
+-- writer to preserve formatting.
+renderFigcaption :: [Inline] -> Bool -> Text
+renderFigcaption ils ariaHidden =
+ let body = renderInlinesToHtml ils
+ attrs = if ariaHidden then " aria-hidden=\"true\"" else ""
+ in " attrs <> ">" <> body <> ""
+
+-- | Pandoc 'Caption' has a long form (@[Block]@) and an optional short
+-- form (@Maybe ShortCaption@). We use the long form, flattening any
+-- @Plain@ / @Para@ blocks into a single inline list. Multi-block
+-- captions (rare) collapse to the inlines of their text-bearing
+-- blocks; non-text blocks (like nested lists) are dropped, since
+-- they don't make sense in a figcaption anyway.
+captionInlines :: Caption -> [Inline]
+captionInlines (Caption _ blocks) = concatMap go blocks
+ where
+ go (Plain ils) = ils
+ go (Para ils) = ils
+ go _ = []
+
+-- | Render Pandoc 'Inline' nodes to HTML using Pandoc's own writer.
+-- Wrapping the inlines in a @Plain@ block (rather than @Para@)
+-- avoids the surrounding @
@ tag the writer would otherwise emit.
+-- On writer failure (extremely unlikely for inline-only input),
+-- falls back to the plain-text 'stringify' rendering — a worse but
+-- still safe figcaption.
+renderInlinesToHtml :: [Inline] -> Text
+renderInlinesToHtml ils =
+ case Pandoc.runPure (Pandoc.writeHtml5String def doc) of
+ Right t -> T.strip t
+ Left _ -> stringify ils
+ where
+ doc = Pandoc mempty [Plain ils]
+
attrId :: Text -> Text
attrId t = if T.null t then "" else " id=\"" <> esc t <> "\""
diff --git a/build/Patterns.hs b/build/Patterns.hs
index c05f8e2..dddf5dc 100644
--- a/build/Patterns.hs
+++ b/build/Patterns.hs
@@ -16,6 +16,8 @@ module Patterns
, poetryPattern
, fictionPattern
, musicPattern
+ , photographyPattern
+ , allPhotoEntries
, standalonePagesPattern
-- * Aggregated patterns
, allWritings -- essays + blog + poetry + fiction
@@ -66,6 +68,44 @@ fictionPattern = "content/fiction/*.md"
musicPattern :: Pattern
musicPattern = "content/music/*/index.md"
+-- | All photo entries — flat singles plus directory-form entries.
+--
+-- Two shapes:
+-- * flat: @content/photography/.md@
+-- * directory: @content/photography//index.md@
+--
+-- The section landing page at @content/photography/index.md@ is
+-- excluded; it routes via 'Photography.photographyLandingRules' as the
+-- section landing, not as a photo entry.
+--
+-- Directory-form @index.md@ files are treated as either single-photo
+-- entries (when the directory has no @.md@ siblings) or series landings
+-- (when it does). 'Photography.photographyEntryRules' branches on that
+-- structurally — no @series: true@ frontmatter flag is needed.
+photographyPattern :: Pattern
+photographyPattern =
+ ("content/photography/*.md" .&&. complement "content/photography/index.md")
+ .||. "content/photography/*/index.md"
+
+-- | Every photographic entry, including children of series. Distinct
+-- from 'photographyPattern' (which enumerates only top-level entries
+-- and series landings) for surfaces that should enumerate every
+-- photograph individually:
+--
+-- * @/photography/by-year//@ — one frame per file
+-- * @/photography/contact-sheet/@ — every frame in the roll
+-- * @/photography/map.json@ — one pin per geotagged photo
+-- * @/photography/feed.xml@ — one entry per shot
+-- * Tag indexes — siblings have their own tags
+--
+-- The main @/photography/@ landing and the library shelf use
+-- 'photographyPattern' instead, so a series shows up as a single
+-- aggregate card rather than once for the landing plus once per child.
+allPhotoEntries :: Pattern
+allPhotoEntries =
+ photographyPattern
+ .||. ("content/photography/*/*.md" .&&. complement "content/photography/*/index.md")
+
-- | Top-level standalone pages (about, colophon, current, gpg, …).
standalonePagesPattern :: Pattern
standalonePagesPattern = "content/*.md"
@@ -95,6 +135,14 @@ allContent =
authorIndexable :: Pattern
authorIndexable = (essayPattern .||. blogPattern) .&&. hasNoVersion
--- | Content shown on tag index pages — essays + blog posts.
+-- | Content shown on tag index pages — essays + blog posts + every
+-- photographic entry (including sibling photos in series).
+-- Photography sub-tags (@photography/landscape@, @photography/film@,
+-- …) generate proper @//@ pages from this pattern; the
+-- bare @photography@ top-level tag is filtered out in
+-- 'Tags.getExpandedTags' to avoid colliding with the section
+-- landing's route at @/photography/@.
tagIndexable :: Pattern
-tagIndexable = (essayPattern .||. blogPattern) .&&. hasNoVersion
+tagIndexable =
+ (essayPattern .||. blogPattern .||. allPhotoEntries)
+ .&&. hasNoVersion
diff --git a/build/Photography.hs b/build/Photography.hs
new file mode 100644
index 0000000..443b518
--- /dev/null
+++ b/build/Photography.hs
@@ -0,0 +1,572 @@
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE OverloadedStrings #-}
+-- | Photography section — routing and per-page compilation.
+--
+-- Activates only when @content/photography/@ exists in the project
+-- tree (gated in 'Site.rules'). Photographers who don't want a
+-- photography section simply leave the directory absent and pay zero
+-- cost — no rules, no generated pages, no feed.
+--
+-- Surfaces:
+--
+-- * Single-photo entries — flat (@content/photography/.md@)
+-- and directory form (@content/photography//index.md@).
+-- * Series — a directory with siblings, e.g.
+-- @content/photography//.md@. Series detection is
+-- structural; no @series: true@ frontmatter flag is needed.
+-- * Section landing at @/photography/@.
+-- * Map at @/photography/map/@ with @map.json@ for the Leaflet client.
+-- * By-year indexes at @/photography/by-year/{year}/@.
+-- * Contact sheet at @/photography/contact-sheet/@.
+-- * Atom feed at @/photography/feed.xml@.
+--
+-- See @PHOTOGRAPHY.md@ in the upstream levineuwirth.org repo for the
+-- full design rationale.
+module Photography
+ ( photographyRules
+ ) where
+
+import Control.Monad (forM, forM_)
+import Data.List (sortBy)
+import qualified Data.Map.Strict as Map
+import Data.Map.Strict (Map)
+import Data.Maybe (mapMaybe, fromMaybe, catMaybes)
+import qualified Data.Set as Set
+import Data.Set (Set)
+import Data.Ord (Down (..), comparing)
+import System.FilePath (takeDirectory, takeFileName, replaceExtension)
+import qualified Data.Aeson as Aeson
+import Data.Aeson (Value (..), (.=))
+import qualified Data.Aeson.KeyMap as KM
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TLE
+import qualified Data.Vector as V
+import qualified Data.Scientific as Sci
+import Hakyll
+import qualified Config
+import Compilers (pageCompiler, photographyCompiler)
+import Contexts (photographyCtx, pageCtx, siteCtx)
+import qualified Patterns as P
+
+-- ---------------------------------------------------------------------------
+-- Rules
+-- ---------------------------------------------------------------------------
+
+-- | All photography rules. Called from 'Site.rules' once, and only
+-- when @content/photography/@ exists.
+--
+-- Order is intentional:
+--
+-- 1. Co-located assets first (so the photo file is in @_site/@
+-- before any page that references it is compiled — Hakyll's
+-- dependency tracker handles this anyway, but the surface
+-- ordering reads top-down by data flow).
+-- 2. Single-photo entries (flat + directory form).
+-- 3. Section landing at @/photography/@ — loaded after the
+-- photo entries so its @loadAll photographyPattern@ resolves
+-- each photo's frontmatter through 'photographyCtx'.
+photographyRules :: Rules ()
+photographyRules = do
+ -- A directory is a "series" iff it has @.md@ siblings alongside
+ -- its @index.md@. Collected once at rule-gen time so the entry
+ -- rule can branch on series-landing template selection without
+ -- re-globbing per item.
+ siblingIds <- getMatches
+ ( "content/photography/*/*.md"
+ .&&. complement "content/photography/*/index.md"
+ )
+ let seriesSlugs :: Set String
+ seriesSlugs = Set.fromList
+ [ takeFileName (takeDirectory (toFilePath ident))
+ | ident <- siblingIds
+ ]
+
+ photographyAssetRules
+ photographyEntryRules seriesSlugs
+ photographySeriesPhotoRules
+ photographyLandingRules
+ photographyMapDataRule
+ photographyMapPageRule
+ photographyFeedRule
+ photographyByYearRules
+ photographyContactSheetRule
+
+-- ---------------------------------------------------------------------------
+-- Assets
+-- ---------------------------------------------------------------------------
+
+-- | Co-located assets — the photo file itself, and the
+-- build-generated @{photo}.exif.yaml@ + @{photo}.palette.yaml@
+-- sidecars. Two patterns are matched in sequence:
+--
+-- * @content/photography/@ — flat-single co-located assets
+-- * @content/photography//@ — directory-form co-located assets
+--
+-- Markdown files are excluded from both rules; they're compiled by
+-- 'photographyEntryRules' and 'photographyLandingRules'. The
+-- @.exif.yaml@ / @.palette.yaml@ / @.dims.yaml@ sidecars are
+-- excluded too — they're consumed by Hakyll at compile time and have
+-- no role in the deployed site.
+photographyAssetRules :: Rules ()
+photographyAssetRules = do
+ -- Top-level non-Markdown files (flat-single co-located assets).
+ match ("content/photography/*"
+ .&&. complement "content/photography/*.md"
+ .&&. complement "content/photography/*.exif.yaml"
+ .&&. complement "content/photography/*.palette.yaml"
+ .&&. complement "content/photography/*.dims.yaml") $ do
+ route $ gsubRoute "content/" (const "")
+ compile copyFileCompiler
+
+ -- Directory-form entries' co-located assets.
+ match ("content/photography/*/*"
+ .&&. complement "content/photography/*/index.md"
+ .&&. complement "content/photography/*/*.md"
+ .&&. complement "content/photography/*/*.exif.yaml"
+ .&&. complement "content/photography/*/*.palette.yaml"
+ .&&. complement "content/photography/*/*.dims.yaml") $ do
+ route $ gsubRoute "content/" (const "")
+ compile copyFileCompiler
+
+-- ---------------------------------------------------------------------------
+-- Single-photo entries
+-- ---------------------------------------------------------------------------
+
+-- | Compile each single-photo entry. Routing follows the essay
+-- convention so the URL shape is predictable:
+--
+-- * @content/photography/.md@ → @photography/.html@
+-- * @content/photography//index.md@ → @photography//index.html@
+--
+-- The @"content"@ snapshot is saved so @/photography/feed.xml@ can
+-- render the rendered body as feed entry content.
+photographyEntryRules :: Set String -> Rules ()
+photographyEntryRules seriesSlugs =
+ match P.photographyPattern $ do
+ route photoEntryRoute
+ compile $ do
+ ident <- getUnderlying
+ let fp = toFilePath ident
+ isIndex = takeFileName fp == "index.md"
+ slug = takeFileName (takeDirectory fp)
+ isSeriesLanding = isIndex && slug `Set.member` seriesSlugs
+ template
+ | isSeriesLanding = "templates/photography-series.html"
+ | otherwise = "templates/photography.html"
+ ctx
+ | isSeriesLanding = seriesCtx
+ | otherwise = photographyCtx
+ photographyCompiler
+ >>= saveSnapshot "content"
+ >>= loadAndApplyTemplate template ctx
+ >>= loadAndApplyTemplate "templates/default.html" ctx
+ >>= relativizeUrls
+
+-- | Sibling photos inside a series directory:
+-- @content/photography//.md@. Compiled with the
+-- single-photo template; routed to @//index.html@
+-- so the URL is the canonical directory form (matches the rest of
+-- the photography section's URL shape).
+--
+-- Series landings (@/index.md@) are handled by
+-- 'photographyEntryRules' with the @photographyPattern@ match;
+-- they're explicitly excluded here so the two rules don't double-route.
+photographySeriesPhotoRules :: Rules ()
+photographySeriesPhotoRules =
+ match ("content/photography/*/*.md"
+ .&&. complement "content/photography/*/index.md") $ do
+ route $ customRoute $ \ident ->
+ -- Drop @"content/"@ prefix and @".md"@ suffix, then append
+ -- @"/index.html"@ to get directory-style URLs.
+ let fp = toFilePath ident
+ rel = drop (length contentPrefix) fp
+ stripped = take (length rel - 3) rel
+ in stripped ++ "/index.html"
+ compile $ photographyCompiler
+ >>= saveSnapshot "content"
+ >>= loadAndApplyTemplate "templates/photography.html" photographyCtx
+ >>= loadAndApplyTemplate "templates/default.html" photographyCtx
+ >>= relativizeUrls
+ where
+ contentPrefix = "content/" :: String
+
+-- | Context for series-landing pages. Extends 'photographyCtx' with a
+-- @series-photos@ list field that loads the directory's sibling
+-- photos (the @/.md@ files), most-recent-first.
+--
+-- The @is-series@ const flag lets the consuming template branch on
+-- whether to render single-photo chrome (figure + EXIF dl + body)
+-- or series chrome (intro + photo grid + body).
+seriesCtx :: Context String
+seriesCtx =
+ constField "is-series" "true"
+ <> listFieldWith "series-photos" photographyCtx loadSeriesChildren
+ <> photographyCtx
+ where
+ loadSeriesChildren parent = do
+ let ident = itemIdentifier parent
+ slug = takeFileName (takeDirectory (toFilePath ident))
+ pat = fromGlob ("content/photography/" ++ slug ++ "/*.md")
+ .&&. complement
+ (fromGlob ("content/photography/" ++ slug ++ "/index.md"))
+ .&&. hasNoVersion
+ recentFirst =<< loadAll pat
+
+-- | Route a photography entry to its public URL. The pattern check on
+-- @takeFileName@ distinguishes flat (@content/photography/.md@)
+-- from directory-form (@content/photography//index.md@) without
+-- re-globbing, since Hakyll has already pre-filtered to entries
+-- matching 'P.photographyPattern'.
+photoEntryRoute :: Routes
+photoEntryRoute = customRoute $ \ident ->
+ let fp = toFilePath ident
+ fname = takeFileName fp
+ isIndex = fname == "index.md"
+ in if isIndex
+ -- content/photography//index.md
+ -- → photography//index.html
+ then replaceExtension (drop (length contentPrefix) fp) "html"
+ -- content/photography/.md → photography/.html
+ else "photography/" ++ replaceExtension fname "html"
+ where
+ contentPrefix :: String
+ contentPrefix = "content/"
+
+-- ---------------------------------------------------------------------------
+-- Landing page
+-- ---------------------------------------------------------------------------
+
+-- | Section landing at @/photography/@. Loads all photo entries
+-- resolved against 'photographyCtx' so each card has access to
+-- slug / photo-url / captured-display / palette swatches.
+photographyLandingRules :: Rules ()
+photographyLandingRules =
+ match "content/photography/index.md" $ do
+ route $ constRoute "photography/index.html"
+ compile $ do
+ photos <- recentFirst
+ =<< loadAll (P.photographyPattern .&&. hasNoVersion)
+ let ctx =
+ listField "photos" photographyCtx (return photos)
+ <> constField "photography" "true"
+ <> constField "list-page" "true"
+ <> pageCtx
+ pageCompiler
+ >>= loadAndApplyTemplate "templates/photography-index.html" ctx
+ >>= loadAndApplyTemplate "templates/default.html" ctx
+ >>= relativizeUrls
+
+-- ---------------------------------------------------------------------------
+-- Map data
+-- ---------------------------------------------------------------------------
+--
+-- Two artifacts together:
+--
+-- * @/photography/map.json@ — JSON array of pin objects, fetched
+-- by @static/js/photography-map.js@ at view time. Built directly
+-- from frontmatter; no Python dependency.
+-- * @/photography/map/@ — the page that renders the Leaflet
+-- viewport. Lightweight HTML; the heavy lifting lives in the JS.
+--
+-- Privacy: every coordinate is rounded to the precision the author
+-- declares in @geo-precision:@ (default @"city"@) BEFORE it leaves
+-- this build step. Full-precision coords never reach @map.json@.
+-- @geo-precision: hidden@ omits the entry entirely.
+
+-- | Strip a trailing @"index.html"@ component so a Hakyll route
+-- like @"photography/foo/index.html"@ becomes @"photography/foo/"@.
+-- Used for map.json click-through URLs.
+stripIndexHtml :: String -> String
+stripIndexHtml r
+ | suffixMatches = take (length r - 10) r -- 10 = length "index.html"
+ | otherwise = r
+ where
+ suffix = "/index.html" :: String
+ suffixMatches = suffix == drop (length r - length suffix) r
+
+-- | Round a decimal coordinate to the precision that matches the
+-- author's @geo-precision:@ declaration.
+--
+-- * @exact@: 4 decimal places (~10 m)
+-- * @km@ : 2 decimal places (~1 km)
+-- * @city@ : 1 decimal place (~10 km) — default
+-- * other : treated as @city@
+--
+-- @hidden@ is handled at the call site by skipping the pin entirely.
+roundCoord :: String -> Double -> Double
+roundCoord prec x =
+ let n = case prec of
+ "exact" -> 4
+ "km" -> 2
+ "city" -> 1
+ _ -> 1
+ scale = 10 ^^ (n :: Int) :: Double
+ in fromIntegral (round (x * scale) :: Integer) / scale
+
+-- | Extract @[lat, lon]@ from a frontmatter @geo:@ list. Accepts only
+-- exactly two numeric entries — anything else returns 'Nothing' so
+-- the entry is silently skipped on the map.
+parseGeo :: Aeson.Object -> Maybe (Double, Double)
+parseGeo meta = case KM.lookup "geo" meta of
+ Just (Array vec) | V.length vec == 2 ->
+ case (asDouble (vec V.! 0), asDouble (vec V.! 1)) of
+ (Just lat, Just lon) -> Just (lat, lon)
+ _ -> Nothing
+ _ -> Nothing
+ where
+ asDouble (Number n) = Just (Sci.toRealFloat n)
+ asDouble _ = Nothing
+
+-- | Build a single pin object from a photo entry. Returns 'Nothing'
+-- when:
+-- * the entry has no @geo:@ frontmatter, or
+-- * it has @geo-precision: hidden@, or
+-- * the entry has no resolvable route.
+buildPin :: Item String -> Compiler (Maybe Value)
+buildPin item = do
+ let ident = itemIdentifier item
+ meta <- getMetadata ident
+ mRoute <- getRoute ident
+ case (parseGeo meta, lookupString "geo-precision" meta, mRoute) of
+ (_, Just "hidden", _) -> return Nothing
+ (Just (lat, lon), prec, Just r) ->
+ let prec' = fromMaybe "city" prec
+ rLat = roundCoord prec' lat
+ rLon = roundCoord prec' lon
+ fp = toFilePath ident
+ slug = takeFileName (takeDirectory fp)
+ title = fromMaybe slug (lookupString "title" meta)
+ photo = lookupString "photo" meta
+ url = "/" ++ stripIndexHtml r
+ thumb = case photo of
+ Just p | not (null p) ->
+ "/photography/" ++ slug ++ "/" ++ p
+ _ -> ""
+ captured = lookupString "captured" meta
+ in return $ Just $ Aeson.object $
+ [ "slug" .= slug
+ , "title" .= title
+ , "url" .= url
+ , "lat" .= rLat
+ , "lon" .= rLon
+ ] ++ (if null thumb then [] else ["thumb" .= thumb])
+ ++ maybe [] (\c -> ["captured" .= c]) captured
+ _ -> return Nothing
+
+-- | @/photography/map.json@ — JSON array of geo-tagged photo pins
+-- for the Leaflet client.
+photographyMapDataRule :: Rules ()
+photographyMapDataRule =
+ create ["photography/map.json"] $ do
+ route idRoute
+ compile $ do
+ photos <- loadAll (P.allPhotoEntries .&&. hasNoVersion)
+ :: Compiler [Item String]
+ pins <- mapMaybe id <$> mapM buildPin photos
+ -- Decode through Text so non-ASCII (em-dashes, accents) are
+ -- preserved correctly in titles instead of being mojibake'd.
+ makeItem $ TL.unpack $ TLE.decodeUtf8 $ Aeson.encode pins
+
+-- ---------------------------------------------------------------------------
+-- Map page
+-- ---------------------------------------------------------------------------
+
+-- | @/photography/map/@ — the Leaflet-driven map view. Synthesised
+-- page; no Markdown source. The @photography-map@ context flag
+-- gates Leaflet CSS / JS loading in @head.html@ and @default.html@,
+-- so other photography pages stay lightweight.
+photographyMapPageRule :: Rules ()
+photographyMapPageRule =
+ create ["photography/map/index.html"] $ do
+ route idRoute
+ compile $ do
+ let ctx = constField "title" "Map · Photography"
+ <> constField "photography" "true"
+ <> constField "photography-map" "true"
+ <> siteCtx
+ makeItem ""
+ >>= loadAndApplyTemplate "templates/photography-map.html" ctx
+ >>= loadAndApplyTemplate "templates/default.html" ctx
+ >>= relativizeUrls
+
+-- ---------------------------------------------------------------------------
+-- Atom feed
+-- ---------------------------------------------------------------------------
+
+-- | Configuration for the photography-only Atom feed. Distinct from
+-- the main feed so text-primary subscribers don't unexpectedly get
+-- image-heavy entries in their reader.
+photographyFeedConfig :: FeedConfiguration
+photographyFeedConfig = FeedConfiguration
+ { feedTitle = T.unpack (Config.siteName Config.siteConfig) ++ " — Photography"
+ , feedDescription = "New photographs"
+ , feedAuthorName = T.unpack (Config.authorName Config.siteConfig)
+ , feedAuthorEmail = T.unpack (Config.authorEmail Config.siteConfig)
+ , feedRoot = T.unpack (Config.siteUrl Config.siteConfig)
+ }
+
+-- | Description field for Atom feed entries: prepends an absolute-URL
+-- @@ tag (so the photograph displays inline in the reader) to
+-- the rendered prose body. Composed ABOVE 'bodyField' so it wins
+-- when @$description$@ is consumed by the Atom template.
+photographyFeedDescription :: Context String
+photographyFeedDescription = field "description" $ \item -> do
+ let ident = itemIdentifier item
+ body <- itemBody <$> (loadSnapshot ident "content" :: Compiler (Item String))
+ meta <- getMetadata ident
+ let fp = toFilePath ident
+ isDir = takeFileName fp == "index.md"
+ slug = takeFileName (takeDirectory fp)
+ photo = lookupString "photo" meta
+ siteUrlStr = T.unpack (Config.siteUrl Config.siteConfig)
+ imgTag = case (isDir, photo) of
+ (True, Just p) | not (null p) ->
+ "
+ Pin coordinates are rounded to the precision each photograph's
+ geo-precision field declares — typically the
+ nearest ten kilometres. Photos with no geo:
+ frontmatter (or with geo-precision: hidden) are
+ omitted from this map by design.
+
+
+
diff --git a/templates/photography-series.html b/templates/photography-series.html
new file mode 100644
index 0000000..446a867
--- /dev/null
+++ b/templates/photography-series.html
@@ -0,0 +1,37 @@
+