diff --git a/build/Contexts.hs b/build/Contexts.hs index 4b0d5ce..e84108f 100644 --- a/build/Contexts.hs +++ b/build/Contexts.hs @@ -176,10 +176,17 @@ pageScriptsField = listFieldWith "page-scripts" ctx $ \item -> do -- | List context field exposing an item's own (non-expanded) tags as -- @tag-name@ / @tag-url@ objects. -- +-- Fails with 'noResult' when the item has no tags — same discipline +-- as the @Excluding@ variants below — so @$if(...)$@ gates are false +-- and templates don't emit empty tag-wrapper markup. +-- -- $for(essay-tags)$$tag-name$$endfor$ tagLinksField :: String -> Context a -tagLinksField fieldName = listFieldWith fieldName ctx $ \item -> - map toItem <$> getTags (itemIdentifier item) +tagLinksField fieldName = listFieldWith fieldName ctx $ \item -> do + ts <- getTags (itemIdentifier item) + if null ts + then noResult "no tags" + else return (map toItem ts) where toItem t = Item (fromFilePath (t ++ "/index.html")) t ctx = field "tag-name" (return . itemBody) @@ -351,7 +358,7 @@ abstractField :: Context String abstractField = field "abstract" $ \item -> do meta <- getMetadata (itemIdentifier item) case lookupString "abstract" meta of - Nothing -> fail "no abstract" + Nothing -> noResult "no abstract" Just src -> do let pandocResult = runPure $ do doc <- readMarkdown defaultHakyllReaderOptions (T.pack src) @@ -385,7 +392,7 @@ descriptionField :: Context String descriptionField = field "description" $ \item -> do meta <- getMetadata (itemIdentifier item) case lookupString "abstract" meta of - Nothing -> fail "no abstract" + Nothing -> noResult "no abstract" Just src -> do let pandocResult = runPure $ do doc <- readMarkdown defaultHakyllReaderOptions (T.pack src) @@ -422,7 +429,7 @@ summaryField :: Context String summaryField = field "summary" $ \item -> do meta <- getMetadata (itemIdentifier item) case lookupString "summary" meta of - Nothing -> fail "no summary" + Nothing -> noResult "no summary" Just src -> do let pandocResult = runPure $ do doc <- readMarkdown defaultHakyllReaderOptions (T.pack src) @@ -468,11 +475,11 @@ 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 + if null bib then noResult "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" + if null bib then noResult "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. @@ -480,22 +487,26 @@ 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 + if null fr then noResult "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. +-- Returns @noResult@ when the key is absent, unparseable, or below 1 +-- (a zero would otherwise render five empty circles); values above 5 +-- clamp to 5. 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') + Nothing -> noResult (ctxKey ++ ": not set") + Just (n :: Int) + | n < 1 -> noResult (ctxKey ++ ": value below the 1-5 scale") + | otherwise -> + let v = 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 @@ -519,11 +530,11 @@ confidenceTrendField = field "confidence-trend" $ \item -> do "[Marks] " ++ toFilePath (itemIdentifier item) ++ ": confidence: proved is incompatible with confidence-history; ignoring history" Nothing -> return () - fail "confidence is proved; trend suppressed" + noResult "confidence is proved; trend suppressed" else case lookupStringList "confidence-history" meta of - Nothing -> fail "no confidence history" + Nothing -> noResult "no confidence history" Just xs -> case lastTwo xs of - Nothing -> fail "no confidence history" + Nothing -> noResult "no confidence history" Just (prevS, curS) -> let prev = readMaybe prevS :: Maybe Int cur = readMaybe curS :: Maybe Int @@ -589,7 +600,7 @@ overallScoreField = field "overall-score" $ \item -> do + 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" + _ -> noResult "overall-score: confidence or evidence not set" -- | @$confidence$@: numeric override that suppresses the @proved@ / -- @proven@ sentinel. When the frontmatter value is parseable as an @@ -1002,7 +1013,7 @@ compositionCtx = 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" + if null pages then noResult "no score pages" else return "true" scorePageCountField = field "score-page-count" $ \item -> do meta <- getMetadata (itemIdentifier item) @@ -1020,7 +1031,7 @@ compositionCtx = hasMovementsField = field "has-movements" $ \item -> do meta <- getMetadata (itemIdentifier item) - if null (parseMovements meta) then fail "no movements" else return "true" + if null (parseMovements meta) then noResult "no movements" else return "true" movementsListField = listFieldWith "movements" movCtx $ \item -> do meta <- getMetadata (itemIdentifier item) @@ -1038,9 +1049,9 @@ compositionCtx = <> 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))) + (\i -> maybe (noResult "no audio") return (movAudio (itemBody i))) <> field "has-audio" - (\i -> maybe (fail "no audio") (const (return "true")) + (\i -> maybe (noResult "no audio") (const (return "true")) (movAudio (itemBody i))) -- --------------------------------------------------------------------------- diff --git a/build/Pagination.hs b/build/Pagination.hs index c949e74..8febe20 100644 --- a/build/Pagination.hs +++ b/build/Pagination.hs @@ -12,6 +12,7 @@ module Pagination ) where import Hakyll +import Patterns (blogPattern) -- | Items per page across most paginated lists (e.g. the blog). @@ -39,7 +40,7 @@ blogPageId n = fromFilePath $ "blog/page/" ++ show n ++ "/index.html" -- @baseCtx@: site-level context (siteCtx). blogPaginateRules :: Context String -> Context String -> Rules () blogPaginateRules itemCtx baseCtx = do - paginate <- buildPaginateWith sortAndGroup ("content/blog/*.md" .&&. hasNoVersion) blogPageId + paginate <- buildPaginateWith sortAndGroup (blogPattern .&&. hasNoVersion) blogPageId paginateRules paginate $ \pageNum pat -> do route idRoute compile $ do diff --git a/build/Patterns.hs b/build/Patterns.hs index a496b72..d6138c8 100644 --- a/build/Patterns.hs +++ b/build/Patterns.hs @@ -122,7 +122,14 @@ allWritings :: Pattern allWritings = essayPattern .||. blogPattern .||. poetryPattern .||. fictionPattern -- | Every content file the backlinks pass should index. Includes music --- landing pages and top-level standalone pages, in addition to writings. +-- landing pages and top-level standalone pages, in addition to writings, +-- plus the two directory-form standalone essays (@content/me/index.md@ +-- and @content/memento-mori/index.md@) — full essays rendered with +-- backlinks, whose outgoing links must be visible to the link graph. +-- +-- Photography is deliberately excluded: photo pages do not render the +-- backlinks block (see 'Contexts.photographyCtx'), and caption-scale +-- entries would add link-graph noise with no consuming surface. allContent :: Pattern allContent = essayPattern @@ -131,6 +138,8 @@ allContent = .||. fictionPattern .||. musicPattern .||. standalonePagesPattern + .||. "content/me/index.md" + .||. "content/memento-mori/index.md" -- | Content shown on author index pages — essays + blog posts. -- (Poetry and fiction have their own dedicated indexes and are not diff --git a/build/Site.hs b/build/Site.hs index 8316a0d..def3d9e 100644 --- a/build/Site.hs +++ b/build/Site.hs @@ -40,7 +40,7 @@ import Pagination (blogPaginateRules) import Stats (statsRules) -- | Home-page portal grid order. Canonical ordering authority for every --- rendering of the eight portals (currently: the home page; future +-- rendering of the portals (currently: the home page; future -- consumers follow this list). Each entry is (display name, tag name); -- the tag name is the key to everything else — URL (@/\/@), -- sidecar path (@content\/tag-meta\/\.md@), and the Tags.hs @@ -73,13 +73,17 @@ libraryShelfMax = 5 libraryIntroId :: Identifier libraryIntroId = fromFilePath "content/library.md" --- Poems inside collection subdirectories, excluding their index pages. -collectionPoems :: Pattern -collectionPoems = "content/poetry/*/*.md" .&&. complement "content/poetry/*/index.md" - --- All poetry content (flat + collection), excluding collection index pages. -allPoetry :: Pattern -allPoetry = "content/poetry/*.md" .||. collectionPoems +-- | Route that strips a literal prefix from the identifier's path. +-- Hakyll's 'gsubRoute' replaces /every/ occurrence of its pattern, so +-- @gsubRoute "content/"@ would also mangle a co-located directory that +-- happened to be named @content@ deeper in the path +-- (@content/essays/slug/content/data.csv@ → @essays/slug/data.csv@). +-- This touches only the leading occurrence; identifiers that don't +-- start with the prefix pass through unchanged. +stripPrefixRoute :: String -> Routes +stripPrefixRoute prefix = customRoute $ \ident -> + let fp = toFilePath ident + in fromMaybe fp (stripPrefix prefix fp) feedConfig :: FeedConfiguration feedConfig = FeedConfiguration @@ -168,18 +172,18 @@ rules = do -- Per-page JS files — authored alongside content in content/**/*.js. -- Draft JS is handled by a separate dev-only rule below. match ("content/**/*.js" .&&. complement "content/drafts/**") $ do - route $ gsubRoute "content/" (const "") + route $ stripPrefixRoute "content/" compile copyFileCompiler -- Per-page JS co-located with draft essays (dev-only). when isDev $ match "content/drafts/**/*.js" $ do - route $ gsubRoute "content/" (const "") + route $ stripPrefixRoute "content/" compile copyFileCompiler -- CSS — must be matched before the broad static/** rule to avoid -- double-matching (compressCssCompiler vs. copyFileCompiler). match "static/css/*" $ do - route $ gsubRoute "static/" (const "") + route $ stripPrefixRoute "static/" compile compressCssCompiler -- All other static files (fonts, JS, images, …). Build-time @@ -192,7 +196,7 @@ rules = do .&&. complement "static/**/*.exif.yaml" .&&. complement "static/**/*.palette.yaml" ) $ do - route $ gsubRoute "static/" (const "") + route $ stripPrefixRoute "static/" compile copyFileCompiler -- Templates @@ -299,7 +303,7 @@ rules = do -- SVG score fragments co-located with me/index.md. match "content/me/scores/*.svg" $ do - route $ gsubRoute "content/me/" (const "") + route $ stripPrefixRoute "content/me/" compile copyFileCompiler -- memento-mori/index.md — lives in its own directory so co-located SVG @@ -315,7 +319,7 @@ rules = do -- SVG score fragments co-located with memento-mori/index.md. match "content/memento-mori/scores/*.svg" $ do - route $ gsubRoute "content/memento-mori/" (const "") + route $ stripPrefixRoute "content/memento-mori/" compile copyFileCompiler -- --------------------------------------------------------------------------- @@ -354,7 +358,7 @@ rules = do .&&. complement "content/colophon.md" .&&. complement "content/current.md" .&&. complement "content/library.md") $ do - route $ gsubRoute "content/" (const "") + route $ stripPrefixRoute "content/" `composeRoutes` setExtension "html" compile $ pageCompiler >>= loadAndApplyTemplate "templates/page.html" pageCtx @@ -414,7 +418,7 @@ rules = do .&&. complement "content/essays/*.md" .&&. complement "content/essays/*/index.md" .&&. complement "content/essays/**/*.dims.yaml") $ do - route $ gsubRoute "content/" (const "") + route $ stripPrefixRoute "content/" compile copyFileCompiler -- Static assets co-located with draft essays (dev-only). @@ -422,14 +426,14 @@ rules = do .&&. complement "content/drafts/essays/*.md" .&&. complement "content/drafts/essays/*/index.md" .&&. complement "content/drafts/essays/**/*.dims.yaml") $ do - route $ gsubRoute "content/" (const "") + route $ stripPrefixRoute "content/" compile copyFileCompiler -- --------------------------------------------------------------------------- -- Blog posts -- --------------------------------------------------------------------------- match "content/blog/*.md" $ do - route $ gsubRoute "content/blog/" (const "blog/") + route $ stripPrefixRoute "content/" `composeRoutes` setExtension "html" compile $ postCompiler >>= saveSnapshot "content" @@ -440,19 +444,12 @@ rules = do -- --------------------------------------------------------------------------- -- Poetry -- --------------------------------------------------------------------------- - -- Flat poems (e.g. content/poetry/sonnet-60.md) - match "content/poetry/*.md" $ do - route $ gsubRoute "content/poetry/" (const "poetry/") - `composeRoutes` setExtension "html" - compile $ poetryCompiler - >>= saveSnapshot "content" - >>= loadAndApplyTemplate "templates/reading.html" poetryCtx - >>= loadAndApplyTemplate "templates/default.html" poetryCtx - >>= relativizeUrls - - -- Collection poems (e.g. content/poetry/shakespeare-sonnets/sonnet-1.md) - match collectionPoems $ do - route $ gsubRoute "content/poetry/" (const "poetry/") + -- All poems — flat (content/poetry/sonnet-60.md) and collection + -- (content/poetry/shakespeare-sonnets/sonnet-1.md) forms share one + -- rule; collection index pages are excluded by 'P.poetryPattern' + -- itself and matched separately below. + match P.poetryPattern $ do + route $ stripPrefixRoute "content/" `composeRoutes` setExtension "html" compile $ poetryCompiler >>= saveSnapshot "content" @@ -462,7 +459,7 @@ rules = do -- Collection index pages (e.g. content/poetry/shakespeare-sonnets/index.md) match "content/poetry/*/index.md" $ do - route $ gsubRoute "content/poetry/" (const "poetry/") + route $ stripPrefixRoute "content/" `composeRoutes` setExtension "html" compile $ pageCompiler >>= loadAndApplyTemplate "templates/default.html" pageCtx @@ -472,7 +469,7 @@ rules = do -- Fiction -- --------------------------------------------------------------------------- match "content/fiction/*.md" $ do - route $ gsubRoute "content/fiction/" (const "fiction/") + route $ stripPrefixRoute "content/" `composeRoutes` setExtension "html" compile $ fictionCompiler >>= saveSnapshot "content" @@ -496,20 +493,20 @@ rules = do -- Static assets (SVG score pages, audio, PDF) served unchanged. match "content/music/**/*.svg" $ do - route $ gsubRoute "content/" (const "") + route $ stripPrefixRoute "content/" compile copyFileCompiler match "content/music/**/*.mp3" $ do - route $ gsubRoute "content/" (const "") + route $ stripPrefixRoute "content/" compile copyFileCompiler match "content/music/**/*.pdf" $ do - route $ gsubRoute "content/" (const "") + route $ stripPrefixRoute "content/" compile copyFileCompiler -- Landing page — full essay pipeline. match "content/music/*/index.md" $ do - route $ gsubRoute "content/" (const "") + route $ stripPrefixRoute "content/" `composeRoutes` setExtension "html" compile $ compositionCompiler >>= saveSnapshot "content" @@ -613,10 +610,10 @@ rules = do route idRoute compile $ do let allContent = ( allEssays - .||. "content/blog/*.md" - .||. "content/fiction/*.md" - .||. allPoetry - .||. "content/music/*/index.md" + .||. P.blogPattern + .||. P.fictionPattern + .||. P.poetryPattern + .||. P.musicPattern ) .&&. hasNoVersion items <- recentFirstByDisplay =<< loadAll allContent let itemCtx = contentKindField @@ -641,7 +638,7 @@ rules = do -- Library — portal-grouped view over the /new.html dataset, deduplicated -- by primary portal. An item's primary portal is the top segment of the -- first tag in its frontmatter 'tags:' list whose top segment matches a - -- known portal (the eight in 'homePortals'). Items with no such tag are + -- known portal (those in 'homePortals'). Items with no such tag are -- silently dropped from the library (they remain on /new.html and on any -- tag pages their frontmatter produces). -- @@ -669,9 +666,11 @@ rules = do -- Top segment of the first tag that names a known portal. -- Nothing when no tag matches — item is excluded from library. + -- Reads tags via 'getTags' (not lookupStringList) so the + -- scalar comma form ("tags: research, ai") is accepted with + -- the same semantics the tag pages use. primaryPortalOf item = do - meta <- getMetadata (itemIdentifier item) - let ts = fromMaybe [] (lookupStringList "tags" meta) + ts <- getTags (itemIdentifier item) return $ listToMaybe [ p | t <- ts , let p = takeWhile (/= '/') t @@ -694,13 +693,13 @@ rules = do -- Load every content item once, then partition by primary portal -- so each shelf draws from a pre-filtered list rather than - -- re-scanning the whole corpus nine times. - essays <- loadAll (allEssays .&&. hasNoVersion) - posts <- loadAll ("content/blog/*.md" .&&. hasNoVersion) - fiction <- loadAll ("content/fiction/*.md" .&&. hasNoVersion) - poetry <- loadAll (allPoetry .&&. hasNoVersion) - music <- loadAll ("content/music/*/index.md" .&&. hasNoVersion) - photos <- loadAll (P.photographyPattern .&&. hasNoVersion) + -- re-scanning the whole corpus once per portal. + essays <- loadAll (allEssays .&&. hasNoVersion) + posts <- loadAll (P.blogPattern .&&. hasNoVersion) + fiction <- loadAll (P.fictionPattern .&&. hasNoVersion) + poetry <- loadAll (P.poetryPattern .&&. hasNoVersion) + music <- loadAll (P.musicPattern .&&. hasNoVersion) + photos <- loadAll (P.photographyPattern .&&. hasNoVersion) let allContent = essays ++ posts ++ fiction ++ poetry ++ music ++ photos :: [Item String] tagged <- mapM (\i -> (,i) <$> primaryPortalOf i) allContent @@ -708,21 +707,30 @@ rules = do itemsByPortal = Map.fromListWith (++) [(p, [i]) | (Just p, i) <- tagged] - -- Eager snapshot load registers the library-intro dependency - -- unconditionally, so a first-populate of content/library.md - -- re-renders the library page even when the gate was previously - -- false (see 'sidecarContext' in Tags.hs for the same pattern). - _ <- loadSnapshot libraryIntroId "body" :: Compiler (Item String) - let libraryIntroFld = field "library-intro" $ \_ -> do - html <- itemBody <$> loadSnapshot libraryIntroId "body" - if all isSpace html - then noResult "empty library intro" - else return html + -- Existence-guarded, like the sidecar contexts in Tags.hs: + -- deleting content/library.md degrades to a library page with + -- no intro block rather than failing the whole compile. When + -- the file exists, the eager snapshot load registers the + -- library-intro dependency unconditionally, so a first-populate + -- of content/library.md re-renders the library page even when + -- the gate was previously false (see 'sidecarContext' in + -- Tags.hs for the same pattern). + introIds <- getMatches "content/library.md" + libraryIntroFld <- + if libraryIntroId `elem` introIds + then do + _ <- loadSnapshot libraryIntroId "body" :: Compiler (Item String) + return $ field "library-intro" $ \_ -> do + html <- itemBody <$> loadSnapshot libraryIntroId "body" + if all isSpace html + then noResult "empty library intro" + else return html + else return mempty - -- One shelf's context contribution: the @-entries@ - -- listField (or absent via noResult when the shelf is - -- empty) plus an optional @-has-more@ gate. - portalSection p = do + -- One shelf's context contribution: the @-entries@ + -- listField (or absent via noResult when the shelf is + -- empty) plus an optional @-has-more@ gate. + let portalSection p = do let portalItems = fromMaybe [] (Map.lookup p itemsByPortal) sorted <- recentFirstByDisplay portalItems @@ -803,10 +811,10 @@ rules = do bibKwMap = invertKeywordsBib bibExtrasAll writingIds <- getMatches $ (P.essayPattern - .||. "content/blog/*.md" - .||. "content/fiction/*.md" + .||. P.blogPattern + .||. P.fictionPattern .||. P.poetryPattern - .||. "content/music/*/index.md") + .||. P.musicPattern) .&&. hasNoVersion writingKwPairs <- forM writingIds $ \ident -> do @@ -903,15 +911,17 @@ rules = do >>= relativizeUrls -- --------------------------------------------------------------------------- - -- Random page manifest — essays + blog posts only (no pagination/index pages) + -- Random page manifest — essays, blog posts, fiction, and poetry (flat + -- and collection poems alike). No pagination/index pages; music and + -- photography landings are also excluded. -- --------------------------------------------------------------------------- create ["random-pages.json"] $ do route idRoute compile $ do - essays <- loadAll (allEssays .&&. hasNoVersion) :: Compiler [Item String] - posts <- loadAll ("content/blog/*.md" .&&. hasNoVersion) :: Compiler [Item String] - fiction <- loadAll ("content/fiction/*.md" .&&. hasNoVersion) :: Compiler [Item String] - poetry <- loadAll ("content/poetry/*.md" .&&. hasNoVersion) :: Compiler [Item String] + essays <- loadAll (allEssays .&&. hasNoVersion) :: Compiler [Item String] + posts <- loadAll (P.blogPattern .&&. hasNoVersion) :: Compiler [Item String] + fiction <- loadAll (P.fictionPattern .&&. hasNoVersion) :: Compiler [Item String] + poetry <- loadAll (P.poetryPattern .&&. hasNoVersion) :: Compiler [Item String] routes <- mapM (getRoute . itemIdentifier) (essays ++ posts ++ fiction ++ poetry) let urls = [ "/" ++ r | Just r <- routes ] makeItem $ LBS.unpack (Aeson.encode urls) @@ -924,11 +934,11 @@ rules = do create ["data/epistemic-meta.json"] $ do route idRoute compile $ do - essays <- loadAll (allEssays .&&. hasNoVersion) :: Compiler [Item String] - posts <- loadAll ("content/blog/*.md" .&&. hasNoVersion) :: Compiler [Item String] - fiction <- loadAll ("content/fiction/*.md" .&&. hasNoVersion) :: Compiler [Item String] - poetry <- loadAll (allPoetry .&&. hasNoVersion) :: Compiler [Item String] - music <- loadAll ("content/music/*/index.md" .&&. hasNoVersion) :: Compiler [Item String] + essays <- loadAll (allEssays .&&. hasNoVersion) :: Compiler [Item String] + posts <- loadAll (P.blogPattern .&&. hasNoVersion) :: Compiler [Item String] + fiction <- loadAll (P.fictionPattern .&&. hasNoVersion) :: Compiler [Item String] + poetry <- loadAll (P.poetryPattern .&&. hasNoVersion) :: Compiler [Item String] + music <- loadAll (P.musicPattern .&&. hasNoVersion) :: Compiler [Item String] let items = essays ++ posts ++ fiction ++ poetry ++ music pairs <- mapM epistemicEntry items let metaMap = Map.fromList (catMaybes pairs) @@ -943,10 +953,10 @@ rules = do posts <- fmap (take 30) . recentFirst =<< loadAllSnapshots ( ( allEssays - .||. "content/blog/*.md" - .||. "content/fiction/*.md" - .||. allPoetry - .||. "content/music/*/index.md" + .||. P.blogPattern + .||. P.fictionPattern + .||. P.poetryPattern + .||. P.musicPattern ) .&&. hasNoVersion ) @@ -966,7 +976,7 @@ rules = do compile $ do compositions <- recentFirst =<< loadAllSnapshots - ("content/music/*/index.md" .&&. hasNoVersion) + (P.musicPattern .&&. hasNoVersion) "content" let feedCtx = dateField "updated" "%Y-%m-%dT%H:%M:%SZ" @@ -1006,10 +1016,10 @@ rules = do entries <- recentFirst =<< loadAllSnapshots ( ( allEssays - .||. "content/blog/*.md" - .||. "content/fiction/*.md" - .||. allPoetry - .||. "content/music/*/index.md" + .||. P.blogPattern + .||. P.fictionPattern + .||. P.poetryPattern + .||. P.musicPattern ) .&&. hasNoVersion ) diff --git a/build/Tags.hs b/build/Tags.hs index 7d97baa..a1c995c 100644 --- a/build/Tags.hs +++ b/build/Tags.hs @@ -30,16 +30,18 @@ module Tags ) where import Data.Char (isSpace) -import Data.List (intercalate, isPrefixOf, nub, sort) +import Data.List (intercalate, isPrefixOf, nub, sort, sortBy) import Data.Maybe (fromMaybe, isNothing, maybeToList) +import Data.Ord (comparing) import Data.Set (Set) import qualified Data.Set as Set +import Data.Time.Clock (UTCTime) +import Data.Time.Format (defaultTimeLocale, parseTimeM) import Hakyll -import Pagination (sortAndGroupAt) import Patterns (tagIndexable) -import Contexts (abstractField, contentKindField, - recentFirstByDisplay, revisionDateFields, - tagLinksFieldExcludingScope) +import Contexts (Revision (..), abstractField, contentKindField, + getRevisions, recentFirstByDisplay, revisionDateFields, + siteCtx, tagLinksFieldExcludingScope) -- --------------------------------------------------------------------------- @@ -293,6 +295,10 @@ sidecarContext sidecarSet tag -- Provides the fields consumed by @templates/partials/item-card.html@ -- (@$item-kind$@, @$date-iso$@, @$date-created$@, @$abstract$@, -- @$item-tags$@) with tag-ribbon suppression scoped to the current tag. +-- +-- Composes 'siteCtx' (not bare 'defaultContext') so per-item fields +-- the card partial gates on — notably @$has-monogram$@ — fire here +-- the same way they do on /new.html and the library. tagItemCtx :: String -> Context String tagItemCtx scope = contentKindField @@ -301,7 +307,7 @@ tagItemCtx scope = <> revisionDateFields <> tagLinksFieldExcludingScope "item-tags" scope <> abstractField - <> defaultContext + <> siteCtx -- | Page identifier for a tag index page. -- Page 1 → /index.html @@ -359,9 +365,39 @@ clientPaginatedRule tag pat sidecarSet saCtx baseCtx = do >>= loadAndApplyTemplate "templates/default.html" ctx >>= relativizeUrls +-- | Display date of an identifier: the most-recent @revised:@ entry's +-- date when present and parseable, else the creation date. Mirrors +-- the (unexported) @itemDisplayUTC@ behind 'Contexts.recentFirstByDisplay', +-- but needs only 'MonadMetadata' — the paginate grouper runs in +-- 'Rules' over bare 'Identifier's, where no 'Item's exist yet. +identifierDisplayUTC :: (MonadMetadata m, MonadFail m) + => Identifier -> m UTCTime +identifierDisplayUTC ident = do + meta <- getMetadata ident + case getRevisions meta of + (r:_) | Just utc <- (parseTimeM True defaultTimeLocale "%Y-%m-%d" + (revisionDateISO r) :: Maybe UTCTime) + -> return utc + _ -> getItemUTC defaultTimeLocale ident + +-- | Partition identifiers into pages of @n@, most recent first by +-- /display/ date — the same revision-aware key +-- 'recentFirstByDisplay' sorts by within each rendered page — so +-- cross-page ordering is monotone. With creation-date partitioning +-- (plain @sortRecentFirst@), a recently revised old item stayed on a +-- late page but jumped to its top; now it migrates to the early page +-- where its displayed date says it belongs. +sortAndGroupByDisplayAt :: (MonadMetadata m, MonadFail m) + => Int -> [Identifier] -> m [[Identifier]] +sortAndGroupByDisplayAt n ids = do + keyed <- mapM (\i -> (,) <$> identifierDisplayUTC i <*> pure i) ids + return $ paginateEvery n $ map snd $ sortBy (flip (comparing fst)) keyed + -- | Server-side pagination at 'tagPageSize' per page. Previous/next -- navigation renders via @templates/partials/paginate-nav.html@; --- the count toggle operates within the current page only. +-- the count toggle operates within the current page only. Pages are +-- partitioned and sorted by the same display-date key (see +-- 'sortAndGroupByDisplayAt'). serverPaginatedRule :: String -> Pattern -> Set Identifier @@ -369,7 +405,7 @@ serverPaginatedRule :: String -> Context String -- ^ base (siteCtx) -> Rules () serverPaginatedRule tag pat sidecarSet saCtx baseCtx = do - paginate <- buildPaginateWith (sortAndGroupAt tagPageSize) pat (tagPageId tag) + paginate <- buildPaginateWith (sortAndGroupByDisplayAt tagPageSize) pat (tagPageId tag) paginateRules paginate $ \pageNum pat' -> do route idRoute compile $ do diff --git a/build/Utils.hs b/build/Utils.hs index bcf7162..4248bb8 100644 --- a/build/Utils.hs +++ b/build/Utils.hs @@ -27,9 +27,9 @@ wordCount :: String -> Int wordCount = length . words -- | Estimate reading time in minutes (assumes 200 words per minute). --- Minimum is 1 minute. +-- Rounds up — 399 words is 2 minutes, not 1. Minimum is 1 minute. readingTime :: String -> Int -readingTime s = max 1 (wordCount s `div` 200) +readingTime s = max 1 ((wordCount s + 199) `div` 200) -- | Escape HTML special characters: @&@, @<@, @>@, @\"@, @\'@. -- @@ -62,7 +62,11 @@ trim :: String -> String trim = dropWhileEnd isSpace . dropWhile isSpace -- | Lowercase a string, drop everything that isn't alphanumeric or --- space, then replace runs of spaces with single hyphens. +-- space, then replace each space with a hyphen. Note that a run of +-- spaces therefore becomes a run of hyphens (@"A B" → "a--b"@) — +-- deliberately left as-is, since every slug on the site is generated +-- by this one function and collapsing runs now would move existing +-- author URLs. -- -- Used for author URL slugs (e.g. @"Levi Neuwirth" → "levi-neuwirth"@). -- Centralised here so 'Authors' and 'Contexts' cannot drift on Unicode