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:
parent
a818b7df9b
commit
725fa17f6a
|
|
@ -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
|
||||
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Reference in New Issue