okf-core 0.1.0.0 → 0.1.1.0

raw patch · 10 files changed

+1116/−112 lines, 10 filesdep +dhalldep +timePVP ok

version bump matches the API change (PVP)

Dependencies added: dhall, time

API changes (from Hackage documentation)

Files

• CHANGELOG.md +31/−0
• okf-core.cabal +51/−48
• src/Okf/Bundle.hs +57/−0
• src/Okf/ConceptId.hs +12/−12
• src/Okf/Document.hs +44/−40
• src/Okf/Log.hs +228/−0
• src/Okf/Prelude.hs +7/−6
• src/Okf/Profile.hs +239/−0
• src/Okf/Validation.hs +107/−1
• test/Main.hs +340/−5

@@ -7,6 +7,37 @@  ## [Unreleased] +## [0.1.1.0] - 2026-06-28++### Added++- `okf --version`, including git SHA reporting for Cabal and Nix builds when+  available.+- Shell completion generation for supported shells.+- `okf help` command with embedded conceptual topic guides (`okf`, `format`,+  `validation`, `profiles`), including a guide explaining what the Open Knowledge+  Format is. The guides are plain text baked into the binary at compile time, so+  `okf help <topic>` works with no network or docs checkout.+- Profile-based validation: `okf validate --profile <descriptor>.dhall` checks a+  bundle against a team's house conventions (allowed `type` strings, required+  frontmatter keys, `resource:` schemes, file layout, and `# Schema` columns)+  declared in a Dhall descriptor. Profiles are not part of the OKF standard, so+  deviations are advisory by default; `--profile-enforce` fails the command on+  drift. Ships an example bundle (`examples/postgresql-sample`), a sample+  descriptor (`docs/profiles/postgresql.dhall`), and a user guide+  (`docs/user/profiles.md`).+- Log support: `okf-core` can parse, serialize, and validate `log.md` files;+  `okf-cli` can preview, validate, author log entries, and report drift between+  bundle logs and git history.+- Canonical OKF profile schema Dhall modules with drift tests.++### Changed++- Expanded the README and user guides to cover the current CLI, profile+  validation, and log workflows.+- Updated release, Nix, and repository metadata so both packages build and check+  as separate Hackage packages.+ ## [0.1.0.0] - 2026-06-19  Initial release.

@@ -1,36 +1,32 @@-cabal-version: 3.4-name: okf-core-version: 0.1.0.0-synopsis: Read, validate, index, and traverse Open Knowledge Format bundles+cabal-version:   3.4+name:            okf-core+version:         0.1.1.0+synopsis:+  Read, validate, index, and traverse Open Knowledge Format bundles+ description:   okf-core parses Open Knowledge Format (OKF) bundles -- plain   Markdown-plus-YAML knowledge graphs -- into typed documents, builds a concept   index and link graph, validates referential integrity, and writes bundles back   out with a round-trip guarantee. -category: Data, Text-license: BSD-3-Clause-license-file: LICENSE-author: Nadeem Bitar-maintainer: nadeem@gmail.com-copyright: (c) 2026 Nadeem Bitar-build-type: Simple+category:        Data, Text+license:         BSD-3-Clause+license-file:    LICENSE+author:          Nadeem Bitar+maintainer:      nadeem@gmail.com+copyright:       (c) 2026 Nadeem Bitar+build-type:      Simple extra-doc-files: CHANGELOG.md  common common-options   ghc-options:-    -Wall-    -Wcompat-    -Widentities-    -Wincomplete-uni-patterns-    -Wincomplete-record-updates-    -Wredundant-constraints-    -fhide-source-paths-    -Wmissing-export-lists-    -Wpartial-fields+    -Wall -Wcompat -Widentities -Wincomplete-uni-patterns+    -Wincomplete-record-updates -Wredundant-constraints+    -fhide-source-paths -Wmissing-export-lists -Wpartial-fields     -Wmissing-deriving-strategies -  default-language: GHC2024+  default-language:   GHC2024   default-extensions:     DeriveAnyClass     DuplicateRecordFields@@ -38,44 +34,51 @@     OverloadedStrings  library-  import: common-options-  hs-source-dirs: src+  import:          common-options+  hs-source-dirs:  src   exposed-modules:     Okf.Bundle     Okf.ConceptId     Okf.Document     Okf.Graph     Okf.Index+    Okf.Log     Okf.Prelude+    Okf.Profile     Okf.Validation    build-depends:-    aeson >=2.2 && <2.4,-    attoparsec >=0.14 && <0.15,-    base >=4.20 && <5,-    bytestring >=0.11 && <0.13,-    cmark-gfm ^>=0.2,-    containers >=0.6 && <0.8,-    directory >=1.3 && <1.4,-    filepath >=1.4 && <1.6,-    frontmatter >=0.1 && <0.2,-    generic-lens >=2.2 && <2.4,-    lens ^>=5.3,-    text ^>=2.1,-    vector >=0.13 && <0.14,-    yaml >=0.11 && <0.12,+    , aeson         >=2.2  && <2.4+    , attoparsec    >=0.14 && <0.15+    , base          >=4.20 && <5+    , bytestring    >=0.11 && <0.13+    , cmark-gfm     ^>=0.2+    , containers    >=0.6  && <0.8+    , dhall         >=1.41 && <1.43+    , directory     >=1.3  && <1.4+    , filepath      >=1.4  && <1.6+    , frontmatter   >=0.1  && <0.2+    , generic-lens  >=2.2  && <2.4+    , lens          ^>=5.3+    , text          ^>=2.1+    , time          >=1.12 && <1.15+    , vector        >=0.13 && <0.14+    , yaml          >=0.11 && <0.12  test-suite okf-core-test-  import: common-options-  type: exitcode-stdio-1.0-  main-is: Main.hs+  import:         common-options+  type:           exitcode-stdio-1.0+  main-is:        Main.hs   hs-source-dirs: test-   build-depends:-    aeson,-    base >=4.20 && <5,-    directory,-    filepath,-    okf-core,-    temporary,-    text ^>=2.1,+    , aeson+    , base          >=4.20 && <5+    , dhall         >=1.41 && <1.43+    , directory+    , filepath+    , generic-lens  >=2.2  && <2.4+    , lens          ^>=5.3+    , okf-core+    , temporary+    , text          ^>=2.1+    , time          >=1.12 && <1.15

