Fix audit HIGHs/MEDs in build code

- ArchiveIndex: guard rawIndex/rawState with doesFileExist so a fresh
  clone (gitignored data/ JSONs absent) degrades to empty instead of
  crashing — the behavior the module doc already promised (AUDIT §1.2)
- Commonplace: decode YAML via encodeUtf8, not Char8.pack, which
  truncates codepoints above 0x7F (AUDIT §3.2)
- Stats: DayOfWeek is ISO-numbered (Mon=1..Sun=7); dowOf and weekStart
  assumed Mon=0..Sun=6, clipping every Sunday cell outside the heatmap
  viewBox and starting weeks on Sunday (AUDIT §3.1)
- Site: epistemicEntry now honors the proved/proven confidence sentinel
  like Contexts.overallScoreField (AUDIT §2.6)
- Contexts: affiliationField returns noResult instead of an empty list,
  so essays without affiliation no longer render an empty meta row
  (AUDIT §2.7)

Verified: full site build passes; proved page gets score=100 in
epistemic-meta.json; empty .meta-affiliation gone; heatmap rows
y=22..94 all inside the 104-high viewBox.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
Levi Neuwirth 2026-06-10 09:21:30 -04:00
parent 70ad44e9f4
commit 7ca937d98c
5 changed files with 40 additions and 15 deletions

View File

@ -132,6 +132,10 @@ activeUrls = unsafePerformIO $ do
{-# NOINLINE rawIndex #-} {-# NOINLINE rawIndex #-}
rawIndex :: Map Text IdxEntry rawIndex :: Map Text IdxEntry
rawIndex = unsafePerformIO $ do rawIndex = unsafePerformIO $ do
exists <- doesFileExist indexPath
if not exists
then return Map.empty
else do
decoded <- A.eitherDecodeFileStrict' indexPath decoded <- A.eitherDecodeFileStrict' indexPath
let parsed = either (const Map.empty) id decoded let parsed = either (const Map.empty) id decoded
return $ Map.filterWithKey return $ Map.filterWithKey
@ -142,6 +146,10 @@ rawIndex = unsafePerformIO $ do
{-# NOINLINE rawState #-} {-# NOINLINE rawState #-}
rawState :: Map Text ArchiveStatus rawState :: Map Text ArchiveStatus
rawState = unsafePerformIO $ do rawState = unsafePerformIO $ do
exists <- doesFileExist statePath
if not exists
then return Map.empty
else do
decoded <- A.eitherDecodeFileStrict' statePath decoded <- A.eitherDecodeFileStrict' statePath
return $ either (const Map.empty) (Map.map seStatus) decoded return $ either (const Map.empty) (Map.map seStatus) decoded

View File

@ -9,7 +9,8 @@ module Commonplace
import Data.Aeson (FromJSON (..), withObject, (.:), (.:?), (.!=)) import Data.Aeson (FromJSON (..), withObject, (.:), (.:?), (.!=))
import Data.List (nub, sortBy) import Data.List (nub, sortBy)
import Data.Ord (comparing, Down (..)) import Data.Ord (comparing, Down (..))
import qualified Data.ByteString.Char8 as BS import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Yaml as Y import qualified Data.Yaml as Y
import Hakyll hiding (escapeHtml, renderTags) import Hakyll hiding (escapeHtml, renderTags)
import Contexts (siteCtx) import Contexts (siteCtx)
@ -140,7 +141,10 @@ loadCommonplace :: Compiler [CPEntry]
loadCommonplace = do loadCommonplace = do
rawItem <- load (fromFilePath "data/commonplace.yaml") :: Compiler (Item String) rawItem <- load (fromFilePath "data/commonplace.yaml") :: Compiler (Item String)
let raw = itemBody rawItem let raw = itemBody rawItem
case Y.decodeEither' (BS.pack raw) of -- encodeUtf8, not Char8.pack: Char8 truncates each Char to 8 bits,
-- silently corrupting any codepoint above 0x7F (same hazard Now.hs
-- documents — em-dash 0x2014 would become control char 0x14).
case Y.decodeEither' (TE.encodeUtf8 (T.pack raw)) of
Left err -> fail ("commonplace.yaml: " ++ show err) Left err -> fail ("commonplace.yaml: " ++ show err)
Right entries -> return entries Right entries -> return entries

View File

@ -22,6 +22,7 @@ module Contexts
, recentFirstByDisplay , recentFirstByDisplay
, Revision (..) , Revision (..)
, getRevisions , getRevisions
, isProvedConfidence
) where ) where
import Data.Aeson (Value (..)) import Data.Aeson (Value (..))
@ -86,7 +87,12 @@ affiliationField = listFieldWith "affiliation-links" ctx $ \item -> do
let entries = case lookupStringList "affiliation" meta of let entries = case lookupStringList "affiliation" meta of
Just xs -> xs Just xs -> xs
Nothing -> maybe [] (:[]) (lookupString "affiliation" meta) Nothing -> maybe [] (:[]) (lookupString "affiliation" meta)
return $ map (Item (fromFilePath "") . parseEntry) entries -- noResult, not an empty list: Hakyll's $if$ treats an empty
-- ListField as truthy, so returning [] would render the wrapper
-- markup (an empty .meta-affiliation row) on every page.
if null entries
then noResult "no affiliation"
else return $ map (Item (fromFilePath "") . parseEntry) entries
where where
ctx = field "affiliation-name" (return . fst . itemBody) ctx = field "affiliation-name" (return . fst . itemBody)
<> field "affiliation-url" (\i -> let u = snd (itemBody i) <> field "affiliation-url" (\i -> let u = snd (itemBody i)

View File

@ -31,7 +31,7 @@ import Commonplace (commonplaceCtx)
import Now (nowCtx) import Now (nowCtx)
import Contexts (siteCtx, essayCtx, postCtx, pageCtx, poetryCtx, fictionCtx, compositionCtx, import Contexts (siteCtx, essayCtx, postCtx, pageCtx, poetryCtx, fictionCtx, compositionCtx,
contentKindField, recentFirstByDisplay, contentKindField, recentFirstByDisplay,
tagLinksFieldExcludingTopSegment) tagLinksFieldExcludingTopSegment, isProvedConfidence)
import qualified Patterns as P import qualified Patterns as P
import Photography (photographyRules) import Photography (photographyRules)
import Tags (buildAllTags, applyTagRules, sidecarIdentifier, import Tags (buildAllTags, applyTagRules, sidecarIdentifier,
@ -1011,8 +1011,12 @@ epistemicEntry item = do
, grab "stability" meta , grab "stability" meta
] ]
obj = Map.fromList fields obj = Map.fromList fields
-- Compute overall-score the same way Contexts.overallScoreField does. -- Compute overall-score the same way Contexts.overallScoreField
obj' = case ( readMaybe =<< lookupString "confidence" meta :: Maybe Int -- does, including the "proved"/"proven" sentinel -> 100.
confRaw = lookupString "confidence" meta
confInt | isProvedConfidence confRaw = Just 100
| otherwise = readMaybe =<< confRaw :: Maybe Int
obj' = case ( confInt
, readMaybe =<< lookupString "evidence" meta :: Maybe Int , readMaybe =<< lookupString "evidence" meta :: Maybe Int
) of ) of
(Just conf, Just ev) -> (Just conf, Just ev) ->

