okf-core 0.9.0.0 → 0.10.0.0
raw patch · 26 files changed
+2986/−66 lines, 26 filesdep +scientificPVP ok
version bump matches the API change (PVP)
Dependencies added: scientific
API changes (from Hackage documentation)
+ Okf.Profile.Bootstrap: DescriptorFreezeError :: !Text -> BootstrapError
+ Okf.Profile.Bootstrap: DescriptorParseError :: !Text -> BootstrapError
+ Okf.Profile.Bootstrap: ImportDescriptorFile :: !FilePath -> DescriptorImport
+ Okf.Profile.Bootstrap: ImportRegistryExpression :: !Text -> !Text -> DescriptorImport
+ Okf.Profile.Bootstrap: ImportRegistryFile :: !FilePath -> !Text -> DescriptorImport
+ Okf.Profile.Bootstrap: RelativeExpressionImport :: !Text -> BootstrapError
+ Okf.Profile.Bootstrap: bootstrapOkfVersion :: Maybe OkfVersion -> ProfileSpec -> Maybe OkfVersion
+ Okf.Profile.Bootstrap: data BootstrapError
+ Okf.Profile.Bootstrap: data DescriptorImport
+ Okf.Profile.Bootstrap: descriptorFileName :: FilePath
+ Okf.Profile.Bootstrap: descriptorImportFor :: ProfileSource -> Text -> DescriptorImport
+ Okf.Profile.Bootstrap: instance GHC.Classes.Eq Okf.Profile.Bootstrap.BootstrapError
+ Okf.Profile.Bootstrap: instance GHC.Classes.Eq Okf.Profile.Bootstrap.DescriptorImport
+ Okf.Profile.Bootstrap: instance GHC.Internal.Generics.Generic Okf.Profile.Bootstrap.BootstrapError
+ Okf.Profile.Bootstrap: instance GHC.Internal.Generics.Generic Okf.Profile.Bootstrap.DescriptorImport
+ Okf.Profile.Bootstrap: instance GHC.Internal.Show.Show Okf.Profile.Bootstrap.BootstrapError
+ Okf.Profile.Bootstrap: instance GHC.Internal.Show.Show Okf.Profile.Bootstrap.DescriptorImport
+ Okf.Profile.Bootstrap: relativeImportPath :: FilePath -> FilePath -> FilePath
+ Okf.Profile.Bootstrap: renderBootstrapDescriptor :: FilePath -> DescriptorImport -> IO (Either BootstrapError Text)
+ Okf.Profile.Bootstrap: renderBootstrapError :: BootstrapError -> Text
+ Okf.Query: Ascending :: SortDirection
+ Okf.Query: Descending :: SortDirection
+ Okf.Query: InvalidSortDirection :: !Text -> !Text -> SortKeyParseError
+ Okf.Query: InvalidWhereSyntax :: !Text -> !Int -> !Text -> WhereParseError
+ Okf.Query: LegacyWhere :: !ConceptFilter -> WhereCondition
+ Okf.Query: LegacyWhereParseError :: !FilterParseError -> WhereParseError
+ Okf.Query: PredicateAnd :: !ConceptPredicate -> !ConceptPredicate -> ConceptPredicate
+ Okf.Query: PredicateAtom :: !ConceptFilter -> ConceptPredicate
+ Okf.Query: PredicateIn :: !FieldSelector -> !NonEmpty Text -> ConceptPredicate
+ Okf.Query: PredicateNot :: !ConceptPredicate -> ConceptPredicate
+ Okf.Query: PredicateNotEquals :: !FieldSelector -> !Text -> ConceptPredicate
+ Okf.Query: PredicateNotIn :: !FieldSelector -> !NonEmpty Text -> ConceptPredicate
+ Okf.Query: PredicateOr :: !ConceptPredicate -> !ConceptPredicate -> ConceptPredicate
+ Okf.Query: PredicateWhere :: !ConceptPredicate -> WhereCondition
+ Okf.Query: SortKey :: !FieldSelector -> !SortDirection -> SortKey
+ Okf.Query: SortKeySelectorError :: !FilterParseError -> SortKeyParseError
+ Okf.Query: [sortDirection] :: SortKey -> !SortDirection
+ Okf.Query: [sortSelector] :: SortKey -> !FieldSelector
+ Okf.Query: checkPredicateAgainstProfile :: CompiledProfile -> [Text] -> ConceptPredicate -> [FilterProfileError]
+ Okf.Query: compareNatural :: Text -> Text -> Ordering
+ Okf.Query: data ConceptPredicate
+ Okf.Query: data SortDirection
+ Okf.Query: data SortKey
+ Okf.Query: data SortKeyParseError
+ Okf.Query: data WhereCondition
+ Okf.Query: data WhereParseError
+ Okf.Query: filterConceptsWhere :: [ConceptFilter] -> [WhereCondition] -> [Concept] -> [Concept]
+ Okf.Query: instance GHC.Classes.Eq Okf.Query.ConceptPredicate
+ Okf.Query: instance GHC.Classes.Eq Okf.Query.NaturalChunk
+ Okf.Query: instance GHC.Classes.Eq Okf.Query.NaturalText
+ Okf.Query: instance GHC.Classes.Eq Okf.Query.SortDirection
+ Okf.Query: instance GHC.Classes.Eq Okf.Query.SortKey
+ Okf.Query: instance GHC.Classes.Eq Okf.Query.SortKeyParseError
+ Okf.Query: instance GHC.Classes.Eq Okf.Query.SortValue
+ Okf.Query: instance GHC.Classes.Eq Okf.Query.WhereCondition
+ Okf.Query: instance GHC.Classes.Eq Okf.Query.WhereParseError
+ Okf.Query: instance GHC.Classes.Ord Okf.Query.ConceptPredicate
+ Okf.Query: instance GHC.Classes.Ord Okf.Query.NaturalChunk
+ Okf.Query: instance GHC.Classes.Ord Okf.Query.NaturalText
+ Okf.Query: instance GHC.Classes.Ord Okf.Query.SortDirection
+ Okf.Query: instance GHC.Classes.Ord Okf.Query.SortValue
+ Okf.Query: instance GHC.Classes.Ord Okf.Query.WhereCondition
+ Okf.Query: instance GHC.Internal.Base.Applicative Okf.Query.WhereParser
+ Okf.Query: instance GHC.Internal.Base.Functor Okf.Query.WhereParser
+ Okf.Query: instance GHC.Internal.Base.Monad Okf.Query.WhereParser
+ Okf.Query: instance GHC.Internal.Generics.Generic Okf.Query.ConceptPredicate
+ Okf.Query: instance GHC.Internal.Generics.Generic Okf.Query.SortDirection
+ Okf.Query: instance GHC.Internal.Generics.Generic Okf.Query.SortKey
+ Okf.Query: instance GHC.Internal.Generics.Generic Okf.Query.SortKeyParseError
+ Okf.Query: instance GHC.Internal.Generics.Generic Okf.Query.WhereCondition
+ Okf.Query: instance GHC.Internal.Generics.Generic Okf.Query.WhereParseError
+ Okf.Query: instance GHC.Internal.Show.Show Okf.Query.ConceptPredicate
+ Okf.Query: instance GHC.Internal.Show.Show Okf.Query.SortDirection
+ Okf.Query: instance GHC.Internal.Show.Show Okf.Query.SortKey
+ Okf.Query: instance GHC.Internal.Show.Show Okf.Query.SortKeyParseError
+ Okf.Query: instance GHC.Internal.Show.Show Okf.Query.WhereCondition
+ Okf.Query: instance GHC.Internal.Show.Show Okf.Query.WhereParseError
+ Okf.Query: matchesPredicate :: ConceptPredicate -> Concept -> Bool
+ Okf.Query: parseSortKey :: Text -> Either SortKeyParseError SortKey
+ Okf.Query: parseWhereCondition :: Text -> Either WhereParseError WhereCondition
+ Okf.Query: renderConceptPredicate :: ConceptPredicate -> Text
+ Okf.Query: renderSortKey :: SortKey -> Text
+ Okf.Query: renderSortKeyParseError :: SortKeyParseError -> Text
+ Okf.Query: renderWhereCondition :: WhereCondition -> Text
+ Okf.Query: renderWhereParseError :: WhereParseError -> Text
+ Okf.Query: sortConcepts :: [SortKey] -> [Concept] -> [Concept]
Files
- CHANGELOG.md +33/−0
- okf-core.cabal +58/−51
- src/Okf/Profile/Bootstrap.hs +166/−0
- src/Okf/Profile/Registry.hs +2/−2
- src/Okf/Query.hs +716/−0
- test/Main.hs +559/−2
- test/fixtures/catalogue/Profile/V02.dhall +7/−4
- test/fixtures/catalogue/Profile/okf.dhall +9/−0
- test/fixtures/catalogue/package.dhall +4/−4
- test/fixtures/catalogue/profiles/assurance/package.dhall +6/−1
- test/fixtures/catalogue/profiles/assurance/verification-evidence.dhall +490/−0
- test/fixtures/catalogue/profiles/coordination/package.dhall +4/−0
- test/fixtures/catalogue/profiles/coordination/pattern-applications.dhall +236/−0
- test/fixtures/catalogue/profiles/documentation/package.dhall +2/−0
- test/fixtures/catalogue/profiles/documentation/pattern-catalog.dhall +146/−0
- test/fixtures/catalogue/profiles/documentation/specifications.dhall +230/−0
- test/fixtures/catalogue/profiles/documentation/terminology.dhall +245/−0
- test/fixtures/catalogue/profiles/okf-v0-2.dhall +2/−2
- test/fixtures/concept-sorting/index.md +8/−0
- test/fixtures/concept-sorting/log.md +5/−0
- test/fixtures/concept-sorting/requests/a-ten.md +12/−0
- test/fixtures/concept-sorting/requests/b-two.md +11/−0
- test/fixtures/concept-sorting/requests/c-nine.md +9/−0
- test/fixtures/concept-sorting/requests/d-none.md +9/−0
- test/fixtures/concept-sorting/requests/e-one.md +9/−0
- test/fixtures/concept-sorting/requests/index.md +8/−0
CHANGELOG.md view
@@ -7,6 +7,39 @@ ## [Unreleased] +## [0.10.0.0] - 2026-10-06++### Added++- `Okf.Profile.Bootstrap` renders adoption descriptors with Dhall path/label escaping, remote import freezing, local relative imports, and maximum-version selection.++- `Okf.Query` gains flexible concept conditions: `WhereCondition`,+ `ConceptPredicate`, `WhereParseError`, `parseWhereCondition`,+ `renderWhereCondition`, `renderConceptPredicate`, `renderWhereParseError`,+ `matchesPredicate`, `filterConceptsWhere`, and+ `checkPredicateAgainstProfile`. Conditions add `!=`, `in`, `not in`, and+ parenthesized `and`/`or`/`not` expressions with `has(KEY)` and+ `missing(KEY)`. Negative value predicates require a comparable scalar and+ reject a list when any element is excluded; `not` negates its whole operand.+ Profile checks cover every operand. Existing `ConceptFilter` APIs and their+ semantics are unchanged.++- `Okf.Query` gains concept ordering: `SortDirection`, `SortKey`,+ `SortKeyParseError`, `parseSortKey`, `renderSortKey`,+ `renderSortKeyParseError`, `compareNatural`, and `sortConcepts`. Text+ compares in natural order (`IR-2` before `IR-10`), numbers numerically and+ before text, concepts without a comparable value last in both directions,+ lists by their smallest or largest element, and ties in input order.+ `okf-core` now depends on `scientific` directly.++### Changed++- `defaultRegistryReference` now pins `mori://shinzui/okf-profiles` v0.19.0+ (from v0.14.0); the offline catalogue conformance fixture decodes all+ seventeen published profiles, adding `assurance.verificationEvidence`,+ `coordination.patternApplications`, `documentation.specifications`, and+ `documentation.terminology`.+ ## [0.9.0.0] - 2026-09-13 ### Added
okf-core.cabal view
@@ -1,6 +1,6 @@-cabal-version: 3.4-name: okf-core-version: 0.9.0.0+cabal-version: 3.4+name: okf-core+version: 0.10.0.0 synopsis: Read, validate, index, and traverse Open Knowledge Format bundles @@ -10,15 +10,14 @@ 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-+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 -- The canonical profile schema, plus the fixtures okf-core-test reads. The -- fixture descriptors import the schema through ../../../dhall, so both trees -- must ship for `cabal test` to work from the sdist.@@ -35,12 +34,18 @@ common common-options ghc-options:- -Wall -Wcompat -Widentities -Wincomplete-uni-patterns- -Wincomplete-record-updates -Wredundant-constraints- -fhide-source-paths -Wmissing-export-lists -Wpartial-fields+ -Wall+ -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ -fhide-source-paths+ -Wmissing-export-lists+ -Wpartial-fields -Wmissing-deriving-strategies - default-language: GHC2024+ default-language: GHC2024 default-extensions: DeriveAnyClass DuplicateRecordFields@@ -48,8 +53,8 @@ OverloadedStrings library- import: common-options- hs-source-dirs: src+ import: common-options+ hs-source-dirs: src exposed-modules: Okf.Actor Okf.Bundle@@ -63,6 +68,7 @@ Okf.Path Okf.Prelude Okf.Profile+ Okf.Profile.Bootstrap Okf.Profile.Discovery Okf.Profile.Documentation Okf.Profile.Registry@@ -71,40 +77,41 @@ 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- , dhall >=1.41 && <1.43- , directory >=1.3 && <1.4- , filepath >=1.4 && <1.6- , frontmatter >=0.1 && <0.2- , generic-lens >=2.2 && <2.4- , lens ^>=5.3- , network-uri >=2.6.4 && <2.7- , regex-tdfa >=1.3.2 && <1.4- , text ^>=2.1- , time >=1.12 && <1.15- , vector >=0.13 && <0.14- , yaml >=0.11 && <0.12+ aeson >=2.2 && <2.4,+ attoparsec >=0.14 && <0.15,+ base >=4.20 && <5,+ bytestring >=0.11 && <0.13,+ cmark-gfm ^>=0.2,+ containers >=0.6 && <0.8,+ dhall >=1.41 && <1.43,+ directory >=1.3 && <1.4,+ filepath >=1.4 && <1.6,+ frontmatter >=0.1 && <0.2,+ generic-lens >=2.2 && <2.4,+ lens ^>=5.3,+ network-uri >=2.6.4 && <2.7,+ regex-tdfa >=1.3.2 && <1.4,+ scientific >=0.3 && <0.4,+ text ^>=2.1,+ time >=1.12 && <1.15,+ vector >=0.13 && <0.14,+ yaml >=0.11 && <0.12, test-suite okf-core-test- import: common-options- type: exitcode-stdio-1.0- main-is: Main.hs+ import: common-options+ type: exitcode-stdio-1.0+ main-is: Main.hs hs-source-dirs: test build-depends:- , aeson- , base >=4.20 && <5- , containers >=0.6 && <0.8- , dhall >=1.41 && <1.43- , directory- , filepath- , generic-lens >=2.2 && <2.4- , lens ^>=5.3- , okf-core- , temporary- , text ^>=2.1- , time >=1.12 && <1.15+ aeson,+ base >=4.20 && <5,+ containers >=0.6 && <0.8,+ dhall >=1.41 && <1.43,+ directory,+ filepath,+ generic-lens >=2.2 && <2.4,+ lens ^>=5.3,+ okf-core,+ temporary,+ text ^>=2.1,+ time >=1.12 && <1.15,
+ src/Okf/Profile/Bootstrap.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE PackageImports #-}++-- | Render an adoption descriptor without writing the destination bundle.+module Okf.Profile.Bootstrap+ ( DescriptorImport (..),+ BootstrapError (..),+ descriptorFileName,+ descriptorImportFor,+ renderBootstrapDescriptor,+ renderBootstrapError,+ relativeImportPath,+ bootstrapOkfVersion,+ )+where++import Control.Exception (SomeAsyncException, SomeException, catch, fromException, throwIO)+import Data.Foldable (toList)+import Data.Maybe (catMaybes)+import Data.Text qualified as Text+import Dhall.Core qualified as D+import Dhall.Freeze qualified as D+import Dhall.Parser qualified as D+import Dhall.Src (Src)+import Okf.Index (OkfVersion, parseOkfVersion)+import Okf.Prelude+import Okf.Profile (ProfileSpec)+import Okf.Profile.Registry+import System.Directory (canonicalizePath)+import System.FilePath (joinPath, normalise, splitDirectories, takeDirectory, takeFileName)+import "generic-lens" Data.Generics.Labels ()++data DescriptorImport+ = ImportRegistryFile !FilePath !Text+ | ImportRegistryExpression !Text !Text+ | ImportDescriptorFile !FilePath+ deriving stock (Generic, Eq, Show)++data BootstrapError+ = RelativeExpressionImport !Text+ | DescriptorParseError !Text+ | DescriptorFreezeError !Text+ deriving stock (Generic, Eq, Show)++descriptorFileName :: FilePath+descriptorFileName = "profile.dhall"++descriptorImportFor :: ProfileSource -> Text -> DescriptorImport+descriptorImportFor source export = case source of+ RegistrySource _ (RegistryFile path) -> ImportRegistryFile path export+ RegistrySource _ (RegistryExpression expression) -> ImportRegistryExpression expression export+ DescriptorSource path -> ImportDescriptorFile path++-- | Inputs are absolute, physically resolved, normalized paths.+relativeImportPath :: FilePath -> FilePath -> FilePath+relativeImportPath base target =+ let (remainingBase, remainingTarget) = dropCommon (splitDirectories base) (splitDirectories target)+ parents = replicate (length remainingBase) ".."+ in joinPath ((if null parents then ["."] else parents) <> remainingTarget)+ where+ dropCommon (x : xs) (y : ys) | x == y = dropCommon xs ys+ dropCommon xs ys = (xs, ys)++renderBootstrapDescriptor :: FilePath -> DescriptorImport -> IO (Either BootstrapError Text)+renderBootstrapDescriptor destination source = handleFailure $ do+ base <- normalise <$> canonicalizePath destination+ prepared <- case source of+ ImportRegistryExpression expression _ -> pure $ case D.exprFromText "registry" expression of+ Left _ -> Left (DescriptorParseError "the registry expression is not valid Dhall")+ Right expr -> case concatMap relativeImports (toList expr) of+ bad : _ -> Left (RelativeExpressionImport (D.pretty bad))+ [] -> Right (expr, expression)+ ImportRegistryFile path _ -> Right <$> localExpression base path+ ImportDescriptorFile path -> Right <$> localExpression base path+ case prepared of+ Left err -> pure (Left err)+ Right (expression, reference) -> do+ frozen <- traverse (freeze base) expression+ let (export, body) = case source of+ ImportRegistryFile _ selected -> (selected, registryBody selected frozen)+ ImportRegistryExpression _ selected -> (selected, registryBody selected frozen)+ ImportDescriptorFile _ -> ("(descriptor)", frozen)+ comments =+ [ "OKF profile descriptor written by `okf profile init`.",+ "",+ "Profile: " <> export,+ "Source: " <> reference,+ ""+ ]+ <> guidance source+ pure (Right (Text.unlines (map ("-- " <>) (concatMap (Text.splitOn "\n") comments)) <> D.pretty body <> "\n"))+ where+ handleFailure action =+ action `catch` \(err :: SomeException) ->+ case fromException err :: Maybe SomeAsyncException of+ Just _ -> throwIO err+ Nothing -> pure (Left (DescriptorFreezeError "could not prepare or freeze the descriptor; check source paths, network access, and integrity hashes"))++localExpression :: FilePath -> FilePath -> IO (D.Expr Src D.Import, Text)+localExpression base path = do+ target <- normalise <$> canonicalizePath path+ let relative = relativeImportPath base target+ pathParts = splitDirectories (takeDirectory relative)+ (prefix, directories) = case pathParts of+ ".." : rest -> (D.Parent, rest)+ "." : rest -> (D.Here, rest)+ _ -> (D.Here, pathParts)+ file = D.File (D.Directory (reverse (map Text.pack directories))) (Text.pack (takeFileName relative))+ expression = D.Embed (D.Import (D.ImportHashed Nothing (D.Local prefix file)) D.Code)+ pure (expression, D.pretty expression)++-- URL headers contain expressions outside the ordinary Expr traversal.+relativeImports :: D.Import -> [D.Import]+relativeImports imp = case D.importType (D.importHashed imp) of+ D.Local D.Here _ -> [imp]+ D.Local D.Parent _ -> [imp]+ D.Remote url -> maybe [] (concatMap relativeImports . toList) (D.headers url)+ _ -> []++freeze :: FilePath -> D.Import -> IO D.Import+freeze base imp = case D.importHashed imp of+ D.ImportHashed Nothing (D.Remote _) | D.importMode imp /= D.Location -> D.freezeRemoteImport base imp+ _ -> pure imp++registryBody :: Text -> D.Expr Src D.Import -> D.Expr Src D.Import+registryBody export expression =+ D.Let (D.makeBinding "registry" expression) $+ foldl+ (\body segment -> D.Field body (D.makeFieldSelection segment))+ (D.Var (D.V "registry" 0))+ (if Text.null export then [] else Text.splitOn "." export)++guidance :: DescriptorImport -> [Text]+guidance = \case+ ImportRegistryFile {} -> local "registry"+ ImportDescriptorFile {} -> local "profile descriptor"+ ImportRegistryExpression expression _+ | expression == defaultRegistryReference ->+ [ "The registry import is pinned by release and frozen with a sha256 integrity",+ "hash. To move to a newer release, change the tag, delete the sha256 line,",+ "and run `dhall freeze profile.dhall`. Never hand-write a sha256 value.",+ "A pin move can change what the profile demands; the okf-profiles Seihou",+ "migration blueprints in mori://shinzui/okf-profiles describe each release."+ ]+ | otherwise ->+ [ "Existing hashes are preserved and unhashed remote value imports are frozen.",+ "Local and environment inputs remain live; this is not a portable snapshot.",+ "To update remote imports, remove their hashes and run `dhall freeze profile.dhall`.",+ "Never hand-write a sha256 value."+ ]+ where+ local label =+ [ "The " <> label <> " is imported from a local path relative to this file and is not frozen.",+ "This is not a portable snapshot; loading its own imports may require network access."+ ]++renderBootstrapError :: BootstrapError -> Text+renderBootstrapError = \case+ RelativeExpressionImport imp ->+ "cwd-relative registry expression import " <> imp <> "; pass the registry as a file or directory path so okf can re-relativize it, or use an absolute path"+ DescriptorParseError message -> "descriptor parse failed: " <> message+ DescriptorFreezeError message -> "descriptor freeze failed: " <> message++bootstrapOkfVersion :: Maybe OkfVersion -> ProfileSpec -> Maybe OkfVersion+bootstrapOkfVersion existing spec = case catMaybes [existing, (spec ^. #requireBundleVersion) >>= parseOkfVersion, parseOkfVersion (spec ^. #okfVersion)] of+ [] -> Nothing+ versions -> Just (maximum versions)
src/Okf/Profile/Registry.hs view
@@ -189,8 +189,8 @@ -- newer tag means changing the URL and the hash together. defaultRegistryReference :: Text defaultRegistryReference =- "https://raw.githubusercontent.com/shinzui/okf-profiles/v0.14.0/package.dhall\- \ sha256:87d2e4076b2491ee608ac1c7a28b24156ba2634f2b09de49ad4ba79f039acf50"+ "https://raw.githubusercontent.com/shinzui/okf-profiles/v0.19.0/package.dhall\+ \ sha256:85176d78369b6d73c9f13c30277903b629d6bf048a4c7d71fc26e68b99c3eaa6" -- | How an entry with an empty export path is displayed. rootExportLabel :: Text
src/Okf/Query.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE PackageImports #-} -- | Selecting concepts out of a bundle by what their frontmatter says.@@ -36,6 +37,28 @@ -- * Checking a filter against a profile FilterProfileError (..), checkFiltersAgainstProfile,++ -- * Where conditions+ WhereCondition (..),+ ConceptPredicate (..),+ WhereParseError (..),+ parseWhereCondition,+ renderWhereCondition,+ renderConceptPredicate,+ renderWhereParseError,+ matchesPredicate,+ filterConceptsWhere,+ checkPredicateAgainstProfile,++ -- * Sorting concepts+ SortDirection (..),+ SortKey (..),+ SortKeyParseError (..),+ parseSortKey,+ renderSortKey,+ renderSortKeyParseError,+ compareNatural,+ sortConcepts, ) where @@ -43,9 +66,13 @@ import Data.Aeson.Key qualified as AesonKey import Data.Aeson.KeyMap qualified as KeyMap import Data.ByteString.Lazy qualified as LazyByteString+import Data.Char (isAsciiLower, isAsciiUpper, isDigit, isSpace) import Data.List qualified as List+import Data.List.NonEmpty qualified as NonEmpty import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map+import Data.Maybe (mapMaybe)+import Data.Scientific (Scientific) import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.Encoding qualified as Text.Encoding@@ -397,3 +424,692 @@ profileSpec :: ProfileSpec profileSpec = compiledProfileSpec compiled++-- | One @--where@ argument, as the user wrote it.+--+-- The two constructors keep apart two readings that must never mix. A+-- 'LegacyWhere' equality joins 'filterConcepts' grouping, where repeating a+-- key means \"either\" — @--where status=accepted --where status=proposed@ has+-- selected both for as long as the flag has existed, and scripts depend on it.+-- A 'PredicateWhere' is an explicit condition and stands on its own: repeating+-- one means \"and\", and an @and@ written inside one means \"and\" even when+-- both sides name the same key. Flattening a predicate's equalities into the+-- legacy groups would quietly turn @(status=\"accepted\" and+-- status=\"proposed\")@ into an \"or\".+data WhereCondition+ = LegacyWhere !ConceptFilter+ | PredicateWhere !ConceptPredicate+ deriving stock (Generic, Eq, Ord, Show)++-- | A true-or-false question asked of one concept: atomic field questions+-- composed with @and@, @or@, and @not@.+data ConceptPredicate+ = -- | An existing atomic question: equality, presence, or absence.+ PredicateAtom !ConceptFilter+ | -- | The field holds at least one comparable scalar and none equals this.+ PredicateNotEquals !FieldSelector !Text+ | -- | Some comparable scalar of the field is one of these.+ PredicateIn !FieldSelector !(NonEmpty Text)+ | -- | The field holds at least one comparable scalar and none is one of+ -- these.+ PredicateNotIn !FieldSelector !(NonEmpty Text)+ | PredicateAnd !ConceptPredicate !ConceptPredicate+ | PredicateOr !ConceptPredicate !ConceptPredicate+ | -- | Ordinary boolean negation of the whole operand, absence included:+ -- @not (status=\"completed\")@ selects a concept with no @status@.+ PredicateNot !ConceptPredicate+ deriving stock (Generic, Eq, Ord, Show)++-- | Why a @--where@ argument could not be read.+data WhereParseError+ = -- | A @KEY=VALUE@ argument failed exactly as it always has.+ LegacyWhereParseError !FilterParseError+ | -- | New syntax went wrong: the original input, the zero-based character+ -- offset where reading stopped, and what was expected there.+ InvalidWhereSyntax !Text !Int !Text+ deriving stock (Generic, Eq, Show)++-- | Read one @--where@ argument.+--+-- Which grammar applies is decided up front from the argument's first+-- characters, never by trying one grammar and falling back to another:+--+-- * An argument whose first non-whitespace character is @(@ is one fully+-- parenthesized expression, with JSON-quoted strings.+-- * An argument that starts with @FIELD!=@, @FIELD in@, or @FIELD not in@ is a+-- standalone inequality or set condition. Once that prefix is seen, a+-- malformed operand is an error; it is not reread as an equality.+-- * Everything else goes to 'parseFieldEquals' untouched.+--+-- The dispatch is this narrow because legacy equality values are verbatim and+-- may hold anything — another @=@, spaces, the word @and@ — and reinterpreting+-- @title=research and development@ as an expression would change what existing+-- scripts select. For the same reason a legacy argument is never trimmed.+parseWhereCondition :: Text -> Either WhereParseError WhereCondition+parseWhereCondition raw+ | "(" `Text.isPrefixOf` Text.stripStart raw =+ PredicateWhere <$> runWholeParser raw expressionArgumentParser+ | Just (selector, operator, cursor) <- standalonePrefix raw =+ PredicateWhere <$> standaloneOperand raw selector operator cursor+ | otherwise =+ first LegacyWhereParseError (LegacyWhere <$> parseFieldEquals raw)++-- | The condition in a form 'parseWhereCondition' reads back with the same+-- meaning. A standalone inequality or set is rendered standalone, so a+-- diagnostic quotes back what was typed; anything else is a parenthesized+-- expression.+renderWhereCondition :: WhereCondition -> Text+renderWhereCondition = \case+ LegacyWhere conceptFilter@(FieldEquals _ _) -> renderFilter conceptFilter+ LegacyWhere conceptFilter -> "(" <> renderConceptPredicate (PredicateAtom conceptFilter) <> ")"+ PredicateWhere (PredicateNotEquals selector value) ->+ renderFieldSelector selector <> "!=" <> value+ PredicateWhere predicate@(PredicateIn _ _) -> renderConceptPredicate predicate+ PredicateWhere predicate@(PredicateNotIn _ _) -> renderConceptPredicate predicate+ PredicateWhere predicate -> "(" <> renderConceptPredicate predicate <> ")"++-- | A predicate in expression syntax, without the outer parentheses an+-- expression argument needs. Parentheses appear only where precedence+-- requires them, plus around a negated compound so @not@ reads unambiguously.+renderConceptPredicate :: ConceptPredicate -> Text+renderConceptPredicate = renderAt 0+ where+ -- Precedence: or 1, and 2, not 3, atom 4. The right operand of a binary+ -- operator is rendered one level tighter so a right-nested tree keeps its+ -- shape when read back.+ renderAt :: Int -> ConceptPredicate -> Text+ renderAt context predicate+ | precedence predicate < context = "(" <> render predicate <> ")"+ | otherwise = render predicate++ precedence = \case+ PredicateOr _ _ -> 1+ PredicateAnd _ _ -> 2+ PredicateNot _ -> 3+ _ -> 4 :: Int++ render = \case+ PredicateAtom (FieldEquals selector value) -> key selector <> "=" <> jsonString value+ PredicateAtom (FieldPresent selector) -> "has(" <> key selector <> ")"+ PredicateAtom (FieldAbsent selector) -> "missing(" <> key selector <> ")"+ PredicateNotEquals selector value -> key selector <> "!=" <> jsonString value+ PredicateIn selector values -> key selector <> " in " <> jsonSet values+ PredicateNotIn selector values -> key selector <> " not in " <> jsonSet values+ PredicateAnd left right -> renderAt 2 left <> " and " <> renderAt 3 right+ PredicateOr left right -> renderAt 1 left <> " or " <> renderAt 2 right+ PredicateNot operand@(PredicateAtom (FieldPresent _)) -> "not " <> render operand+ PredicateNot operand@(PredicateAtom (FieldAbsent _)) -> "not " <> render operand+ PredicateNot operand@(PredicateNot _) -> "not " <> render operand+ PredicateNot operand -> "not (" <> render operand <> ")"++ key = renderFieldSelector+ jsonString = jsonText . String+ jsonSet = jsonText . Aeson.toJSON . NonEmpty.toList+ jsonText = Text.Encoding.decodeUtf8Lenient . LazyByteString.toStrict . Aeson.encode++renderWhereParseError :: WhereParseError -> Text+renderWhereParseError = \case+ LegacyWhereParseError parseError -> renderFilterParseError parseError+ InvalidWhereSyntax input offset expected ->+ "expected "+ <> expected+ <> " at offset "+ <> Text.pack (show offset)+ <> caret+ where+ -- A caret under the offending character, unless a newline in the input+ -- would make the column meaningless.+ caret+ | Text.any (== '\n') input = " in: " <> input+ | otherwise = "\n " <> input <> "\n " <> Text.replicate offset " " <> "^"++-- | Whether one concept satisfies one predicate.+--+-- Positive and negative value questions both need something to compare: a+-- comparable scalar is a string, number, or boolean, as 'scalarText' reads it,+-- whether it is the value itself or an element of a list. A concept with no+-- such scalar for the key — the key absent, null, an empty list, or only+-- records — fails @status!=completed@ just as it fails @status=completed@,+-- because \"its status is not completed\" is not something the concept says.+-- A negative question is __universal over a list__: @tags!=cli@ rejects a+-- concept tagged @[profiles, cli]@, because hiding a tag means hiding every+-- concept that carries it. Explicit @not@ is different: it is plain boolean+-- negation of its whole operand, absence included.+matchesPredicate :: ConceptPredicate -> Concept -> Bool+matchesPredicate predicate concept =+ case predicate of+ PredicateAtom conceptFilter -> matchesFilter conceptFilter concept+ PredicateNotEquals selector forbidden -> holdsNoneOf selector (== forbidden)+ PredicateIn selector wanted -> any (`elem` wanted) (comparable selector)+ PredicateNotIn selector forbidden -> holdsNoneOf selector (`elem` forbidden)+ PredicateAnd left right -> matchesPredicate left concept && matchesPredicate right concept+ PredicateOr left right -> matchesPredicate left concept || matchesPredicate right concept+ PredicateNot operand -> not (matchesPredicate operand concept)+ where+ comparable selector = mapMaybe scalarText (conceptFieldValues selector concept)+ holdsNoneOf selector isForbidden =+ case comparable selector of+ [] -> False+ values -> not (any isForbidden values)++-- | Keep the concepts that satisfy the given legacy filters together with+-- every condition, in the order they arrived.+--+-- Legacy equalities join the supplied filters and are answered by+-- 'filterConcepts', so repeating a legacy key still means \"either\". Every+-- predicate must then hold on its own: repeating one is an \"and\", even on the+-- same key, so two @--where status!=...@ flags exclude both values.+filterConceptsWhere :: [ConceptFilter] -> [WhereCondition] -> [Concept] -> [Concept]+filterConceptsWhere filters conditions concepts =+ filter satisfiesPredicates (filterConcepts (filters <> legacyFilters) concepts)+ where+ legacyFilters = [conceptFilter | LegacyWhere conceptFilter <- conditions]+ predicates = [predicate | PredicateWhere predicate <- conditions]+ satisfiesPredicates concept = all (`matchesPredicate` concept) predicates++-- | Check every field and value a predicate mentions against a profile, as+-- 'checkFiltersAgainstProfile' checks a legacy filter.+--+-- Every operand counts, including those under @not@ and on either side of+-- @or@: a misspelled exclusion is otherwise silently ineffective, which is+-- worse than a misspelled inclusion because the listing still looks right.+-- Each excluded value or set member is checked as the equality it names, so+-- scopes, nested vocabularies, the core-key fallback, and @type@ checking are+-- exactly the legacy ones. Requested types come from the caller; a @type@+-- equality inside an expression does not narrow anything, and a contradiction+-- is not an error, only an empty result. Errors are reported once each, in the+-- order the predicate mentions them.+checkPredicateAgainstProfile :: CompiledProfile -> [Text] -> ConceptPredicate -> [FilterProfileError]+checkPredicateAgainstProfile compiled requestedTypes =+ List.nub . checkFiltersAgainstProfile compiled requestedTypes . operandFilters+ where+ operandFilters = \case+ PredicateAtom conceptFilter -> [conceptFilter]+ PredicateNotEquals selector value -> [FieldEquals selector value]+ PredicateIn selector values -> FieldEquals selector <$> NonEmpty.toList values+ PredicateNotIn selector values -> FieldEquals selector <$> NonEmpty.toList values+ PredicateAnd left right -> operandFilters left <> operandFilters right+ PredicateOr left right -> operandFilters left <> operandFilters right+ PredicateNot operand -> operandFilters operand++-- Sorting ---------------------------------------------------------------------++-- | Which way one sort key orders concepts.+data SortDirection = Ascending | Descending+ deriving stock (Generic, Eq, Ord, Show)++-- | One @--sort@ argument: the frontmatter value to order by, and which way.+data SortKey = SortKey+ { sortSelector :: !FieldSelector,+ sortDirection :: !SortDirection+ }+ deriving stock (Generic, Eq, Show)++-- | Why a @--sort@ argument could not be read.+data SortKeyParseError+ = -- | The key itself was malformed, exactly as a filter key would be.+ SortKeySelectorError !FilterParseError+ | -- | A @:@ introduced something other than @asc@ or @desc@. Holds the whole+ -- argument and the offending suffix.+ InvalidSortDirection !Text !Text+ deriving stock (Generic, Eq, Show)++-- | Read @KEY@, @KEY:asc@, or @KEY:desc@.+--+-- Any @:@ introduces a direction, and the text after the last one must be+-- exactly @asc@ or @desc@. Reading @status:up@ as a key named @status:up@+-- would sort by nothing and look as though it had worked, so it is an error+-- instead; the cost is that a key containing a colon cannot be sorted on.+parseSortKey :: Text -> Either SortKeyParseError SortKey+parseSortKey raw =+ case Text.breakOnEnd ":" raw of+ ("", _) -> SortKey <$> selector raw <*> pure Ascending+ (beforeWithColon, suffix) -> do+ direction <- case suffix of+ "asc" -> Right Ascending+ "desc" -> Right Descending+ _ -> Left (InvalidSortDirection raw suffix)+ SortKey <$> selector (Text.dropEnd 1 beforeWithColon) <*> pure direction+ where+ selector = first SortKeySelectorError . parseFieldSelector++-- | The key in the form 'parseSortKey' reads back; ascending, the default, is+-- not spelled out.+renderSortKey :: SortKey -> Text+renderSortKey SortKey {sortSelector, sortDirection} =+ renderFieldSelector sortSelector <> case sortDirection of+ Ascending -> ""+ Descending -> ":desc"++renderSortKeyParseError :: SortKeyParseError -> Text+renderSortKeyParseError = \case+ SortKeySelectorError parseError -> renderFilterParseError parseError+ InvalidSortDirection raw suffix ->+ "sort direction must be asc or desc, not " <> suffix <> ", in " <> raw++-- | Compare two texts the way a person reads identifiers: @IR-2@ before+-- @IR-10@, @v0.9@ before @v0.13@.+--+-- Each text is split into runs of ASCII digits and runs of everything else.+-- Digit runs compare by numeric value, and on a tie the shorter spelling comes+-- first, so @IR-2@ precedes @IR-02@. Other runs compare by Unicode code point,+-- which keeps the order identical on every machine whatever its locale. A+-- digit run sorts before a text run, as an ASCII digit sorts before a letter.+-- Two texts whose runs are all equal fall back to plain comparison, so+-- distinct texts never compare equal and the order is total.+compareNatural :: Text -> Text -> Ordering+compareNatural left right =+ compare (naturalChunks left) (naturalChunks right) <> compare left right++-- | One run of a text under 'compareNatural'. The derived 'Ord' is the rule:+-- every 'DigitRun' before every 'TextRun', digit runs by value then length,+-- text runs by code point.+data NaturalChunk = DigitRun !Integer !Int | TextRun !Text+ deriving stock (Eq, Ord)++naturalChunks :: Text -> [NaturalChunk]+naturalChunks = map chunk . Text.groupBy (\a b -> isDigit a == isDigit b)+ where+ chunk run+ | Text.all isDigit run = DigitRun (read (Text.unpack run)) (Text.length run)+ | otherwise = TextRun run++-- | Text ordered by 'compareNatural'.+newtype NaturalText = NaturalText Text++instance Eq NaturalText where+ left == right = compare left right == EQ++instance Ord NaturalText where+ compare (NaturalText left) (NaturalText right) = compareNatural left right++-- | What a concept is sorted by for one key. Every number sorts before every+-- text value, which keeps the order total even for a key that mixes them.+data SortValue = SortNumber !Scientific | SortText !NaturalText+ deriving stock (Eq, Ord)++-- | A stored number compares numerically, because natural order on the text+-- @1.5@ and @1.25@ would get them backwards. Strings and booleans compare as+-- the text 'scalarText' gives them. A value with no scalar reading has no+-- sort value.+sortValue :: Value -> Maybe SortValue+sortValue = \case+ Number number -> Just (SortNumber number)+ value -> SortText . NaturalText <$> scalarText value++-- | Order concepts by frontmatter keys. The first key decides; later keys+-- break its ties.+--+-- Text compares in natural order ('compareNatural'), numbers numerically, and+-- every number before any text. A concept with no comparable value for a key+-- — the key absent, null, an empty list, or only records — sorts after every+-- concept that has one, in both directions: asking to sort by a key is asking+-- to see the concepts that carry it, and @:desc@ should not lead with those+-- that say nothing. A list sorts by its smallest value when ascending and its+-- largest when descending, so the order does not depend on how an author+-- happened to list the elements. Concepts equal on every key keep the order+-- they arrived in, which for a walked bundle is concept-ID order, so the+-- listing stays deterministic.+sortConcepts :: [SortKey] -> [Concept] -> [Concept]+sortConcepts [] concepts = concepts+sortConcepts keys concepts =+ map snd (List.sortBy (\(left, _) (right, _) -> mconcat (zipWith3 compareCell keys left right)) decorated)+ where+ -- Read each concept's values once per key rather than once per comparison.+ decorated = [(map (cellFor concept) keys, concept) | concept <- concepts]+ cellFor concept SortKey {sortSelector, sortDirection} =+ representative sortDirection (mapMaybe sortValue (conceptFieldValues sortSelector concept))+ representative _ [] = Nothing+ representative Ascending values = Just (minimum values)+ representative Descending values = Just (maximum values)+ compareCell SortKey {sortDirection} left right =+ case (left, right) of+ (Just x, Just y) -> case sortDirection of+ Ascending -> compare x y+ Descending -> compare y x+ (Just _, Nothing) -> LT+ (Nothing, Just _) -> GT+ (Nothing, Nothing) -> EQ++-- Reading ---------------------------------------------------------------------++-- | Where a parser stands: the zero-based character offset into the original+-- argument and the text still unread.+data Cursor = Cursor !Int !Text++-- | A small hand-written parser. It never backtracks across a committed+-- choice, so the offset it reports is where the input really went wrong.+newtype WhereParser value = WhereParser+ {runWhereParser :: Cursor -> Either (Int, Text) (value, Cursor)}++instance Functor WhereParser where+ fmap f (WhereParser run) = WhereParser (fmap (first f) . run)++instance Applicative WhereParser where+ pure value = WhereParser (\cursor -> Right (value, cursor))+ WhereParser runF <*> WhereParser runValue = WhereParser $ \cursor -> do+ (f, afterF) <- runF cursor+ (value, afterValue) <- runValue afterF+ pure (f value, afterValue)++instance Monad WhereParser where+ WhereParser run >>= continue = WhereParser $ \cursor -> do+ (value, next) <- run cursor+ runWhereParser (continue value) next++-- | Run a parser over a whole argument.+runWholeParser :: Text -> WhereParser value -> Either WhereParseError value+runWholeParser raw parser =+ case runWhereParser parser (Cursor 0 raw) of+ Left (offset, expected) -> Left (InvalidWhereSyntax raw offset expected)+ Right (value, _) -> Right value++remaining :: WhereParser Text+remaining = WhereParser (\cursor@(Cursor _ rest) -> Right (rest, cursor))++failHere :: Text -> WhereParser value+failHere expected = WhereParser (\(Cursor offset _) -> Left (offset, expected))++-- | Fail at an earlier offset, for an error best pointed at the start of the+-- construct rather than wherever scanning gave up.+failAt :: Int -> Text -> WhereParser value+failAt offset expected = WhereParser (\_ -> Left (offset, expected))++currentOffset :: WhereParser Int+currentOffset = WhereParser (\cursor@(Cursor offset _) -> Right (offset, cursor))++skipChars :: Int -> WhereParser ()+skipChars count =+ WhereParser (\(Cursor offset rest) -> Right ((), Cursor (offset + count) (Text.drop count rest)))++peekChar :: WhereParser (Maybe Char)+peekChar = fmap fst . Text.uncons <$> remaining++skipSpaces :: WhereParser ()+skipSpaces = do+ rest <- remaining+ skipChars (Text.length (Text.takeWhile isSpace rest))++expectChar :: Char -> Text -> WhereParser ()+expectChar wanted expected = do+ next <- peekChar+ if next == Just wanted then skipChars 1 else failHere expected++expectEnd :: Text -> WhereParser ()+expectEnd expected = do+ skipSpaces+ rest <- remaining+ unless (Text.null rest) (failHere expected)++-- | Consume a lowercase keyword if the input continues with it as a whole+-- word, so @orphan@ is never read as @or@.+keyword :: Text -> WhereParser Bool+keyword word = do+ rest <- remaining+ if word `Text.isPrefixOf` rest && wordBoundary (Text.drop (Text.length word) rest)+ then True <$ skipChars (Text.length word)+ else pure False++wordBoundary :: Text -> Bool+wordBoundary rest =+ case Text.uncons rest of+ Nothing -> True+ Just (next, _) -> not (isSegmentChar next || next == '.')++-- | A key segment starts with a letter or underscore and continues with+-- letters, digits, underscores, or hyphens.+isSegmentStart :: Char -> Bool+isSegmentStart c = isAsciiLower c || isAsciiUpper c || c == '_'++isSegmentChar :: Char -> Bool+isSegmentChar c = isSegmentStart c || isDigit c || c == '-'++segmentParser :: WhereParser Text+segmentParser = do+ rest <- remaining+ case Text.uncons rest of+ Just (next, _)+ | isSegmentStart next -> do+ let segment = Text.takeWhile isSegmentChar rest+ segment <$ skipChars (Text.length segment)+ _ -> failHere "a frontmatter key such as status or reviews.outcome"++-- | @KEY@ or @PARENT.MEMBER@, with the same one-level limit as+-- 'parseFieldSelector' and for the same reason.+selectorParser :: WhereParser FieldSelector+selectorParser = do+ parentKey <- segmentParser+ next <- peekChar+ if next /= Just '.'+ then pure (TopLevelField parentKey)+ else do+ skipChars 1+ memberKey <- segmentParser+ deeper <- peekChar+ when (deeper == Just '.') $+ failHere "an operator; a frontmatter key nests at most one level (KEY or PARENT.MEMBER)"+ pure (NestedField parentKey memberKey)++-- | A JSON double-quoted string, decoded by aeson so escapes mean exactly what+-- they mean in JSON. The scan only finds where the string ends.+jsonStringParser :: Text -> WhereParser Text+jsonStringParser expected = do+ start <- currentOffset+ rest <- remaining+ case Text.uncons rest of+ Just ('"', body) ->+ case closingQuote 1 body of+ Nothing -> failAt start "a closing quotation mark for the string that starts here"+ Just width ->+ case Aeson.eitherDecodeStrict (Text.Encoding.encodeUtf8 (Text.take width rest)) of+ Left _ -> failAt start "a valid JSON string; check its escape sequences"+ Right decoded -> decoded <$ skipChars width+ _ -> failHere expected+ where+ -- The width of the whole string literal, quotes included.+ closingQuote :: Int -> Text -> Maybe Int+ closingQuote consumed body =+ case Text.uncons body of+ Nothing -> Nothing+ Just ('"', _) -> Just (consumed + 1)+ Just ('\\', escaped) ->+ if Text.null escaped then Nothing else closingQuote (consumed + 2) (Text.drop 1 escaped)+ Just (_, next) -> closingQuote (consumed + 1) next++-- | A non-empty JSON array of strings. Duplicates are dropped, keeping the+-- first occurrence, since a set mentioning a value twice means the same as+-- mentioning it once.+jsonStringSetParser :: WhereParser (NonEmpty Text)+jsonStringSetParser = do+ expectChar '[' "a non-empty JSON array of strings such as [\"accepted\",\"proposed\"]"+ skipSpaces+ next <- peekChar+ when (next == Just ']') $+ failHere "at least one string in the set; an empty set can never match"+ firstMember <- member+ NonEmpty.nub . (firstMember :|) <$> moreMembers+ where+ member = jsonStringParser "a JSON double-quoted string as a set member"+ moreMembers = do+ skipSpaces+ next <- peekChar+ case next of+ Just ',' -> do+ skipChars 1+ skipSpaces+ value <- member+ (value :) <$> moreMembers+ Just ']' -> [] <$ skipChars 1+ _ -> failHere "a comma or a closing bracket to continue the set"++-- | The standalone operators recognized after a leading field.+data StandaloneOperator+ = StandaloneNotEquals+ | StandaloneIn+ | StandaloneNotIn++-- | Recognize @FIELD!=@, @FIELD in@, or @FIELD not in@ at the very start of an+-- argument, without judging what follows. A keyword here must be followed by+-- whitespace, @[@, or the end, which is stricter than inside an expression so+-- that fewer legacy keys can ever be mistaken for one.+standalonePrefix :: Text -> Maybe (FieldSelector, StandaloneOperator, Cursor)+standalonePrefix raw = do+ (selector, Cursor offset rest) <- either (const Nothing) Just (runWhereParser selectorParser (Cursor 0 raw))+ let (spaces, afterSpaces) = Text.span isSpace rest+ afterSpacesOffset = offset + Text.length spaces+ if+ | "!=" `Text.isPrefixOf` rest ->+ Just (selector, StandaloneNotEquals, Cursor (offset + 2) (Text.drop 2 rest))+ | Text.null spaces -> Nothing+ | Just afterIn <- standaloneKeyword "in" afterSpaces ->+ Just (selector, StandaloneIn, Cursor (afterSpacesOffset + 2) afterIn)+ | Just afterNot <- standaloneKeyword "not" afterSpaces,+ (notSpaces, afterNotSpaces) <- Text.span isSpace afterNot,+ not (Text.null notSpaces),+ Just afterIn <- standaloneKeyword "in" afterNotSpaces ->+ Just+ ( selector,+ StandaloneNotIn,+ Cursor (afterSpacesOffset + 3 + Text.length notSpaces + 2) afterIn+ )+ | otherwise -> Nothing+ where+ standaloneKeyword word text = do+ afterWord <- Text.stripPrefix word text+ case Text.uncons afterWord of+ Nothing -> Just afterWord+ Just (next, _)+ | isSpace next || next == '[' -> Just afterWord+ | otherwise -> Nothing++-- | The operand of a recognized standalone operator. An inequality's value is+-- the rest of the argument verbatim, exactly like a legacy equality's; a set+-- is JSON and must be all that is left.+standaloneOperand :: Text -> FieldSelector -> StandaloneOperator -> Cursor -> Either WhereParseError ConceptPredicate+standaloneOperand raw selector operator cursor@(Cursor _ rest) =+ case operator of+ StandaloneNotEquals -> Right (PredicateNotEquals selector rest)+ StandaloneIn -> PredicateIn selector <$> setOperand+ StandaloneNotIn -> PredicateNotIn selector <$> setOperand+ where+ setOperand =+ case runWhereParser (skipSpaces *> jsonStringSetParser <* expectEnd "the end of the condition after the set") cursor of+ Left (offset, expected) -> Left (InvalidWhereSyntax raw offset expected)+ Right (values, _) -> Right values++-- | @( expression )@, followed by nothing but whitespace.+expressionArgumentParser :: WhereParser ConceptPredicate+expressionArgumentParser = do+ skipSpaces+ expectChar '(' "an opening parenthesis"+ predicate <- expressionParser+ skipSpaces+ expectChar ')' "and, or, or a closing parenthesis"+ expectEnd "the end of the condition after its closing parenthesis; wrap the whole condition in one pair of parentheses"+ pure predicate++-- | @or@ binds loosest, then @and@, then @not@; both binary operators group+-- to the left.+expressionParser :: WhereParser ConceptPredicate+expressionParser = conjunctionParser >>= alternatives+ where+ alternatives left = do+ skipSpaces+ isOr <- keyword "or"+ if isOr+ then conjunctionParser >>= alternatives . PredicateOr left+ else pure left++conjunctionParser :: WhereParser ConceptPredicate+conjunctionParser = unaryParser >>= conjunctions+ where+ conjunctions left = do+ skipSpaces+ isAnd <- keyword "and"+ if isAnd+ then unaryParser >>= conjunctions . PredicateAnd left+ else pure left++unaryParser :: WhereParser ConceptPredicate+unaryParser = do+ skipSpaces+ next <- peekChar+ case next of+ Just '(' -> do+ skipChars 1+ predicate <- expressionParser+ skipSpaces+ expectChar ')' "and, or, or a closing parenthesis"+ pure predicate+ _ -> do+ isNot <- negationKeyword+ if isNot then PredicateNot <$> unaryParser else atomParser++-- | @not@ as an operator, unless it is plainly a key named @not@ being+-- compared: @(not="x")@.+negationKeyword :: WhereParser Bool+negationKeyword = do+ rest <- remaining+ case Text.stripPrefix "not" rest of+ Just afterNot+ | wordBoundary afterNot,+ not (any (`Text.isPrefixOf` Text.stripStart afterNot) ["=", "!="]) ->+ True <$ skipChars 3+ _ -> pure False++atomParser :: WhereParser ConceptPredicate+atomParser = do+ rest <- remaining+ case Text.uncons rest of+ Just (next, _) | isSegmentStart next -> pure ()+ _ ->+ failHere+ "a condition: KEY=\"VALUE\", KEY!=\"VALUE\", KEY in [...], KEY not in [...], has(KEY), missing(KEY), not CONDITION, or a parenthesized condition"+ if+ | isFunctionCall "has" rest -> PredicateAtom . FieldPresent <$> functionCall "has"+ | isFunctionCall "missing" rest -> PredicateAtom . FieldAbsent <$> functionCall "missing"+ | otherwise -> do+ selector <- selectorParser+ skipSpaces+ operatorParser selector+ where+ isFunctionCall name text =+ case Text.stripPrefix name text of+ Just afterName -> "(" `Text.isPrefixOf` Text.stripStart afterName+ Nothing -> False+ functionCall name = do+ skipChars (Text.length name)+ skipSpaces+ expectChar '(' "an opening parenthesis"+ skipSpaces+ selector <- selectorParser+ skipSpaces+ expectChar ')' "a closing parenthesis after the key"+ pure selector++operatorParser :: FieldSelector -> WhereParser ConceptPredicate+operatorParser selector = do+ rest <- remaining+ if+ | "!=" `Text.isPrefixOf` rest -> do+ skipChars 2+ skipSpaces+ PredicateNotEquals selector <$> stringOperand+ | "=" `Text.isPrefixOf` rest -> do+ skipChars 1+ skipSpaces+ PredicateAtom . FieldEquals selector <$> stringOperand+ | otherwise -> do+ isIn <- keyword "in"+ if isIn+ then skipSpaces *> (PredicateIn selector <$> jsonStringSetParser)+ else do+ isNot <- keyword "not"+ unless isNot (failHere "an operator: =, !=, in, or not in")+ skipSpaces+ isNotIn <- keyword "in"+ unless isNotIn (failHere "in after not")+ skipSpaces+ PredicateNotIn selector <$> jsonStringSetParser+ where+ stringOperand = jsonStringParser "a JSON double-quoted string such as \"accepted\""
test/Main.hs view
@@ -2,6 +2,7 @@ module Main (main) where +import Control.Exception (bracket) import Data.Aeson (object, toJSON, (.=)) import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KeyMap@@ -14,6 +15,7 @@ import Data.Text qualified as Text import Data.Text.IO qualified as Text.IO import Data.Time (fromGregorian)+import Dhall.Parser qualified as Dhall import Okf.Actor import Okf.Bundle import Okf.ConceptId@@ -32,6 +34,7 @@ -- reached as 'Profile.HumanActor'. import Okf.Profile hiding (HumanActor) import Okf.Profile qualified as Profile+import Okf.Profile.Bootstrap import Okf.Profile.Discovery qualified as ProfileDiscovery import Okf.Profile.Documentation import Okf.Profile.Registry@@ -40,6 +43,7 @@ import Okf.Validation import System.Directory ( createDirectoryIfMissing,+ createDirectoryLink, createFileLink, doesDirectoryExist, doesFileExist,@@ -56,7 +60,10 @@ main = do results <- sequence- [ test "parseActor classifies the three specification section 7 shapes" testParseActorShapes,+ [ testIO "bootstrap descriptors round-trip from local sources and physical paths" testBootstrapRoundTrip,+ testIO "bootstrap expressions preserve hashes and reject relative imports" testBootstrapExpressions,+ test "bootstrap paths and versions" testBootstrapPure,+ test "parseActor classifies the three specification section 7 shapes" testParseActorShapes, test "renderActor inverts parseActor on every input" testActorRoundTrip, test "parse valid document with YAML frontmatter" testParseValidDocument, test "parse document with no frontmatter as empty-frontmatter body" testParseNoFrontmatter,@@ -307,9 +314,16 @@ testIO "document reference fixture covers local, external, self, and duplicate targets" testDocumentReferencesFixture, testIO "optional-field fixture reports only the recommendation and bad values" testOptionalFieldsFixture, test "parseFieldEquals and parseFieldSelector read the filter grammar" testParseConceptFilters,+ test "parseWhereCondition reads legacy, standalone, and expression conditions" testParseWhereConditions, test "scalarText compares numbers and booleans as JSON, containers as nothing" testQueryScalarText, testIO "filterConcepts selects over lists, nested records, presence, and absence" testFilterConceptsOverFixture,- testIO "checkFiltersAgainstProfile rejects undeclared keys and out-of-vocabulary values" testCheckFiltersAgainstProfile+ testIO "checkFiltersAgainstProfile rejects undeclared keys and out-of-vocabulary values" testCheckFiltersAgainstProfile,+ testIO "filterConceptsWhere selects with inclusion, exclusion, and composition" testFilterConceptsWhereOverFixture,+ test "matchesPredicate needs a comparable scalar for every value question" testMatchesPredicateEdgeCases,+ testIO "checkPredicateAgainstProfile checks every operand with legacy scope rules" testCheckPredicateAgainstProfile,+ test "compareNatural orders digit runs by value" testCompareNatural,+ test "parseSortKey reads keys and directions" testParseSortKey,+ testIO "sortConcepts orders by frontmatter keys" testSortConceptsOverFixture ] unless (and results) exitFailure @@ -3271,13 +3285,17 @@ assertEqual [ "assurance.failureModes", "assurance.reviews",+ "assurance.verificationEvidence", "coordination.bugReports", "coordination.capabilities", "coordination.improvementRequests",+ "coordination.patternApplications", "coordination.useCases", "documentation.architectureDecisions", "documentation.patternCatalog", "documentation.researchDocuments",+ "documentation.specifications",+ "documentation.terminology", "documentation.userDocumentation", "okfV02", "postgresql",@@ -7121,6 +7139,78 @@ "Body text." ] +-- | Natural order: digit runs by value, then by spelling length, everything+-- else by code point, and only identical texts equal.+testCompareNatural :: Either Text ()+testCompareNatural = do+ let ordered smaller larger = do+ assertEqual (smaller, larger, LT) (smaller, larger, compareNatural smaller larger)+ assertEqual (larger, smaller, GT) (larger, smaller, compareNatural larger smaller)+ ordered "IR-2" "IR-10"+ ordered "IR-9" "IR-10"+ ordered "IR-2" "IR-02"+ ordered "v0.9" "v0.13"+ ordered "a" "b"+ ordered "B" "a"+ ordered "2026-08-08" "2026-10-01"+ ordered "IR-10" "IR-10a"+ ordered "7" "x"+ assertEqual EQ (compareNatural "IR-10" "IR-10")+ assertEqual EQ (compareNatural "" "")++-- | @--sort@ arguments: a selector, an optional @:asc@ or @:desc@, and errors+-- for anything else after a colon.+testParseSortKey :: Either Text ()+testParseSortKey = do+ let status = TopLevelField "status"+ assertEqual (Right (SortKey status Ascending)) (parseSortKey "status")+ assertEqual (Right (SortKey status Ascending)) (parseSortKey "status:asc")+ assertEqual (Right (SortKey status Descending)) (parseSortKey "status:desc")+ assertEqual+ (Right (SortKey (NestedField "reviews" "outcome") Descending))+ (parseSortKey "reviews.outcome:desc")+ assertEqual (Left (InvalidSortDirection "status:up" "up")) (parseSortKey "status:up")+ assertEqual (Left (InvalidSortDirection "status:DESC" "DESC")) (parseSortKey "status:DESC")+ assertEqual (Left (InvalidSortDirection "a:b:c" "c")) (parseSortKey "a:b:c")+ assertEqual (Left (SortKeySelectorError EmptyFilterKey)) (parseSortKey ":desc")+ assertEqual (Left (SortKeySelectorError EmptyFilterKey)) (parseSortKey "")+ assertEqual (Left (SortKeySelectorError (FilterKeyTooDeep "a.b.c"))) (parseSortKey "a.b.c")+ assertEqual+ "sort direction must be asc or desc, not up, in status:up"+ (either renderSortKeyParseError (const "") (parseSortKey "status:up"))+ for_ ["status", "status:desc", "reviews.outcome", "generated.by:desc"] $ \raw ->+ assertEqual (Right raw) (renderSortKey <$> parseSortKey raw)+ assertEqual (Right "status") (renderSortKey <$> parseSortKey "status:asc")++-- | 'sortConcepts' over the concept-sorting fixture, whose concept-ID order+-- (a-ten, b-two, c-nine, d-none, e-one) matches none of the orders asked for.+testSortConceptsOverFixture :: IO (Either Text ())+testSortConceptsOverFixture = do+ root <- fixturePath "concept-sorting"+ concepts <- readBundle root+ pure $ do+ let key name = SortKey (TopLevelField name)+ sortedBy keys = Text.drop (Text.length "requests/") . renderConceptId . conceptIdOf <$> sortConcepts keys concepts++ assertEqual ["a-ten", "b-two", "c-nine", "d-none", "e-one"] (sortedBy [])+ -- Natural order puts IR-10 after IR-9; the concept with no ID is last.+ assertEqual ["e-one", "b-two", "c-nine", "a-ten", "d-none"] (sortedBy [key "requestId" Ascending])+ -- Descending reverses the present values only: absence stays last.+ assertEqual ["a-ten", "c-nine", "b-two", "e-one", "d-none"] (sortedBy [key "requestId" Descending])+ -- Numbers compare numerically, and the 2-2 tie keeps concept-ID order.+ assertEqual ["c-nine", "a-ten", "e-one", "b-two", "d-none"] (sortedBy [key "priority" Ascending])+ -- A second key breaks the tie instead.+ assertEqual+ ["b-two", "e-one", "a-ten", "c-nine", "d-none"]+ (sortedBy [key "priority" Descending, key "requestId" Ascending])+ -- A list sorts by its smallest element ascending and largest descending.+ assertEqual ["a-ten", "d-none", "b-two", "c-nine", "e-one"] (sortedBy [key "tags" Ascending])+ assertEqual ["a-ten", "b-two", "d-none", "c-nine", "e-one"] (sortedBy [key "tags" Descending])+ -- A key no concept carries leaves the order alone.+ assertEqual ["a-ten", "b-two", "c-nine", "d-none", "e-one"] (sortedBy [key "nothing" Descending])+ -- Titles Nine, None, One, Ten, Two in code-point order.+ assertEqual ["c-nine", "d-none", "e-one", "a-ten", "b-two"] (sortedBy [key "title" Ascending])+ assertEqual :: (Eq value, Show value) => value -> value -> Either Text () assertEqual expected actual | expected == actual = Right ()@@ -7192,6 +7282,179 @@ assertEqual "completedAt" (renderFilter (FieldPresent (TopLevelField "completedAt"))) assertEqual "!status" (renderFilter (FieldAbsent (TopLevelField "status"))) +-- | The @--where@ grammar: legacy @KEY=VALUE@ untouched, standalone @!=@ and+-- set conditions, and parenthesized expressions with JSON strings.+testParseWhereConditions :: Either Text ()+testParseWhereConditions = do+ let status = TopLevelField "status"+ outcome = NestedField "reviews" "outcome"+ parsed = parseWhereCondition+ predicate = Right . PredicateWhere+ equals selector value = PredicateAtom (FieldEquals selector value)+ syntaxOffset = \case+ Left (InvalidWhereSyntax _ offset _) -> Just offset+ _ -> Nothing+ isSyntaxError result = isJust (syntaxOffset result)+ assertOffset expected raw =+ first (\message -> raw <> ": " <> message) (assertEqual (Just expected) (syntaxOffset (parsed raw)))++ -- Legacy arguments keep their exact meaning, however expression-like the+ -- value looks.+ assertEqual (Right (LegacyWhere (FieldEquals status "accepted"))) (parsed "status=accepted")+ assertEqual+ (Right (LegacyWhere (FieldEquals (TopLevelField "resource") "postgres://host/db?a=b")))+ (parsed "resource=postgres://host/db?a=b")+ assertEqual (Right (LegacyWhere (FieldEquals (TopLevelField "title") " "))) (parsed "title= ")+ assertEqual (Right (LegacyWhere (FieldEquals (TopLevelField "title") ""))) (parsed "title=")+ assertEqual+ (Right (LegacyWhere (FieldEquals (TopLevelField "title") "research and development")))+ (parsed "title=research and development")+ assertEqual+ (Right (LegacyWhere (FieldEquals (TopLevelField "title") "a in [\"b\"]")))+ (parsed "title=a in [\"b\"]")+ -- Quotes outside expression mode are part of the literal value.+ assertEqual (Right (LegacyWhere (FieldEquals status "\"accepted\""))) (parsed "status=\"accepted\"")+ -- A key that merely starts like a keyword is still a legacy key.+ assertEqual (Right (LegacyWhere (FieldEquals (TopLevelField "status index") "1"))) (parsed "status index=1")+ assertEqual (Left (LegacyWhereParseError (MissingFilterSeparator "status"))) (parsed "status")+ assertEqual (Left (LegacyWhereParseError (FilterKeyTooDeep "a.b.c"))) (parsed "a.b.c=x")++ -- Standalone inequality: the value is verbatim, like a legacy equality's.+ assertEqual (predicate (PredicateNotEquals status "completed")) (parsed "status!=completed")+ assertEqual (predicate (PredicateNotEquals status "")) (parsed "status!=")+ assertEqual (predicate (PredicateNotEquals status " a=b ")) (parsed "status!= a=b ")+ assertEqual (predicate (PredicateNotEquals outcome "approved")) (parsed "reviews.outcome!=approved")++ -- Standalone sets are JSON, consume the whole argument, and keep the first+ -- occurrence of a duplicate.+ assertEqual+ (predicate (PredicateIn status ("accepted" :| ["proposed"])))+ (parsed "status in [\"accepted\",\"proposed\"]")+ assertEqual+ (predicate (PredicateNotIn status ("completed" :| ["rejected"])))+ (parsed "status not in [ \"completed\" , \"rejected\" ] ")+ assertEqual+ (predicate (PredicateIn status ("a" :| ["b"])))+ (parsed "status in [\"a\",\"b\",\"a\"]")+ assertEqual (predicate (PredicateIn status ("a" :| []))) (parsed "status in[\"a\"]")+ assertEqual+ (predicate (PredicateNotIn outcome ("changes-requested" :| [])))+ (parsed "reviews.outcome not in [\"changes-requested\"]")+ -- A recognized prefix commits: a malformed set is an error, never an+ -- equality.+ assertOffset 11 "status in []"+ assertOffset 10 "status in "+ assertOffset 11 "status in [1]"+ assertOffset 21 "status in [\"accepted\""+ assertOffset 23 "status in [\"accepted\"] x"+ assertOffset 11 "status in [\"bad\\q\"]"+ assertOffset 14 "status not in accepted"++ -- Expressions.+ assertEqual (predicate (equals status "accepted")) (parsed "(status=\"accepted\")")+ assertEqual (predicate (equals status "accepted")) (parsed " ( status = \"accepted\" ) ")+ assertEqual (predicate (PredicateNotEquals status "completed")) (parsed "(status!=\"completed\")")+ assertEqual+ (predicate (PredicateAtom (FieldPresent (TopLevelField "completedAt"))))+ (parsed "(has(completedAt))")+ assertEqual (predicate (PredicateAtom (FieldAbsent status))) (parsed "(missing( status ))")+ assertEqual+ ( predicate+ ( PredicateAnd+ (PredicateIn status ("accepted" :| ["proposed"]))+ (PredicateNot (equals (TopLevelField "tags") "archived"))+ )+ )+ (parsed "(status in [\"accepted\",\"proposed\"] and not (tags=\"archived\"))")+ -- not binds tighter than and, which binds tighter than or; both group left.+ let a = equals (TopLevelField "a") "1"+ b = equals (TopLevelField "b") "2"+ c = equals (TopLevelField "c") "3"+ assertEqual+ (predicate (PredicateOr a (PredicateAnd b c)))+ (parsed "(a=\"1\" or b=\"2\" and c=\"3\")")+ assertEqual+ (predicate (PredicateAnd (PredicateOr a b) c))+ (parsed "((a=\"1\" or b=\"2\") and c=\"3\")")+ assertEqual+ (predicate (PredicateAnd (PredicateNot a) b))+ (parsed "(not a=\"1\" and b=\"2\")")+ assertEqual+ (predicate (PredicateOr (PredicateOr a b) c))+ (parsed "(a=\"1\" or b=\"2\" or c=\"3\")")+ assertEqual+ (predicate (PredicateNot (PredicateNot a)))+ (parsed "(not not a=\"1\")")+ -- Whitespace includes tabs and newlines.+ assertEqual (predicate (PredicateAnd a b)) (parsed "(a=\"1\"\n\tand\tb=\"2\")")+ -- Keywords need a word boundary: 'orphan' and 'notes' are keys.+ assertEqual+ (predicate (PredicateOr a (equals (TopLevelField "orphan") "x")))+ (parsed "(a=\"1\" or orphan=\"x\")")+ assertEqual (predicate (equals (TopLevelField "notes") "x")) (parsed "(notes=\"x\")")+ assertEqual (predicate (equals (TopLevelField "not") "x")) (parsed "(not=\"x\")")+ assertEqual+ (predicate (equals (TopLevelField "has") "x"))+ (parsed "(has=\"x\")")+ -- Strings decode JSON escapes, Unicode included, and are never coerced.+ assertEqual+ (predicate (equals (TopLevelField "title") "say \"hi\"\\ é ✓"))+ (parsed "(title=\"say \\\"hi\\\"\\\\ \\u00e9 ✓\")")+ assertEqual (predicate (equals (TopLevelField "title") "")) (parsed "(title=\"\")")+ assertEqual (predicate (equals (TopLevelField "usage_count") "12")) (parsed "(usage_count=\"12\")")+ assertEqual+ (predicate (PredicateIn outcome ("approved" :| [])))+ (parsed "(reviews.outcome in [\"approved\"])")++ -- Rejections, each at the offset where reading stopped. An invalid+ -- parenthesized argument never falls back to a literal equality.+ assertOffset 22 "(status=\"accepted\" and)"+ assertOffset 8 "(status=accepted)"+ assertOffset 18 "(status=\"accepted\""+ assertOffset 8 "(status=\"accepted)"+ assertOffset 20 "(status=\"accepted\") and (a=\"1\")"+ assertOffset 8 "(status ~ \"x\")"+ assertOffset 1 "()"+ assertOffset 4 "(a.b.c=\"x\")"+ assertOffset 12 "(status in [])"+ assertOffset 12 "(status in [true])"+ assertOffset 8 "(status=\"\\x\")"+ assertOffset 12 "(status not [\"a\"])"+ assertOffset 5 "(has status)"+ assertBool "uppercase AND is not an operator" (isSyntaxError (parsed "(a=\"1\" AND b=\"2\")"))+ assertBool+ "a syntax error names what was expected"+ ( case parsed "(status=\"accepted\" and)" of+ Left parseError -> "expected a condition" `Text.isPrefixOf` renderWhereParseError parseError+ Right _ -> False+ )+ assertEqual+ "expected at least one string in the set; an empty set can never match at offset 11\n status in []\n ^"+ (either renderWhereParseError (const "") (parsed "status in []"))++ -- Rendering reads back as the same condition.+ for_+ [ "status=accepted",+ "title=research and development",+ "status!=completed",+ "status in [\"accepted\",\"proposed\"]",+ "status not in [\"completed\",\"rejected\"]",+ "(status=\"accepted\")",+ "(missing(status) or status!=\"completed\")",+ "(status in [\"accepted\",\"proposed\"] and not (tags=\"archived\"))",+ "(a=\"1\" or (b=\"2\" or c=\"3\"))",+ "((a=\"1\" or b=\"2\") and c=\"3\")",+ "(not has(x) and not not y=\"\\\"q\\\"\")",+ "(title=\"say \\\"hi\\\" é\")"+ ]+ $ \raw -> do+ condition <- first renderWhereParseError (parsed raw)+ assertEqual (Right condition) (parsed (renderWhereCondition condition))+ assertEqual "status!=completed" (either (const "") renderWhereCondition (parsed "status!=completed"))+ assertEqual+ "(status in [\"accepted\",\"proposed\"] and not (tags=\"archived\"))"+ (either (const "") renderWhereCondition (parsed "(status in [\"accepted\",\"proposed\"] and not (tags=\"archived\"))"))+ -- | A filter compares against text, so every non-textual scalar needs a -- spelling. Aeson writes an integral number without a trailing @.0@, which is -- what makes @--where usage_count=12@ match a YAML @usage_count: 12@.@@ -7360,6 +7623,227 @@ ] ) +-- | 'filterConceptsWhere' over the concept-filter fixture: inclusion,+-- exclusion, explicit composition, and how they meet legacy grouping.+testFilterConceptsWhereOverFixture :: IO (Either Text ())+testFilterConceptsWhereOverFixture = do+ root <- fixturePath "concept-filters"+ concepts <- readBundle root+ pure $ do+ let status = TopLevelField "status"+ tags = TopLevelField "tags"+ outcome = NestedField "reviews" "outcome"+ equals selector value = PredicateAtom (FieldEquals selector value)+ selectedWith legacy conditions =+ renderConceptId . conceptIdOf <$> filterConceptsWhere legacy conditions concepts+ selected = selectedWith []+ predicates = map PredicateWhere+ parsedConditions raws = traverse (first renderWhereParseError . parseWhereCondition) raws+ selectedParsed raws = selected <$> parsedConditions raws++ assertEqual+ ["requests/alpha", "requests/beta"]+ (selected (predicates [PredicateIn status ("accepted" :| ["proposed"])]))+ -- Scratch has no status and Gamma is completed.+ assertEqual+ ["requests/alpha", "requests/beta"]+ (selected (predicates [PredicateNotIn status ("completed" :| ["rejected"])]))+ -- Repeated explicit conditions are a conjunction, even on one key.+ assertEqual+ ["requests/alpha", "requests/beta"]+ (selected (predicates [PredicateNotEquals status "completed", PredicateNotEquals status "rejected"]))+ assertEqual+ ["requests/beta"]+ ( selected+ ( predicates+ [ PredicateIn status ("accepted" :| ["proposed"]),+ PredicateIn status ("proposed" :| ["completed"])+ ]+ )+ )+ assertEqual [] (selected (predicates [PredicateAnd (equals status "accepted") (equals status "proposed")]))+ -- A negative value question is universal over a list: Alpha's other tag+ -- does not save it, nor does Gamma's approving review.+ assertEqual [] (selected (predicates [PredicateNotEquals tags "cli"]))+ assertEqual ["requests/beta"] (selected (predicates [PredicateNotEquals tags "profiles"]))+ assertEqual+ ["requests/alpha"]+ (selected (predicates [PredicateNotIn outcome ("changes-requested" :| [])]))+ -- Boolean not negates its whole operand, absence included.+ assertEqual+ ["notes/scratch", "requests/alpha", "requests/beta"]+ (selected (predicates [PredicateNot (equals status "completed")]))+ assertEqual+ ["notes/scratch", "requests/beta"]+ (selected (predicates [PredicateNot (PredicateAtom (FieldPresent (TopLevelField "reviews")))]))+ assertEqual+ ["requests/gamma"]+ (selected (predicates [PredicateAtom (FieldPresent (TopLevelField "completedAt"))]))+ -- Absence is spelled out when it should be included.+ assertEqual+ ["notes/scratch", "requests/alpha"]+ (selected (predicates [PredicateOr (equals status "accepted") (PredicateAtom (FieldAbsent status))]))+ -- A disjunction across keys.+ assertEqual+ ["requests/alpha", "requests/gamma"]+ (selected (predicates [PredicateOr (equals status "completed") (equals tags "profiles")]))+ assertEqual+ ["requests/alpha", "requests/beta"]+ (selected (predicates [PredicateAnd (PredicateIn status ("accepted" :| ["proposed"])) (equals tags "cli")]))++ -- Legacy repetition stays an "or", and a predicate then narrows it.+ assertEqual+ ["requests/alpha", "requests/beta"]+ (selected [LegacyWhere (FieldEquals status "accepted"), LegacyWhere (FieldEquals status "proposed")])+ assertEqual+ ["requests/alpha"]+ ( selected+ [ LegacyWhere (FieldEquals status "accepted"),+ LegacyWhere (FieldEquals status "proposed"),+ PredicateWhere (PredicateNotEquals status "proposed")+ ]+ )+ -- A supplied --type filter and a legacy type= still share one group.+ assertEqual+ ["notes/scratch", "requests/alpha", "requests/beta", "requests/gamma"]+ ( selectedWith+ [FieldEquals (TopLevelField "type") "Note"]+ [LegacyWhere (FieldEquals (TopLevelField "type") "Improvement Request")]+ )+ -- Stored frontmatter only: no default status is invented for Scratch.+ assertEqual [] (selected [LegacyWhere (FieldEquals status "stable")])+ assertEqual [] (selected (predicates [PredicateIn status ("stable" :| [])]))++ -- The same selections, read from the strings a user types.+ assertEqual+ (Right ["requests/alpha", "requests/beta"])+ (selectedParsed ["status not in [\"completed\",\"rejected\"]"])+ assertEqual (Right ["requests/alpha"]) (selectedParsed ["reviews.outcome not in [\"changes-requested\"]"])+ assertEqual+ (Right ["notes/scratch", "requests/alpha", "requests/beta"])+ (selectedParsed ["(not (status=\"completed\"))"])+ assertEqual+ (Right ["notes/scratch", "requests/alpha", "requests/beta"])+ (selectedParsed ["(missing(status) or status!=\"completed\")"])++-- | Value predicates over the shapes the fixture does not hold: null, empty+-- lists, records, lists of records, non-textual scalars, escaped strings, and+-- lists mixing scalars with records.+testMatchesPredicateEdgeCases :: Either Text ()+testMatchesPredicateEdgeCases = do+ let key = TopLevelField+ conceptWith rawId pairs = profileConcept rawId pairs ""+ matches predicate concept = matchesPredicate predicate concept+ nullStatus <- conceptWith "edge/null" [("status", Null)]+ emptyList <- conceptWith "edge/empty" [("status", toJSON ([] :: [Text]))]+ record <- conceptWith "edge/record" [("status", object ["a" .= (1 :: Int)])]+ records <- conceptWith "edge/records" [("status", toJSON [object ["a" .= (1 :: Int)]])]+ emptyText <- conceptWith "edge/empty-text" [("status", String "")]+ scalars <- conceptWith "edge/scalars" [("flag", Bool True), ("count", Number 12), ("title", String "say \"hi\"")]+ mixed <- conceptWith "edge/mixed" [("tags", toJSON [String "cli", object ["a" .= (1 :: Int)]])]++ -- No comparable scalar: every direct value question fails, positive or+ -- negative, while presence still sees the key and boolean not inverts.+ for_ [nullStatus, emptyList, record, records] $ \concept -> do+ assertBool "!= needs a comparable scalar" (not (matches (PredicateNotEquals (key "status") "x") concept))+ assertBool "not in needs a comparable scalar" (not (matches (PredicateNotIn (key "status") ("x" :| [])) concept))+ assertBool "in needs a comparable scalar" (not (matches (PredicateIn (key "status") ("x" :| [])) concept))+ assertBool "not inverts a failed equality" (matches (PredicateNot (PredicateAtom (FieldEquals (key "status") "x"))) concept)+ assertBool "a stored null is present" (matches (PredicateAtom (FieldPresent (key "status"))) nullStatus)+ assertBool "an empty list is absent" (matches (PredicateAtom (FieldAbsent (key "status"))) emptyList)+ assertBool "a record is present" (matches (PredicateAtom (FieldPresent (key "status"))) record)++ -- An empty string is a comparable string.+ assertBool "empty string != x" (matches (PredicateNotEquals (key "status") "x") emptyText)+ assertBool "empty string in [\"\"]" (matches (PredicateIn (key "status") ("" :| [])) emptyText)+ assertBool "empty string != \"\" fails" (not (matches (PredicateNotEquals (key "status") "") emptyText))++ -- Numbers and booleans compare as their JSON text.+ assertBool "true in [true]" (matches (PredicateIn (key "flag") ("true" :| [])) scalars)+ assertBool "true != false" (matches (PredicateNotEquals (key "flag") "false") scalars)+ assertBool "12 not in [12]" (not (matches (PredicateNotIn (key "count") ("12" :| [])) scalars))+ assertBool "12 != 13" (matches (PredicateNotEquals (key "count") "13") scalars)+ -- An escaped expression string reaches the stored text.+ quoted <- first renderWhereParseError (parseWhereCondition "(title=\"say \\\"hi\\\"\")")+ assertBool+ "escaped quotes match"+ (case quoted of PredicateWhere predicate -> matches predicate scalars; LegacyWhere _ -> False)++ -- A record inside a list is ignored; its scalar siblings still count.+ assertBool "cli is forbidden" (not (matches (PredicateNotEquals (key "tags") "cli") mixed))+ assertBool "other is not present" (matches (PredicateNotIn (key "tags") ("other" :| [])) mixed)+ assertBool "cli is included" (matches (PredicateIn (key "tags") ("cli" :| [])) mixed)++-- | Every operand of a predicate is checked, with the legacy checker's scope+-- rules, below @not@ and on both sides of @or@.+testCheckPredicateAgainstProfile :: IO (Either Text ())+testCheckPredicateAgainstProfile = do+ descriptorPath <- fixtureFilePath "profiles/concept-filters.dhall"+ loaded <- loadProfileFile descriptorPath+ pure $ do+ spec <- first ("failed to load concept-filter profile: " <>) loaded+ compiled <- firstShow (compileProfile spec)+ openTypes <- firstShow (compileProfile (spec & #allowUnknownTypes .~ True))+ let status = TopLevelField "status"+ statusError value = FilterValueNotInVocabulary status value ["proposed", "accepted", "completed", "rejected"]+ equals selector value = PredicateAtom (FieldEquals selector value)+ checkAll = checkPredicateAgainstProfile compiled []+ checkFor = checkPredicateAgainstProfile compiled++ -- Negative values and set members outside a closed vocabulary. 'status'+ -- is also a core key, so this guards the declaration-before-core order.+ assertEqual [statusError "acepted"] (checkAll (PredicateNotEquals status "acepted"))+ assertEqual [] (checkAll (PredicateNotEquals status "accepted"))+ assertEqual [statusError "acepted"] (checkAll (PredicateNotIn status ("completed" :| ["acepted"])))+ assertEqual [statusError "proposd"] (checkAll (PredicateIn status ("accepted" :| ["proposd"])))+ -- Below not and on a branch of or that would match everything.+ assertEqual [statusError "acepted"] (checkAll (PredicateNot (equals status "acepted")))+ assertEqual+ [statusError "acepted"]+ (checkAll (PredicateOr (PredicateAtom (FieldAbsent status)) (PredicateNot (equals status "acepted"))))+ -- Once each, in written order, undeclared keys included.+ assertEqual+ [statusError "acepted"]+ (checkAll (PredicateAnd (PredicateNotEquals status "acepted") (PredicateNotEquals status "acepted")))+ assertEqual+ [FilterFieldNotDeclared (TopLevelField "statuz"), statusError "acepted"]+ ( checkAll+ ( PredicateOr+ (PredicateIn (TopLevelField "statuz") ("x" :| ["y"]))+ (PredicateNotEquals status "acepted")+ )+ )+ assertEqual+ [FilterFieldNotDeclared (TopLevelField "statuz")]+ (checkAll (PredicateNot (PredicateAtom (FieldPresent (TopLevelField "statuz")))))+ -- The core-key fallback and an open nested vocabulary accept anything.+ assertEqual [] (checkAll (PredicateNotEquals (TopLevelField "timestamp") "anything"))+ assertEqual [] (checkAll (PredicateNotIn (NestedField "reviews" "reviewer") ("anyone" :| [])))+ -- A closed nested vocabulary.+ assertEqual+ [FilterValueNotInVocabulary (NestedField "reviews" "outcome") "approvd" ["approved", "changes-requested", "commented"]]+ (checkAll (PredicateNotIn (NestedField "reviews" "outcome") ("approvd" :| [])))+ -- The scope trap: noteKind is closed on Note alone.+ assertEqual+ [FilterValueNotInVocabulary (TopLevelField "noteKind") "bogus" ["scratch", "reference"]]+ (checkFor ["Note"] (PredicateNotEquals (TopLevelField "noteKind") "bogus"))+ assertEqual [] (checkAll (PredicateNotEquals (TopLevelField "noteKind") "bogus"))+ -- A type equality inside an expression narrows nothing.+ assertEqual+ []+ (checkAll (PredicateAnd (equals (TopLevelField "type") "Note") (equals (TopLevelField "noteKind") "bogus")))+ -- Requested types restrict declarations.+ assertEqual+ [FilterFieldNotDeclared (TopLevelField "targetPlan")]+ (checkFor ["Note"] (PredicateNot (PredicateAtom (FieldPresent (TopLevelField "targetPlan")))))+ -- Type names are the vocabulary of type unless unknown types are allowed.+ assertEqual+ [FilterValueNotInVocabulary (TopLevelField "type") "Ghost" ["Improvement Request", "Note"]]+ (checkAll (PredicateNotEquals (TopLevelField "type") "Ghost"))+ assertEqual [] (checkPredicateAgainstProfile openTypes [] (PredicateNotEquals (TopLevelField "type") "Ghost"))+ -- A contradiction is not an error.+ assertEqual [] (checkAll (PredicateAnd (equals status "accepted") (equals status "proposed")))+ fixturePath :: FilePath -> IO FilePath fixturePath name = do let candidates =@@ -7436,3 +7920,76 @@ "", documentBody ]++-- These imports must continue to mean the selected profile after relocation.+testBootstrapRoundTrip :: IO (Either Text ())+testBootstrapRoundTrip = do+ registry <- fixtureFilePath "registry/package.dhall" >>= makeAbsolute+ descriptor <- fixtureFilePath "profiles/decisions.dhall" >>= makeAbsolute+ temp <- getTemporaryDirectory+ bracket (createTempDirectory temp "okf-bootstrap") removeDirectoryRecursive $ \root -> do+ createDirectoryIfMissing True (root </> "physical" </> "unused")+ createDirectoryLink (root </> "physical") (root </> "alias")+ let destination = root </> "alias" </> "unused" </> ".." </> "bundle space 日本語"+ localSource = root </> "source space 日本語.dhall"+ -- A source filename also needs Dhall component quoting.+ sourceText <- renderBootstrapDescriptor root (ImportDescriptorFile descriptor)+ case sourceText of+ Left err -> pure (Left (renderBootstrapError err))+ Right contents -> do+ Text.IO.writeFile localSource contents+ results <- for+ [ (ImportRegistryFile registry "postgresql", RegistryFile registry, "postgresql"),+ (ImportRegistryFile registry "nested.decisions", RegistryFile registry, "nested.decisions"),+ (ImportRegistryFile descriptor "", RegistryFile descriptor, ""),+ (ImportDescriptorFile localSource, RegistryFile descriptor, "")+ ]+ $ \(source, ref, selected) -> do+ rendered <- renderBootstrapDescriptor destination source+ case rendered of+ Left err -> pure (Left (renderBootstrapError err))+ Right contents' -> do+ createDirectoryIfMissing True destination+ Text.IO.writeFile (destination </> "profile.dhall") contents'+ actual <- loadProfileFile (destination </> "profile.dhall")+ expected <- loadRegistry ref+ pure $ do+ entries <- expected+ entry <- maybe (Left "missing export") Right (findRegistryEntry selected entries)+ assertEqual (Right (entry ^. #spec)) actual+ pure (sequence_ results)++testBootstrapExpressions :: IO (Either Text ())+testBootstrapExpressions = do+ let hash = "sha256:" <> Text.replicate 64 "0"+ reference = "https://example.invalid/package.dhall " <> hash+ render expression selected = renderBootstrapDescriptor "/tmp" (ImportRegistryExpression expression selected)+ hashed <- render reference "a.b"+ escaped <- render reference "foo bar"+ relative <- render "./registry/package.dhall" "x"+ header <- render ("https://example.invalid/package.dhall using ./headers.dhall " <> hash) "x"+ malformed <- render "let =" "x"+ multiline <- render (reference <> "\n-- metadata\n") "x"+ location <- render "https://example.invalid/package.dhall as Location" ""+ pure $ do+ contents <- first renderBootstrapError hashed+ assertBool "hash preserved" (hash `Text.isInfixOf` contents)+ assertBool "nested selection" ("registry.a.b" `Text.isSuffixOf` Text.stripEnd contents)+ escapedText <- first renderBootstrapError escaped+ assertBool "escaped label" ("registry.`foo bar`" `Text.isInfixOf` escapedText)+ assertBool "relative import rejected" (case relative of Left RelativeExpressionImport {} -> True; _ -> False)+ assertBool "relative header import rejected" (case header of Left RelativeExpressionImport {} -> True; _ -> False)+ assertBool "parse failure classified" (case malformed of Left DescriptorParseError {} -> True; _ -> False)+ multilineText <- first renderBootstrapError multiline+ assertBool "multiline metadata remains a comment" (case Dhall.exprFromText "descriptor" multilineText of Right _ -> True; _ -> False)+ void (first renderBootstrapError location)++testBootstrapPure :: Either Text ()+testBootstrapPure = do+ assertEqual "../c/f.dhall" (relativeImportPath "/a/b" "/a/c/f.dhall")+ assertEqual "./f.dhall" (relativeImportPath "/a/b" "/a/b/f.dhall")+ assertEqual "./c/d/f.dhall" (relativeImportPath "/a/b" "/a/b/c/d/f.dhall")+ let spec = testProfileSpec & #okfVersion .~ "0.1" & #requireBundleVersion .~ Just "0.2"+ assertEqual (parseOkfVersion "0.2") (bootstrapOkfVersion Nothing spec)+ assertEqual (parseOkfVersion "0.3") (bootstrapOkfVersion (parseOkfVersion "0.3") spec)+ assertEqual (parseOkfVersion "0.1") (bootstrapOkfVersion Nothing (spec & #requireBundleVersion .~ Just "bad"))
test/fixtures/catalogue/Profile/V02.dhall view
@@ -32,13 +32,16 @@ -- ## Policy one: where the house `status` key collides, the house key wins -- -- OKF v0.2 §5.4 gives `status` the vocabulary `draft` / `stable` / `deprecated`.--- Seven profiles in this repository use the same key name for a house lifecycle--- vocabulary — five that predate v0.2, and two introduced after it that answer a--- question v0.2's vocabulary cannot:+-- Nine profiles in this repository use the same key name for a house lifecycle+-- vocabulary — five that predate v0.2, and four introduced after it that answer+-- a question v0.2's vocabulary cannot: -- -- * `documentation.architectureDecisions` — `Accepted`, and siblings -- * `documentation.patternCatalog` — `current`, `deprecated` -- * `documentation.researchDocuments` — `active`, `complete`, `superseded`+-- * `documentation.specifications` — `draft`, `proposed`, `ratified`,+-- `superseded`, `withdrawn`+-- * `documentation.terminology` — `current`, `deprecated` -- * `coordination.improvementRequests` — `proposed`, `accepted`, `in-progress`, -- `completed`, `rejected`, `withdrawn`, -- `superseded`@@ -49,7 +52,7 @@ -- `fixed`, `wont-fix`, `duplicate`, -- `not-a-bug`, `cannot-reproduce` ----- Those seven keep their house vocabulary and do **not** splice in `status` or+-- Those nine keep their house vocabulary and do **not** splice in `status` or -- `staleAfter` from this module. This is sanctioned rather than tolerated: a -- profile key name does not imply the OKF core key of that name, and okf never -- rejects a profile over it. What okf checks instead is value *formats*, because
test/fixtures/catalogue/Profile/okf.dhall view
@@ -1808,6 +1808,7 @@ , when : Optional { field : Text, hasValue : List Text } } }+ , guidance : Optional Text , idField : Optional Text , name : Text , okfVersion : Text@@ -2582,6 +2583,7 @@ , when : Optional { field : Text, hasValue : List Text } } }+ , guidance : Optional Text , idPrefix : Optional Text , pathPattern : Optional Text , requireSchemaSection : Bool@@ -3338,6 +3340,7 @@ , when : Optional { field : Text, hasValue : List Text } } }+ , guidance : Optional Text , idPrefix : Optional Text , pathPattern : Optional Text , requireSchemaSection : Bool@@ -6345,6 +6348,7 @@ , when : Optional { field : Text, hasValue : List Text } } }+ , guidance : Optional Text , idField : Optional Text , name : Text , okfVersion : Text@@ -7125,6 +7129,7 @@ , when : Optional { field : Text, hasValue : List Text } } }+ , guidance : Optional Text , idPrefix : Optional Text , pathPattern : Optional Text , requireSchemaSection : Bool@@ -7904,6 +7909,7 @@ , when : Optional { field : Text, hasValue : List Text } } }+ , guidance = None Text , idField = None Text , okfVersion = "0.1" , requireBundleVersion = None Text@@ -8740,6 +8746,7 @@ Optional { field : Text, hasValue : List Text } } }+ , guidance : Optional Text , idPrefix : Optional Text , pathPattern : Optional Text , requireSchemaSection : Bool@@ -9519,6 +9526,7 @@ , when : Optional { field : Text, hasValue : List Text } } }+ , guidance : Optional Text , idPrefix : Optional Text , pathPattern : Optional Text , requireSchemaSection : Bool@@ -10295,6 +10303,7 @@ , when : Optional { field : Text, hasValue : List Text } } }+ , guidance = None Text , idPrefix = None Text , pathPattern = None Text , requireSchemaSection = False
test/fixtures/catalogue/package.dhall view
@@ -1,4 +1,4 @@---| Offline snapshot of mori://shinzui/okf-profiles at v0.14.0.+--| Offline snapshot of mori://shinzui/okf-profiles at v0.19.0. -- Generated by scripts/refresh-default-registry.sh; do not edit by hand. -- Profile/okf.dhall is the resolved schema pinned by that release, so this -- fixture evaluates without network access.@@ -8,12 +8,12 @@ -- ready-made profiles. With a versioned, hash-pinned remote import: -- -- let okf =--- https://raw.githubusercontent.com/shinzui/okf-profiles/v0.1.0/package.dhall--- sha256:0000000000000000000000000000000000000000000000000000000000000000+-- https://raw.githubusercontent.com/shinzui/okf-profiles/v0.19.0/package.dhall+-- sha256:85176d78369b6d73c9f13c30277903b629d6bf048a4c7d71fc26e68b99c3eaa6 -- -- in okf.postgresql // { name = "acme-warehouse" } ----- See README.md for how to generate the real hash (`dhall freeze`) and for the+-- v0.19.0 requires okf 0.9.0.0 or later. See README.md for how to generate the real hash (`dhall freeze`) and for the -- public-repo / pinning rationale. let okf = ./Profile/okf.dhall
test/fixtures/catalogue/profiles/assurance/package.dhall view
@@ -12,4 +12,9 @@ -- repository owns is a `coordination.bugReports` entry; what recurs across -- repositories, or lives in a toolchain rather than in anybody's source, is a -- failure mode.-{ reviews = ./reviews.dhall, failureModes = ./failure-modes.dhall }+-- `verificationEvidence` records a claim about a system being put to the test+-- and what the run and independent verifier concluded.+{ reviews = ./reviews.dhall+, failureModes = ./failure-modes.dhall+, verificationEvidence = ./verification-evidence.dhall+}
+ test/fixtures/catalogue/profiles/assurance/verification-evidence.dhall view
@@ -0,0 +1,490 @@+--| Shared profile for verification evidence.+--+-- ## Evidence and identity+--+-- One Verification Run is an immutable event: one execution of one scenario at+-- exact revisions, or one comparison of recorded runs. It links to digest-pinned+-- data in durable storage and never contains measurements. An Attested Computation+-- defines how a result is produced and independently checked; an Attestation+-- records the verifier's conclusion. All three live in one bundle so runs can+-- resolve local VC-N computation handles. Definitions use stable handles; runs+-- and attestations use paths because concurrent writers cannot safely allocate+-- sequential handles with `okf id next`. A runId identifies the event even in+-- `okf concepts --json`, whose rows omit paths; a timestamp is not identity.+--+-- ## Scope and limits+--+-- `verified` is an append-only confirmation on a run; the Attestation is the+-- separate evidence of what was checked. A tool never writes a `human:` actor.+-- Event records take neither status nor stale_after because they are not+-- redrafted and do not decay. Definition records take OKF's v0.2 pair.+-- Runtime-specific layer and cost-tier vocabularies are open here; a consumer+-- can narrow them with a profile-scope overlay. The descriptor cannot check+-- digest or revision hex lengths, UUIDv7 identity, data reachability, or Git+-- immutability; consumers check those locally. Markdown under references/ is a+-- concept and would need another declared type, so runnable reference files+-- are non-Markdown. No legacyTimestamp field exists in OKF v0.2.+let Profile = ../../Profile/Type.dhall++let TypeRule = ../../Profile/TypeRule.dhall++let FrontmatterRules = ../../Profile/FrontmatterRules.dhall++let okf = ../../Profile/okf.dhall++let FieldRule = okf.defaults.FieldRule++let NestedRules = okf.defaults.NestedRules++let NestedFieldRule = okf.defaults.NestedFieldRule++let HandleReferenceRule = okf.defaults.HandleReferenceRule++let PathReferenceRule = okf.defaults.PathReferenceRule++let Cardinality = okf.Cardinality++let FieldFormat = okf.FieldFormat++let v02 = ../../Profile/V02.dhall++let kinds = [ "correctness", "concurrency", "soak", "benchmark" ]++let placements = [ "local", "cell" ]++let outcomes =+ [ "passed"+ , "failed"+ , "errored"+ , "inconclusive"+ , "infrastructure-failure"+ ]++let comparisonVerdicts =+ [ "pass", "regression", "inconclusive", "infrastructure-failure" ]++let purposes = [ "nightly", "release", "baseline", "investigation" ]++let dataKinds =+ [ "run-spec"+ , "run-result"+ , "manifest"+ , "cell-manifest"+ , "samples"+ , "series"+ , "verdicts"+ , "diagnosis"+ , "logs"+ , "comparison"+ ]++let checkNames =+ [ "digests-match"+ , "revisions-resolve"+ , "cohort-matches-plan"+ , "verdict-recomputed"+ , "environment-captured"+ , "clean-worktree"+ ]++let scalar =+ \(name : Text) ->+ \(description : Text) ->+ FieldRule::{+ , field = name+ , description = Some description+ , cardinality = Cardinality.Scalar+ }++let enum =+ \(name : Text) ->+ \(description : Text) ->+ \(allowedValues : List Text) ->+ scalar name description // { allowedValues }++let formatted =+ \(name : Text) ->+ \(description : Text) ->+ \(format : FieldFormat) ->+ scalar name description // { format = Some format }++let list =+ \(name : Text) ->+ \(description : Text) ->+ FieldRule::{+ , field = name+ , description = Some description+ , cardinality = Cardinality.List+ }++let nScalar =+ \(name : Text) ->+ \(description : Text) ->+ NestedFieldRule::{+ , field = name+ , description = Some description+ , cardinality = Cardinality.Scalar+ }++let nEnum =+ \(name : Text) ->+ \(description : Text) ->+ \(allowedValues : List Text) ->+ nScalar name description // { allowedValues }++let nFormatted =+ \(name : Text) ->+ \(description : Text) ->+ \(format : FieldFormat) ->+ nScalar name description // { format = Some format }++let nPaths =+ \(name : Text) ->+ \(description : Text) ->+ NestedFieldRule::{+ , field = name+ , description = Some description+ , cardinality = Cardinality.List+ , path = Some PathReferenceRule::{=}+ }++let nPath =+ \(name : Text) ->+ \(description : Text) ->+ NestedFieldRule::{+ , field = name+ , description = Some description+ , path = Some PathReferenceRule::{=}+ }++let bundlePath =+ \(name : Text) ->+ \(description : Text) ->+ scalar name description // { path = Some PathReferenceRule::{=} }++let computationRef = Some HandleReferenceRule::{ localPrefix = "VC" }++let isRun = Some { field = "recordKind", hasValue = [ "run" ] }++let isComparison = Some { field = "recordKind", hasValue = [ "comparison" ] }++let nameValue =+ NestedRules::{+ , required =+ [ nScalar "name" "Name, as the harness spells it."+ , nScalar "value" "Value the run used."+ ]+ }++let attestedComputation =+ TypeRule::{+ , type = "Attested Computation"+ , description = Some+ "How one outcome, verdict or figure is computed from raw run data, and how a deterministic verifier re-checks it."+ , pathPattern = Some "computations/*"+ , idPrefix = Some "VC"+ , frontmatter = FrontmatterRules::{+ , required =+ [ formatted+ "computationId"+ "Bundle-scoped stable VC-N handle."+ (FieldFormat.DocumentHandle "VC")+ , scalar "runtime" "How the computation is run."+ , scalar+ "algorithm"+ "Identifier the harness writes into its documents."+ , formatted+ "algorithmVersion"+ "A change that can alter a result takes a new VC handle."+ FieldFormat.NonNegativeInteger+ , enum+ "produces"+ "What the computation yields."+ [ "outcome", "verdict", "diagnosis", "comparison", "summary" ]+ , list "inputs" "Data-link kinds the computation reads."+ // { allowedValues = dataKinds }+ , scalar "implementation" "Module implementing the algorithm."+ , list "parameters" "Typed named holes; empty when it takes none."+ // { elementFields = Some NestedRules::{+ , required =+ [ nScalar "name" "The name the computation binds."+ , nScalar "type" "What kind of value it takes."+ ]+ , optional =+ [ nFormatted+ "required"+ "Whether a caller must supply it."+ FieldFormat.Boolean+ ]+ }+ }+ , FieldRule::{+ , field = "executor"+ , description = Some "How a run is performed and what it returns."+ , objectFields = Some NestedRules::{+ , required =+ [ nPath "resource" "Run instructions: a non-Markdown file here."+ , nScalar "receipt" "Run-directory documents a run returns."+ // { cardinality = Cardinality.List }+ ]+ }+ }+ , FieldRule::{+ , field = "attester"+ , description = Some "Deterministic code that re-checks a run."+ , objectFields = Some NestedRules::{+ , required =+ [ nPath "resource" "The verifier: a non-Markdown file here." ]+ }+ }+ ]+ , optional =+ [ v02.status+ , v02.staleAfter+ , list "appliesTo" "Evidence kinds whose runs may name it."+ // { allowedValues = kinds }+ , bundlePath "computation" "The computation file, when not inline."+ , scalar "supersedes" "The definition this one replaces."+ // { reference = computationRef }+ ]+ }+ }++let componentMembers =+ NestedRules::{+ , required =+ [ nFormatted+ "project"+ "Mori URI of the owning project."+ (FieldFormat.UriWithScheme "mori")+ , nScalar "package" "Cabal package name."+ , nScalar "version" "Exact resolved version."+ , nEnum "source" "Where the solver took it from." [ "hackage", "git" ]+ , nScalar "revision" "Full 40-character commit."+ // { when = Some { field = "source", hasValue = [ "git" ] } }+ ]+ }++let environmentMembers =+ NestedRules::{+ , required =+ [ nScalar "os" "Operating system."+ , nScalar "arch" "CPU architecture."+ , nScalar "cpuModel" "CPU model string."+ , nFormatted "cores" "Logical cores." FieldFormat.NonNegativeInteger+ , nFormatted+ "memoryBytes"+ "Physical memory."+ FieldFormat.NonNegativeInteger+ , nScalar "ghc" "Compiler that built the harness."+ , nScalar "postgres" "PostgreSQL server version."+ ]+ , optional =+ [ nScalar "kernel" "Kernel release."+ , nScalar "machineType" "Cloud machine type of the driver."+ , nScalar "cell" "Name of the leased cell."+ , nScalar "cellRun" "The cell's own identifier for the leased run."+ , nScalar "zone" "Cloud zone."+ , nScalar "kafka" "Broker version, when a broker took part."+ ]+ }++let dataMembers =+ NestedRules::{+ , required =+ [ nEnum "kind" "What the object is." dataKinds+ , nFormatted+ "uri"+ "Where the object lives in durable storage."+ FieldFormat.Uri+ , nScalar "digest" "Lowercase 64-hex SHA-256 of the object."+ , nScalar "mediaType" "IANA media type."+ , nFormatted "bytes" "Object size." FieldFormat.NonNegativeInteger+ ]+ }++let comparisonMembers =+ NestedRules::{+ , required =+ [ nEnum "verdict" "What the comparison concluded." comparisonVerdicts+ , nEnum+ "factor"+ "What differs between the arms."+ [ "cohort", "harness", "dimension", "knob" ]+ , nScalar "baselineValue" "The factor's value on the baseline arm."+ , nScalar "candidateValue" "The factor's value on the candidate arm."+ , nEnum+ "design"+ "How the arms were interleaved."+ [ "abba", "baab", "sequential" ]+ , nPaths "baselineRuns" "Recorded runs of the baseline arm."+ , nPaths "candidateRuns" "Recorded runs of the candidate arm."+ ]+ , optional =+ [ nScalar "factorName" "Which dimension, knob or package differs." ]+ }++let verificationRun =+ TypeRule::{+ , type = "Verification Run"+ , description = Some+ "One recorded run, or one recorded comparison of runs: what ran, against what, where, with which outcome, and where the data is."+ , pathPattern = Some "runs/*/*/*/*"+ , frontmatter = FrontmatterRules::{+ , required =+ [ scalar "runId" "UUIDv7 of the record. Equals the file name."+ , enum+ "recordKind"+ "One run, or a comparison of runs."+ [ "run", "comparison" ]+ , enum "purpose" "Why this was recorded." purposes+ , scalar "scenario" "Scenario identifier: layer/component/kind/name."+ , scalar "layer" "Runtime layer the scenario isolates."+ , scalar "component" "Component inside the layer."+ , enum "kind" "Kind of evidence." kinds+ , scalar "tier" "Cost tier."+ , enum "placement" "Where it ran." placements+ , enum "outcome" "What came of it." outcomes+ , formatted "startedAt" "UTC start." FieldFormat.Rfc3339Utc+ , formatted "finishedAt" "UTC finish." FieldFormat.Rfc3339Utc+ , formatted+ "subject"+ "Mori URI of the most specific runtime artifact under test."+ (FieldFormat.UriWithScheme "mori")+ , enum "subjectKind" "What `subject` names." [ "project", "package" ]+ , scalar "harnessRevision" "Full 40-character commit of the harness."+ , formatted+ "harnessDirty"+ "Whether the harness was built from a modified tree."+ FieldFormat.Boolean+ , list "computations" "Definitions that produced the outcome."+ // { reference = computationRef }+ , list "data" "Digest-pinned links to the data."+ // { elementFields = Some dataMembers, uniqueBy = Some "uri" }+ , scalar "cohort" "Name of the cohort the build linked."+ // { when = isRun }+ , scalar "solverPlanHash" "Hash of the resolved solver plan."+ // { when = isRun }+ , list "components" "Every runtime package the build linked."+ // { elementFields = Some componentMembers+ , uniqueBy = Some "package"+ , when = isRun+ }+ , FieldRule::{+ , field = "environment"+ , description = Some "Flat excerpt of the environment fingerprint."+ , objectFields = Some environmentMembers+ , when = isRun+ }+ , formatted+ "seed"+ "Seed of every random choice."+ FieldFormat.NonNegativeInteger+ // { when = isRun }+ , scalar+ "compatibilityKey"+ "64-hex digest of what must match for two runs to be comparable."+ // { when = isRun }+ , FieldRule::{+ , field = "comparison"+ , description = Some "The arms and the verdict."+ , objectFields = Some comparisonMembers+ , when = isComparison+ }+ ]+ , optional =+ [ list "knobs" "Knob values the run used."+ // { elementFields = Some nameValue, uniqueBy = Some "name" }+ , list "dimensions" "Dimension values the run used."+ // { elementFields = Some nameValue, uniqueBy = Some "name" }+ , list "knownDefects" "Known-defect references of the scenario."+ // { format = Some FieldFormat.Uri }+ , list "produced" "Mori URIs of reports this run caused."+ // { format = Some (FieldFormat.UriWithScheme "mori") }+ , bundlePath+ "previousRun"+ "Latest earlier record of the same scenario and compatibility key."+ ]+ }+ }++let attestation =+ TypeRule::{+ , type = "Attestation"+ , description = Some+ "A deterministic verifier fetched a record's data, re-checked it, and this is what it concluded."+ , pathPattern = Some "attestations/*/*/*"+ , frontmatter = FrontmatterRules::{+ , required =+ [ scalar "attestationId" "UUIDv7. Equals the file name."+ , bundlePath "run" "The record attested."+ , formatted+ "attester"+ "The verifier, as an OKF actor."+ FieldFormat.Actor+ , scalar+ "attesterRevision"+ "Full 40-character commit of the verifier."+ , formatted "attestedAt" "UTC completion time." FieldFormat.Rfc3339Utc+ , enum+ "verdict"+ "What the verifier concluded."+ [ "confirmed", "refuted", "incomplete" ]+ , list "checks" "Every check, and what it found."+ // { elementFields = Some NestedRules::{+ , required =+ [ nEnum "name" "Which check." checkNames+ , nEnum+ "result"+ "What it found."+ [ "passed", "failed", "skipped" ]+ ]+ , optional = [ nScalar "detail" "One line saying why." ]+ }+ , uniqueBy = Some "name"+ }+ , list+ "dataDigests"+ "64-hex SHA-256 of every object fetched and matched."+ ]+ , optional =+ [ FieldRule::{+ , field = "exception"+ , description = Some "A human's acceptance of an anomaly."+ , objectFields = Some NestedRules::{+ , required =+ [ nFormatted+ "authority"+ "The human who accepted it."+ FieldFormat.HumanActor+ , nScalar "reason" "Why the anomaly is acceptable."+ ]+ }+ }+ ]+ }+ }++let shared =+ Profile::{+ , name = "verification-evidence"+ , description = Some+ "Evidence about a runtime: definitions of how verdicts are computed, immutable records of runs that link to their data by digest, and attestations that a deterministic verifier re-checked that data."+ , okfVersion = "0.2"+ , requireBundleVersion = Some "0.2"+ , allowUnknownTypes = False+ , allowUnknownFields = False+ , idField = Some "computationId"+ , frontmatter = FrontmatterRules::{+ , required =+ [ scalar "type" "One of the three concept types."+ , scalar "title" "What this record is, in one line."+ , scalar "description" "One sentence a reader can evaluate alone."+ , v02.generated+ ]+ , optional = [ v02.verified ]+ }+ , types = [ attestedComputation, verificationRun, attestation ]+ }++in shared
test/fixtures/catalogue/profiles/coordination/package.dhall view
@@ -5,8 +5,12 @@ -- the gap between them. A bug report is the fourth corner: a capability that is -- claimed but does not hold. Behavior that was never provided is an improvement -- request rather than a bug, which is the line that keeps the two apart.+--+-- A pattern application sits beside them: a service's decision about whether+-- an assessable catalog pattern governs it and which of its own checks prove it. { bugReports = ./bug-reports.dhall , capabilities = ./capabilities.dhall , improvementRequests = ./improvement-requests.dhall+, patternApplications = ./pattern-applications.dhall , useCases = ./use-cases.dhall }
+ test/fixtures/catalogue/profiles/coordination/pattern-applications.dhall view
@@ -0,0 +1,236 @@+--| Profile for a service's decisions about which assessable patterns apply to it.+--+-- ## What a pattern application is+--+-- A catalog maintainer owns an assessable pattern: its stable `PAT-N` handle,+-- its applicability scope, and its criteria (`documentation.patternCatalog`).+-- The service that might adopt it owns the answer to "does this apply to us,+-- and how do we prove it?" A pattern application records that answer as one+-- reviewable document per service and pattern, with a bundle-scoped `PA-N`+-- handle in `applicationId`.+--+-- The `decision` is one of:+--+-- * `applicable` — the service commits to the pattern's criteria. It may bind+-- criterion ids to local, allow-listed check targets in `checks`;+-- * `not-applicable` — the pattern does not govern this service, and the+-- `rationale` says why;+-- * `exception` — the pattern applies but the service is knowingly not+-- meeting it. An `exception` record naming the human authority, the bounded+-- scope, the reason, and the condition that reopens it is then required;+-- * `needs-triage` — nobody has decided yet.+--+-- None of these is conformance. Conformance is evidence about one criterion at+-- an exact service and catalog revision, and it lives outside the document.+-- A scorecard derived from these records must keep `not-applicable`,+-- `exception`, and `needs-triage` apart from a conforming criterion.+--+--+-- ## Checks name local targets, never commands+--+-- A `checks` entry maps a criterion id from the pattern to a target name the+-- service itself defines and allow-lists, such as a Kotei pipeline target. The+-- shared catalog never supplies what runs. Whether every deterministic+-- criterion of an applicable pattern has a binding, and whether a bound id+-- still exists in the pattern, needs both documents, so it belongs to a+-- registry-side projection rather than this profile: a missing binding is an+-- unassessed criterion, not a profile violation.+--+--+-- ## Presence classes+--+-- Nothing is recommended. Per ADR-8 a field is recommended only when a+-- well-run corpus carries it, and a `not-applicable` or `needs-triage` record+-- routinely has no checks and no exception.+--+--+-- ## `legacyTimestamp` is deliberately absent+--+-- This profile is introduced at v0.2 and no v0.1 application corpus exists.+let Profile = ../../Profile/Type.dhall++let FrontmatterRules = ../../Profile/FrontmatterRules.dhall++let TypeRule = ../../Profile/TypeRule.dhall++let okf = ../../Profile/okf.dhall++let FieldRule = okf.defaults.FieldRule++let NestedRules = okf.defaults.NestedRules++let NestedFieldRule = okf.defaults.NestedFieldRule++let HandleReferenceRule = okf.defaults.HandleReferenceRule++let Cardinality = okf.Cardinality++let FieldFormat = okf.FieldFormat++let v02 = ../../Profile/V02.dhall++let scalar =+ \(name : Text) ->+ \(description : Text) ->+ FieldRule::{+ , field = name+ , description = Some description+ , cardinality = Cardinality.Scalar+ }++let list =+ \(name : Text) ->+ \(description : Text) ->+ FieldRule::{+ , field = name+ , description = Some description+ , cardinality = Cardinality.List+ }++let nestedScalar =+ \(name : Text) ->+ \(description : Text) ->+ NestedFieldRule::{+ , field = name+ , description = Some description+ , cardinality = Cardinality.Scalar+ }++-- Both references are external only: an application lives in the service's+-- repository, while the pattern lives in a catalog elsewhere, so neither can+-- be a local handle. okf requires `localPrefix` to name a prefix this profile+-- declares, so both use `PA`; it is never consulted because `allowLocal` is+-- false. Declaring them as references is also what lets a registry index+-- `service` and `pattern` as typed edges.+let externalOnly =+ \(pattern : Text) ->+ Some+ HandleReferenceRule::{+ , localPrefix = "PA"+ , externalUriSchemes = [ "mori" ]+ , allowLocal = False+ , externalUriPattern = Some pattern+ }++let checks =+ FieldRule::{+ , field = "checks"+ , description = Some+ "Bindings from a pattern criterion id to a check target this service defines and allow-lists. Never a command copied from the catalog."+ , cardinality = Cardinality.List+ , elementFields = Some NestedRules::{+ , required =+ [ nestedScalar+ "criterion"+ "A criterion id declared by the applied pattern."+ , nestedScalar+ "target"+ "The name of a service-owned, allow-listed check target, such as a Kotei pipeline target."+ ]+ , recommended = [] : List NestedFieldRule.Type+ , optional = [] : List NestedFieldRule.Type+ }+ , uniqueBy = Some "criterion"+ }++-- Conditionally required is spelled `required` + `when`: okf rejects a `when`+-- on an optional field.+let exception =+ FieldRule::{+ , field = "exception"+ , description = Some+ "Who accepted not meeting an applicable pattern, over what bounded scope, why, and what reopens the decision. Demanded once `decision` is `exception`."+ , objectFields = Some NestedRules::{+ , required =+ [ nestedScalar+ "authority"+ "The human who accepted the exception, as an OKF §7 human actor such as `human:alice`."+ // { format = Some FieldFormat.HumanActor }+ , nestedScalar+ "scope"+ "Exactly which criteria, components, or situations the exception covers."+ , nestedScalar "reason" "Why the service does not meet the pattern."+ , nestedScalar+ "reviewCondition"+ "The date or event that reopens this decision."+ ]+ , recommended = [] : List NestedFieldRule.Type+ , optional = [] : List NestedFieldRule.Type+ }+ , when = Some { field = "decision", hasValue = [ "exception" ] }+ }++in Profile::{+ , name = "pattern-applications"+ , description = Some+ "A service's reviewable decisions about which assessable catalog patterns govern it: stable PA handles, the service and pattern as canonical Mori URIs, an applicable / not-applicable / exception / needs-triage decision with rationale, service-owned check bindings, and bounded exceptions. Records applicability, never conformance."+ , okfVersion = "0.2"+ , requireBundleVersion = Some "0.2"+ , allowUnknownTypes = False+ , idField = Some "applicationId"+ , frontmatter = FrontmatterRules::{+ , required =+ [ scalar "type" "The Pattern Application concept type."+ , scalar "title" "Human-readable application title."+ , scalar+ "description"+ "One sentence stating the decision and the pattern it concerns."+ , v02.generated+ // { description = Some+ "§5.2. Who produced this application's current content, and when."+ }+ ]+ , recommended = [] : List FieldRule.Type+ , optional =+ [ list "tags" "Free classification tags."+ , v02.verified+ // { description = Some+ "§5.2. Independent confirmations that this decision is accurate."+ }+ ]+ }+ , types =+ [ TypeRule::{+ , type = "Pattern Application"+ , description = Some+ "One service's decision about one assessable catalog pattern."+ , frontmatter = FrontmatterRules::{+ , required =+ [ FieldRule::{+ , field = "applicationId"+ , description = Some "Bundle-scoped stable PA-N handle."+ , cardinality = Cardinality.Scalar+ , format = Some (FieldFormat.DocumentHandle "PA")+ }+ , scalar+ "service"+ "Canonical Mori project URI of the service this decision governs, such as `mori://acme/billing`."+ // { reference =+ externalOnly "mori://[^/]+/[^/]+"+ }+ , scalar+ "pattern"+ "Canonical Mori URI of the assessable pattern, such as `mori://acme/patterns/okf/patterns/concepts/PAT-3`."+ // { reference =+ externalOnly+ "mori://[^/]+/[^/]+/okf/[^/]+/concepts/PAT-[1-9][0-9]*"+ }+ , scalar+ "decision"+ "Whether the pattern governs this service: `applicable`, `not-applicable`, `exception`, or `needs-triage`."+ // { allowedValues =+ [ "applicable", "not-applicable", "exception", "needs-triage" ]+ }+ , scalar+ "rationale"+ "Why this decision holds for this service."+ , exception+ ]+ , recommended = [] : List FieldRule.Type+ , optional = [ checks ]+ }+ , pathPattern = Some "*"+ , idPrefix = Some "PA"+ }+ ]+ }
test/fixtures/catalogue/profiles/documentation/package.dhall view
@@ -2,5 +2,7 @@ { architectureDecisions = ./architecture-decisions.dhall , patternCatalog = ./pattern-catalog.dhall , researchDocuments = ./research-documents.dhall+, specifications = ./specifications.dhall+, terminology = ./terminology.dhall , userDocumentation = ./user-documentation.dhall }
test/fixtures/catalogue/profiles/documentation/pattern-catalog.dhall view
@@ -1,4 +1,31 @@ --| Profile for a Mori-addressable catalog of implementation patterns and standards.+--+-- ## Narrative and assessable guidance+--+-- Most catalog documents are narrative: a `Standard` or `Pattern` whose+-- requirements live in prose. Those types carry no handle and gain no new+-- obligation from this profile.+--+-- A maintainer who wants services to report conformance against a document+-- promotes it to `Assessable Standard` or `Assessable Pattern`. Only those two+-- types carry the bundle-scoped `PAT-N` handle in `patternId`, a structured+-- `applicability` scope, and a non-empty list of stable `criteria`. The types+-- are opt-in because okf demands an id from every document of a type that+-- declares an `idPrefix`: putting `PAT` on `Standard` and `Pattern` themselves+-- would break every existing catalog at once.+--+-- A criterion declares the kind of evidence that settles it, never a command.+-- A shared catalog is not authorized to execute code in an adopting service;+-- the service binds criteria to its own allow-listed checks in a+-- `coordination.patternApplications` record. Applicability hints help discover+-- candidate services and never settle applicability: the service's+-- application record does.+--+-- Checks that need more than one document — that every deterministic criterion+-- of an applicable pattern has a check binding, that a retired criterion id is+-- never reused for a new meaning — belong to a registry-side projection, not to+-- the profile. A missing binding is an unassessed criterion, not a profile+-- violation. let Profile = ../../Profile/Type.dhall let FrontmatterRules = ../../Profile/FrontmatterRules.dhall@@ -13,6 +40,10 @@ let FieldFormat = okf.FieldFormat +let NestedRules = okf.defaults.NestedRules++let NestedFieldRule = okf.defaults.NestedFieldRule+ let v02 = ../../Profile/V02.dhall let scalar =@@ -24,6 +55,24 @@ , cardinality = Cardinality.Scalar } +let nestedScalar =+ \(name : Text) ->+ \(description : Text) ->+ NestedFieldRule::{+ , field = name+ , description = Some description+ , cardinality = Cardinality.Scalar+ }++let nestedList =+ \(name : Text) ->+ \(description : Text) ->+ NestedFieldRule::{+ , field = name+ , description = Some description+ , cardinality = Cardinality.List+ }+ let rule = \(conceptType : Text) -> \(path : Text) ->@@ -34,6 +83,93 @@ , resourceScheme = Some "mori" } +-- Whether a candidate service is in scope. `scope` is the human statement;+-- the optional hints are deterministic discovery aids only.+let applicability =+ FieldRule::{+ , field = "applicability"+ , description = Some+ "Where this guidance applies: a human scope statement plus optional deterministic discovery hints. Hints nominate candidate services; a service's pattern application decides."+ , objectFields = Some NestedRules::{+ , required =+ [ nestedScalar+ "scope"+ "The services, components, or situations this guidance governs, in plain language."+ ]+ , recommended = [] : List NestedFieldRule.Type+ , optional =+ [ nestedList+ "projectTypes"+ "Mori project types that are candidates, such as `service` or `library`."+ , nestedList+ "languages"+ "Implementation languages that are candidates, such as `haskell`."+ , nestedList+ "dependenciesAny"+ "Canonical Mori project URIs; a project depending on any of them is a candidate."+ // { format = Some (FieldFormat.UriWithScheme "mori") }+ ]+ }+ }++-- One stable, separately reportable requirement. A criterion id is never+-- reused for a different meaning; a changed requirement gets a new id.+let criteria =+ FieldRule::{+ , field = "criteria"+ , description = Some+ "Stable, separately reportable requirements. Each names the kind of evidence that settles it, never a command to run."+ , cardinality = Cardinality.List+ , elementFields = Some NestedRules::{+ , required =+ [ nestedScalar+ "id"+ "Stable document-local criterion id in lowercase-hyphenated form, such as `separate-live-and-ready`. Never reused for a different meaning."+ , nestedScalar+ "statement"+ "The observable requirement a conforming service satisfies."+ , nestedScalar+ "evidenceKind"+ "What settles the criterion: `test` (an executable test outcome), `report` (a generated machine-readable report), `static-check` (a deterministic analysis), or `review` (human or agent judgment, never a deterministic pass)."+ // { allowedValues =+ [ "test", "report", "static-check", "review" ]+ }+ , nestedScalar+ "severity"+ "`required` for an obligation a conforming service must meet; `advisory` for one it should meet."+ // { allowedValues = [ "required", "advisory" ] }+ ]+ , recommended = [] : List NestedFieldRule.Type+ , optional = [] : List NestedFieldRule.Type+ }+ , uniqueBy = Some "id"+ }++let assessableRule =+ \(conceptType : Text) ->+ \(description : Text) ->+ TypeRule::{+ , type = conceptType+ , description = Some description+ , frontmatter = FrontmatterRules::{+ , required =+ [ FieldRule::{+ , field = "patternId"+ , description = Some "Bundle-scoped stable PAT-N handle."+ , cardinality = Cardinality.Scalar+ , format = Some (FieldFormat.DocumentHandle "PAT")+ }+ , applicability+ , criteria+ ]+ , recommended = [] : List FieldRule.Type+ , optional = [] : List FieldRule.Type+ }+ , pathPattern = Some "*/**"+ , resourceScheme = Some "mori"+ , idPrefix = Some "PAT"+ }+ in Profile::{ , name = "mori-documentation-pattern-catalog" , description = Some@@ -100,12 +236,22 @@ -- ../../Profile/V02.dhall for the policy and its reasoning. okfVersion = "0.2" , requireBundleVersion = Some "0.2"+ , -- Only the two assessable types declare an `idPrefix`, so only they are+ -- required to carry `patternId`. A narrative `Standard` or `Pattern`+ -- still validates without one.+ idField = Some "patternId" , types = [ rule "Navigation" "getting-started" , rule "Overview" "*/overview" , rule "Standard" "*/**" , rule "Guide" "*/**" , rule "Pattern" "*/**"+ , assessableRule+ "Assessable Standard"+ "A catalog standard promoted to an assessable contract: stable PAT handle, applicability, and criteria a service can report conformance against."+ , assessableRule+ "Assessable Pattern"+ "A catalog pattern promoted to an assessable contract: stable PAT handle, applicability, and criteria a service can report conformance against." , rule "Runbook" "*/**" , rule "Reference" "*/**" , rule "Gotcha" "*/**"
+ test/fixtures/catalogue/profiles/documentation/specifications.dhall view
@@ -0,0 +1,230 @@+--| Profile for normative specifications with stable SPEC-N handles.+--+-- A specification states what an owning boundary MUST do. That is what+-- separates this profile from its three documentation siblings, and the+-- separation is the reason it exists rather than being an override on one of+-- them:+--+-- * `architectureDecisions` records a choice and its rationale at a point in+-- time. A decision is finished when it is made; a specification keeps being+-- true, or is superseded.+-- * `researchDocuments` records evidence, alternatives, and conclusions+-- within a bounded question. Research describes what *is*; a specification+-- prescribes what must be.+-- * `userDocumentation` helps a reader accomplish something. A `Reference`+-- page describes an interface as built; a specification binds an+-- implementation that may not exist yet.+--+-- Two fields carry the distinction and neither sibling has anywhere to put+-- them: `specVersion`, the version of the contract that was ratified, and+-- `normativeScope`, which parts of the prose actually bind. Both are demanded+-- on a `Specification` once `status` reaches `ratified`, because a ratified+-- specification that cannot say what binds, at which version, has not been+-- ratified in any usable sense. Before ratification both are optional: a draft+-- legitimately has neither. They are declared on the type rather than+-- profile-wide because they describe the specification text, which a+-- `Specification Pointer` does not carry.+--+-- `normativeScope` lists the binding parts. Anything the document says that is+-- not covered by an entry is informative. There is deliberately no companion+-- list of non-binding sections: a complement is derivable, and two lists can+-- disagree.+--+-- The `Specification Pointer` type covers the common portfolio case where a+-- boundary is accepted in one repository while the authoritative specification+-- lives in the repository that owns it. A pointer is not a weaker+-- specification; it is a specification whose text is elsewhere, and it carries+-- `authoritativeSpec` to say where. Both types share one `SPEC-N` prefix, so a+-- document that is promoted out of a repository — or absorbed back into one —+-- keeps its handle and every durable reference to it. This follows ADR-11's+-- rule that identity is decoupled from classification.+let Profile = ../../Profile/Type.dhall++let FrontmatterRules = ../../Profile/FrontmatterRules.dhall++let TypeRule = ../../Profile/TypeRule.dhall++let okf = ../../Profile/okf.dhall++let FieldRule = okf.defaults.FieldRule++let HandleReferenceRule = okf.defaults.HandleReferenceRule++let Cardinality = okf.Cardinality++let FieldFormat = okf.FieldFormat++let reviewRule = ../../Profile/ReviewRule.dhall++let v02 = ../../Profile/V02.dhall++let scalar =+ \(name : Text) ->+ \(description : Text) ->+ FieldRule::{+ , field = name+ , description = Some description+ , cardinality = Cardinality.Scalar+ }++let specReference =+ \(name : Text) ->+ \(description : Text) ->+ FieldRule::{+ , field = name+ , description = Some description+ , reference = Some HandleReferenceRule::{+ , localPrefix = "SPEC"+ , externalUriSchemes = [ "mori" ]+ }+ }++let ratified = Some { field = "status", hasValue = [ "ratified" ] }++in Profile::{+ , name = "specifications"+ , description = Some+ "Normative specifications with stable SPEC handles: which boundary is obliged to satisfy the contract, which parts of it bind, at which version, and what proves conformance. The `Specification Pointer` type covers a subject specified authoritatively in another repository."+ , frontmatter = FrontmatterRules::{+ , required =+ [ scalar+ "type"+ "Whether this document is the specification or a pointer to one owned elsewhere."+ , scalar "title" "Human-readable specification title."+ , scalar+ "description"+ "Concise statement of what this specification governs."+ , FieldRule::{+ , field = "specId"+ , description = Some "Bundle-scoped stable SPEC-N handle."+ , cardinality = Cardinality.Scalar+ , format = Some (FieldFormat.DocumentHandle "SPEC")+ }+ , FieldRule::{+ , field = "status"+ , description = Some "Ratification state of the specification."+ , allowedValues =+ [ "draft", "proposed", "ratified", "superseded", "withdrawn" ]+ , cardinality = Cardinality.Scalar+ }+ , -- Deliberately `Uri` and not `UriWithScheme "mori"`. The obliged+ -- boundary is named by whatever canonical identity scheme the+ -- consuming organization uses; `mori://` satisfies this rule without+ -- the profile mandating a particular registry. A list, because one+ -- specification may bind several boundaries at once.+ FieldRule::{+ , field = "owner"+ , description = Some+ "Canonical URI of each boundary obliged to satisfy this specification."+ , cardinality = Cardinality.List+ , format = Some FieldFormat.Uri+ }+ , v02.generated+ // { description = Some+ "§5.2. Who produced this specification's current content, and when."+ }+ , specReference+ "supersededBy"+ "Later specification replacing this one."+ // { cardinality = Cardinality.Scalar+ , when = Some { field = "status", hasValue = [ "superseded" ] }+ }+ ]+ , -- Nothing is recommended. Under `--strict` a recommended-and-absent+ -- field is an error, and the obvious candidate — `reviews` — fails+ -- ADR-8's test: a draft specification that nobody has reviewed yet is+ -- complete and correct for what it is. Ratification review is recorded+ -- through `reviews` and `verified` when it happens, and demanded by+ -- neither, because a corpus adopting this profile retroactively cannot+ -- truthfully supply review records it never kept.+ recommended = [] : List FieldRule.Type+ , optional =+ [ FieldRule::{+ , field = "conformance"+ , description = Some+ "Versioned contract, fixture package, or suite that proves conformance to this specification."+ , cardinality = Cardinality.List+ , format = Some FieldFormat.Uri+ }+ , specReference+ "supersedes"+ "Earlier specifications replaced by this one."+ // { cardinality = Cardinality.List }+ , -- Coexists with `verified` rather than replacing it; see Policy two+ -- in the header of ../../Profile/V02.dhall.+ reviewRule+ , v02.sources+ // { description = Some+ "§5.1. Prior art, requirements, and evidence this specification was derived from."+ }+ , v02.verified+ // { description = Some+ "§5.2. Independent confirmations that this specification is accurate. Mirror approving `reviews` entries here."+ }+ , -- The superseded v0.1 key, kept so an unmigrated corpus keeps+ -- validating. `optional` means its absence is never reported while+ -- its format is still checked whenever it is present.+ v02.legacyTimestamp+ // { description = Some+ "Superseded v0.1 revision timestamp. Prefer `generated.at`."+ }+ ]+ }+ , -- The house `status` key above keeps its ratification vocabulary and+ -- deliberately does not adopt OKF v0.2 §5.4's draft/stable/deprecated,+ -- nor `stale_after`. Its allowing `draft` is a coincidence, not partial+ -- conformance: `ratified` is the state OKF has no word for. See the+ -- header of ../../Profile/V02.dhall for the policy and its reasoning.+ okfVersion = "0.2"+ , requireBundleVersion = Some "0.2"+ , allowUnknownTypes = False+ , idField = Some "specId"+ , types =+ [ TypeRule::{+ , type = "Specification"+ , description = Some+ "A durable statement of required behavior that an owning boundary must satisfy."+ , pathPattern = Some "**"+ , idPrefix = Some "SPEC"+ , -- The two rules that distinguish a specification from a decision+ -- record or a research document, demanded exactly when ratification+ -- makes them answerable. They describe the specification *text*, so+ -- they live on this type rather than profile-wide: a pointer holds no+ -- text to scope or version, and states the version through the+ -- authoritative document it names.+ frontmatter = FrontmatterRules::{+ , required =+ [ scalar+ "specVersion"+ "Version of the contract this document ratifies, as implementations cite it."+ // { when = ratified }+ , FieldRule::{+ , field = "normativeScope"+ , description = Some+ "The parts of this document that bind. Anything not named here is informative."+ , cardinality = Cardinality.List+ }+ // { when = ratified }+ ]+ }+ }+ , TypeRule::{+ , type = "Specification Pointer"+ , description = Some+ "A specification whose authoritative text is owned by another repository, recorded here with the ownership it establishes."+ , pathPattern = Some "**"+ , idPrefix = Some "SPEC"+ , frontmatter = FrontmatterRules::{+ , required =+ [ FieldRule::{+ , field = "authoritativeSpec"+ , description = Some+ "Canonical URI of the document that authoritatively specifies this subject."+ , cardinality = Cardinality.Scalar+ , format = Some FieldFormat.Uri+ }+ ]+ }+ }+ ]+ }
+ test/fixtures/catalogue/profiles/documentation/terminology.dhall view
@@ -0,0 +1,245 @@+--| Profile for controlled project vocabularies with stable TERM-N handles.+--+-- ## What a term is, and what it is not+--+-- A term defines a word: the canonical spelling a project uses for one concept,+-- a one-sentence definition, the synonyms that mean the same thing, and the+-- wording that must not be used for it. It then points to where the concept's+-- behavior is described or embodied. That pointing is the whole reason the+-- catalog exists as structured data rather than as a glossary page: typed+-- relations, discouraged wording, and code anchors are what an agent or a+-- reviewer can act on.+--+-- A terminology catalog is a controlled vocabulary, not a general ontology or+-- knowledge graph. It does not record:+--+-- * a choice and its rationale — `documentation.architectureDecisions`;+-- * an obligation a boundary must satisfy — `documentation.specifications`;+-- * a reusable solution — `documentation.patternCatalog`;+-- * a provision claim — `coordination.capabilities`;+-- * a page that helps a reader do something — `documentation.userDocumentation`.+--+-- A term links to those from its body or through a `doc` anchor. It never+-- restates them.+--+--+-- ## The house `status` vocabulary+--+-- Per ADR-1, `status` is a house vocabulary, `current` or `deprecated`, and this+-- profile does not splice OKF v0.2 §5.4's `status` or §5.5's `stale_after`.+-- OKF's `draft`/`stable` distinction has no meaning for a word: a term is either+-- the one to use or one that has been retired. A retired term must say what to+-- say instead, so `replacedBy` is demanded once `status` is `deprecated`.+--+--+-- ## Relations+--+-- `broader`, `related`, and `replaces` each accept a local `TERM-N` handle or a+-- canonical `mori://` concept URI, following ADR-11: local references use+-- handles, cross-project references use `mori://`. `sameAs` is external only.+-- An equivalent inside one bundle is an alias, not a second term, so a local+-- `sameAs` is rejected.+--+-- `narrower` is deliberately not a field. A consumer derives it as the inverse+-- of `broader`, so the two directions cannot disagree. There is likewise no+-- body/frontmatter mirror rule: the body should link related terms, but the+-- typed fields already carry the edges, and okf cannot enforce a mirror.+-- Checks that need the whole corpus or the repository — that a reference+-- resolves to a term, that `broader` has no cycle, that `replaces` and+-- `replacedBy` agree, that an anchor exists on disk, that discouraged wording is+-- not another term's name — belong to a repository-local or registry-side gate,+-- not to the profile.+--+--+-- ## Presence classes+--+-- Nothing is recommended. Per ADR-8 a field is recommended only when a well-run+-- corpus carries it, and a well-formed term routinely has no abbreviation, no+-- alias, no discouraged wording, no relation, and no anchor.+--+--+-- ## `legacyTimestamp` is deliberately absent+--+-- This profile is introduced at v0.2 and no v0.1 terminology corpus exists.+let Profile = ../../Profile/Type.dhall++let FrontmatterRules = ../../Profile/FrontmatterRules.dhall++let TypeRule = ../../Profile/TypeRule.dhall++let okf = ../../Profile/okf.dhall++let FieldRule = okf.defaults.FieldRule++let NestedRules = okf.defaults.NestedRules++let NestedFieldRule = okf.defaults.NestedFieldRule++let HandleReferenceRule = okf.defaults.HandleReferenceRule++let Cardinality = okf.Cardinality++let FieldFormat = okf.FieldFormat++let v02 = ../../Profile/V02.dhall++let scalar =+ \(name : Text) ->+ \(description : Text) ->+ FieldRule::{+ , field = name+ , description = Some description+ , cardinality = Cardinality.Scalar+ }++let list =+ \(name : Text) ->+ \(description : Text) ->+ FieldRule::{+ , field = name+ , description = Some description+ , cardinality = Cardinality.List+ }++let nestedScalar =+ \(name : Text) ->+ \(description : Text) ->+ NestedFieldRule::{+ , field = name+ , description = Some description+ , cardinality = Cardinality.Scalar+ }++let termReference =+ Some+ HandleReferenceRule::{+ , localPrefix = "TERM"+ , externalUriSchemes = [ "mori" ]+ }++let termReferences =+ \(name : Text) ->+ \(description : Text) ->+ list name description // { reference = termReference }++-- `resource` is a plain scalar and deliberately NOT an okf `path` rule, for the+-- same reason as capability evidence: a path rule resolves inside the bundle,+-- and what embodies a term — a module, a source file, a user guide — is almost+-- always outside it. Resolving anchors is a repository-local check.+let anchors =+ FieldRule::{+ , field = "anchors"+ , description = Some+ "What embodies this term: a module, type, function, file, document, or absolute URI a reader can open."+ , cardinality = Cardinality.List+ , elementFields = Some NestedRules::{+ , required =+ [ NestedFieldRule::{+ , field = "kind"+ , description = Some "What sort of artifact this anchor names."+ , allowedValues =+ [ "module", "type", "function", "file", "doc", "uri" ]+ , cardinality = Cardinality.Scalar+ }+ , nestedScalar+ "resource"+ "Module name, qualified identifier, repository-relative path, or absolute URI."+ ]+ , recommended = [] : List NestedFieldRule.Type+ , optional = [ nestedScalar "note" "Why this anchor matters." ]+ }+ }++in Profile::{+ , name = "terminology"+ , description = Some+ "Controlled project vocabulary with stable TERM handles: the canonical term, a one-sentence definition, accepted and discouraged wording, typed relations to other terms in this or another project, succession, and anchors to what embodies the term. A controlled vocabulary, not a general ontology: decisions, specifications, patterns, capabilities, and guides keep their own profiles."+ , okfVersion = "0.2"+ , requireBundleVersion = Some "0.2"+ , allowUnknownTypes = False+ , idField = Some "termId"+ , frontmatter = FrontmatterRules::{+ , required =+ [ scalar "type" "The Term concept type."+ , scalar+ "title"+ "The canonical term, spelled and cased exactly as it should be written."+ , scalar "description" "A one-sentence definition."+ , v02.generated+ // { description = Some+ "§5.2. Who produced this term's current content, and when."+ }+ ]+ , recommended = [] : List FieldRule.Type+ , optional =+ [ list "tags" "Free classification tags."+ , v02.verified+ // { description = Some+ "§5.2. Independent confirmations that this definition is accurate."+ }+ ]+ }+ , types =+ [ TypeRule::{+ , type = "Term"+ , description = Some+ "One concept of this project's vocabulary, under the one name the project uses for it."+ , frontmatter = FrontmatterRules::{+ , required =+ [ FieldRule::{+ , field = "termId"+ , description = Some "Bundle-scoped stable TERM-N handle."+ , cardinality = Cardinality.Scalar+ , format = Some (FieldFormat.DocumentHandle "TERM")+ }+ , FieldRule::{+ , field = "status"+ , description = Some+ "Whether this is the term to use or a retired one."+ , allowedValues = [ "current", "deprecated" ]+ , cardinality = Cardinality.Scalar+ }+ , -- Conditionally required is spelled `required` + `when`: okf+ -- rejects a `when` on an optional field.+ scalar+ "replacedBy"+ "The term to use instead. Demanded once `status` is `deprecated`."+ // { reference = termReference+ , when = Some { field = "status", hasValue = [ "deprecated" ] }+ }+ ]+ , optional =+ [ scalar "abbreviation" "An accepted short form of the term."+ , scalar+ "scope"+ "The subsystem or bounded context in which this meaning holds."+ , list "aliases" "Accepted synonyms with identical meaning."+ , list+ "discouraged"+ "Wording that must not be used for this concept. The body says why."+ , termReferences+ "broader"+ "More general terms this term specialises."+ , termReferences+ "related"+ "Associated terms that are neither broader nor equivalent."+ , termReferences "replaces" "Terms this term succeeds."+ , list+ "sameAs"+ "The same concept published by another project, as canonical Mori term URIs."+ // { reference = Some HandleReferenceRule::{+ , localPrefix = "TERM"+ , externalUriSchemes = [ "mori" ]+ , allowLocal = False+ , externalUriPattern = Some+ "mori://[^/]+/[^/]+/okf/[^/]+/concepts/TERM-[1-9][0-9]*"+ }+ }+ , anchors+ ]+ }+ , pathPattern = Some "*"+ , idPrefix = Some "TERM"+ }+ ]+ }
test/fixtures/catalogue/profiles/okf-v0-2.dhall view
@@ -8,8 +8,8 @@ -- Exported from this repository's root package as `okfV02`, so a consumer pins -- it by URL like any other profile in the catalog: ----- let okf = https://raw.githubusercontent.com/shinzui/okf-profiles/v0.8.0/package.dhall--- sha256:…+-- let okf = https://raw.githubusercontent.com/shinzui/okf-profiles/v0.19.0/package.dhall+-- sha256:85176d78369b6d73c9f13c30277903b629d6bf048a4c7d71fc26e68b99c3eaa6 -- -- in okf.okfV02 --
+ test/fixtures/concept-sorting/index.md view
@@ -0,0 +1,8 @@+---+okf_version: "0.2"+---++# Subdirectories++- [requests/](requests/index.md)+
+ test/fixtures/concept-sorting/log.md view
@@ -0,0 +1,5 @@+# Bundle Update Log++## 2026-10-03++* **Addition**: Fixture bundle for ordering concept listings by frontmatter keys.
+ test/fixtures/concept-sorting/requests/a-ten.md view
@@ -0,0 +1,12 @@+---+type: Improvement Request+title: Ten+description: The tenth request, filed first by name, with two tags written out of order.+requestId: IR-10+priority: 2+tags:+ - zeta+ - alpha+---++# Ten
+ test/fixtures/concept-sorting/requests/b-two.md view
@@ -0,0 +1,11 @@+---+type: Improvement Request+title: Two+description: The second request, with the largest priority.+requestId: IR-2+priority: 10+tags:+ - mid+---++# Two
+ test/fixtures/concept-sorting/requests/c-nine.md view
@@ -0,0 +1,9 @@+---+type: Improvement Request+title: Nine+description: The ninth request, with a fractional priority and no tags.+requestId: IR-9+priority: 1.5+---++# Nine
+ test/fixtures/concept-sorting/requests/d-none.md view
@@ -0,0 +1,9 @@+---+type: Improvement Request+title: None+description: A request that has no ID and no priority yet.+tags:+ - beta+---++# None
+ test/fixtures/concept-sorting/requests/e-one.md view
@@ -0,0 +1,9 @@+---+type: Improvement Request+title: One+description: The first request, tied on priority with the tenth.+requestId: IR-1+priority: 2+---++# One
+ test/fixtures/concept-sorting/requests/index.md view
@@ -0,0 +1,8 @@+# Improvement Request++- [Ten](a-ten.md) - The tenth request, filed first by name, with two tags written out of order.+- [Two](b-two.md) - The second request, with the largest priority.+- [Nine](c-nine.md) - The ninth request, with a fractional priority and no tags.+- [None](d-none.md) - A request that has no ID and no priority yet.+- [One](e-one.md) - The first request, tied on priority with the tenth.+