@@ -2,6 +2,7 @@ module Okf.Bundle   ( BundleError (..),     Concept,+    LogFile (..),     conceptFromDocument,     conceptDescription,     conceptDocument,@@ -15,6 +16,7 @@     isReservedMarkdownFile,     serializeConcept,     walkBundle,+    walkLogs,     writeBundle,   ) where@@ -25,6 +27,7 @@ import Data.Text.IO qualified as Text.IO import Okf.ConceptId import Okf.Document+import Okf.Log import Okf.Prelude import System.Directory   ( createDirectoryIfMissing,@@ -55,6 +58,13 @@   | BundleIoError FilePath Text   deriving stock (Generic, Eq, Show) +-- | A parsed @log.md@ reserved file discovered in a bundle.+data LogFile = LogFile+  { logSourcePath :: !FilePath,+    logContent :: !Log+  }+  deriving stock (Generic, Eq, Show)+ -- | Discover and parse every non-reserved Markdown concept in a bundle. walkBundle :: FilePath -> IO (Either BundleError [Concept]) walkBundle root = do@@ -65,6 +75,16 @@       results <- mapM (readConcept root) paths       pure (List.sortOn (renderConceptId . conceptIdOf) <$> sequenceA results) +-- | Discover and parse every @log.md@ reserved file in a bundle.+walkLogs :: FilePath -> IO (Either BundleError [LogFile])+walkLogs root = do+  discovered <- discoverLogFiles root ""+  case discovered of+    Left bundleError -> pure (Left bundleError)+    Right paths -> do+      results <- mapM (readLog root) paths+      pure (List.sortOn logSourcePath <$> sequenceA results)+ -- | Find a concept by identifier in an already walked bundle. findConcept :: ConceptId -> [Concept] -> Maybe Concept findConcept conceptId =@@ -132,6 +152,34 @@           )       pure (concat <$> sequenceA discovered) +discoverLogFiles :: FilePath -> FilePath -> IO (Either BundleError [FilePath])+discoverLogFiles root relativeDir = do+  let absoluteDir = root </> relativeDir+      displayDir = if null relativeDir then root else relativeDir+  listed <- tryBundleIo displayDir (listDirectory absoluteDir)+  case listed of+    Left bundleError -> pure (Left bundleError)+    Right entries -> do+      discovered <-+        for+          (List.sort entries)+          ( \entry -> do+              let relativePath = relativeDir </> entry+                  absolutePath = root </> relativePath+              isDirectory <- tryBundleIo relativePath (doesDirectoryExist absolutePath)+              case isDirectory of+                Left bundleError -> pure (Left bundleError)+                Right True -> discoverLogFiles root relativePath+                Right False ->+                  pure+                    ( Right+                        [ FilePath.normalise relativePath+                        | entry == "log.md"+                        ]+                    )+          )+      pure (concat <$> sequenceA discovered)+ -- | Write every concept to @root/\<conceptId\>.md@, creating parent directories -- as needed, using 'serializeDocument' for the file contents. Existing files for -- the given concepts are overwritten; files NOT corresponding to a supplied@@ -161,6 +209,15 @@         conceptId <- first (InvalidConceptPath relativePath) (conceptIdFromFilePath relativePath)         document <- first (InvalidConceptDocument relativePath) (parseDocument content)         pure (conceptAt conceptId relativePath document)+    )++readLog :: FilePath -> FilePath -> IO (Either BundleError LogFile)+readLog root relativePath = do+  loaded <- tryBundleIo relativePath (Text.IO.readFile (root </> relativePath))+  pure+    ( do+        content <- loaded+        pure (LogFile {logSourcePath = relativePath, logContent = parseLog content})     )  tryBundleIo :: FilePath -> IO value -> IO (Either BundleError value)

@@ -1,23 +1,23 @@ -- | Safe concept identifiers for bundle-relative OKF Markdown documents. module Okf.ConceptId-  ( ConceptId-  , ConceptIdError (..)-  , conceptIdFromFilePath-  , conceptIdToFilePath-  , parseConceptId-  , renderConceptId-  , renderConceptLinkTarget-  , renderConceptLink-  ) where+  ( ConceptId,+    ConceptIdError (..),+    conceptIdFromFilePath,+    conceptIdToFilePath,+    parseConceptId,+    renderConceptId,+    renderConceptLinkTarget,+    renderConceptLink,+  )+where -import Data.Char qualified as Char import Data.Aeson (ToJSON (..))+import Data.Char qualified as Char import Data.List.NonEmpty qualified as NonEmpty import Data.Text qualified as Text+import Okf.Prelude hiding ((<.>)) import System.FilePath ((<.>)) import System.FilePath qualified as FilePath--import Okf.Prelude hiding ((<.>))  -- | A bundle-relative concept path without the @.md@ suffix. newtype ConceptId = ConceptId

