Tighten partial patterns and switch to strict file reads in build/

- Stats.hs: median uses (!!) directly after the empty-case equation,
  dropping the unreachable empty-fallback arm.
- Stats.hs + BibExtras.hs: switch lazy readFile to strict readFile'
  (System.IO). Lazy IO leaves handles open until the value is forced;
  errors surface at unpredictable points and the em-dash fallback in
  Stats can hide real I/O failures. Strict reads fail at the read.
- Stability.hs: stabilityFromDates uses 'last dates' directly, since
  the (newest:_) pattern guarantees non-empty input.
  versionHistoryRangeField and versionHistoryRangeEndField bind the
  matched list as 'es' and call 'last es', dropping the
  reconstruction of (newest : more) just to call last on it.
- Tags.hs: parentOf is a 3-arm case (\[\], \[_\], segs) instead of a
  length-based guard around 'init segs'.
- Catalog.hs: renderGroup re-orders so the structurally-guaranteed
  (e:_) arm is matched first; the empty arm stays as a coverage stub
  with a comment noting it's unreachable per groupBy's contract.
- Utils.hs: trim uses dropWhileEnd instead of double-reverse.

All sites were runtime-safe before; the changes make the safety
structural and shorter to read.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
Levi Neuwirth 2026-05-07 15:08:47 -04:00
parent a818b7df9b
commit 725fa17f6a
6 changed files with 27 additions and 30 deletions

View File

@ -30,6 +30,7 @@ import Data.Char (isAlphaNum, isSpace, toLower)
import Data.List (dropWhileEnd)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import System.IO (readFile')
-- | Custom fields we extract per citekey. Fields absent from the
@ -63,7 +64,7 @@ firstAuthorSurname extra = case bibAuthor extra of
-- | Parse a @.bib@ file; returns a map @citekey -> 'BibExtra'@.
parseBibExtras :: FilePath -> IO (Map String BibExtra)
parseBibExtras path = Map.fromList . parseBib <$> readFile path
parseBibExtras path = Map.fromList . parseBib <$> readFile' path
-- ---------------------------------------------------------------------------

View File

@ -229,10 +229,10 @@ catalogByCategoryField = field "catalog-by-category" $ \_ -> do
grouped = groupBy (\a b -> ceCategory a == ceCategory b) sorted
return $ concatMap renderGroup grouped
where
-- groupBy on a non-empty list yields non-empty sublists, but pattern
-- matching is total whereas 'head' is not.
renderGroup [] = ""
-- groupBy on a non-empty list yields non-empty sublists, so the
-- (e:_) pattern is structurally guaranteed in this call site.
renderGroup g@(e : _) = renderCategorySection (ceCategory e) g
renderGroup [] = "" -- unreachable; satisfies coverage checker
musicCatalogCtx :: Context String
musicCatalogCtx =

View File

@ -107,10 +107,8 @@ daySpan oldest newest =
stabilityFromDates :: [String] -> String
stabilityFromDates [] = "volatile"
stabilityFromDates dates@(newest : _) =
let oldest = case reverse dates of
(x : _) -> x
[] -> newest -- unreachable; matched above
in classify (length dates) (daySpan oldest newest)
-- 'last' is safe: the (newest:_) pattern guarantees non-empty.
classify (length dates) (daySpan (last dates) newest)
where
classify n age
| n <= 1 || age < volatileAge = "volatile"
@ -293,8 +291,8 @@ versionHistoryRangeField = field "version-history-range" $ \item -> do
case entries of
[] -> fail "no version-history range"
[one] -> return (vhDate one)
(newest : more) ->
let oldest = last (newest : more)
es@(newest:_) ->
let oldest = last es -- safe: es is non-empty by pattern
newD = vhDate newest
oldD = vhDate oldest
in if newD == oldD
@ -320,8 +318,8 @@ versionHistoryRangeEndField =
case entries of
[] -> fail "no version-history end"
[_] -> fail "single-day history — no end"
(newest : more) ->
let oldest = last (newest : more)
es@(newest:_) ->
let oldest = last es -- safe: es is non-empty by pattern
in if vhDateIso newest == vhDateIso oldest
then fail "single-day history — no end"
else return (vhDateIso newest)

View File

@ -22,6 +22,7 @@ import System.Directory (doesDirectoryExist, getFileSize, listDirector
pathIsSymbolicLink)
import System.Exit (ExitCode (..))
import System.FilePath (takeExtension, (</>))
import System.IO (readFile')
import System.Process (readProcessWithExitCode)
import Text.Read (readMaybe)
import qualified Data.Aeson as Aeson
@ -161,15 +162,12 @@ normUrl u
pad2 :: (Show a, Integral a) => a -> String
pad2 n = if n < 10 then "0" ++ show n else show n
-- | Median of a non-empty list; returns 0 for empty. Uses 'drop' +
-- pattern match instead of @(!!)@ so the function is total in its
-- own implementation, not just by external invariant.
-- | Median of a non-empty list; returns 0 for empty.
median :: [Int] -> Int
median [] = 0
median xs =
case drop (length xs `div` 2) (sort xs) of
(m : _) -> m
[] -> 0 -- unreachable: length xs >= 1 above
median xs = sort xs !! (length xs `div` 2)
-- Index is < length xs for non-empty xs, so '(!!)' is safe here
-- by construction. The empty case is caught by the first equation.
-- ---------------------------------------------------------------------------
@ -854,7 +852,7 @@ statsRules tags = do
buildTimestamp <- unsafeCompiler $
formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" <$> getCurrentTime
lastBuildDur <- unsafeCompiler $
(readFile "data/last-build-seconds.txt" >>= \s ->
(readFile' "data/last-build-seconds.txt" >>= \s ->
let secs = fromMaybe 0 (readMaybe (filter (/= '\n') s) :: Maybe Int)
in return (show secs ++ "s"))
`catch` (\(_ :: IOException) -> return "\x2014")

View File

@ -175,11 +175,10 @@ portalTooltipField getSidecarId = field "portal-tooltip" $ \item -> do
-- "nonfiction" → Nothing
-- "a/b/c" → Just "a/b"
parentOf :: String -> Maybe String
parentOf t =
let segs = wordsBy (== '/') t
in if length segs > 1
then Just (intercalate "/" (init segs))
else Nothing
parentOf t = case wordsBy (== '/') t of
[] -> Nothing
[_] -> Nothing
segs -> Just (intercalate "/" (init segs)) -- 'init' safe: 2+ segments
-- | Number of @/@ characters in a tag path (i.e., depth - 1).
slashCount :: String -> Int

View File

@ -19,6 +19,7 @@ module Utils
) where
import Data.Char (isAlphaNum, isSpace, toLower)
import Data.List (dropWhileEnd)
import qualified Data.Text as T
-- | Count the number of words in a string (split on whitespace).
@ -58,7 +59,7 @@ escapeHtmlText = T.concatMap escChar
-- | Strip leading and trailing whitespace.
trim :: String -> String
trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse
trim = dropWhileEnd isSpace . dropWhile isSpace
-- | Lowercase a string, drop everything that isn't alphanumeric or
-- space, then replace runs of spaces with single hyphens.