View File

@ -181,8 +181,11 @@ parseDay :: String -> Maybe Day
parseDay = parseTimeM True defaultTimeLocale "%Y-%m-%d" parseDay = parseTimeM True defaultTimeLocale "%Y-%m-%d"
-- | First Monday on or before 'day' (start of its ISO week). -- | First Monday on or before 'day' (start of its ISO week).
-- 'fromEnum' on 'DayOfWeek' is ISO-numbered (Monday=1 .. Sunday=7),
-- so Monday must subtract 0 days, Sunday 6.
weekStart :: Day -> Day weekStart :: Day -> Day
weekStart day = addDays (fromIntegral (negate (fromEnum (dayOfWeek day)))) day weekStart day =
addDays (fromIntegral (negate (fromEnum (dayOfWeek day) - 1))) day
-- | Intensity class for the heatmap (hm0 … hm4). -- | Intensity class for the heatmap (hm0 … hm4).
heatClass :: Int -> String heatClass :: Int -> String
@ -297,7 +300,7 @@ renderHeatmap wordsByDay today =
nDays = diffDays today startDay + 1 nDays = diffDays today startDay + 1
allDays = [addDays i startDay | i <- [0 .. nDays - 1]] allDays = [addDays i startDay | i <- [0 .. nDays - 1]]
weekOf d = fromIntegral (diffDays d startDay `div` 7) :: Int weekOf d = fromIntegral (diffDays d startDay `div` 7) :: Int
dowOf d = fromEnum (dayOfWeek d) -- Mon=0..Sun=6 dowOf d = fromEnum (dayOfWeek d) - 1 -- ISO 1..7 -> Mon=0..Sun=6
svgW = (nWeeks - 1) * step + cellSz svgW = (nWeeks - 1) * step + cellSz
svgH = 6 * step + cellSz + hdrH svgH = 6 * step + cellSz + hdrH