@@ -1,25 +1,27 @@ -- | Parsing and serialization for OKF Markdown concept documents. module Okf.Document-  ( Frontmatter (..)-  , OKFDocument (..)-  , DocumentParseError (..)-  , emptyFrontmatter-  , frontmatterLookup-  , parseDocument-  , serializeDocument+  ( Frontmatter (..),+    OKFDocument (..),+    DocumentParseError (..),+    emptyFrontmatter,+    frontmatterLookup,+    parseDocument,+    serializeDocument,+     -- * Frontmatter authoring-  , frontmatterFromFields-  , setField-  , removeField-  , OkfCommon (..)-  , okfCommon-  , setType-  , setTitle-  , setDescription-  , setTimestamp-  , setResource-  , setTags-  ) where+    frontmatterFromFields,+    setField,+    removeField,+    OkfCommon (..),+    okfCommon,+    setType,+    setTitle,+    setDescription,+    setTimestamp,+    setResource,+    setTags,+  )+where  import Data.Aeson.Key qualified as AesonKey import Data.Aeson.KeyMap qualified as KeyMap@@ -32,7 +34,6 @@ import Data.Vector qualified as Vector import Data.Yaml qualified as Yaml import Data.Yaml.Pretty qualified as YamlPretty- import Okf.Prelude hiding (setField)  -- | YAML frontmatter fields. OKF allows producer-defined extension keys, so@@ -44,8 +45,8 @@  -- | A Markdown concept document split into frontmatter and body. data OKFDocument = OKFDocument-  { frontmatter :: !Frontmatter-  , body :: !Text+  { frontmatter :: !Frontmatter,+    body :: !Text   }   deriving stock (Generic, Eq, Show) @@ -84,21 +85,23 @@ -- omitted because they are optional and have distinct shapes; set them with -- 'setResource' and 'setTags'. data OkfCommon = OkfCommon-  { commonType :: !Text-  , commonTitle :: !(Maybe Text)-  , commonDescription :: !(Maybe Text)-  , commonTimestamp :: !(Maybe Text)+  { commonType :: !Text,+    commonTitle :: !(Maybe Text),+    commonDescription :: !(Maybe Text),+    commonTimestamp :: !(Maybe Text)   }   deriving stock (Generic, Eq, Show)  -- | Build frontmatter from the common OKF fields: @type@ always, plus -- whichever of @title@, @description@, @timestamp@ are present. okfCommon :: OkfCommon -> Frontmatter-okfCommon OkfCommon{commonType, commonTitle, commonDescription, commonTimestamp} =-  foldr ($) (setType commonType emptyFrontmatter)-    [ maybe id setTitle commonTitle-    , maybe id setDescription commonDescription-    , maybe id setTimestamp commonTimestamp+okfCommon OkfCommon {commonType, commonTitle, commonDescription, commonTimestamp} =+  foldr+    ($)+    (setType commonType emptyFrontmatter)+    [ maybe id setTitle commonTitle,+      maybe id setDescription commonDescription,+      maybe id setTimestamp commonTimestamp     ]  -- | Set the @type@ field.@@ -140,18 +143,19 @@ -- @type, title, description, timestamp, resource, tags@ — then every other key -- in ascending alphabetical order) so regenerating a bundle yields minimal diffs. serializeDocument :: OKFDocument -> Text-serializeDocument OKFDocument{frontmatter, body} =+serializeDocument OKFDocument {frontmatter, body} =   Text.unlines ["---", renderedYaml, "---", ""] <> ensureTrailingNewline body- where-  renderedYaml = renderOrderedYaml frontmatter+  where+    renderedYaml = renderOrderedYaml frontmatter  -- | Render frontmatter to YAML with the deterministic OKF key order. renderOrderedYaml :: Frontmatter -> Text renderOrderedYaml (Frontmatter rawFields) =-  Text.dropWhileEnd (== '\n')+  Text.dropWhileEnd+    (== '\n')     (Text.Encoding.decodeUtf8 (YamlPretty.encodePretty config (Object rawFields)))- where-  config = YamlPretty.setConfCompare (comparing okfKeyRank) YamlPretty.defConfig+  where+    config = YamlPretty.setConfCompare (comparing okfKeyRank) YamlPretty.defConfig  -- | Sort key for deterministic frontmatter ordering: the six common OKF fields -- come first in their fixed order; every other key sorts after them@@ -161,9 +165,9 @@   case lookup keyText commonRanks of     Just rank -> (rank, "")     Nothing -> (length commonRanks, keyText)- where-  commonRanks =-    zip ["type", "title", "description", "timestamp", "resource", "tags"] [0 ..]+  where+    commonRanks =+      zip ["type", "title", "description", "timestamp", "resource", "tags"] [0 ..]  parseFrontmatterDocument :: ByteString.ByteString -> Either DocumentParseError OKFDocument parseFrontmatterDocument inputBytes =

@@ -0,0 +1,228 @@+-- | Parsing and rendering for OKF @log.md@ reserved files.+module Okf.Log+  ( Log (..),+    LogDay (..),+    LogEntry (..),+    LogParseError (..),+    LogValidationError (..),+    appendLogEntry,+    logErrorIsStructural,+    parseLog,+    serializeLog,+    validateLog,+  )+where++import CMarkGFM qualified+import Data.Char qualified as Char+import Data.Text qualified as Text+import Data.Time (Day, defaultTimeLocale, parseTimeM)+import Okf.Prelude++-- | One parsed @log.md@ file.+data Log = Log+  { logTitle :: !Text,+    logDays :: ![LogDay]+  }+  deriving stock (Generic, Eq, Show)++-- | One @## YYYY-MM-DD@ date group and its entries.+data LogDay = LogDay+  { logDate :: !Text,+    logEntries :: ![LogEntry]+  }+  deriving stock (Generic, Eq, Show)++-- | One bullet entry under a date group.+data LogEntry = LogEntry+  { logKind :: !(Maybe Text),+    logText :: !Text+  }+  deriving stock (Generic, Eq, Show)++-- | Reserved for future parser failures. CommonMark parsing is total today.+data LogParseError+  = LogNotMarkdown Text+  deriving stock (Generic, Eq, Show)++-- | A structural or advisory problem in one parsed log.+data LogValidationError+  = LogDateNotIso Text+  | LogDaysOutOfOrder Text Text+  | LogEmptyDay Text+  deriving stock (Generic, Eq, Show)++-- | Parse Markdown into the log model. Structural validation is separate.+parseLog :: Text -> Log+parseLog markdown =+  finish (foldl' step emptyBuild topLevelNodes)+  where+    topLevelNodes =+      case CMarkGFM.commonmarkToNode [] [] markdown of+        CMarkGFM.Node _ _ documentChildren -> documentChildren++-- | Render a log deterministically with a trailing newline.+serializeLog :: Log -> Text+serializeLog Log {logTitle, logDays} =+  ensureTrailingNewline+    ( Text.intercalate+        "\n\n"+        ("# " <> logTitle : fmap renderDay logDays)+    )+  where+    renderDay LogDay {logDate, logEntries} =+      Text.intercalate "\n" ("## " <> logDate : fmap renderEntry logEntries)++    renderEntry LogEntry {logKind = Just kind, logText} =+      "* **" <> kind <> "**: " <> logText+    renderEntry LogEntry {logKind = Nothing, logText} =+      "* " <> logText++-- | Validate the OKF @log.md@ structure and ordering.+validateLog :: Log -> [LogValidationError]+validateLog Log {logDays} =+  foldMap validateDay logDays <> validateOrdering logDays+  where+    validateDay LogDay {logDate, logEntries} =+      [LogDateNotIso logDate | not (isIsoDate logDate)]+        <> [LogEmptyDay logDate | null logEntries]++    validateOrdering days =+      [ LogDaysOutOfOrder earlier later+      | (LogDay earlier _, LogDay later _) <- zip days (drop 1 days),+        isIsoDate earlier,+        isIsoDate later,+        earlier < later+      ]++-- | Whether a log validation error is a hard reserved-file structure error.+logErrorIsStructural :: LogValidationError -> Bool+logErrorIsStructural = \case+  LogDateNotIso _ -> True+  LogEmptyDay _ -> True+  LogDaysOutOfOrder _ _ -> False++data BuildLog = BuildLog+  { buildTitle :: !(Maybe Text),+    buildDaysRev :: ![LogDay],+    buildCurrentDay :: !(Maybe LogDay)+  }++emptyBuild :: BuildLog+emptyBuild =+  BuildLog+    { buildTitle = Nothing,+      buildDaysRev = [],+      buildCurrentDay = Nothing+    }++step :: BuildLog -> CMarkGFM.Node -> BuildLog+step build node@(CMarkGFM.Node _ nodeType childNodes) =+  case nodeType of+    CMarkGFM.HEADING 1 ->+      case buildTitle build of+        Nothing -> build {buildTitle = Just (plainText node)}+        Just _ -> build+    CMarkGFM.HEADING 2 ->+      (pushCurrent build) {buildCurrentDay = Just (LogDay (plainText node) [])}+    CMarkGFM.LIST _ ->+      case buildCurrentDay build of+        Nothing -> build+        Just day ->+          build+            { buildCurrentDay =+                Just day {logEntries = logEntries day <> foldMap logEntriesFromItem childNodes}+            }+    _ -> build++pushCurrent :: BuildLog -> BuildLog+pushCurrent build =+  case buildCurrentDay build of+    Nothing -> build+    Just day -> build {buildDaysRev = day : buildDaysRev build, buildCurrentDay = Nothing}++finish :: BuildLog -> Log+finish build =+  Log+    { logTitle = fromMaybe "" (buildTitle build),+      logDays = reverse (maybe (buildDaysRev build) (: buildDaysRev build) (buildCurrentDay build))+    }++logEntriesFromItem :: CMarkGFM.Node -> [LogEntry]+logEntriesFromItem (CMarkGFM.Node _ CMarkGFM.ITEM childNodes) =+  case inlineNodes childNodes of+    [] -> [LogEntry Nothing ""]+    firstInline : restInline ->+      case firstInline of+        CMarkGFM.Node _ CMarkGFM.STRONG _ ->+          [ LogEntry+              { logKind = Just (plainText firstInline),+                logText = dropKindSeparator (renderInlineNodes restInline)+              }+          | not (Text.null (plainText firstInline))+          ]+        _ ->+          [LogEntry {logKind = Nothing, logText = renderInlineNodes (firstInline : restInline)}]+logEntriesFromItem _ = []++inlineNodes :: [CMarkGFM.Node] -> [CMarkGFM.Node]+inlineNodes [] = []+inlineNodes (CMarkGFM.Node _ CMarkGFM.PARAGRAPH paragraphChildren : rest) =+  paragraphChildren <> inlineNodes rest+inlineNodes (node : rest) =+  node : inlineNodes rest++plainText :: CMarkGFM.Node -> Text+plainText (CMarkGFM.Node _ nodeType childNodes) =+  case nodeType of+    CMarkGFM.TEXT text -> text+    CMarkGFM.CODE text -> text+    CMarkGFM.SOFTBREAK -> "\n"+    CMarkGFM.LINEBREAK -> "\n"+    _ -> foldMap plainText childNodes++renderInlineNodes :: [CMarkGFM.Node] -> Text+renderInlineNodes nodes =+  Text.strip (CMarkGFM.nodeToCommonmark [] Nothing (CMarkGFM.Node Nothing CMarkGFM.PARAGRAPH nodes))++-- | Insert an entry under a date, keeping date groups newest first.+appendLogEntry :: Text -> LogEntry -> Log -> Log+appendLogEntry dateText entry logFile@Log {logDays} =+  logFile {logDays = insertDay logDays}+  where+    newDay = LogDay dateText [entry]++    insertDay [] = [newDay]+    insertDay (day : rest)+      | logDate day == dateText = day {logEntries = entry : logEntries day} : rest+      | dateText > logDate day = newDay : day : rest+      | otherwise = day : insertDay rest++dropKindSeparator :: Text -> Text+dropKindSeparator text =+  Text.stripStart+    ( fromMaybe+        stripped+        (Text.stripPrefix ":" stripped)+    )+  where+    stripped = Text.stripStart text++ensureTrailingNewline :: Text -> Text+ensureTrailingNewline text+  | Text.null text = "\n"+  | "\n" `Text.isSuffixOf` text = text+  | otherwise = text <> "\n"++isIsoDate :: Text -> Bool+isIsoDate value =+  Text.length value == 10+    && Text.index value 4 == '-'+    && Text.index value 7 == '-'+    && Text.all Char.isDigit (Text.take 4 value)+    && Text.all Char.isDigit (Text.take 2 (Text.drop 5 value))+    && Text.all Char.isDigit (Text.drop 8 value)+    && isJust parsed+  where+    parsed :: Maybe Day+    parsed = parseTimeM True defaultTimeLocale "%Y-%m-%d" (Text.unpack value)

@@ -4,13 +4,14 @@ --   vocabulary while keeping generic-lens label instances local to modules --   that explicitly opt into them. module Okf.Prelude-  ( module X-  , module Control.Lens+  ( module X,+    module Control.Lens,      -- * Generic-lens vocabulary-  , module Data.Generics.Product-  , module Data.Generics.Sum-  ) where+    module Data.Generics.Product,+    module Data.Generics.Sum,+  )+where  import "aeson" Data.Aeson as X (FromJSON, ToJSON, Value (..)) import "base" Control.Applicative as X ((<|>))@@ -20,7 +21,7 @@ import "base" Data.Maybe as X (fromMaybe, isJust, isNothing) import "base" Data.Traversable as X (for) import "base" GHC.Generics as X (Generic)-import "lens" Control.Lens import "generic-lens" Data.Generics.Product import "generic-lens" Data.Generics.Sum+import "lens" Control.Lens import "text" Data.Text as X (Text)

@@ -0,0 +1,239 @@+{-# LANGUAGE PackageImports #-}++-- | House-convention profiles: a declarative, Dhall-authored description of how a+-- team uses OKF, checkable against a bundle. Profiles are NOT part of the OKF+-- standard; a bundle that deviates from a profile remains fully OKF-conformant.+--+-- A profile is loaded from a Dhall descriptor ('loadProfileFile') into a+-- 'ProfileSpec' and checked against a list of 'Concept's with 'validateProfile',+-- which returns a (possibly empty) list of 'ProfileViolation's. By design the+-- caller decides whether those violations are advisory or fatal; this module only+-- reports them.+module Okf.Profile+  ( -- * Descriptor+    ProfileSpec (..),+    FrontmatterRules (..),+    TypeRule (..),+    loadProfileFile,++    -- * Validation+    ProfileViolation (..),+    validateProfile,++    -- * Body inspection+    schemaSectionColumns,+  )+where++import CMarkGFM qualified+import Control.Exception (SomeException, catch)+import Data.List qualified as List+import Data.Text qualified as Text+import Dhall (FromDhall (..), auto, genericAutoWith)+import Dhall qualified+import Okf.Bundle+  ( Concept,+    conceptDocument,+    conceptIdOf,+    conceptResource,+    conceptType,+  )+import Okf.ConceptId (ConceptId, renderConceptId)+import Okf.Document (Frontmatter, frontmatterLookup)+import Okf.Prelude+import "generic-lens" Data.Generics.Labels ()++-- | A complete house profile.+data ProfileSpec = ProfileSpec+  { name :: !Text,+    okfVersion :: !Text,+    frontmatter :: !FrontmatterRules,+    allowUnknownTypes :: !Bool,+    types :: ![TypeRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | Frontmatter keys the profile expects on every concept.+data FrontmatterRules = FrontmatterRules+  { required :: ![Text],+    recommended :: ![Text]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | One rule per allowed concept @type@ string.+data TypeRule = TypeRule+  { type_ :: !Text,+    pathPattern :: !(Maybe Text),+    resourceScheme :: !(Maybe Text),+    requireSchemaSection :: !Bool,+    schemaColumns :: ![Text]+  }+  deriving stock (Generic, Eq, Show)++-- | Decode @type_@ from the Dhall field @type@ by stripping the trailing+-- underscore; all other fields map by their exact name. (Mirrors how+-- 'Okf.Bundle' uses a @type_@ field to avoid clashing with the @type@ keyword.)+instance FromDhall TypeRule where+  autoWith _normalizer =+    genericAutoWith+      (Dhall.defaultInterpretOptions {Dhall.fieldModifier = stripTrailingUnderscore})+    where+      stripTrailingUnderscore fieldName =+        fromMaybe fieldName (Text.stripSuffix "_" fieldName)++-- | Load and decode a Dhall profile descriptor from a file path. Any evaluation+-- or decoding failure is captured as a human-readable 'Left'.+loadProfileFile :: FilePath -> IO (Either Text ProfileSpec)+loadProfileFile path =+  (Right <$> Dhall.inputFile auto path)+    `catch` \(e :: SomeException) -> pure (Left (Text.pack (show e)))++-- | A single deviation from a profile. Advisory by default at the CLI layer.+data ProfileViolation+  = -- | concept's @type@ is not listed in the profile and unknown types are disallowed+    TypeNotInProfile ConceptId Text+  | -- | a required frontmatter key is missing or empty (concept, key)+    MissingProfileField ConceptId Text+  | -- | concept's file path does not match the type rule's pattern (concept, type, pattern)+    PathPatternMismatch ConceptId Text Text+  | -- | type rule requires a resource scheme but resource is absent (concept, type, scheme)+    MissingResource ConceptId Text Text+  | -- | resource present but its scheme is wrong (concept, expected scheme, actual resource)+    ResourceSchemeMismatch ConceptId Text Text+  | -- | required @# Schema@ section is absent (concept, type)+    MissingSchemaSection ConceptId Text+  | -- | @# Schema@ table columns do not match (concept, type, expected, actual)+    SchemaColumnsMismatch ConceptId Text [Text] [Text]+  deriving stock (Generic, Eq, Show)++-- | Check every concept against the profile, returning all deviations. Concepts+-- whose @type@ is not in the profile vocabulary skip the per-rule checks (there+-- is no rule to check against) and only produce a 'TypeNotInProfile' violation+-- when @allowUnknownTypes@ is @False@.+validateProfile :: ProfileSpec -> [Concept] -> [ProfileViolation]+validateProfile spec = concatMap checkConcept+  where+    rulesByType = [(rule ^. #type_, rule) | rule <- spec ^. #types]++    checkConcept concept =+      let cid = conceptIdOf concept+          ctype = conceptType concept+       in case lookup ctype rulesByType of+            Nothing ->+              [TypeNotInProfile cid ctype | not (spec ^. #allowUnknownTypes)]+            Just rule ->+              checkRequiredFields cid concept+                <> checkPath cid ctype rule+                <> checkResource cid ctype rule concept+                <> checkSchema cid ctype rule concept++    checkRequiredFields cid concept =+      [ MissingProfileField cid key+      | key <- spec ^. #frontmatter . #required,+        not (hasNonEmptyField key (conceptFrontmatter concept))+      ]++-- | Project a concept's frontmatter (the document's @frontmatter@ field).+conceptFrontmatter :: Concept -> Frontmatter+conceptFrontmatter concept = conceptDocument concept ^. #frontmatter++-- | A field counts as present only if it is a non-empty string or a non-empty+-- list (mirroring how the core validator treats @type@). Anything else,+-- including a missing key, does not count.+hasNonEmptyField :: Text -> Frontmatter -> Bool+hasNonEmptyField key fm =+  case frontmatterLookup key fm of+    Just (String value) -> not (Text.null (Text.strip value))+    Just (Array values) -> not (null values)+    _ -> False++-- | A type rule's @pathPattern@, when present, constrains where the concept's+-- file may live.+checkPath :: ConceptId -> Text -> TypeRule -> [ProfileViolation]+checkPath cid ctype rule =+  case rule ^. #pathPattern of+    Nothing -> []+    Just patternText+      | matchPathPattern patternText cid -> []+      | otherwise -> [PathPatternMismatch cid ctype patternText]++-- | Match a concept ID against a segment-glob pattern. @*@ matches exactly one+-- segment; a single trailing @**@ matches one or more remaining segments; every+-- other segment matches literally. Both segment lists must be consumed exactly,+-- except for the trailing @**@ case.+matchPathPattern :: Text -> ConceptId -> Bool+matchPathPattern patternText cid =+  go (Text.splitOn "/" patternText) (Text.splitOn "/" (renderConceptId cid))+  where+    go [] [] = True+    go ["**"] (_ : _) = True+    go ("*" : ps) (_ : ss) = go ps ss+    go (p : ps) (s : ss) = p == s && go ps ss+    go _ _ = False++-- | A type rule's @resourceScheme@, when present, requires a @resource:@ value+-- whose scheme matches.+checkResource :: ConceptId -> Text -> TypeRule -> Concept -> [ProfileViolation]+checkResource cid ctype rule concept =+  case rule ^. #resourceScheme of+    Nothing -> []+    Just scheme ->+      case conceptResource concept of+        Nothing -> [MissingResource cid ctype scheme]+        Just value+          | (scheme <> "://") `Text.isPrefixOf` value -> []+          | otherwise -> [ResourceSchemeMismatch cid scheme value]++-- | A type rule's @# Schema@ contract: when @requireSchemaSection@ is set, the+-- body must contain a @# Schema@ section whose table header begins with the+-- required @schemaColumns@ (case-insensitive, trimmed, compared as a prefix so a+-- team may add trailing columns without tripping the check).+checkSchema :: ConceptId -> Text -> TypeRule -> Concept -> [ProfileViolation]+checkSchema cid ctype rule concept+  | not (rule ^. #requireSchemaSection) = []+  | otherwise =+      case schemaSectionColumns (conceptDocument concept ^. #body) of+        Nothing -> [MissingSchemaSection cid ctype]+        Just actual ->+          let expected = rule ^. #schemaColumns+              norm = map (Text.toLower . Text.strip)+           in [ SchemaColumnsMismatch cid ctype expected actual+              | not (norm expected `List.isPrefixOf` norm actual)+              ]++-- | The header-row columns of the first GitHub-flavored table that follows the+-- first top-level @# Schema@ heading, or 'Nothing' if there is no Schema heading+-- or no following table. Columns are trimmed.+schemaSectionColumns :: Text -> Maybe [Text]+schemaSectionColumns markdown =+  let CMarkGFM.Node _ _ topLevel = CMarkGFM.commonmarkToNode [] [CMarkGFM.extTable] markdown+   in firstTableAfterSchema topLevel++firstTableAfterSchema :: [CMarkGFM.Node] -> Maybe [Text]+firstTableAfterSchema topLevel =+  case dropWhile (not . isSchemaHeading) topLevel of+    (_heading : rest) -> headerRow rest+    [] -> Nothing+  where+    isSchemaHeading (CMarkGFM.Node _ (CMarkGFM.HEADING _) inner) =+      Text.toLower (Text.strip (nodeText inner)) == "schema"+    isSchemaHeading _ = False++    headerRow [] = Nothing+    headerRow (CMarkGFM.Node _ (CMarkGFM.TABLE _) tableChildren : _) =+      case tableChildren of+        (CMarkGFM.Node _ CMarkGFM.TABLE_ROW cells : _) -> Just (map cellText cells)+        _ -> Nothing+    headerRow (_ : more) = headerRow more++    cellText (CMarkGFM.Node _ _ inner) = Text.strip (nodeText inner)++-- | Concatenate all @TEXT@/@CODE@ literals under a node list, recursively.+nodeText :: [CMarkGFM.Node] -> Text+nodeText = foldMap go+  where+    go (CMarkGFM.Node _ (CMarkGFM.TEXT t) _) = t+    go (CMarkGFM.Node _ (CMarkGFM.CODE t) _) = t+    go (CMarkGFM.Node _ _ inner) = nodeText inner

@@ -5,16 +5,24 @@     validateDocument,     BundleValidationError (..),     validateBundle,+    validateBundleLogs,+    validateLogs,+    LogStaleness (..),+    logStaleness,+    nearestEnclosingLogPath,   ) where +import Data.List qualified as List import Data.Text qualified as Text import Data.Vector qualified as Vector-import Okf.Bundle (Concept, conceptDocument, conceptIdOf)+import Okf.Bundle (Concept, LogFile, conceptDocument, conceptIdOf, conceptSourcePath, logContent, logSourcePath) import Okf.ConceptId (ConceptId) import Okf.Document import Okf.Graph (danglingReferences, duplicateConceptIds)+import Okf.Log (Log (logDays), LogDay (logDate), LogValidationError, validateLog) import Okf.Prelude+import System.FilePath qualified as FilePath  -- | Validation modes supported by the initial OKF core library. data ValidationProfile@@ -38,8 +46,19 @@     DanglingReference ConceptId ConceptId   | -- | The same concept ID was assembled more than once.     DuplicateConceptId ConceptId+  | -- | A reserved log file does not match the required log structure.+    LogInvalid FilePath LogValidationError   deriving stock (Generic, Eq, Show) +-- | A concept whose timestamp appears newer than its nearest covering log.+data LogStaleness = LogStaleness+  { staleConcept :: !ConceptId,+    staleConceptDate :: !Text,+    staleLogPath :: !(Maybe FilePath),+    staleLogDate :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)+ -- | Validate a whole bundle: per-document checks under the given profile, plus -- referential integrity (no links to missing concepts) and uniqueness of -- concept IDs. An empty list means the bundle is valid under the profile.@@ -55,6 +74,28 @@     dangling = uncurry DanglingReference <$> danglingReferences concepts     duplicates = DuplicateConceptId <$> duplicateConceptIds concepts +-- | Validate all parsed @log.md@ files discovered in a bundle.+validateBundleLogs :: [LogFile] -> [BundleValidationError]+validateBundleLogs = validateLogs++-- | Validate all parsed @log.md@ files discovered in a bundle.+validateLogs :: [LogFile] -> [BundleValidationError]+validateLogs logFiles =+  [ LogInvalid (logSourcePath logFile) err+  | logFile <- logFiles,+    err <- validateLog (logContent logFile)+  ]++-- | Find concepts whose timestamp date is newer than their nearest enclosing log.+logStaleness :: [Concept] -> [LogFile] -> [LogStaleness]+logStaleness concepts logs =+  [ staleness+  | concept <- concepts,+    Just conceptDate <- [conceptTimestampDate concept],+    let nearest = nearestEnclosingLog (conceptSourcePath concept) logs,+    Just staleness <- [staleIfNeeded concept conceptDate nearest]+  ]+ -- | Validate a parsed document under the requested profile. validateDocument :: ValidationProfile -> OKFDocument -> [ValidationError] validateDocument profile document =@@ -85,3 +126,68 @@   where     isString (String _) = True     isString _ = False++conceptTimestampDate :: Concept -> Maybe Text+conceptTimestampDate concept =+  case frontmatterLookup "timestamp" (frontmatter (conceptDocument concept)) of+    Just (String timestamp)+      | Text.length timestamp >= 10 -> Just (Text.take 10 timestamp)+    _ -> Nothing++staleIfNeeded :: Concept -> Text -> Maybe LogFile -> Maybe LogStaleness+staleIfNeeded concept conceptDate nearest =+  case nearest of+    Nothing ->+      Just+        LogStaleness+          { staleConcept = conceptIdOf concept,+            staleConceptDate = conceptDate,+            staleLogPath = Nothing,+            staleLogDate = Nothing+          }+    Just logFile ->+      let newest = newestLogDate (logContent logFile)+       in if maybe True (conceptDate >) newest+            then+              Just+                LogStaleness+                  { staleConcept = conceptIdOf concept,+                    staleConceptDate = conceptDate,+                    staleLogPath = Just (logSourcePath logFile),+                    staleLogDate = newest+                  }+            else Nothing++newestLogDate :: Log -> Maybe Text+newestLogDate logFile =+  case logDate <$> logDays logFile of+    [] -> Nothing+    dates -> Just (maximum dates)++nearestEnclosingLog :: FilePath -> [LogFile] -> Maybe LogFile+nearestEnclosingLog conceptPath logs =+  case nearestEnclosingLogPath conceptPath (logSourcePath <$> logs) of+    Nothing -> Nothing+    Just path -> List.find ((== path) . logSourcePath) logs++-- | Pick the closest @log.md@ path whose directory contains the concept path.+nearestEnclosingLogPath :: FilePath -> [FilePath] -> Maybe FilePath+nearestEnclosingLogPath conceptPath logPaths =+  case candidates of+    [] -> Nothing+    _ -> Just (snd (List.maximumBy compareDepth candidates))+  where+    conceptDirectory = pathSegments (FilePath.takeDirectory conceptPath)+    candidates =+      [ (scope, logPath)+      | logPath <- logPaths,+        let scope = pathSegments (FilePath.takeDirectory logPath),+        scope `List.isPrefixOf` conceptDirectory+      ]+    compareDepth left right = compare (length (fst left)) (length (fst right))++pathSegments :: FilePath -> [FilePath]+pathSegments path =+  case FilePath.splitDirectories (FilePath.normalise path) of+    ["."] -> []+    segments -> filter (`notElem` [".", ""]) segments

@@ -1,3 +1,5 @@+{-# LANGUAGE PackageImports #-}+ module Main (main) where  import Data.Aeson (object, toJSON, (.=))@@ -9,17 +11,21 @@ import Okf.Document import Okf.Graph import Okf.Index+import Okf.Log import Okf.Prelude hiding (setField, (.=))+import Okf.Profile import Okf.Validation import System.Directory   ( createDirectoryIfMissing,     doesDirectoryExist,+    doesFileExist,     getTemporaryDirectory,     removeDirectoryRecursive,   ) import System.Exit (exitFailure) import System.FilePath ((</>)) import System.IO.Temp (createTempDirectory)+import "generic-lens" Data.Generics.Labels ()  main :: IO () main = do@@ -38,6 +44,14 @@         testIO "walkBundle reports a structured IO error for a missing root" testWalkBundleMissingRoot,         testIO "walkBundle skips index.md and log.md" testWalkBundleSkipsReserved,         testIO "walkBundle discovers nested concept IDs" testWalkBundleDiscoversNestedConceptIds,+        test "parseLog/serializeLog round-trips a canonical log" testLogRoundTrip,+        test "validateLog flags a non-ISO date heading" testValidateLogNonIsoDate,+        test "validateLog flags an empty date group" testValidateLogEmptyDay,+        test "validateLog flags out-of-order days" testValidateLogOutOfOrder,+        testIO "walkLogs discovers nested log.md files" testWalkLogsDiscoversNested,+        test "logStaleness flags a concept newer than its nearest log" testLogStalenessFlagsNewerConcept,+        test "logStaleness prefers the deepest enclosing log" testLogStalenessPrefersDeepestLog,+        test "appendLogEntry inserts newest-first and prepends within a day" testAppendLogEntry,         testIO "generateIndex groups documents by frontmatter type" testGenerateIndexGroupsByType,         testIO "extractLinks resolves relative and absolute bundle links" testExtractLinksResolveBundleLinks,         testIO "extractLinks ignores external markdown URLs" testExtractLinksIgnoresExternalUrls,@@ -56,7 +70,17 @@         test "duplicateConceptIds finds repeated ids" testDuplicateConceptIds,         test "conceptFromDocument derives typed fields from frontmatter" testConceptFromDocumentDerivesFields,         testIO "writeBundle then walkBundle round-trips" testWriteBundleRoundTrip,-        testIO "fixture dangling link reports a bundle validation error" testFixtureDanglingLink+        testIO "fixture dangling link reports a bundle validation error" testFixtureDanglingLink,+        testIO "loadProfileFile decodes the postgresql fixture" testLoadProfileFixture,+        test "validateProfile accepts a conforming table concept" testProfileConformingTable,+        test "validateProfile flags a type not in the vocabulary" testProfileUnknownType,+        test "validateProfile flags a missing required field" testProfileMissingField,+        test "validateProfile flags a resource scheme mismatch" testProfileResourceMismatch,+        test "validateProfile flags a path pattern mismatch" testProfilePathMismatch,+        test "validateProfile flags a missing # Schema section" testProfileMissingSchema,+        test "validateProfile flags mismatched # Schema columns" testProfileSchemaColumnsMismatch,+        test "schemaSectionColumns reads the header row of the Schema table" testSchemaSectionColumns,+        testIO "validateProfile reports the expected deviations for the fixture bundle" testProfileDeviationsFixture       ]   unless (and results) exitFailure @@ -78,13 +102,13 @@ testParseValidDocument :: Either Text () testParseValidDocument = do   document <- firstShow (parseDocument sampleDocument)-  assertEqual (Just (String "BigQuery Table")) (frontmatterLookup "type" (frontmatter document))+  assertEqual (Just (String "BigQuery Table")) (frontmatterLookup "type" (document ^. #frontmatter))   assertEqual "# Schema\n\nBody text.\n" (body document)  testParseNoFrontmatter :: Either Text () testParseNoFrontmatter = do   document <- firstShow (parseDocument "# Draft\n")-  assertEqual Nothing (frontmatterLookup "type" (frontmatter document))+  assertEqual Nothing (frontmatterLookup "type" (document ^. #frontmatter))   assertEqual "# Draft\n" (body document)  testRejectUnterminatedFrontmatter :: Either Text ()@@ -119,7 +143,7 @@   assertEqual [] (validateDocument PermissiveConformance document)   assertEqual [] (validateDocument StrictAuthoring document)   reparsed <- firstShow (parseDocument (serializeDocument document))-  assertEqual (frontmatter document) (frontmatter reparsed)+  assertEqual (document ^. #frontmatter) (reparsed ^. #frontmatter)   assertEqual (body document) (body reparsed)  testRejectInvalidConceptId :: Either Text ()@@ -165,6 +189,132 @@           )     ) +testLogRoundTrip :: Either Text ()+testLogRoundTrip = do+  let canonicalLog =+        Text.unlines+          [ "# Directory Update Log",+            "",+            "## 2026-06-23",+            "* **Update**: Refreshed [orders](tables/orders.md).",+            "* **Creation**: Added customers.",+            "",+            "## 2026-06-01",+            "* Deprecated a stale note."+          ]+      parsed = parseLog canonicalLog+      reparsed = parseLog (serializeLog parsed)+  assertEqual+    ( Log+        { logTitle = "Directory Update Log",+          logDays =+            [ LogDay+                { logDate = "2026-06-23",+                  logEntries =+                    [ LogEntry (Just "Update") "Refreshed [orders](tables/orders.md).",+                      LogEntry (Just "Creation") "Added customers."+                    ]+                },+              LogDay+                { logDate = "2026-06-01",+                  logEntries = [LogEntry Nothing "Deprecated a stale note."]+                }+            ]+        }+    )+    parsed+  assertEqual parsed reparsed++testValidateLogNonIsoDate :: Either Text ()+testValidateLogNonIsoDate =+  assertBool+    "expected LogDateNotIso"+    (LogDateNotIso "not-a-date" `List.elem` validateLog (parseLog "# Log\n\n## not-a-date\n* **Update**: oops\n"))++testValidateLogEmptyDay :: Either Text ()+testValidateLogEmptyDay =+  assertBool+    "expected LogEmptyDay"+    (LogEmptyDay "2026-06-23" `List.elem` validateLog (parseLog "# Log\n\n## 2026-06-23\n"))++testValidateLogOutOfOrder :: Either Text ()+testValidateLogOutOfOrder =+  assertBool+    "expected LogDaysOutOfOrder"+    ( LogDaysOutOfOrder "2026-01-01" "2026-06-23"+        `List.elem` validateLog (parseLog "# Log\n\n## 2026-01-01\n* Old.\n\n## 2026-06-23\n* New.\n")+    )++testWalkLogsDiscoversNested :: IO (Either Text ())+testWalkLogsDiscoversNested = do+  temporaryDirectory <- getTemporaryDirectory+  root <- createTempDirectory temporaryDirectory "okf-core-logs"+  createDirectoryIfMissing True (root </> "tables")+  Text.IO.writeFile (root </> "log.md") "# Root Log\n\n## 2026-06-23\n* Root entry.\n"+  Text.IO.writeFile (root </> "tables" </> "log.md") "# Tables Log\n\n## 2026-06-22\n* Tables entry.\n"+  result <- walkLogs root+  removeDirectoryRecursive root+  pure+    ( case result of+        Right logs -> assertEqual ["log.md", "tables/log.md"] (logSourcePath <$> logs)+        Left bundleError -> Left ("expected logs, got " <> Text.pack (show bundleError))+    )++testLogStalenessFlagsNewerConcept :: Either Text ()+testLogStalenessFlagsNewerConcept = do+  staleId <- parseTestConceptId "stale"+  staleConcept <- testConceptWithTimestamp "stale" "2026-06-23T00:00:00Z"+  currentConcept <- testConceptWithTimestamp "current" "2026-01-01T00:00:00Z"+  let logs = [LogFile "log.md" (parseLog "# Log\n\n## 2026-06-01\n* **Update**: logged.\n")]+  assertEqual+    [ LogStaleness+        { staleConcept = staleId,+          staleConceptDate = "2026-06-23",+          staleLogPath = Just "log.md",+          staleLogDate = Just "2026-06-01"+        }+    ]+    (logStaleness [staleConcept, currentConcept] logs)++testLogStalenessPrefersDeepestLog :: Either Text ()+testLogStalenessPrefersDeepestLog = do+  usersId <- parseTestConceptId "tables/users"+  usersConcept <- testConceptWithTimestamp "tables/users" "2026-06-21T00:00:00Z"+  let logs =+        [ LogFile "log.md" (parseLog "# Root Log\n\n## 2026-06-01\n* **Update**: root.\n"),+          LogFile "tables/log.md" (parseLog "# Tables Log\n\n## 2026-06-20\n* **Update**: tables.\n")+        ]+  assertEqual+    [ LogStaleness+        { staleConcept = usersId,+          staleConceptDate = "2026-06-21",+          staleLogPath = Just "tables/log.md",+          staleLogDate = Just "2026-06-20"+        }+    ]+    (logStaleness [usersConcept] logs)++testAppendLogEntry :: Either Text ()+testAppendLogEntry =+  assertEqual+    ( Log+        { logTitle = "Log",+          logDays =+            [ LogDay "2026-06-23" [LogEntry (Just "Update") "new"],+              LogDay "2026-06-01" [LogEntry (Just "Update") "prepended", LogEntry (Just "Creation") "old"]+            ]+        }+    )+    ( appendLogEntry+        "2026-06-01"+        (LogEntry (Just "Update") "prepended")+        ( appendLogEntry+            "2026-06-23"+            (LogEntry (Just "Update") "new")+            (Log "Log" [LogDay "2026-06-01" [LogEntry (Just "Creation") "old"]])+        )+    )+ testGenerateIndexGroupsByType :: IO (Either Text ()) testGenerateIndexGroupsByType =   withFixtureBundle@@ -318,7 +468,7 @@               }       original = OKFDocument frontmatterValue "# Orders\n\nBody text.\n"   reparsed <- firstShow (parseDocument (serializeDocument original))-  assertEqual (frontmatter original) (frontmatter reparsed)+  assertEqual (original ^. #frontmatter) (reparsed ^. #frontmatter)   assertEqual (body original) (body reparsed)  testSerializeDeterministicKeyOrder :: Either Text ()@@ -414,6 +564,19 @@             }   pure (conceptFromDocument conceptId (OKFDocument frontmatterValue bodyText)) +testConceptWithTimestamp :: Text -> Text -> Either Text Concept+testConceptWithTimestamp rawId timestamp = do+  conceptId <- parseTestConceptId rawId+  let frontmatterValue =+        okfCommon+          OkfCommon+            { commonType = "Test",+              commonTitle = Just "Title",+              commonDescription = Just "Description",+              commonTimestamp = Just timestamp+            }+  pure (conceptFromDocument conceptId (OKFDocument frontmatterValue "# Test\n"))+ testConceptFromDocumentDerivesFields :: Either Text () testConceptFromDocumentDerivesFields = do   conceptId <- parseTestConceptId "tables/orders"@@ -469,6 +632,178 @@   where     isDangling DanglingReference {} = True     isDangling _ = False++-- | Resolve a fixture file path regardless of whether tests run from the repo+-- root or the package directory (mirrors 'fixturePath' for files).+fixtureFilePath :: FilePath -> IO FilePath+fixtureFilePath name = findExisting candidates+  where+    candidates =+      [ "okf-core" </> "test" </> "fixtures" </> name,+        "test" </> "fixtures" </> name+      ]+    findExisting [] = fail ("fixture file not found: " <> name)+    findExisting (candidate : rest) = do+      exists <- doesFileExist candidate+      if exists then pure candidate else findExisting rest++-- | Milestone 1: the Dhall descriptor round-trips into a 'ProfileSpec'.+testLoadProfileFixture :: IO (Either Text ())+testLoadProfileFixture = do+  path <- fixtureFilePath "profiles/postgresql.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load profile: " <> err)+    Right spec -> do+      assertEqual "shinzui-postgresql" (spec ^. #name)+      assertEqual False (spec ^. #allowUnknownTypes)+      assertEqual ["type", "title"] (spec ^. #frontmatter . #required)+      assertEqual+        ["PostgreSQL Schema", "PostgreSQL Table", "PostgreSQL View"]+        (map (^. #type_) (spec ^. #types))++-- | A standalone profile literal so the validation tests do not depend on the+-- Dhall fixture. One rule: PostgreSQL Table, fully constrained.+testProfileSpec :: ProfileSpec+testProfileSpec =+  ProfileSpec+    { name = "test-postgresql",+      okfVersion = "0.1",+      frontmatter = FrontmatterRules {required = ["type", "title"], recommended = []},+      allowUnknownTypes = False,+      types =+        [ TypeRule+            { type_ = "PostgreSQL Table",+              pathPattern = Just "schemas/*/tables/*",+              resourceScheme = Just "postgresql",+              requireSchemaSection = True,+              schemaColumns = ["Column", "Type", "Nullable", "Description"]+            }+        ]+    }++-- | Build an in-memory concept from a raw ID, frontmatter pairs, and a body.+profileConcept :: Text -> [(Text, Value)] -> Text -> Either Text Concept+profileConcept rawId fieldPairs bodyText = do+  conceptId <- parseTestConceptId rawId+  pure (conceptFromDocument conceptId (OKFDocument (frontmatterFromFields fieldPairs) bodyText))++-- | A well-formed @# Schema@ section matching the profile's required columns.+schemaSectionBody :: Text+schemaSectionBody =+  Text.unlines+    [ "# Schema",+      "",+      "| Column | Type   | Nullable | Description |",+      "|--------|--------|----------|-------------|",+      "| id     | bigint | no       | Primary key |"+    ]++testProfileConformingTable :: Either Text ()+testProfileConformingTable = do+  concept <-+    profileConcept+      "schemas/sales/tables/orders"+      [ ("type", String "PostgreSQL Table"),+        ("title", String "Orders"),+        ("resource", String "postgresql://warehouse/sales/orders")+      ]+      schemaSectionBody+  assertEqual [] (validateProfile testProfileSpec [concept])++testProfileUnknownType :: Either Text ()+testProfileUnknownType = do+  concept <-+    profileConcept+      "schemas/sales/tables/bad"+      [("type", String "pg table"), ("title", String "Bad"), ("resource", String "postgresql://x")]+      schemaSectionBody+  cid <- parseTestConceptId "schemas/sales/tables/bad"+  assertEqual [TypeNotInProfile cid "pg table"] (validateProfile testProfileSpec [concept])++testProfileMissingField :: Either Text ()+testProfileMissingField = do+  concept <-+    profileConcept+      "schemas/sales/tables/orders"+      [("type", String "PostgreSQL Table"), ("resource", String "postgresql://x")]+      schemaSectionBody+  cid <- parseTestConceptId "schemas/sales/tables/orders"+  assertEqual [MissingProfileField cid "title"] (validateProfile testProfileSpec [concept])++testProfileResourceMismatch :: Either Text ()+testProfileResourceMismatch = do+  concept <-+    profileConcept+      "schemas/sales/tables/orders"+      [("type", String "PostgreSQL Table"), ("title", String "Orders"), ("resource", String "mysql://x")]+      schemaSectionBody+  cid <- parseTestConceptId "schemas/sales/tables/orders"+  assertEqual+    [ResourceSchemeMismatch cid "postgresql" "mysql://x"]+    (validateProfile testProfileSpec [concept])++testProfilePathMismatch :: Either Text ()+testProfilePathMismatch = do+  concept <-+    profileConcept+      "tables/orders"+      [("type", String "PostgreSQL Table"), ("title", String "Orders"), ("resource", String "postgresql://x")]+      schemaSectionBody+  cid <- parseTestConceptId "tables/orders"+  assertEqual+    [PathPatternMismatch cid "PostgreSQL Table" "schemas/*/tables/*"]+    (validateProfile testProfileSpec [concept])++testProfileMissingSchema :: Either Text ()+testProfileMissingSchema = do+  concept <-+    profileConcept+      "schemas/sales/tables/orders"+      [("type", String "PostgreSQL Table"), ("title", String "Orders"), ("resource", String "postgresql://x")]+      "# Overview\n\nNo schema section here.\n"+  cid <- parseTestConceptId "schemas/sales/tables/orders"+  assertEqual+    [MissingSchemaSection cid "PostgreSQL Table"]+    (validateProfile testProfileSpec [concept])++testProfileSchemaColumnsMismatch :: Either Text ()+testProfileSchemaColumnsMismatch = do+  let mismatchBody =+        Text.unlines+          ["# Schema", "", "| Col | Type |", "|-----|------|", "| id  | bigint |"]+  concept <-+    profileConcept+      "schemas/sales/tables/orders"+      [("type", String "PostgreSQL Table"), ("title", String "Orders"), ("resource", String "postgresql://x")]+      mismatchBody+  cid <- parseTestConceptId "schemas/sales/tables/orders"+  assertEqual+    [SchemaColumnsMismatch cid "PostgreSQL Table" ["Column", "Type", "Nullable", "Description"] ["Col", "Type"]]+    (validateProfile testProfileSpec [concept])++testSchemaSectionColumns :: Either Text ()+testSchemaSectionColumns =+  assertEqual+    (Just ["Column", "Type", "Nullable", "Description"])+    (schemaSectionColumns schemaSectionBody)++-- | Milestone 5: walking the deviating fixture and validating it against the+-- shipped descriptor produces exactly the expected advisory deviations.+testProfileDeviationsFixture :: IO (Either Text ())+testProfileDeviationsFixture = do+  descriptorPath <- fixtureFilePath "profiles/postgresql.dhall"+  loaded <- loadProfileFile descriptorPath+  root <- fixturePath "profile-deviations"+  concepts <- readBundle root+  pure $ case loaded of+    Left err -> Left ("failed to load profile: " <> err)+    Right spec -> do+      badId <- parseTestConceptId "schemas/sales/tables/bad"+      ordersId <- parseTestConceptId "schemas/sales/tables/orders"+      assertEqual+        [TypeNotInProfile badId "pg table", MissingProfileField ordersId "title"]+        (validateProfile spec concepts)  substringIndex :: Text -> Text -> Maybe Int substringIndex needle haystack =