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 +22/−0
- LICENSE +30/−0
- okf-core.cabal +81/−0
- src/Okf/Bundle.hs +216/−0
- src/Okf/ConceptId.hs +93/−0
- src/Okf/Document.hs +203/−0
- src/Okf/Graph.hs +176/−0
- src/Okf/Index.hs +128/−0
- src/Okf/Prelude.hs +26/−0
- src/Okf/Validation.hs +87/−0
- test/Main.hs +598/−0
+ 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+ ]