okf-core 0.12.0.1 → 0.13.0.0

raw patch · 4 files changed

+157/−1 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• okf-core.cabal +1/−1
• src/Okf/Log.hs +129/−0
• test/Main.hs +18/−0

@@ -7,6 +7,15 @@  ## [Unreleased] +## [0.13.0.0] - 2026-11-08++### Added++- `Okf.Log.insertLogEntry` inserts an entry into original Markdown while+  preserving existing content and formatting, refusing unsafe insertion.+- `Okf.Log.renderLogDiff` renders an exact unified diff against source Markdown+  or a new file, including deletions and line-ending changes.+ ## [0.12.0.1] - 2026-10-28  ### Fixed

@@ -1,6 +1,6 @@ cabal-version: 3.4 name: okf-core-version: 0.12.0.1+version: 0.13.0.0 synopsis:   Read, validate, index, and traverse Open Knowledge Format bundles 

@@ -6,8 +6,10 @@     LogParseError (..),     LogValidationError (..),     appendLogEntry,+    insertLogEntry,     logErrorIsStructural,     parseLog,+    renderLogDiff,     serializeLog,     validateLog,   )@@ -15,8 +17,10 @@  import CMarkGFM qualified import Data.Char qualified as Char+import Data.List qualified as List import Data.Text qualified as Text import Data.Time (Day, defaultTimeLocale, parseTimeM)+import Numeric (showOct) import Okf.Markdown (markdownOptions) import Okf.Prelude @@ -54,6 +58,8 @@   deriving stock (Generic, Eq, Show)  -- | Parse Markdown into the log model. Structural validation is separate.+-- This model omits other Markdown blocks and source formatting; use+-- 'insertLogEntry' to modify an existing file without losing that content. parseLog :: Text -> Log parseLog markdown =   finish (foldl' step emptyBuild topLevelNodes)@@ -199,6 +205,74 @@       | dateText > logDate day = newDay : day : rest       | otherwise = day : insertDay rest +-- | Insert into the original Markdown without rendering historical content.+-- Source positions come from top-level headings, so heading-like text inside+-- code, HTML, lists and block quotes cannot become an insertion boundary.+-- Unsupported or ambiguous structure is rejected before a caller writes it.+insertLogEntry :: Text -> LogEntry -> Text -> Either Text Text+insertLogEntry dateText entry markdown = do+  unless (isIsoDate dateText) (Left "use a real calendar date in YYYY-MM-DD form")+  when (Text.any (== '\r') (Text.replace "\r\n" "" markdown)) $+    Left "bare CR line endings are unsupported; use LF or CRLF"+  title <- case titles of+    [node] -> Right node+    _ -> Left "expected exactly one top-level log title (# heading)"+  titlePosition <- headingPosition title+  days <- for dateHeadings $ \node -> do+    pos <- headingPosition node+    let day = plainText node+    unless (isIsoDate day) (Left ("non-date level-two heading: " <> day))+    unless (CMarkGFM.startLine pos > CMarkGFM.endLine titlePosition) $+      Left "date headings must follow the log title"+    pure (day, pos)+  unless (and (zipWith (>) (fmap fst days) (drop 1 (fmap fst days)))) $+    Left "date headings must be unique and ordered newest first"+  -- Parsing the generated fragment also rejects messages that introduce extra+  -- headings or entries. Compare the complete parsed result below to catch an+  -- insertion swallowed by an unclosed code fence or HTML block at EOF.+  case CMarkGFM.commonmarkToNode markdownOptions [] fragment of+    CMarkGFM.Node _ _ [CMarkGFM.Node _ (CMarkGFM.HEADING 1) _, CMarkGFM.Node _ (CMarkGFM.HEADING 2) _, CMarkGFM.Node _ (CMarkGFM.LIST _) [_]] -> pure ()+    _ -> Left "kind and message must form a single log entry"+  let (offset, insertion) = case List.find ((== dateText) . fst) days of+        Just (_, pos) -> (afterLine (CMarkGFM.endLine pos), renderedEntry)+        Nothing ->+          ( maybe+              (Text.length markdown)+              (beforeLine . CMarkGFM.startLine . snd)+              (List.find ((< dateText) . fst) days),+            "## " <> dateText <> newline <> renderedEntry+          )+      (before, after) = Text.splitAt offset markdown+      separator+        | Text.null before || (newline <> newline) `Text.isSuffixOf` before = ""+        | newline `Text.isSuffixOf` before = newline+        | otherwise = newline <> newline+      result = before <> separator <> insertion <> newline <> (if Text.null after then "" else newline) <> after+      parsedResult = parseLog result+  -- Read the new entry in context: reference-style links may resolve against+  -- definitions in the original Markdown rather than in the isolated fragment.+  insertedEntry <- case [newEntry | LogDay day (newEntry : _) <- logDays parsedResult, day == dateText] of+    [newEntry] -> Right newEntry+    _ -> Left "inserted entry is not visible under its date heading"+  unless (parsedResult == appendLogEntry dateText insertedEntry (parseLog markdown)) $+    Left "cannot safely insert an entry into this Markdown structure"+  pure result+  where+    CMarkGFM.Node _ _ nodes = CMarkGFM.commonmarkToNode markdownOptions [] markdown+    titles = [node | node@(CMarkGFM.Node _ (CMarkGFM.HEADING 1) _) <- nodes]+    dateHeadings = [node | node@(CMarkGFM.Node _ (CMarkGFM.HEADING 2) _) <- nodes]+    headingPosition (CMarkGFM.Node (Just pos) _ _) = Right pos+    headingPosition _ = Left "log heading has no source position"+    newline = if "\r\n" `Text.isInfixOf` markdown then "\r\n" else "\n"+    renderedEntry = case entry of+      LogEntry (Just kind) body -> "* **" <> kind <> "**: " <> body+      LogEntry Nothing body -> "* " <> body+    fragment = "# Log\n\n## " <> dateText <> "\n" <> renderedEntry <> "\n"+    -- Keep CRs and all original line terminators in the slices. Only line+    -- numbers are used; cmark's byte-based columns need no Text conversion.+    afterLine line = min (Text.length markdown) (sum (fmap ((+ 1) . Text.length) (take line (Text.splitOn "\n" markdown))))+    beforeLine line = afterLine (line - 1)+ dropKindSeparator :: Text -> Text dropKindSeparator text =   Text.stripStart@@ -214,6 +288,61 @@   | Text.null text = "\n"   | "\n" `Text.isSuffixOf` text = text   | otherwise = text <> "\n"++-- | Show an exact unified diff against the original source, or @/dev/null@+-- for a new file. A single hunk spans every change with up to three context+-- lines at each end. Line terminators (including CRLF and absent final LF)+-- participate in comparison, so formatting changes cannot be hidden.+renderLogDiff :: FilePath -> Maybe Text -> Text -> Text+renderLogDiff path original updated =+  "--- "+    <> maybe "/dev/null" (const displayPath) original+    <> "\n"+    <> "+++ "+    <> displayPath+    <> "\n"+    <> if old == new+      then ""+      else+        "@@ -"+          <> range start (length before + length removed + length after)+          <> " +"+          <> range start (length before + length added + length after)+          <> " @@\n"+          <> foldMap (renderLine " ") before+          <> foldMap (renderLine "-") removed+          <> foldMap (renderLine "+") added+          <> foldMap (renderLine " ") after+  where+    -- Quote unusual path characters using Git's quoted-path convention.+    displayPath+      | any (\c -> c == '"' || c == '\\' || Char.isControl c) path = "\"" <> Text.concatMap quoteChar (Text.pack path) <> "\""+      | otherwise = Text.pack path+    quoteChar '"' = "\\\""+    quoteChar '\\' = "\\\\"+    quoteChar c+      | Char.ord c < 32 || Char.ord c == 127 =+          let octal = showOct (Char.ord c) ""+           in "\\" <> Text.pack (replicate (3 - length octal) '0' <> octal)+      | otherwise = Text.singleton c+    old = sourceLines (fromMaybe "" original)+    new = sourceLines updated+    prefixLength = length (takeWhile (uncurry (==)) (zip old new))+    oldRest = drop prefixLength old+    newRest = drop prefixLength new+    suffixLength = length (takeWhile (uncurry (==)) (zip (reverse oldRest) (reverse newRest)))+    before = drop (max 0 (prefixLength - 3)) (take prefixLength old)+    after = take 3 (drop (length oldRest - suffixLength) oldRest)+    removed = take (length oldRest - suffixLength) oldRest+    added = take (length newRest - suffixLength) newRest+    start = prefixLength - length before+    range offset count = Text.pack (show (if count == 0 then offset else offset + 1)) <> "," <> Text.pack (show count)+    renderLine marker line = marker <> line <> if "\n" `Text.isSuffixOf` line then "" else "\n\\ No newline at end of file\n"+    sourceLines text+      | Text.null text = []+      | otherwise =+          let (line, rest) = Text.breakOn "\n" text+           in if Text.null rest then [line] else (line <> "\n") : sourceLines (Text.drop 1 rest)  isIsoDate :: Text -> Bool isIsoDate value =

@@ -101,6 +101,7 @@         test "logStaleness reads generated.at ahead of the legacy timestamp" testLogStalenessReadsGeneratedAt,         test "logStaleness prefers the deepest enclosing log" testLogStalenessPrefersDeepestLog,         test "appendLogEntry inserts newest-first and prepends within a day" testAppendLogEntry,+        test "log diffs expose removals and exact line endings" testLogDiff,         testIO "generateIndex groups documents by frontmatter type" testGenerateIndexGroupsByType,         testIO "index endings are exact for every directory shape" testIndexEndings,         testIO "index writers preserve endings and versions across directory shapes" testIndexWriterEndings,@@ -752,6 +753,23 @@         }     ]     (logStaleness [usersConcept] logs)++testLogDiff :: Either Text ()+testLogDiff =+  if and+    [ renderLogDiff "log.md" (Just "# Log\n\nAdoption evidence.\n- Old entry\n") "# Log\n\n- New entry\n"+        == "--- log.md\n+++ log.md\n@@ -1,4 +1,3 @@\n # Log\n \n-Adoption evidence.\n-- Old entry\n+- New entry\n",+      renderLogDiff "log.md" Nothing "# Log\n"+        == "--- /dev/null\n+++ log.md\n@@ -0,0 +1,1 @@\n+# Log\n",+      renderLogDiff "log.md" (Just "# Log\r\nold") "# Log\r\nnew\n"+        == "--- log.md\n+++ log.md\n@@ -1,2 +1,2 @@\n # Log\r\n-old\n\\ No newline at end of file\n+new\n",+      renderLogDiff "log.md" (Just "# Log\n") "# Log\r\n"+        == "--- log.md\n+++ log.md\n@@ -1,1 +1,1 @@\n-# Log\n+# Log\r\n",+      renderLogDiff "log.md" (Just "same\n") "same\n" == "--- log.md\n+++ log.md\n",+      renderLogDiff "a\t\"b/log.md" Nothing "new" == "--- /dev/null\n+++ \"a\\011\\\"b/log.md\"\n@@ -0,0 +1,1 @@\n+new\n\\ No newline at end of file\n"+    ]+    then Right ()+    else Left "log diff omitted a change or rendered an incorrect hunk"  testAppendLogEntry :: Either Text () testAppendLogEntry =