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.List (dropWhileEnd)
|
||||||
import Data.Map.Strict (Map)
|
import Data.Map.Strict (Map)
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
|
import System.IO (readFile')
|
||||||
|
|
||||||
|
|
||||||
-- | Custom fields we extract per citekey. Fields absent from the
|
-- | 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'@.
|
-- | Parse a @.bib@ file; returns a map @citekey -> 'BibExtra'@.
|
||||||
parseBibExtras :: FilePath -> IO (Map String 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
|
grouped = groupBy (\a b -> ceCategory a == ceCategory b) sorted
|
||||||
return $ concatMap renderGroup grouped
|
return $ concatMap renderGroup grouped
|
||||||
where
|
where
|
||||||
-- groupBy on a non-empty list yields non-empty sublists, but pattern
|
-- groupBy on a non-empty list yields non-empty sublists, so the
|
||||||
-- matching is total whereas 'head' is not.
|
-- (e:_) pattern is structurally guaranteed in this call site.
|
||||||
renderGroup [] = ""
|
|
||||||
renderGroup g@(e : _) = renderCategorySection (ceCategory e) g
|
renderGroup g@(e : _) = renderCategorySection (ceCategory e) g
|
||||||
|
renderGroup [] = "" -- unreachable; satisfies coverage checker
|
||||||
|
|
||||||
musicCatalogCtx :: Context String
|
musicCatalogCtx :: Context String
|
||||||
musicCatalogCtx =
|
musicCatalogCtx =
|
||||||
|
|
|
||||||
|
|
@ -107,10 +107,8 @@ daySpan oldest newest =
|
||||||
stabilityFromDates :: [String] -> String
|
stabilityFromDates :: [String] -> String
|
||||||
stabilityFromDates [] = "volatile"
|
stabilityFromDates [] = "volatile"
|
||||||
stabilityFromDates dates@(newest : _) =
|
stabilityFromDates dates@(newest : _) =
|
||||||
let oldest = case reverse dates of
|
-- 'last' is safe: the (newest:_) pattern guarantees non-empty.
|
||||||
(x : _) -> x
|
classify (length dates) (daySpan (last dates) newest)
|
||||||
[] -> newest -- unreachable; matched above
|
|
||||||
in classify (length dates) (daySpan oldest newest)
|
|
||||||
where
|
where
|
||||||
classify n age
|
classify n age
|
||||||
| n <= 1 || age < volatileAge = "volatile"
|
| n <= 1 || age < volatileAge = "volatile"
|
||||||
|
|
@ -291,10 +289,10 @@ versionHistoryRangeField :: Context String
|
||||||
versionHistoryRangeField = field "version-history-range" $ \item -> do
|
versionHistoryRangeField = field "version-history-range" $ \item -> do
|
||||||
entries <- loadVersionHistory item
|
entries <- loadVersionHistory item
|
||||||
case entries of
|
case entries of
|
||||||
[] -> fail "no version-history range"
|
[] -> fail "no version-history range"
|
||||||
[one] -> return (vhDate one)
|
[one] -> return (vhDate one)
|
||||||
(newest : more) ->
|
es@(newest:_) ->
|
||||||
let oldest = last (newest : more)
|
let oldest = last es -- safe: es is non-empty by pattern
|
||||||
newD = vhDate newest
|
newD = vhDate newest
|
||||||
oldD = vhDate oldest
|
oldD = vhDate oldest
|
||||||
in if newD == oldD
|
in if newD == oldD
|
||||||
|
|
@ -318,10 +316,10 @@ versionHistoryRangeEndField =
|
||||||
field "version-history-range-end" $ \item -> do
|
field "version-history-range-end" $ \item -> do
|
||||||
entries <- loadVersionHistory item
|
entries <- loadVersionHistory item
|
||||||
case entries of
|
case entries of
|
||||||
[] -> fail "no version-history end"
|
[] -> fail "no version-history end"
|
||||||
[_] -> fail "single-day history — no end"
|
[_] -> fail "single-day history — no end"
|
||||||
(newest : more) ->
|
es@(newest:_) ->
|
||||||
let oldest = last (newest : more)
|
let oldest = last es -- safe: es is non-empty by pattern
|
||||||
in if vhDateIso newest == vhDateIso oldest
|
in if vhDateIso newest == vhDateIso oldest
|
||||||
then fail "single-day history — no end"
|
then fail "single-day history — no end"
|
||||||
else return (vhDateIso newest)
|
else return (vhDateIso newest)
|
||||||
|
|
|
||||||
|
|
@ -22,6 +22,7 @@ import System.Directory (doesDirectoryExist, getFileSize, listDirector
|
||||||
pathIsSymbolicLink)
|
pathIsSymbolicLink)
|
||||||
import System.Exit (ExitCode (..))
|
import System.Exit (ExitCode (..))
|
||||||
import System.FilePath (takeExtension, (</>))
|
import System.FilePath (takeExtension, (</>))
|
||||||
|
import System.IO (readFile')
|
||||||
import System.Process (readProcessWithExitCode)
|
import System.Process (readProcessWithExitCode)
|
||||||
import Text.Read (readMaybe)
|
import Text.Read (readMaybe)
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as Aeson
|
||||||
|
|
@ -161,15 +162,12 @@ normUrl u
|
||||||
pad2 :: (Show a, Integral a) => a -> String
|
pad2 :: (Show a, Integral a) => a -> String
|
||||||
pad2 n = if n < 10 then "0" ++ show n else show n
|
pad2 n = if n < 10 then "0" ++ show n else show n
|
||||||
|
|
||||||
-- | Median of a non-empty list; returns 0 for empty. Uses 'drop' +
|
-- | Median of a non-empty list; returns 0 for empty.
|
||||||
-- pattern match instead of @(!!)@ so the function is total in its
|
|
||||||
-- own implementation, not just by external invariant.
|
|
||||||
median :: [Int] -> Int
|
median :: [Int] -> Int
|
||||||
median [] = 0
|
median [] = 0
|
||||||
median xs =
|
median xs = sort xs !! (length xs `div` 2)
|
||||||
case drop (length xs `div` 2) (sort xs) of
|
-- Index is < length xs for non-empty xs, so '(!!)' is safe here
|
||||||
(m : _) -> m
|
-- by construction. The empty case is caught by the first equation.
|
||||||
[] -> 0 -- unreachable: length xs >= 1 above
|
|
||||||
|
|
||||||
|
|
||||||
-- ---------------------------------------------------------------------------
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
@ -854,7 +852,7 @@ statsRules tags = do
|
||||||
buildTimestamp <- unsafeCompiler $
|
buildTimestamp <- unsafeCompiler $
|
||||||
formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" <$> getCurrentTime
|
formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" <$> getCurrentTime
|
||||||
lastBuildDur <- unsafeCompiler $
|
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)
|
let secs = fromMaybe 0 (readMaybe (filter (/= '\n') s) :: Maybe Int)
|
||||||
in return (show secs ++ "s"))
|
in return (show secs ++ "s"))
|
||||||
`catch` (\(_ :: IOException) -> return "\x2014")
|
`catch` (\(_ :: IOException) -> return "\x2014")
|
||||||
|
|
|
||||||
|
|
@ -175,11 +175,10 @@ portalTooltipField getSidecarId = field "portal-tooltip" $ \item -> do
|
||||||
-- "nonfiction" → Nothing
|
-- "nonfiction" → Nothing
|
||||||
-- "a/b/c" → Just "a/b"
|
-- "a/b/c" → Just "a/b"
|
||||||
parentOf :: String -> Maybe String
|
parentOf :: String -> Maybe String
|
||||||
parentOf t =
|
parentOf t = case wordsBy (== '/') t of
|
||||||
let segs = wordsBy (== '/') t
|
[] -> Nothing
|
||||||
in if length segs > 1
|
[_] -> Nothing
|
||||||
then Just (intercalate "/" (init segs))
|
segs -> Just (intercalate "/" (init segs)) -- 'init' safe: 2+ segments
|
||||||
else Nothing
|
|
||||||
|
|
||||||
-- | Number of @/@ characters in a tag path (i.e., depth - 1).
|
-- | Number of @/@ characters in a tag path (i.e., depth - 1).
|
||||||
slashCount :: String -> Int
|
slashCount :: String -> Int
|
||||||
|
|
|
||||||
|
|
@ -19,6 +19,7 @@ module Utils
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Char (isAlphaNum, isSpace, toLower)
|
import Data.Char (isAlphaNum, isSpace, toLower)
|
||||||
|
import Data.List (dropWhileEnd)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
-- | Count the number of words in a string (split on whitespace).
|
-- | Count the number of words in a string (split on whitespace).
|
||||||
|
|
@ -58,7 +59,7 @@ escapeHtmlText = T.concatMap escChar
|
||||||
|
|
||||||
-- | Strip leading and trailing whitespace.
|
-- | Strip leading and trailing whitespace.
|
||||||
trim :: String -> String
|
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
|
-- | Lowercase a string, drop everything that isn't alphanumeric or
|
||||||
-- space, then replace runs of spaces with single hyphens.
|
-- space, then replace runs of spaces with single hyphens.
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue