packages feed

okf-core (empty) → 0.1.0.0

raw patch · 11 files changed

+1660/−0 lines, 11 filesdep +aesondep +attoparsecdep +base

Dependencies added: aeson, attoparsec, base, bytestring, cmark-gfm, containers, directory, filepath, frontmatter, generic-lens, lens, okf-core, temporary, text, vector, yaml

Files

+ CHANGELOG.md view
@@ -0,0 +1,22 @@+# Changelog++All notable changes to okf are recorded here.++The format follows [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), and+this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).++## [Unreleased]++## [0.1.0.0] - 2026-06-19++Initial release.++### Added++- `okf-core` library: OKF document parser (`Okf.Document`), bundle graph+  indexing (`Okf.Index`, `Okf.Graph`), bundle validation with referential+  integrity (`Okf.Validation`, `Okf.Bundle`), concept construction and bundle+  writing, concept-link rendering with a round-trip guarantee, and a frontmatter+  authoring API.+- `okf-cli` library and `okf` executable: bundle validation and document+  authoring commands over the core API.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2026 Nadeem Bitar++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Nadeem Bitar nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ okf-core.cabal view
@@ -0,0 +1,81 @@+cabal-version: 3.4+name: okf-core+version: 0.1.0.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+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+    -Wmissing-deriving-strategies++  default-language: GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    OverloadedLabels+    OverloadedStrings++library+  import: common-options+  hs-source-dirs: src+  exposed-modules:+    Okf.Bundle+    Okf.ConceptId+    Okf.Document+    Okf.Graph+    Okf.Index+    Okf.Prelude+    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,++test-suite okf-core-test+  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,
+ src/Okf/Bundle.hs view
@@ -0,0 +1,216 @@+-- | Bundle-level discovery for OKF concept documents.+module Okf.Bundle+  ( BundleError (..),+    Concept,+    conceptFromDocument,+    conceptDescription,+    conceptDocument,+    conceptIdOf,+    conceptResource,+    conceptSourcePath,+    conceptTags,+    conceptTitle,+    conceptType,+    findConcept,+    isReservedMarkdownFile,+    serializeConcept,+    walkBundle,+    writeBundle,+  )+where++import Control.Exception (IOException, try)+import Data.List qualified as List+import Data.Text qualified as Text+import Data.Text.IO qualified as Text.IO+import Okf.ConceptId+import Okf.Document+import Okf.Prelude+import System.Directory+  ( createDirectoryIfMissing,+    doesDirectoryExist,+    listDirectory,+  )+import System.FilePath ((</>))+import System.FilePath qualified as FilePath+import System.IO.Error (ioeGetErrorString)++-- | A parsed concept document discovered in a bundle.+data Concept = Concept+  { id :: !ConceptId,+    sourcePath :: !FilePath,+    document :: !OKFDocument,+    type_ :: !Text,+    title :: !(Maybe Text),+    description :: !(Maybe Text),+    resource :: !(Maybe Text),+    tags :: ![Text]+  }+  deriving stock (Generic, Eq, Show)++-- | Filesystem or parser failures while walking a bundle.+data BundleError+  = InvalidConceptPath FilePath ConceptIdError+  | InvalidConceptDocument FilePath DocumentParseError+  | BundleIoError FilePath Text+  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+  discovered <- discoverMarkdownFiles root ""+  case discovered of+    Left bundleError -> pure (Left bundleError)+    Right paths -> do+      results <- mapM (readConcept root) paths+      pure (List.sortOn (renderConceptId . conceptIdOf) <$> sequenceA results)++-- | Find a concept by identifier in an already walked bundle.+findConcept :: ConceptId -> [Concept] -> Maybe Concept+findConcept conceptId =+  List.find (\concept -> conceptIdOf concept == conceptId)++-- | Extract a concept identifier without colliding with Prelude's `id`.+conceptIdOf :: Concept -> ConceptId+conceptIdOf Concept {id = conceptId} = conceptId++-- | Bundle-relative path the concept was read from or would be written to.+conceptSourcePath :: Concept -> FilePath+conceptSourcePath Concept {sourcePath} = sourcePath++-- | Parsed Markdown document backing the concept.+conceptDocument :: Concept -> OKFDocument+conceptDocument Concept {document} = document++-- | Required @type@ frontmatter field projected as text, or empty when invalid.+conceptType :: Concept -> Text+conceptType Concept {type_} = type_++conceptTitle :: Concept -> Maybe Text+conceptTitle Concept {title} = title++conceptDescription :: Concept -> Maybe Text+conceptDescription Concept {description} = description++conceptResource :: Concept -> Maybe Text+conceptResource Concept {resource} = resource++conceptTags :: Concept -> [Text]+conceptTags Concept {tags} = tags++-- | Reserved Markdown filenames are not normal concept documents.+isReservedMarkdownFile :: FilePath -> Bool+isReservedMarkdownFile path =+  FilePath.takeFileName path `List.elem` ["index.md", "log.md"]++discoverMarkdownFiles :: FilePath -> FilePath -> IO (Either BundleError [FilePath])+discoverMarkdownFiles 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 -> discoverMarkdownFiles root relativePath+                Right False ->+                  pure+                    ( Right+                        [ FilePath.normalise relativePath+                        | FilePath.takeExtension entry == ".md",+                          not (isReservedMarkdownFile entry)+                        ]+                    )+          )+      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+-- concept are left untouched (a producer wanting a pristine output directory+-- should clear it first). Does not validate; run 'Okf.Validation.validateBundle'+-- first if you want referential-integrity guarantees.+writeBundle :: FilePath -> [Concept] -> IO ()+writeBundle root concepts =+  mapM_ writeConcept concepts+  where+    writeConcept concept = do+      let relativePath = conceptIdToFilePath (conceptIdOf concept)+          absolutePath = root </> relativePath+      createDirectoryIfMissing True (FilePath.takeDirectory absolutePath)+      Text.IO.writeFile absolutePath (serializeConcept concept)++-- | Serialize a single concept's document to a Markdown string.+serializeConcept :: Concept -> Text+serializeConcept = serializeDocument . document++readConcept :: FilePath -> FilePath -> IO (Either BundleError Concept)+readConcept root relativePath = do+  loaded <- tryBundleIo relativePath (Text.IO.readFile (root </> relativePath))+  pure+    ( do+        content <- loaded+        conceptId <- first (InvalidConceptPath relativePath) (conceptIdFromFilePath relativePath)+        document <- first (InvalidConceptDocument relativePath) (parseDocument content)+        pure (conceptAt conceptId relativePath document)+    )++tryBundleIo :: FilePath -> IO value -> IO (Either BundleError value)+tryBundleIo path action = do+  result <- try action+  pure+    ( case result of+        Right value -> Right value+        Left (exception :: IOException) -> Left (BundleIoError path (Text.pack (ioeGetErrorString exception)))+    )++-- | Build a 'Concept' from its identity and document. The typed projection+-- fields (@type_@, @title@, @description@, @resource@, @tags@) are derived from+-- the document's frontmatter, so they can never disagree with it. The source+-- path is derived from the concept ID. Use this when assembling concepts in+-- memory (for 'writeBundle' or 'Okf.Validation.validateBundle').+conceptFromDocument :: ConceptId -> OKFDocument -> Concept+conceptFromDocument conceptId =+  conceptAt conceptId (conceptIdToFilePath conceptId)++-- | Build a 'Concept' with an explicit on-disk source path (used by the reader).+conceptAt :: ConceptId -> FilePath -> OKFDocument -> Concept+conceptAt conceptId relativePath document =+  Concept+    { id = conceptId,+      sourcePath = relativePath,+      document,+      type_ = textField "type" (frontmatter document),+      title = optionalTextField "title" (frontmatter document),+      description = optionalTextField "description" (frontmatter document),+      resource = optionalTextField "resource" (frontmatter document),+      tags = tagsField (frontmatter document)+    }++textField :: Text -> Frontmatter -> Text+textField key frontmatter =+  fromMaybe "" (optionalTextField key frontmatter)++optionalTextField :: Text -> Frontmatter -> Maybe Text+optionalTextField key frontmatter =+  case frontmatterLookup key frontmatter of+    Just (String value) -> Just value+    _ -> Nothing++tagsField :: Frontmatter -> [Text]+tagsField frontmatter =+  case frontmatterLookup "tags" frontmatter of+    Just (Array values) -> foldMap tagValue values+    Just (String value) -> [value]+    _ -> []+  where+    tagValue (String value) = [value]+    tagValue _ = []
+ src/Okf/ConceptId.hs view
@@ -0,0 +1,93 @@+-- | Safe concept identifiers for bundle-relative OKF Markdown documents.+module Okf.ConceptId+  ( ConceptId+  , ConceptIdError (..)+  , conceptIdFromFilePath+  , conceptIdToFilePath+  , parseConceptId+  , renderConceptId+  , renderConceptLinkTarget+  , renderConceptLink+  ) where++import Data.Char qualified as Char+import Data.Aeson (ToJSON (..))+import Data.List.NonEmpty qualified as NonEmpty+import Data.Text qualified as Text+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+  { segments :: NonEmpty Text+  }+  deriving stock (Generic, Eq, Ord, Show)++instance ToJSON ConceptId where+  toJSON = toJSON . renderConceptId++-- | Why a piece of text could not become a 'ConceptId'.+data ConceptIdError+  = EmptyConceptId+  | InvalidConceptIdSegment Text+  deriving stock (Generic, Eq, Show)++-- | Parse a slash-separated concept identifier such as @tables/users@.+parseConceptId :: Text -> Either ConceptIdError ConceptId+parseConceptId raw =+  case Text.splitOn "/" raw of+    [] -> Left EmptyConceptId+    [""] -> Left EmptyConceptId+    firstSegment : rest -> do+      parsedSegments <- traverse validateSegment (firstSegment :| rest)+      pure (ConceptId parsedSegments)++-- | Render a concept identifier without a file extension.+renderConceptId :: ConceptId -> Text+renderConceptId (ConceptId rawSegments) =+  Text.intercalate "/" (NonEmpty.toList rawSegments)++-- | Convert a concept identifier to a bundle-relative Markdown path.+conceptIdToFilePath :: ConceptId -> FilePath+conceptIdToFilePath (ConceptId rawSegments) =+  FilePath.joinPath (Text.unpack <$> NonEmpty.toList rawSegments) <.> "md"++-- | Convert a bundle-relative Markdown path to a concept identifier.+conceptIdFromFilePath :: FilePath -> Either ConceptIdError ConceptId+conceptIdFromFilePath path =+  parseConceptId (Text.pack (FilePath.dropExtension (FilePath.normalise path)))++-- | The canonical bundle-absolute Markdown link target for a concept, e.g.+-- @/modules/nix-haskell-flake.md@. A link whose URL is this string resolves+-- back to the same 'ConceptId' regardless of which document contains it.+renderConceptLinkTarget :: ConceptId -> Text+renderConceptLinkTarget conceptId =+  "/" <> Text.replace "\\" "/" (Text.pack (conceptIdToFilePath conceptId))++-- | A complete Markdown link to a concept: @[label](/path.md)@. Only the URL is+-- read by OKF link extraction, so an odd label does not break edges, but the+-- caller should choose a label free of unbalanced brackets to keep prose readable.+renderConceptLink :: ConceptId -> Text -> Text+renderConceptLink conceptId label =+  "[" <> label <> "](" <> renderConceptLinkTarget conceptId <> ")"++validateSegment :: Text -> Either ConceptIdError Text+validateSegment segment+  | Text.null segment = Left (InvalidConceptIdSegment segment)+  | Text.any (== '/') segment = Left (InvalidConceptIdSegment segment)+  | otherwise =+      case Text.uncons segment of+        Nothing -> Left (InvalidConceptIdSegment segment)+        Just (firstChar, rest)+          | isInitialChar firstChar && Text.all isTrailingChar rest -> Right segment+          | otherwise -> Left (InvalidConceptIdSegment segment)++isInitialChar :: Char -> Bool+isInitialChar char =+  Char.isAsciiLower char || Char.isAsciiUpper char || Char.isDigit char || char == '_'++isTrailingChar :: Char -> Bool+isTrailingChar char =+  isInitialChar char || char == '.' || char == '-'
+ src/Okf/Document.hs view
@@ -0,0 +1,203 @@+-- | Parsing and serialization for OKF Markdown concept documents.+module Okf.Document+  ( Frontmatter (..)+  , OKFDocument (..)+  , DocumentParseError (..)+  , emptyFrontmatter+  , frontmatterLookup+  , parseDocument+  , serializeDocument+    -- * Frontmatter authoring+  , 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+import Data.Attoparsec.ByteString qualified as Attoparsec+import Data.ByteString qualified as ByteString+import Data.Frontmatter qualified as Frontmatter+import Data.Ord (comparing)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text.Encoding+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+-- values are preserved as Aeson values instead of projected into a closed type.+newtype Frontmatter = Frontmatter+  { fields :: KeyMap.KeyMap Value+  }+  deriving stock (Generic, Eq, Show)++-- | A Markdown concept document split into frontmatter and body.+data OKFDocument = OKFDocument+  { frontmatter :: !Frontmatter+  , body :: !Text+  }+  deriving stock (Generic, Eq, Show)++-- | Structured parser failures for leading YAML frontmatter.+data DocumentParseError+  = UnterminatedFrontmatter+  | InvalidYaml Text+  | FrontmatterNotMapping+  deriving stock (Generic, Eq, Show)++emptyFrontmatter :: Frontmatter+emptyFrontmatter = Frontmatter KeyMap.empty++-- | Look up a frontmatter key.+frontmatterLookup :: Text -> Frontmatter -> Maybe Value+frontmatterLookup key (Frontmatter rawFields) =+  KeyMap.lookup (AesonKey.fromText key) rawFields++-- | Build frontmatter from a list of @(key, value)@ pairs. Later duplicate+-- keys overwrite earlier ones.+frontmatterFromFields :: [(Text, Value)] -> Frontmatter+frontmatterFromFields pairs =+  Frontmatter (KeyMap.fromList [(AesonKey.fromText key, value) | (key, value) <- pairs])++-- | Insert or replace a single frontmatter key.+setField :: Text -> Value -> Frontmatter -> Frontmatter+setField key value (Frontmatter rawFields) =+  Frontmatter (KeyMap.insert (AesonKey.fromText key) value rawFields)++-- | Delete a frontmatter key if present.+removeField :: Text -> Frontmatter -> Frontmatter+removeField key (Frontmatter rawFields) =+  Frontmatter (KeyMap.delete (AesonKey.fromText key) rawFields)++-- | The common OKF identity fields. @resource@ and @tags@ are intentionally+-- 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)+  }+  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+    ]++-- | Set the @type@ field.+setType :: Text -> Frontmatter -> Frontmatter+setType value = setField "type" (String value)++-- | Set the @title@ field.+setTitle :: Text -> Frontmatter -> Frontmatter+setTitle value = setField "title" (String value)++-- | Set the @description@ field.+setDescription :: Text -> Frontmatter -> Frontmatter+setDescription value = setField "description" (String value)++-- | Set the @timestamp@ field.+setTimestamp :: Text -> Frontmatter -> Frontmatter+setTimestamp value = setField "timestamp" (String value)++-- | Set the @resource@ field.+setResource :: Text -> Frontmatter -> Frontmatter+setResource value = setField "resource" (String value)++-- | Set the @tags@ field as a YAML list of strings. This is the single place+-- that knows @tags@ is a list of strings.+setTags :: [Text] -> Frontmatter -> Frontmatter+setTags tags = setField "tags" (Array (Vector.fromList (String <$> tags)))++-- | Parse a Markdown document. A leading @---@ line starts YAML frontmatter;+-- documents without a leading fence are accepted with empty frontmatter.+parseDocument :: Text -> Either DocumentParseError OKFDocument+parseDocument input =+  let inputBytes = Text.Encoding.encodeUtf8 input+   in if hasLeadingFrontmatterFence inputBytes+        then parseFrontmatterDocument inputBytes+        else Right (OKFDocument emptyFrontmatter input)++-- | Serialize to a normalized YAML-frontmatter Markdown document. Frontmatter+-- keys are emitted in a deterministic order (the six common OKF fields first —+-- @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} =+  Text.unlines ["---", renderedYaml, "---", ""] <> ensureTrailingNewline body+ where+  renderedYaml = renderOrderedYaml frontmatter++-- | Render frontmatter to YAML with the deterministic OKF key order.+renderOrderedYaml :: Frontmatter -> Text+renderOrderedYaml (Frontmatter rawFields) =+  Text.dropWhileEnd (== '\n')+    (Text.Encoding.decodeUtf8 (YamlPretty.encodePretty config (Object rawFields)))+ 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+-- alphabetically by its text form.+okfKeyRank :: Text -> (Int, Text)+okfKeyRank keyText =+  case lookup keyText commonRanks of+    Just rank -> (rank, "")+    Nothing -> (length commonRanks, keyText)+ where+  commonRanks =+    zip ["type", "title", "description", "timestamp", "resource", "tags"] [0 ..]++parseFrontmatterDocument :: ByteString.ByteString -> Either DocumentParseError OKFDocument+parseFrontmatterDocument inputBytes =+  case Attoparsec.parseOnly frontmatterAndBody inputBytes of+    Left _ -> Left UnterminatedFrontmatter+    Right (yamlBytes, bodyBytes) -> do+      parsedYaml <- parseYamlMapping yamlBytes+      Right (OKFDocument parsedYaml (Text.Encoding.decodeUtf8 (dropSeparatorBlankLine bodyBytes)))++frontmatterAndBody :: Attoparsec.Parser (ByteString.ByteString, ByteString.ByteString)+frontmatterAndBody =+  (,)+    <$> Frontmatter.frontmatter+    <*> Attoparsec.takeByteString++parseYamlMapping :: ByteString.ByteString -> Either DocumentParseError Frontmatter+parseYamlMapping yamlBytes =+  case Yaml.decodeEither' yamlBytes of+    Left parseException -> Left (InvalidYaml (Text.pack (Yaml.prettyPrintParseException parseException)))+    Right (Object rawFields) -> Right (Frontmatter rawFields)+    Right _ -> Left FrontmatterNotMapping++ensureTrailingNewline :: Text -> Text+ensureTrailingNewline text+  | Text.null text = "\n"+  | Text.isSuffixOf "\n" text = text+  | otherwise = text <> "\n"++hasLeadingFrontmatterFence :: ByteString.ByteString -> Bool+hasLeadingFrontmatterFence inputBytes =+  "---\n" `ByteString.isPrefixOf` inputBytes || "---\r\n" `ByteString.isPrefixOf` inputBytes++dropSeparatorBlankLine :: ByteString.ByteString -> ByteString.ByteString+dropSeparatorBlankLine bodyBytes+  | "\r\n" `ByteString.isPrefixOf` bodyBytes = ByteString.drop 2 bodyBytes+  | "\n" `ByteString.isPrefixOf` bodyBytes = ByteString.drop 1 bodyBytes+  | otherwise = bodyBytes
+ src/Okf/Graph.hs view
@@ -0,0 +1,176 @@+-- | Markdown link extraction and concept graph construction.+module Okf.Graph+  ( Edge (..),+    Graph (..),+    Node (..),+    buildGraph,+    extractConceptLinks,+    danglingReferences,+    duplicateConceptIds,+  )+where++import CMarkGFM qualified+import Control.Monad (foldM)+import Data.Aeson (ToJSON (..), object, (.=))+import Data.List qualified as List+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import Okf.Bundle+import Okf.ConceptId+import Okf.Document (body)+import Okf.Prelude hiding ((.=))+import System.FilePath ((</>))+import System.FilePath qualified as FilePath++-- | A graph node for one concept.+data Node = Node+  { id :: !ConceptId,+    label :: !Text,+    type_ :: !Text,+    description :: !(Maybe Text),+    resource :: !(Maybe Text),+    tags :: ![Text]+  }+  deriving stock (Generic, Eq, Show)++-- | A directed concept-to-concept link.+data Edge = Edge+  { source :: !ConceptId,+    target :: !ConceptId+  }+  deriving stock (Generic, Eq, Ord, Show)++-- | Bundle graph data with presentation-free nodes and edges.+data Graph = Graph+  { nodes :: ![Node],+    edges :: ![Edge]+  }+  deriving stock (Generic, Eq, Show)++instance ToJSON Node where+  toJSON Node {id = nodeId, label = nodeLabel, type_ = nodeType, description = nodeDescription, resource = nodeResource, tags = nodeTags} =+    object+      [ "id" .= nodeId,+        "label" .= nodeLabel,+        "type" .= nodeType,+        "description" .= nodeDescription,+        "resource" .= nodeResource,+        "tags" .= nodeTags+      ]++instance ToJSON Edge where+  toJSON Edge {source, target} =+    object+      [ "source" .= source,+        "target" .= target+      ]++instance ToJSON Graph where+  toJSON Graph {nodes, edges} =+    object+      [ "nodes" .= nodes,+        "edges" .= edges+      ]++-- | Build a graph, excluding links whose targets are not known concepts.+buildGraph :: [Concept] -> Graph+buildGraph concepts =+  Graph+    { nodes = conceptNode <$> sortedConcepts,+      edges = Set.toAscList knownEdges+    }+  where+    sortedConcepts = List.sortOn (renderConceptId . conceptIdOf) concepts+    knownIds = Set.fromList (conceptIdOf <$> concepts)+    knownEdges =+      Set.fromList+        [ Edge {source = conceptIdOf concept, target}+        | concept <- concepts,+          target <- extractConceptLinks concept,+          target `Set.member` knownIds+        ]++-- | Extract OKF concept links from a concept body.+extractConceptLinks :: Concept -> [ConceptId]+extractConceptLinks concept =+  foldMap (resolveLink concept) (extractMarkdownLinks (body (conceptDocument concept)))++-- | Every @(source, target)@ pair where a document links to a @.md@ concept ID+-- that is not present in the bundle. These are the edges 'buildGraph' silently+-- drops. An empty list means every internal link resolves to a real concept.+danglingReferences :: [Concept] -> [(ConceptId, ConceptId)]+danglingReferences concepts =+  [ (conceptIdOf concept, target)+  | concept <- concepts,+    target <- extractConceptLinks concept,+    not (target `Set.member` knownIds)+  ]+  where+    knownIds = Set.fromList (conceptIdOf <$> concepts)++-- | Concept IDs that appear more than once in a concept list. Always empty for+-- a bundle read from disk (paths are unique) but possible for an in-memory+-- producer assembling concepts before writing.+duplicateConceptIds :: [Concept] -> [ConceptId]+duplicateConceptIds concepts =+  [ conceptId+  | (conceptId, count) <- Map.toList counts,+    count > (1 :: Int)+  ]+  where+    counts = Map.fromListWith (+) [(conceptIdOf concept, 1) | concept <- concepts]++conceptNode :: Concept -> Node+conceptNode concept =+  Node+    { id = conceptIdOf concept,+      label = fromMaybe (renderConceptId (conceptIdOf concept)) (conceptTitle concept),+      type_ = conceptType concept,+      description = conceptDescription concept,+      resource = conceptResource concept,+      tags = conceptTags concept+    }++extractMarkdownLinks :: Text -> [Text]+extractMarkdownLinks markdown =+  walk (CMarkGFM.commonmarkToNode [] [] markdown)+  where+    walk (CMarkGFM.Node _ nodeType childNodes) =+      case nodeType of+        CMarkGFM.LINK url _title -> [url]+        _ -> foldMap walk childNodes++resolveLink :: Concept -> Text -> [ConceptId]+resolveLink concept rawUrl+  | isExternalUrl rawUrl = []+  | FilePath.takeExtension cleanPath /= ".md" = []+  | otherwise = maybe [] (either (const []) pure . conceptIdFromFilePath) bundleRelativePath+  where+    cleanPath = Text.unpack (stripUrlSuffix rawUrl)+    sourceDirectory = FilePath.takeDirectory (conceptIdToFilePath (conceptIdOf concept))+    bundleRelativePath+      | "/" `Text.isPrefixOf` rawUrl = collapseBundlePath (dropWhile (== '/') cleanPath)+      | otherwise = collapseBundlePath (sourceDirectory </> cleanPath)++stripUrlSuffix :: Text -> Text+stripUrlSuffix =+  Text.takeWhile (\char -> char /= '#' && char /= '?')++isExternalUrl :: Text -> Bool+isExternalUrl rawUrl =+  let lower = Text.toLower rawUrl+   in "http://" `Text.isPrefixOf` lower+        || "https://" `Text.isPrefixOf` lower+        || "mailto:" `Text.isPrefixOf` lower++collapseBundlePath :: FilePath -> Maybe FilePath+collapseBundlePath =+  fmap FilePath.joinPath . foldM step [] . FilePath.splitDirectories+  where+    step [] "." = Just []+    step acc "." = Just acc+    step [] ".." = Nothing+    step acc ".." = Just (init acc)+    step acc segment = Just (acc <> [segment])
+ src/Okf/Index.hs view
@@ -0,0 +1,128 @@+-- | Deterministic Markdown index rendering for OKF bundle directories.+module Okf.Index+  ( renderBundleIndexes,+    renderIndex,+    writeBundleIndexes,+  )+where++import Data.List qualified as List+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Data.Text.IO qualified as Text.IO+import Okf.Bundle+import Okf.Prelude+import System.Directory+  ( doesDirectoryExist,+    listDirectory,+  )+import System.FilePath ((</>))+import System.FilePath qualified as FilePath++-- | Render an @index.md@ for one bundle directory from its immediate concepts+-- and subdirectory names.+renderIndex :: [FilePath] -> [Concept] -> Text+renderIndex subdirectories concepts =+  Text.intercalate "\n" (filter (not . Text.null) [subdirectorySection, conceptSections]) <> "\n"+  where+    sortedSubdirectories = List.sort subdirectories+    subdirectorySection+      | null sortedSubdirectories = ""+      | otherwise =+          Text.unlines+            ( "# Subdirectories"+                : ""+                : (directoryBullet <$> sortedSubdirectories)+            )++    groupedConcepts = Map.toAscList (foldr addConcept Map.empty concepts)+    conceptSections =+      Text.intercalate "\n" (sectionForType <$> groupedConcepts)++addConcept :: Concept -> Map.Map Text [Concept] -> Map.Map Text [Concept]+addConcept concept =+  Map.insertWith (<>) (conceptType concept) [concept]++sectionForType :: (Text, [Concept]) -> Text+sectionForType (typeName, concepts) =+  Text.unlines+    ( ("# " <> typeName)+        : ""+        : (conceptBullet <$> List.sortOn conceptSourcePath concepts)+    )++directoryBullet :: FilePath -> Text+directoryBullet directory =+  "- [" <> Text.pack directory <> "/](" <> Text.pack directory <> "/index.md)"++conceptBullet :: Concept -> Text+conceptBullet concept =+  "- ["+    <> fromMaybe (Text.pack (FilePath.dropExtension (FilePath.takeFileName (conceptSourcePath concept)))) (conceptTitle concept)+    <> "]("+    <> Text.pack (FilePath.takeFileName (conceptSourcePath concept))+    <> ")"+    <> maybe "" (" - " <>) (conceptDescription concept)++-- | Write deterministic @index.md@ files for every directory in a bundle.+writeBundleIndexes :: FilePath -> IO (Either BundleError ())+writeBundleIndexes root = do+  rendered <- renderBundleIndexes root+  case rendered of+    Left bundleError -> pure (Left bundleError)+    Right indexes -> do+      mapM_ (\(relativePath, content) -> Text.IO.writeFile (root </> relativePath) content) indexes+      pure (Right ())++-- | Render every @index.md@ file that would be written for a bundle.+renderBundleIndexes :: FilePath -> IO (Either BundleError [(FilePath, Text)])+renderBundleIndexes root = do+  walked <- walkBundle root+  case walked of+    Left bundleError -> pure (Left bundleError)+    Right concepts -> do+      directories <- indexDirectories root concepts+      indexes <- mapM (renderDirectoryIndex root concepts) directories+      pure (Right indexes)++indexDirectories :: FilePath -> [Concept] -> IO [FilePath]+indexDirectories root concepts = do+  discovered <- discoverDirectories root ""+  let conceptDirectories = List.nub (FilePath.takeDirectory . conceptSourcePath <$> concepts)+  pure (List.sort (List.nub ("" : discovered <> conceptDirectories)))++discoverDirectories :: FilePath -> FilePath -> IO [FilePath]+discoverDirectories root relativeDir = do+  entries <- List.sort <$> listDirectory (root </> relativeDir)+  fmap concat $+    mapM+      ( \entry -> do+          let relativePath = FilePath.normalise (relativeDir </> entry)+              absolutePath = root </> relativePath+          isDirectory <- doesDirectoryExist absolutePath+          if isDirectory+            then (relativePath :) <$> discoverDirectories root relativePath+            else pure []+      )+      entries++renderDirectoryIndex :: FilePath -> [Concept] -> FilePath -> IO (FilePath, Text)+renderDirectoryIndex root concepts relativeDir = do+  subdirectories <- immediateSubdirectories root relativeDir+  let immediateConcepts =+        List.filter+          (\concept -> FilePath.normalise (FilePath.takeDirectory (conceptSourcePath concept)) == FilePath.normalise relativeDir)+          concepts+      indexPath = relativeDir </> "index.md"+  pure (FilePath.normalise indexPath, renderIndex subdirectories immediateConcepts)++immediateSubdirectories :: FilePath -> FilePath -> IO [FilePath]+immediateSubdirectories root relativeDir = do+  entries <- List.sort <$> listDirectory (root </> relativeDir)+  fmap concat $+    mapM+      ( \entry -> do+          isDirectory <- doesDirectoryExist (root </> relativeDir </> entry)+          pure [entry | isDirectory]+      )+      entries
+ src/Okf/Prelude.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE PackageImports #-}++-- | Project-wide prelude for okf-core. Re-exports the common project+--   vocabulary while keeping generic-lens label instances local to modules+--   that explicitly opt into them.+module Okf.Prelude+  ( module X+  , module Control.Lens++    -- * Generic-lens vocabulary+  , module Data.Generics.Product+  , module Data.Generics.Sum+  ) where++import "aeson" Data.Aeson as X (FromJSON, ToJSON, Value (..))+import "base" Control.Applicative as X ((<|>))+import "base" Control.Monad as X (unless, void, when)+import "base" Data.Bifunctor as X (first)+import "base" Data.List.NonEmpty as X (NonEmpty (..))+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 "text" Data.Text as X (Text)
+ src/Okf/Validation.hs view
@@ -0,0 +1,87 @@+-- | OKF document validation profiles and errors.+module Okf.Validation+  ( ValidationError (..),+    ValidationProfile (..),+    validateDocument,+    BundleValidationError (..),+    validateBundle,+  )+where++import Data.Text qualified as Text+import Data.Vector qualified as Vector+import Okf.Bundle (Concept, conceptDocument, conceptIdOf)+import Okf.ConceptId (ConceptId)+import Okf.Document+import Okf.Graph (danglingReferences, duplicateConceptIds)+import Okf.Prelude++-- | Validation modes supported by the initial OKF core library.+data ValidationProfile+  = PermissiveConformance+  | StrictAuthoring+  deriving stock (Generic, Eq, Show)++-- | A validation problem that can be rendered by callers.+data ValidationError+  = MissingRequiredField Text+  | FieldMustBeNonEmptyText Text+  | MissingRecommendedField Text+  | FieldMustBeListOfText Text+  deriving stock (Generic, Eq, Show)++-- | A whole-bundle validation problem.+data BundleValidationError+  = -- | A per-document problem, tagged with which concept it came from.+    DocumentInvalid ConceptId ValidationError+  | -- | A source concept links to a target that is not present in the bundle.+    DanglingReference ConceptId ConceptId+  | -- | The same concept ID was assembled more than once.+    DuplicateConceptId ConceptId+  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.+validateBundle :: ValidationProfile -> [Concept] -> [BundleValidationError]+validateBundle profile concepts =+  perDocument <> dangling <> duplicates+  where+    perDocument =+      [ DocumentInvalid (conceptIdOf concept) err+      | concept <- concepts,+        err <- validateDocument profile (conceptDocument concept)+      ]+    dangling = uncurry DanglingReference <$> danglingReferences concepts+    duplicates = DuplicateConceptId <$> duplicateConceptIds concepts++-- | Validate a parsed document under the requested profile.+validateDocument :: ValidationProfile -> OKFDocument -> [ValidationError]+validateDocument profile document =+  requireNonEmptyText MissingRequiredField "type" document+    <> optionalListOfText "tags" document+    <> case profile of+      PermissiveConformance -> []+      StrictAuthoring ->+        foldMap (requireNonEmptyText MissingRecommendedField `flip` document) ["title", "description", "timestamp"]++requireNonEmptyText :: (Text -> ValidationError) -> Text -> OKFDocument -> [ValidationError]+requireNonEmptyText missing key OKFDocument {frontmatter} =+  case frontmatterLookup key frontmatter of+    Nothing -> [missing key]+    Just (String value)+      | Text.null (Text.strip value) -> [FieldMustBeNonEmptyText key]+      | otherwise -> []+    Just _ -> [FieldMustBeNonEmptyText key]++optionalListOfText :: Text -> OKFDocument -> [ValidationError]+optionalListOfText key OKFDocument {frontmatter} =+  case frontmatterLookup key frontmatter of+    Nothing -> []+    Just (Array values)+      | Vector.all isString values -> []+      | otherwise -> [FieldMustBeListOfText key]+    Just _ -> [FieldMustBeListOfText key]+  where+    isString (String _) = True+    isString _ = False
+ test/Main.hs view
@@ -0,0 +1,598 @@+module Main (main) where++import Data.Aeson (object, toJSON, (.=))+import Data.List qualified as List+import Data.Text qualified as Text+import Data.Text.IO qualified as Text.IO+import Okf.Bundle+import Okf.ConceptId+import Okf.Document+import Okf.Graph+import Okf.Index+import Okf.Prelude hiding (setField, (.=))+import Okf.Validation+import System.Directory+  ( createDirectoryIfMissing,+    doesDirectoryExist,+    getTemporaryDirectory,+    removeDirectoryRecursive,+  )+import System.Exit (exitFailure)+import System.FilePath ((</>))+import System.IO.Temp (createTempDirectory)++main :: IO ()+main = do+  results <-+    sequence+      [ test "parse valid document with YAML frontmatter" testParseValidDocument,+        test "parse document with no frontmatter as empty-frontmatter body" testParseNoFrontmatter,+        test "reject unterminated frontmatter" testRejectUnterminatedFrontmatter,+        test "reject frontmatter that is not a YAML mapping" testRejectNonMappingFrontmatter,+        test "validate permissive profile with only type" testPermissiveValidation,+        test "validate strict profile requiring title description timestamp" testStrictValidation,+        test "validate rejects tags that are not a string list" testRejectInvalidTags,+        test "round-trip preserves semantic frontmatter and body" testRoundTrip,+        test "reject invalid concept id segment" testRejectInvalidConceptId,+        test "convert concept id tables/users to tables/users.md" testConceptIdToFilePath,+        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,+        testIO "generateIndex groups documents by frontmatter type" testGenerateIndexGroupsByType,+        testIO "extractLinks resolves relative and absolute bundle links" testExtractLinksResolveBundleLinks,+        testIO "extractLinks ignores external markdown URLs" testExtractLinksIgnoresExternalUrls,+        testIO "buildGraph includes only edges to existing concepts" testBuildGraphIncludesKnownEdges,+        testIO "writeBundleIndexes is deterministic" testWriteBundleIndexesDeterministic,+        testIO "fixture valid bundle validates and graphs expected edges" testFixtureValidBundle,+        testIO "fixture graph JSON shape is stable" testFixtureGraphJsonShape,+        testIO "fixture unterminated frontmatter reports parse error" testFixtureUnterminatedFrontmatter,+        testIO "fixture missing type reports validation error" testFixtureMissingType,+        test "frontmatter builder round-trips through serialize and parse" testFrontmatterBuilderRoundTrip,+        test "serializeDocument emits deterministic key order" testSerializeDeterministicKeyOrder,+        test "rendered concept link round-trips through extractConceptLinks" testConceptLinkRoundTrip,+        test "over-escaping relative links do not resolve inside bundle" testRejectOverEscapingRelativeLink,+        test "validateBundle reports a dangling reference" testValidateBundleDanglingReference,+        test "validateBundle accepts a bundle whose links all resolve" testValidateBundleAcceptsResolved,+        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+      ]+  unless (and results) exitFailure++test :: Text -> Either Text () -> IO Bool+test name assertion =+  case assertion of+    Right () -> do+      putStrLn ("PASS " <> Text.unpack name)+      pure True+    Left message -> do+      putStrLn ("FAIL " <> Text.unpack name <> ": " <> Text.unpack message)+      pure False++testIO :: Text -> IO (Either Text ()) -> IO Bool+testIO name assertion = do+  result <- assertion+  test name result++testParseValidDocument :: Either Text ()+testParseValidDocument = do+  document <- firstShow (parseDocument sampleDocument)+  assertEqual (Just (String "BigQuery Table")) (frontmatterLookup "type" (frontmatter document))+  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 "# Draft\n" (body document)++testRejectUnterminatedFrontmatter :: Either Text ()+testRejectUnterminatedFrontmatter =+  assertEqual (Left UnterminatedFrontmatter) (parseDocument "---\ntype: BigQuery Table\n")++testRejectNonMappingFrontmatter :: Either Text ()+testRejectNonMappingFrontmatter =+  assertEqual (Left FrontmatterNotMapping) (parseDocument "---\n- one\n- two\n---\nBody\n")++testPermissiveValidation :: Either Text ()+testPermissiveValidation = do+  document <- firstShow (parseDocument "---\ntype: BigQuery Table\n---\nBody\n")+  assertEqual [] (validateDocument PermissiveConformance document)++testStrictValidation :: Either Text ()+testStrictValidation = do+  document <- firstShow (parseDocument "---\ntype: BigQuery Table\n---\nBody\n")+  let errors = validateDocument StrictAuthoring document+  assertBool "missing title" (MissingRecommendedField "title" `List.elem` errors)+  assertBool "missing description" (MissingRecommendedField "description" `List.elem` errors)+  assertBool "missing timestamp" (MissingRecommendedField "timestamp" `List.elem` errors)++testRejectInvalidTags :: Either Text ()+testRejectInvalidTags = do+  document <- firstShow (parseDocument "---\ntype: BigQuery Table\ntags: orders\n---\nBody\n")+  assertEqual [FieldMustBeListOfText "tags"] (validateDocument PermissiveConformance document)++testRoundTrip :: Either Text ()+testRoundTrip = do+  document <- firstShow (parseDocument sampleDocument)+  assertEqual [] (validateDocument PermissiveConformance document)+  assertEqual [] (validateDocument StrictAuthoring document)+  reparsed <- firstShow (parseDocument (serializeDocument document))+  assertEqual (frontmatter document) (frontmatter reparsed)+  assertEqual (body document) (body reparsed)++testRejectInvalidConceptId :: Either Text ()+testRejectInvalidConceptId =+  assertEqual (Left (InvalidConceptIdSegment "-users")) (parseConceptId "tables/-users")++testConceptIdToFilePath :: Either Text ()+testConceptIdToFilePath = do+  conceptId <- firstShow (parseConceptId "tables/users")+  assertEqual "tables/users.md" (conceptIdToFilePath conceptId)++testWalkBundleMissingRoot :: IO (Either Text ())+testWalkBundleMissingRoot = do+  temporaryDirectory <- getTemporaryDirectory+  root <- createTempDirectory temporaryDirectory "okf-core-missing-parent"+  let missingRoot = root </> "missing"+  result <- walkBundle missingRoot+  removeDirectoryRecursive root+  pure+    ( case result of+        Left (BundleIoError path message)+          | path == missingRoot && "does not exist" `Text.isInfixOf` message -> Right ()+        other -> Left ("expected missing-root BundleIoError, got " <> Text.pack (show other))+    )++testWalkBundleSkipsReserved :: IO (Either Text ())+testWalkBundleSkipsReserved =+  withFixtureBundle+    ( \root -> do+        concepts <- readBundle root+        pure (assertEqual ["datasets/sales", "tables/customers", "tables/orders"] (renderConceptId . conceptIdOf <$> concepts))+    )++testWalkBundleDiscoversNestedConceptIds :: IO (Either Text ())+testWalkBundleDiscoversNestedConceptIds =+  withFixtureBundle+    ( \root -> do+        concepts <- readBundle root+        pure+          ( do+              expected <- firstShow (parseConceptId "tables/orders")+              assertBool "nested concept exists" (isJust (findConcept expected concepts))+          )+    )++testGenerateIndexGroupsByType :: IO (Either Text ())+testGenerateIndexGroupsByType =+  withFixtureBundle+    ( \root -> do+        concepts <- readBundle root+        pure+          ( do+              orders <- requireConcept "tables/orders" concepts+              customers <- requireConcept "tables/customers" concepts+              let rendered = renderIndex [] [orders, customers]+              assertBool "has type heading" ("# BigQuery Table" `Text.isInfixOf` rendered)+              assertBool "has orders bullet" ("[Orders](orders.md) - Order records." `Text.isInfixOf` rendered)+              assertBool "has customers bullet" ("[Customers](customers.md) - Customer records." `Text.isInfixOf` rendered)+          )+    )++testExtractLinksResolveBundleLinks :: IO (Either Text ())+testExtractLinksResolveBundleLinks =+  withFixtureBundle+    ( \root -> do+        concepts <- readBundle root+        pure+          ( do+              orders <- requireConcept "tables/orders" concepts+              customers <- firstShow (parseConceptId "tables/customers")+              sales <- firstShow (parseConceptId "datasets/sales")+              let links = extractConceptLinks orders+              assertBool "absolute or ./ customers link" (customers `List.elem` links)+              assertBool "../ sales link" (sales `List.elem` links)+          )+    )++testExtractLinksIgnoresExternalUrls :: IO (Either Text ())+testExtractLinksIgnoresExternalUrls =+  withFixtureBundle+    ( \root -> do+        concepts <- readBundle root+        pure+          ( do+              orders <- requireConcept "tables/orders" concepts+              assertEqual 4 (length (extractConceptLinks orders))+          )+    )++testBuildGraphIncludesKnownEdges :: IO (Either Text ())+testBuildGraphIncludesKnownEdges =+  withFixtureBundle+    ( \root -> do+        concepts <- readBundle root+        pure+          ( do+              orders <- firstShow (parseConceptId "tables/orders")+              customers <- firstShow (parseConceptId "tables/customers")+              missing <- firstShow (parseConceptId "missing")+              let graph = buildGraph concepts+              assertEqual 3 (length (nodes graph))+              assertBool "known edge exists" (Edge {source = orders, target = customers} `List.elem` edges graph)+              assertBool "broken edge excluded" (Edge {source = orders, target = missing} `notElem` edges graph)+          )+    )++testWriteBundleIndexesDeterministic :: IO (Either Text ())+testWriteBundleIndexesDeterministic =+  withFixtureBundle+    ( \root -> do+        firstResult <- writeBundleIndexes root+        firstIndex <- Text.IO.readFile (root </> "tables" </> "index.md")+        secondResult <- writeBundleIndexes root+        secondIndex <- Text.IO.readFile (root </> "tables" </> "index.md")+        pure+          ( do+              firstShow firstResult+              firstShow secondResult+              assertEqual firstIndex secondIndex+              assertBool "tables index has BigQuery Table section" ("# BigQuery Table" `Text.isInfixOf` secondIndex)+          )+    )++testFixtureValidBundle :: IO (Either Text ())+testFixtureValidBundle = do+  root <- fixturePath "valid-bundle"+  concepts <- readBundle root+  pure+    ( do+        orders <- firstShow (parseConceptId "tables/orders")+        customers <- firstShow (parseConceptId "tables/customers")+        sales <- firstShow (parseConceptId "datasets/sales")+        assertEqual 4 (length concepts)+        assertEqual [] (foldMap (validateDocument PermissiveConformance . conceptDocument) concepts)+        let graph = buildGraph concepts+        assertBool "orders to customers" (Edge {source = orders, target = customers} `List.elem` edges graph)+        assertBool "orders to sales" (Edge {source = orders, target = sales} `List.elem` edges graph)+    )++testFixtureGraphJsonShape :: IO (Either Text ())+testFixtureGraphJsonShape = do+  root <- fixturePath "valid-bundle"+  concepts <- readBundle root+  orders <- requireConceptIO "tables/orders" concepts+  pure+    ( case filter (\Node {id = nodeId} -> nodeId == conceptIdOf orders) (nodes (buildGraph concepts)) of+        [ordersNode] ->+          assertEqual+            ( object+                [ "id" .= ("tables/orders" :: Text),+                  "label" .= ("Orders" :: Text),+                  "type" .= ("BigQuery Table" :: Text),+                  "description" .= Just ("Order fact table." :: Text),+                  "resource" .= Just ("bigquery://analytics.tables.orders" :: Text),+                  "tags" .= ["orders" :: Text, "sales"]+                ]+            )+            (toJSON ordersNode)+        other -> Left ("expected one orders node, got " <> Text.pack (show (length other)))+    )++testFixtureUnterminatedFrontmatter :: IO (Either Text ())+testFixtureUnterminatedFrontmatter = do+  root <- fixturePath "invalid-unterminated-frontmatter"+  result <- walkBundle root+  pure+    ( case result of+        Left (InvalidConceptDocument "broken.md" UnterminatedFrontmatter) -> Right ()+        other -> Left ("expected unterminated frontmatter error, got " <> Text.pack (show other))+    )++testFixtureMissingType :: IO (Either Text ())+testFixtureMissingType = do+  root <- fixturePath "invalid-missing-type"+  concepts <- readBundle root+  pure+    ( do+        assertEqual 1 (length concepts)+        case foldMap (validateDocument PermissiveConformance . conceptDocument) concepts of+          [MissingRequiredField "type"] -> Right ()+          other -> Left ("expected missing type error, got " <> Text.pack (show other))+    )++testFrontmatterBuilderRoundTrip :: Either Text ()+testFrontmatterBuilderRoundTrip = do+  let frontmatterValue =+        setField "version" (String "0.2.0")+          . setTags ["orders", "sales"]+          . setResource "bigquery://analytics.tables.orders"+          $ okfCommon+            OkfCommon+              { commonType = "BigQuery Table",+                commonTitle = Just "Orders",+                commonDescription = Just "Order fact table.",+                commonTimestamp = Just "2026-06-16T00:00:00Z"+              }+      original = OKFDocument frontmatterValue "# Orders\n\nBody text.\n"+  reparsed <- firstShow (parseDocument (serializeDocument original))+  assertEqual (frontmatter original) (frontmatter reparsed)+  assertEqual (body original) (body reparsed)++testSerializeDeterministicKeyOrder :: Either Text ()+testSerializeDeterministicKeyOrder = do+  let frontmatterValue =+        setField "zeta" (String "z")+          . setField "alpha" (String "a")+          . setTags ["t"]+          . setResource "res://x"+          . setType "Recipe"+          . setTimestamp "2026-06-16T00:00:00Z"+          . setDescription "Desc"+          . setTitle "Demo"+          $ emptyFrontmatter+      rendered = serializeDocument (OKFDocument frontmatterValue "# Demo\n")+      expectedOrder =+        ["type:", "title:", "description:", "timestamp:", "resource:", "tags:", "alpha:", "zeta:"]+  keyIndices <- traverse (\key -> maybe (Left ("missing key " <> key)) Right (substringIndex key rendered)) expectedOrder+  assertBool ("keys not in deterministic order: " <> Text.pack (show keyIndices)) (strictlyIncreasing keyIndices)++testConceptLinkRoundTrip :: Either Text ()+testConceptLinkRoundTrip = do+  sourceId <- parseTestConceptId "recipes/haskell-library-repo"+  let targetStrings = ["orders", "modules/nix-haskell-flake", "refs/source-system.v1"]+  mapM_+    ( \rawTarget -> do+        targetId <- parseTestConceptId rawTarget+        let extracted = extractFromBodyLinkingTo sourceId targetId+        assertEqual [targetId] extracted+    )+    targetStrings++parseTestConceptId :: Text -> Either Text ConceptId+parseTestConceptId rawId =+  first (\err -> "bad concept id " <> rawId <> ": " <> Text.pack (show err)) (parseConceptId rawId)++extractFromBodyLinkingTo :: ConceptId -> ConceptId -> [ConceptId]+extractFromBodyLinkingTo sourceId targetId =+  extractConceptLinks+    (conceptFromDocument sourceId (OKFDocument (setType "Test" emptyFrontmatter) ("See " <> renderConceptLink targetId "link" <> ".\n")))++testRejectOverEscapingRelativeLink :: Either Text ()+testRejectOverEscapingRelativeLink = do+  sourceId <- parseTestConceptId "a/b/source"+  targetId <- parseTestConceptId "tables/orders"+  let concept =+        conceptFromDocument+          sourceId+          (OKFDocument (setType "Test" emptyFrontmatter) "[Escapes](../../../tables/orders.md)\n")+  assertEqual [] (extractConceptLinks concept)+  assertEqual [] (validateBundle PermissiveConformance [concept, targetConcept targetId])+  where+    targetConcept targetId =+      conceptFromDocument+        targetId+        (OKFDocument (setType "Test" emptyFrontmatter) "# Orders\n")++testValidateBundleDanglingReference :: Either Text ()+testValidateBundleDanglingReference = do+  aId <- parseTestConceptId "a"+  bId <- parseTestConceptId "b"+  conceptA <- testConcept "a" ("See " <> renderConceptLink bId "b" <> ".\n")+  assertEqual [DanglingReference aId bId] (validateBundle StrictAuthoring [conceptA])++testValidateBundleAcceptsResolved :: Either Text ()+testValidateBundleAcceptsResolved = do+  bId <- parseTestConceptId "b"+  conceptA <- testConcept "a" ("See " <> renderConceptLink bId "b" <> ".\n")+  conceptB <- testConcept "b" "Standalone.\n"+  assertEqual [] (validateBundle StrictAuthoring [conceptA, conceptB])++testDuplicateConceptIds :: Either Text ()+testDuplicateConceptIds = do+  aId <- parseTestConceptId "a"+  conceptA <- testConcept "a" "First.\n"+  conceptAAgain <- testConcept "a" "Second.\n"+  assertEqual [aId] (duplicateConceptIds [conceptA, conceptAAgain])++-- | Build an in-memory concept via the public 'conceptFromDocument' constructor,+-- so its typed fields are derived from the frontmatter and cannot diverge.+-- Includes all StrictAuthoring fields so per-document validation passes and+-- bundle-level checks can be isolated.+testConcept :: Text -> Text -> Either Text Concept+testConcept rawId bodyText = do+  conceptId <- parseTestConceptId rawId+  let frontmatterValue =+        okfCommon+          OkfCommon+            { commonType = "Test",+              commonTitle = Just "Title",+              commonDescription = Just "Description",+              commonTimestamp = Just "2026-06-16T00:00:00Z"+            }+  pure (conceptFromDocument conceptId (OKFDocument frontmatterValue bodyText))++testConceptFromDocumentDerivesFields :: Either Text ()+testConceptFromDocumentDerivesFields = do+  conceptId <- parseTestConceptId "tables/orders"+  let frontmatterValue =+        okfCommon+          OkfCommon+            { commonType = "BigQuery Table",+              commonTitle = Just "Orders",+              commonDescription = Nothing,+              commonTimestamp = Nothing+            }+      concept = conceptFromDocument conceptId (OKFDocument frontmatterValue "# Orders\n")+  assertEqual "BigQuery Table" (conceptType concept)+  assertEqual (Just "Orders") (conceptTitle concept)+  assertEqual "tables/orders.md" (conceptSourcePath concept)++testWriteBundleRoundTrip :: IO (Either Text ())+testWriteBundleRoundTrip = do+  temporaryDirectory <- getTemporaryDirectory+  root <- createTempDirectory temporaryDirectory "okf-core-writebundle"+  let buildConcepts = do+        orders <- testConcept "tables/orders" "# Orders\n\nOrder records.\n"+        customers <- testConcept "tables/customers" "# Customers\n\nCustomer records.\n"+        pure [orders, customers]+  case buildConcepts of+    Left message -> do+      removeDirectoryRecursive root+      pure (Left message)+    Right concepts -> do+      writeBundle root concepts+      recovered <- readBundle root+      removeDirectoryRecursive root+      pure+        ( do+            assertEqual+              (List.sort (renderConceptId . conceptIdOf <$> concepts))+              (List.sort (renderConceptId . conceptIdOf <$> recovered))+            assertEqual+              (List.sort ((body . conceptDocument) <$> concepts))+              (List.sort ((body . conceptDocument) <$> recovered))+        )++testFixtureDanglingLink :: IO (Either Text ())+testFixtureDanglingLink = do+  root <- fixturePath "invalid-dangling-link"+  concepts <- readBundle root+  pure+    ( case validateBundle PermissiveConformance concepts of+        errs+          | any isDangling errs -> Right ()+          | otherwise -> Left ("expected a DanglingReference, got: " <> Text.pack (show errs))+    )+  where+    isDangling DanglingReference {} = True+    isDangling _ = False++substringIndex :: Text -> Text -> Maybe Int+substringIndex needle haystack =+  let (prefix, match) = Text.breakOn needle haystack+   in if Text.null match then Nothing else Just (Text.length prefix)++strictlyIncreasing :: [Int] -> Bool+strictlyIncreasing xs = and (zipWith (<) xs (drop 1 xs))++sampleDocument :: Text+sampleDocument =+  Text.unlines+    [ "---",+      "type: BigQuery Table",+      "title: Users",+      "description: User records.",+      "timestamp: 2026-06-16T00:00:00Z",+      "tags: [users]",+      "---",+      "",+      "# Schema",+      "",+      "Body text."+    ]++assertEqual :: (Eq value, Show value) => value -> value -> Either Text ()+assertEqual expected actual+  | expected == actual = Right ()+  | otherwise =+      Left+        ( "expected "+            <> Text.pack (show expected)+            <> ", got "+            <> Text.pack (show actual)+        )++assertBool :: Text -> Bool -> Either Text ()+assertBool _ True = Right ()+assertBool label False = Left label++firstShow :: (Show err) => Either err value -> Either Text value+firstShow =+  either (Left . Text.pack . show) Right++readBundle :: FilePath -> IO [Concept]+readBundle root = do+  result <- walkBundle root+  case result of+    Left bundleError -> fail (show bundleError)+    Right concepts -> pure concepts++fixturePath :: FilePath -> IO FilePath+fixturePath name = do+  let candidates =+        [ "okf-core" </> "test" </> "fixtures" </> name,+          "test" </> "fixtures" </> name+        ]+  findExisting candidates+  where+    findExisting [] = fail ("fixture not found: " <> name)+    findExisting (candidate : rest) = do+      exists <- doesDirectoryExist candidate+      if exists then pure candidate else findExisting rest++requireConcept :: Text -> [Concept] -> Either Text Concept+requireConcept rawId concepts = do+  conceptId <- firstShow (parseConceptId rawId)+  case findConcept conceptId concepts of+    Just concept -> Right concept+    Nothing -> Left ("missing concept " <> rawId)++requireConceptIO :: Text -> [Concept] -> IO Concept+requireConceptIO rawId concepts =+  case requireConcept rawId concepts of+    Right concept -> pure concept+    Left message -> fail (Text.unpack message)++withFixtureBundle :: (FilePath -> IO (Either Text ())) -> IO (Either Text ())+withFixtureBundle action = do+  temporaryDirectory <- getTemporaryDirectory+  root <- createTempDirectory temporaryDirectory "okf-core-test"+  createFixtureBundle root+  result <- action root+  removeDirectoryRecursive root+  pure result++createFixtureBundle :: FilePath -> IO ()+createFixtureBundle root = do+  createDirectoryIfMissing True (root </> "datasets")+  createDirectoryIfMissing True (root </> "tables")+  Text.IO.writeFile (root </> "index.md") "# Reserved root index\n"+  Text.IO.writeFile (root </> "tables" </> "index.md") "# Reserved tables index\n"+  Text.IO.writeFile (root </> "tables" </> "log.md") "# Reserved log\n"+  Text.IO.writeFile+    (root </> "datasets" </> "sales.md")+    (fixtureDocument "Dataset" "Sales" "Sales dataset." "")+  Text.IO.writeFile+    (root </> "tables" </> "customers.md")+    (fixtureDocument "BigQuery Table" "Customers" "Customer records." "")+  Text.IO.writeFile+    (root </> "tables" </> "orders.md")+    ( fixtureDocument+        "BigQuery Table"+        "Orders"+        "Order records."+        ( Text.unlines+            [ "[Customers absolute](/tables/customers.md)",+              "[Customers relative](./customers.md)",+              "[Sales relative](../datasets/sales.md)",+              "[Broken](/missing.md)",+              "[External](https://example.com/x.md)"+            ]+        )+    )++fixtureDocument :: Text -> Text -> Text -> Text -> Text+fixtureDocument typeName titleText descriptionText documentBody =+  Text.unlines+    [ "---",+      "type: " <> typeName,+      "title: " <> titleText,+      "description: " <> descriptionText,+      "timestamp: 2026-06-16T00:00:00Z",+      "---",+      "",+      documentBody+    ]