{-# LANGUAGE GHC2021 #-} {-# LANGUAGE OverloadedStrings #-} -- | Stability auto-calculation, last-reviewed derivation, and version history. -- -- For each content page: -- * If the page's source path appears in @IGNORE.txt@, the stability and -- last-reviewed fields fall back to the frontmatter values. -- * Otherwise, @git log --follow@ is used. Stability is derived from -- commit count + age; last-reviewed is the most-recent commit date. -- -- Version history (@$version-history$@): -- * Prioritises frontmatter @history:@ list (date + note pairs). -- * Falls back to the raw git log dates (date-only, no message). -- * Falls back to nothing (template shows created/modified dates instead). -- -- @IGNORE.txt@ is cleared by the build target in the Makefile after -- every successful build, so pins are one-shot. module Stability ( stabilityField , lastReviewedField , versionHistoryField ) where import Control.Exception (catch, IOException) import Data.Aeson (Value (..)) import qualified Data.Aeson.KeyMap as KM import qualified Data.Vector as V import Data.Maybe (catMaybes, fromMaybe, listToMaybe) import Data.Time.Calendar (Day, diffDays) import Data.Time.Format (parseTimeM, formatTime, defaultTimeLocale) import qualified Data.Text as T import System.Exit (ExitCode (..)) import System.Process (readProcessWithExitCode) import Hakyll -- --------------------------------------------------------------------------- -- IGNORE.txt -- --------------------------------------------------------------------------- -- | Read @IGNORE.txt@ (paths relative to project root, one per line). -- Returns an empty list when the file is absent or empty. readIgnore :: IO [FilePath] readIgnore = (filter (not . null) . lines <$> readFile "IGNORE.txt") `catch` \(_ :: IOException) -> return [] -- --------------------------------------------------------------------------- -- Git helpers -- --------------------------------------------------------------------------- -- | Return commit dates (ISO "YYYY-MM-DD", newest-first) for @fp@. gitDates :: FilePath -> IO [String] gitDates fp = do (ec, out, _) <- readProcessWithExitCode "git" ["log", "--follow", "--format=%ad", "--date=short", "--", fp] "" case ec of ExitFailure _ -> return [] ExitSuccess -> return $ filter (not . null) (lines out) -- | Parse an ISO "YYYY-MM-DD" string to a 'Day'. parseIso :: String -> Maybe Day parseIso = parseTimeM True defaultTimeLocale "%Y-%m-%d" -- | Approximate day-span between the oldest and newest ISO date strings. daySpan :: String -> String -> Int daySpan oldest newest = case (parseIso oldest, parseIso newest) of (Just o, Just n) -> fromIntegral (abs (diffDays n o)) _ -> 0 -- | Derive stability label from commit dates (newest-first). stabilityFromDates :: [String] -> String stabilityFromDates [] = "volatile" stabilityFromDates dates = classify (length dates) (daySpan (last dates) (head dates)) where classify n age | n <= 1 || age < 14 = "volatile" | n <= 5 && age < 90 = "revising" | n <= 15 || age < 365 = "fairly stable" | n <= 30 || age < 730 = "stable" | otherwise = "established" -- | Format an ISO date as "%-d %B %Y" (e.g. "16 March 2026"). fmtIso :: String -> String fmtIso s = case parseIso s of Nothing -> s Just day -> formatTime defaultTimeLocale "%-d %B %Y" (day :: Day) -- --------------------------------------------------------------------------- -- Stability and last-reviewed context fields -- --------------------------------------------------------------------------- -- | Context field @$stability$@. -- Always resolves to a label; prefers frontmatter when the file is pinned. stabilityField :: Context String stabilityField = field "stability" $ \item -> do let srcPath = toFilePath (itemIdentifier item) meta <- getMetadata (itemIdentifier item) unsafeCompiler $ do ignored <- readIgnore if srcPath `elem` ignored then return $ fromMaybe "volatile" (lookupString "stability" meta) else stabilityFromDates <$> gitDates srcPath -- | Context field @$last-reviewed$@. -- Returns the formatted date of the most-recent commit, or @noResult@ when -- unavailable (making @$if(last-reviewed)$@ false in templates). lastReviewedField :: Context String lastReviewedField = field "last-reviewed" $ \item -> do let srcPath = toFilePath (itemIdentifier item) meta <- getMetadata (itemIdentifier item) mDate <- unsafeCompiler $ do ignored <- readIgnore if srcPath `elem` ignored then return $ lookupString "last-reviewed" meta else fmap fmtIso . listToMaybe <$> gitDates srcPath case mDate of Nothing -> fail "no last-reviewed" Just d -> return d -- --------------------------------------------------------------------------- -- Version history -- --------------------------------------------------------------------------- data VHEntry = VHEntry { vhDate :: String , vhMessage :: Maybe String -- Nothing for git-log-only entries } -- | Parse the optional frontmatter @history:@ list. -- Each item must have @date:@ and @note:@ keys. parseFmHistory :: Metadata -> [VHEntry] parseFmHistory meta = case KM.lookup "history" meta of Just (Array v) -> catMaybes (map parseOne (V.toList v)) _ -> [] where parseOne (Object o) = case getString =<< KM.lookup "date" o of Nothing -> Nothing Just d -> Just $ VHEntry (fmtIso d) (getString =<< KM.lookup "note" o) parseOne _ = Nothing getString (String t) = Just (T.unpack t) getString _ = Nothing -- | Get git log for a file as version history entries (date-only, no message). gitLogHistory :: FilePath -> IO [VHEntry] gitLogHistory fp = map (\d -> VHEntry (fmtIso d) Nothing) <$> gitDates fp -- | Context list field @$version-history$@ providing @$vh-date$@ and -- (when present) @$vh-message$@ per entry. -- -- Priority: -- 1. Frontmatter @history:@ list — dates + authored notes. -- 2. Git log dates — date-only, no annotation. -- 3. Empty list — template falls back to @$date-created$@ / @$date-modified$@. versionHistoryField :: Context String versionHistoryField = listFieldWith "version-history" vhCtx $ \item -> do let srcPath = toFilePath (itemIdentifier item) meta <- getMetadata (itemIdentifier item) let fmEntries = parseFmHistory meta entries <- if not (null fmEntries) then return fmEntries else unsafeCompiler (gitLogHistory srcPath) if null entries then fail "no version history" else return $ zipWith (\i e -> Item (fromFilePath ("vh" ++ show (i :: Int))) e) [1..] entries where vhCtx = field "vh-date" (return . vhDate . itemBody) <> field "vh-message" (\i -> case vhMessage (itemBody i) of Nothing -> fail "no message" Just m -> return m)