diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,77 @@ ## [Unreleased] +## [0.3.0.0] - 2026-07-29 + +### Added + +- `okf profile show` and profile JSON expose local-prefix, external-scheme, and + self-reference policies. `okf validate` renders path-precise dangling, + wrong-prefix, malformed, disallowed-external, and self-reference deviations; + the profiles help topic documents the offline local/external boundary. +- `okf profile show` renders top-level and nested `when` predicates, while + `okf validate` explains the activating condition on missing-field diagnostics. + The profiles help topic documents same-scope resolution, compiler checks, + strict recommendations, and no-cascade runtime behavior. +- `okf profile show` renders bounded nested field rules, and `okf validate` + reports missing nested fields, non-record list elements, and nested value + violations with indexed paths such as `reviews[2].outcome`. +- `okf profile show` and profile JSON expose named field formats, and + `okf validate` renders parser-backed timestamp, date, URI, URI-scheme, and + document-handle mismatches. +- Profile detail output and validation diagnostics for `Any`, `Scalar`, and + `List` field cardinality. +- `okf profile show` now displays `allowUnknownFields` and each field's + `allowedValues`; validation renders value-vocabulary and undeclared-field + deviations. +- `okf profile show` and `--json` now expose required and recommended + frontmatter rules beneath each type. +- `okf validate --strict --profile ...` checks profile-recommended fields and + renders them as `missing profile-recommended field`; `--profile-enforce` + continues to control whether the deviation fails the command. +- An `UPGRADING FROM 0.1.x` section in the `okf help profiles` topic, summarizing + how to move a 0.1.x profile descriptor onto the 0.2.0.0 schema. +- Profile descriptions are surfaced everywhere a profile is displayed: + `okf profile show` prints the profile's description, a ` - key: prose` line + per frontmatter key, and a description line in each type block; `okf profile + list` gains a trailing `DESCRIPTION` column reading `-` when absent; and + `okf validate --profile` appends the key's prose in parentheses to a + `missing profile-required field` advisory. A `DESCRIPTIONS` section in the + `okf help profiles` topic covers all of it. + +### Changed + +- Requires `okf-core ^>=0.3.0.0`. This major bound reflects the breaking + compiled-profile API and the expanded profile-rule and diagnostic types. +- Profile-definition output now reports invalid reference prefixes and schemes, + undeclared target prefixes, missing `idField`, profile/type prefix conflicts, + and reference-plus-format combinations. Mori and other exhaustive consumers + must handle the five new reference violations and six definition errors, plus + all previously accumulated profile API changes, before moving the matching + `cabal.project` and `flake.nix` pins together. +- Profile-definition output now reports every invalid condition category. Mori + and other exhaustive consumers must handle the new definition errors and the + condition payload added to missing-field violations before updating their + `okf-core` pin. +- Profile-definition output now reports invalid format parameters and + contradictory profile/type formats. Mori and other exhaustive `okf-core` + consumers must add cases for `InvalidFormatParameter`, + `ConflictingFieldFormat`, and `ValueFormatMismatch` before updating their + `okf-core` pin. Mori's renderer is + `mori-cli/src/Mori/Okf/Advisory.hs`, and its matching `cabal.project` and + `flake.nix` pins must move together. +- Profile descriptors are compiled before validation. Duplicate type names and + ambiguous required/recommended declarations are fatal profile-definition + errors reported once, before any concept is checked. +- Mori and other `okf-core` consumers must call `compileProfile`, handle its + structured errors, pass `PermissiveConformance` or `StrictAuthoring` to + `validateProfile`, and handle `MissingRecommendedProfileField` in exhaustive + violation renderers. +- `okf profile show` prints a non-empty `frontmatter.required` or + `frontmatter.recommended` as a headed block, one key per line, rather than one + comma-joined line — per-key prose cannot share a line. An empty list keeps the + single-line `(none)` form, so every optional field still prints. + ## [0.2.0.0] - 2026-07-26 ### Added diff --git a/help/profiles.md b/help/profiles.md --- a/help/profiles.md +++ b/help/profiles.md @@ -20,6 +20,9 @@ --profile-enforce Make profile deviations fail the command (non-zero exit). + --strict Also check profile `recommended` fields. Required + profile fields are checked in both modes. + EXIT CODES - Structural errors always exit non-zero, with or without --profile. @@ -41,8 +44,231 @@ handle, `okf id list BUNDLE --profile PROFILE.dhall` to list allocations, and `okf show BUNDLE ADR-7` to resolve one. +REGISTRIES + + You do not have to write a descriptor from scratch. A registry is any Dhall + expression evaluating to a record whose fields -- possibly nested -- are + profile values. okf finds them structurally: it walks the evaluated record + and reports every field that decodes as a profile, under the dotted path it + was found at. That path is the profile's export path. + + okf profile list + okf profile list --registry /path/to/okf-profiles + okf profile show postgresql --registry /path/to/okf-profiles + + A bare `okf profile` means `okf profile list`. Both subcommands accept + --json. The EXPORT column reads "(root)" when the reference is itself a + profile rather than a record of profiles; the ID FIELD column reads "-" when + the profile declares no idField. + +DESCRIPTIONS + + A profile may document itself: one description for the profile as a whole, + one per required or recommended frontmatter key, and one per type rule. + Descriptions are prose for humans -- okf never checks one against a bundle + and none can produce a deviation. + + `okf profile list` shows the profile's own description in a trailing + DESCRIPTION column, reading "-" when it has none. `okf profile show` prints + the profile description under the name, one " - key: prose" line per + frontmatter key, and a description line in each type block, all reading + "(none)" when absent. When a required key is missing from a concept, the + advisory repeats the key's prose in parentheses: + + profile: schemas/sales/tables/orders: missing profile-required field: title (Human-readable name of the object.) + + Descriptions are optional and additive. A descriptor written before they + existed loads unchanged and simply shows none; nothing needs migrating. See + docs/user/profiles.md for how to add them to a descriptor you already have. + +TYPE-AWARE FRONTMATTER + + Each type rule may add its own required and recommended frontmatter fields. + Profile-wide rules apply to every concept; a matching type rule adds to them. + Value constraints merge by key, while presence declarations remain separate; + an applicable required clause wins over a strict recommendation. Unknown + types still receive profile-wide rules. + + `okf profile show` prints `frontmatter.required` and + `frontmatter.recommended` beneath each type. New descriptors should use + `okf.defaults.TypeRule::{ ... }`, whose default supplies empty lists. + + Before validating a bundle, okf rejects duplicate type rules, repeated keys + in one list, and keys placed in both required and recommended at the same + scope. These are hard profile-definition errors regardless of + `--profile-enforce`. + +VALUE VOCABULARIES AND CLOSED FIELDS + + A FieldRule may set allowedValues to a list of legal text values. An empty + list means unconstrained. Present strings and lists of strings are checked in + both permissive and strict modes; a type-level vocabulary narrows a + profile-wide vocabulary by intersection. Disjoint vocabularies are rejected + as a profile-definition error before bundle validation. + + Set allowUnknownFields = False to reject undeclared top-level frontmatter + keys. The allowed names come from the effective rules for that concept's own + type, plus the core OKF keys and the profile's idField. The default is True, + so existing profiles continue to allow producer extensions. + + profile: requests/typo: missing profile-required field: status + profile: requests/typo: frontmatter field not declared by profile: stauts + +FIELD CARDINALITY + + Every FieldRule has a cardinality: Any, Scalar, or List. Any is the default + and preserves the legacy non-empty-text-or-non-empty-list presence behavior. + Scalar accepts non-blank text, numbers, and booleans. List accepts arrays. + Objects and null fail an explicit cardinality constraint. + + Use `field.scalar "title"` or `field.list "tags"`. At profile and type scope, + Any is the identity; contradictory Scalar and List declarations are a hard + profile-definition error. Wrong-shape values are reported even for a + recommended field outside --strict, without a duplicate missing-field or + vocabulary-shape diagnostic. + + profile: bad: frontmatter cardinality at title must be scalar, found list: ["One","Two"] + profile: bad: frontmatter cardinality at tags must be list, found scalar: "one" + +NAMED FIELD FORMATS + + A FieldRule may set format to one of five parser-backed textual contracts: + Rfc3339Utc, Date, Uri, UriWithScheme Text, or DocumentHandle Text. The default + is None, so existing fields remain unconstrained. Formats check present strings + and every string in a list; they do not make an absent field required. + + Rfc3339Utc accepts extended timestamps such as 2026-07-29T17:00:00Z and + requires uppercase Z rather than a numeric offset. Date accepts exactly + YYYY-MM-DD and rejects impossible calendar dates. Uri requires an absolute RFC + 3986 URI. UriWithScheme additionally requires the named scheme, compared + case-insensitively. DocumentHandle requires the canonical PREFIX-N form and + compares the prefix case-sensitively. + + The FieldRule constructors cover the common forms: + + field.rfc3339Utc "timestamp" + field.date "published" + field.uri "source" + field.uriWithScheme "originPlan" "mori" + field.documentHandle "decision" "ADR" + + Uri at profile scope may be narrowed to UriWithScheme at type scope. Equal + formats merge unchanged; other unequal pairs are a hard profile-definition + error. URI scheme parameters must follow RFC 3986 scheme syntax, and document + prefixes must follow the same grammar as okf document IDs. + + profile: bad: frontmatter value at timestamp must match format rfc3339-utc, found: "2026-07-29T17:00:00+01:00" + profile: bad: frontmatter value at originPlan must match format uri-with-scheme(mori), found: "https://example.test" + +NESTED RECORD FIELDS + + A top-level FieldRule may set elementFields to required and recommended rules + for every record in a list. The public schema is intentionally bounded to one + level: NestedFieldRule has vocabulary, cardinality, and format constraints but + cannot contain another elementFields value. + + Use field.recordList with NestedFieldRule constructors or record completion. + Declaring elementFields implies list cardinality; combining it with Scalar is + a hard profile-definition error. Profile-wide and type-specific nested rules + merge by sibling key just like top-level rules. + + Each list element must be a record. Required nested keys are always checked; + recommended nested keys only under --strict. Present nested values are checked + in both modes, and diagnostics identify the exact index: + + profile: requests/example: missing profile-required field: reviews[2].outcome + profile: requests/example: frontmatter element at reviews[1] must be a record, found: "not-a-record" + + Extra keys inside a record remain allowed. Nested field-name closure and a + second nested level are not part of this schema. + +CONDITIONAL FIELD PRESENCE + + FieldRule and NestedFieldRule may set `when = Some { field, hasValue }` so a + required or recommended field applies only when a sibling scalar text field + has one of the listed values. Top-level rules see top-level siblings; nested + rules see only siblings in the same list element. There is no cross-scope + capture. + + The source must be explicitly Scalar and have a non-empty allowedValues + vocabulary. hasValue must be non-empty and a subset of that vocabulary. Empty, + self-referential, undeclared, open, non-scalar, and unreachable conditions are + hard profile-definition errors before any bundle is read. + + FieldRule::{ + , field = "supersededBy" + , when = Some { field = "status", hasValue = [ "superseded" ] } + } + + A missing, wrong-shape, or out-of-vocabulary source makes the condition false, + avoiding a second target-field diagnostic. When the target is present, its + vocabulary, cardinality, and format are checked regardless of the condition. + Recommended conditions are evaluated only under --strict. + + profile: decisions/old: missing profile-required field: supersededBy (when status is superseded) + +DOCUMENT REFERENCES + + A top-level FieldRule may set reference to a local handle prefix, a list of + allowed external URI schemes, and an allowSelf policy. The constructors cover + local-only and explicit external alternatives: + + field.localReference "supersedes" "ADR" + field.localOrExternalReference "supersededBy" "ADR" [ "mori" ] + + The helpers default allowSelf to False. Use + okf.defaults.HandleReferenceRule record completion to override it. + + A canonical handle is checked first. A handle with another prefix is a + category error; one with the declared prefix must belong to a valid, + profile-governed concept in this bundle. Duplicate owners still produce the + existing duplicate-ID deviation but count as present, avoiding a false + dangling-reference message. Lists are checked element-wise with indexed paths. + + profile: decisions/current: supersedes[1] references ADR-99, which does not exist in this bundle + + Text that is not a handle must be an absolute URI whose scheme is listed by + the policy. Scheme comparison is case-insensitive. okf checks syntax and the + scheme offline; it never resolves an external URI or consults Mori, a registry, + DNS, or the network. + + The local prefix must use document-handle grammar, be declared by at least one + type idPrefix, and have a profile idField. URI schemes must use RFC 3986 scheme + grammar. A reference field cannot also declare format. Matching profile/type + policies must use the same local prefix; their external schemes intersect and + self-reference is allowed only when both permit it. Invalid combinations are + hard profile-definition errors before any bundle is read. + + A registry reference may be a path to a Dhall file, a directory holding + package.dhall, or a Dhall expression such as a hash-pinned URL. Without + --registry, okf uses OKF_PROFILE_REGISTRY, then profiles.registry from + configuration, then the built-in default: the okf-profiles package pinned by + tag and sha256 hash. Because it is pinned, Dhall caches it under + ~/.cache/dhall after the first fetch, so later runs are offline. Pass + --registry with a local checkout to be offline throughout. + + There is no install step. `okf profile show` closes with the two-line Dhall + snippet that consumes the profile; save it to a file and pass that file to + `okf validate --profile`. + +UPGRADING FROM 0.1.x + + okf 0.2.0.0 added idField to Profile and idPrefix to TypeRule. Dhall record + types are closed, so descriptors written against 0.1.x fail to load with + "Expression doesn't match annotation", listing the missing fields with a "-". + + Set idField = None Text and idPrefix = None Text to keep the old behavior + (no document-ID checks), or adopt record completion via + okf.defaults.Profile::{ ... } so later schema additions do not break the + descriptor again. + + Descriptors pinned to a schema URL must bump the tag and the sha256 hash + together. Edit the tag, then run `dhall freeze PROFILE.dhall`, which + rewrites the hash in place even when the old one is stale. + SEE ALSO okf help validation Structural validation and referential integrity. - The full descriptor schema is documented in docs/user/profiles.md. + The full descriptor schema, and the upgrade steps above in detail, are + documented in docs/user/profiles.md. diff --git a/okf-cli.cabal b/okf-cli.cabal --- a/okf-cli.cabal +++ b/okf-cli.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: okf-cli -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Command-line interface for Open Knowledge Format bundles description: okf-cli provides the @okf@ executable for working with Open Knowledge Format @@ -66,7 +66,7 @@ , generic-lens >=2.2 && <2.4 , githash ^>=0.1 , lens ^>=5.3 - , okf-core ^>=0.2.0.0 + , okf-core ^>=0.3.0.0 , optparse-applicative >=0.18 && <0.20 , process >=1.6 && <1.7 , text ^>=2.1 @@ -78,11 +78,11 @@ main-is: Main.hs hs-source-dirs: test build-depends: - , base >=4.20 && <5 + , base >=4.20 && <5 , directory , filepath , okf-cli - , okf-core + , okf-core ^>=0.3.0.0 , optparse-applicative >=0.18 , temporary , text ^>=2.1 diff --git a/src/Okf/Cli.hs b/src/Okf/Cli.hs --- a/src/Okf/Cli.hs +++ b/src/Okf/Cli.hs @@ -10,9 +10,15 @@ LogOptions (..), LogSub (..), Options (..), + ProfileCommand (..), + ProfileListOptions (..), + ProfileShowOptions (..), ShowOptions (..), ValidateOptions (..), parserInfo, + profileRegistryEnvVar, + renderProfileDetail, + renderRegistryTable, runCli, runCommand, runLogAdd, @@ -24,7 +30,7 @@ import Data.Aeson.Key qualified as AesonKey import Data.Aeson.KeyMap qualified as KeyMap import Data.ByteString.Lazy.Char8 qualified as LazyByteString -import Data.Foldable (traverse_) +import Data.Foldable (toList, traverse_) import Data.List qualified as List import Data.Set qualified as Set import Data.Text qualified as Text @@ -50,21 +56,43 @@ import Okf.Graph (buildGraph) import Okf.Index import Okf.Log qualified as Log -import Okf.Prelude +import Okf.Prelude hiding (List) import Okf.Profile - ( ProfileSpec (..), + ( Cardinality (..), + CompiledProfile, + FieldCondition (..), + FieldFormat (..), + FieldPath (..), + FieldPathSegment (..), + FrontmatterRules (..), + HandleReferenceRule (..), + NestedRules (..), + ProfileDefinitionError (..), + ProfileSpec (..), ProfileViolation (..), TypeRule (..), + compileProfile, documentIdsInBundle, loadProfileFile, nextDocumentId, parseDocumentId, + profileFieldDescriptionForType, renderDocumentId, validateProfile, ) +import Okf.Profile.Registry + ( RegistryEntry (..), + RegistryRef (..), + findRegistryEntry, + loadRegistry, + renderRegistryRef, + resolveRegistryRef, + rootExportLabel, + ) import Okf.Validation import Options.Applicative import System.Directory (createDirectoryIfMissing, doesFileExist) +import System.Environment (lookupEnv) import System.Exit (ExitCode (..), exitFailure, exitWith) import System.FilePath (()) import System.FilePath qualified as FilePath @@ -79,6 +107,7 @@ | ShowConcept ShowOptions | Id IdOptions | Config ConfigCommand + | Profile ProfileCommand | Kit KitCommand | Assist AssistOptions | Completions CompletionsShell @@ -152,6 +181,24 @@ | ConfigInit !Bool deriving stock (Show, Eq) +data ProfileCommand + = ProfileList ProfileListOptions + | ProfileShow ProfileShowOptions + deriving stock (Show, Eq) + +data ProfileListOptions = ProfileListOptions + { registryRef :: !(Maybe Text), + json :: !Bool + } + deriving stock (Show, Eq) + +data ProfileShowOptions = ProfileShowOptions + { registryRef :: !(Maybe Text), + export :: !(Maybe Text), + json :: !Bool + } + deriving stock (Show, Eq) + data Options = Options { cmd :: !Command } @@ -190,6 +237,7 @@ <> command "show" (info (ShowConcept <$> showOptionsParser <**> helper) (progDesc "Show one concept")) <> command "id" (info (Id <$> idOptionsParser <**> helper) (progDesc "Allocate and list document IDs")) <> command "config" (info (Config <$> configCommandParser <**> helper) (progDesc "Show and manage okf configuration")) + <> command "profile" (info (Profile <$> profileCommandParser <**> helper) (progDesc "List and inspect profiles published by a registry")) <> command "kit" (info (Kit <$> kitCommandParser <**> helper) (progDesc "Install and manage agent skills and subagents")) <> command "assist" (info (Assist <$> assistOptionsParser <**> helper) (progDesc "Launch an interactive agent session with installed okf skills")) <> command "completions" (info (Completions <$> completionsParser <**> helper) (progDesc "Generate a shell completion script (bash, zsh, fish)")) @@ -362,6 +410,55 @@ ) <|> pure ConfigShow +profileCommandParser :: Parser ProfileCommand +profileCommandParser = + hsubparser + ( command + "list" + ( info + (ProfileList <$> profileListOptionsParser <**> helper) + (progDesc "List the profiles a registry publishes") + ) + <> command + "show" + ( info + (ProfileShow <$> profileShowOptionsParser <**> helper) + (progDesc "Print one registry profile in full") + ) + ) + <|> pure (ProfileList (ProfileListOptions Nothing False)) + +profileListOptionsParser :: Parser ProfileListOptions +profileListOptionsParser = + ProfileListOptions + <$> optional registryOption + <*> jsonSwitch + +profileShowOptionsParser :: Parser ProfileShowOptions +profileShowOptionsParser = + ProfileShowOptions + <$> optional registryOption + <*> optional + ( Text.pack + <$> strArgument + ( metavar "EXPORT" + <> help "Dotted export path of the profile, as printed by `okf profile list`" + ) + ) + <*> jsonSwitch + +registryOption :: Parser Text +registryOption = + Text.pack + <$> strOption + ( long "registry" + <> metavar "REGISTRY" + <> help "Dhall file, directory holding package.dhall, or Dhall expression publishing profiles" + ) + +jsonSwitch :: Parser Bool +jsonSwitch = switch (long "json" <> help "Emit JSON instead of text") + bundleArgument :: Parser FilePath bundleArgument = strArgument (metavar "BUNDLE" <> help "Path to an OKF bundle directory") @@ -375,6 +472,7 @@ ShowConcept options -> runShow options Id options -> runId options Config configCommand -> runConfig configCommand + Profile profileCommand -> runProfile profileCommand Kit kitCommand -> do config <- loadConfigOrDie handleKitCommand config kitCommand @@ -413,6 +511,276 @@ Left err -> dieText ("Failed to load config: " <> err) Right loaded -> pure loaded +-- | Environment override for the registry @okf profile@ reads. +profileRegistryEnvVar :: String +profileRegistryEnvVar = "OKF_PROFILE_REGISTRY" + +runProfile :: ProfileCommand -> IO () +runProfile = \case + ProfileList options -> runProfileList options + ProfileShow options -> runProfileShow options + +-- | Registry reference precedence: @--registry@, then 'profileRegistryEnvVar', +-- then configuration (which falls back to the built-in default). Configuration +-- is read only when it is actually needed, so a broken @okf-config.dhall@ +-- cannot stop @okf profile list --registry ./somewhere.dhall@. +resolveRegistryReference :: Maybe Text -> IO Text +resolveRegistryReference (Just explicit) = pure explicit +resolveRegistryReference Nothing = do + fromEnvironment <- lookupEnv profileRegistryEnvVar + case fromEnvironment of + Just fromShell | not (null fromShell) -> pure (Text.pack fromShell) + _ -> do + OkfConfig {profiles = ProfileSettings {registry}} <- loadConfigOrDie + pure registry + +-- | Resolve, evaluate, and enumerate a registry, or exit 1 explaining why not. +-- The reference is returned in the form the user gave it, for messages, along +-- with the resolved reference, which is what @show@ quotes back as Dhall. +loadRegistryOrDie :: Maybe Text -> IO (Text, RegistryRef, [RegistryEntry]) +loadRegistryOrDie explicit = do + reference <- resolveRegistryReference explicit + ref <- resolveRegistryRef reference + loaded <- loadRegistry ref + case loaded of + Left err -> dieText (renderRegistryLoadError reference err) + Right [] -> dieText ("No profiles found in registry " <> reference) + Right entries -> pure (reference, ref, entries) + +-- | A load failure is usually a mistyped path or a missing network, so say what +-- a reference may be and how to work offline. +renderRegistryLoadError :: Text -> Text -> Text +renderRegistryLoadError reference err = + Text.unlines + [ "Failed to load profile registry " <> reference <> ": " <> err, + "A registry reference may be a path to a Dhall file, a directory holding package.dhall, or a", + "Dhall expression such as a hash-pinned URL. Remote references need network access on first", + "use; pass --registry with a local checkout to work offline." + ] + +runProfileList :: ProfileListOptions -> IO () +runProfileList ProfileListOptions {registryRef, json} = do + (reference, _ref, entries) <- loadRegistryOrDie registryRef + if json + then LazyByteString.putStrLn (Aeson.encode (registryListJson reference entries)) + else traverse_ Text.IO.putStrLn (renderRegistryTable entries) + +registryListJson :: Text -> [RegistryEntry] -> Aeson.Value +registryListJson reference entries = + Aeson.object + [ "registry" Aeson..= reference, + "profiles" + Aeson..= [ Aeson.object + [ "export" Aeson..= export, + "profile" Aeson..= spec + ] + | RegistryEntry {export, spec} <- entries + ] + ] + +-- | An aligned table: a header row plus one row per profile, columns padded to +-- their widest value. Pure so it can be tested without evaluating any Dhall. +-- +-- @DESCRIPTION@ comes last so the existing columns keep their positions and a +-- long description cannot push anything off the right edge. Nothing follows it, +-- so it is never padded; an absent description reads @-@, matching @ID FIELD@. +renderRegistryTable :: [RegistryEntry] -> [Text] +renderRegistryTable entries = + map renderRow rows + where + headerRow = ["EXPORT", "NAME", "OKF", "TYPES", "ID FIELD", "DESCRIPTION"] + entryRow + RegistryEntry + { export = exportPath, + spec = ProfileSpec {name, description, okfVersion, idField, types = typeRules} + } = + [ displayExport exportPath, + name, + okfVersion, + Text.pack (show (length typeRules)), + fromMaybe "-" idField, + fromMaybe "-" description + ] + + rows = headerRow : map entryRow entries + + -- One padder per column, in order; the last column is left as it is. + padders = [padRight, padRight, padLeft, padLeft, padRight, \_ cell -> cell] + widths = [maximum (0 : map (Text.length . (!! column)) rows) | column <- [0 .. 5]] + + renderRow cells = Text.intercalate " " (zipWith3 id padders widths cells) + + padRight width cell = cell <> Text.replicate (max 0 (width - Text.length cell)) " " + padLeft width cell = Text.replicate (max 0 (width - Text.length cell)) " " <> cell + +-- | An entry found at the registry root has no export path of its own. +displayExport :: Text -> Text +displayExport exportPath + | Text.null exportPath = rootExportLabel + | otherwise = exportPath + +runProfileShow :: ProfileShowOptions -> IO () +runProfileShow ProfileShowOptions {registryRef, export = requestedExport, json} = do + (reference, ref, entries) <- loadRegistryOrDie registryRef + RegistryEntry {export = foundExport, spec} <- selectEntry reference entries requestedExport + if json + then LazyByteString.putStrLn (Aeson.encode spec) + else do + traverse_ Text.IO.putStrLn (renderProfileDetail foundExport spec) + traverse_ Text.IO.putStrLn (renderProfileUsage ref foundExport) + +-- | Pick the profile to show. With no @EXPORT@ argument a single-profile +-- registry needs no disambiguation; otherwise the available exports are listed, +-- which is also what an unknown export reports. +selectEntry :: Text -> [RegistryEntry] -> Maybe Text -> IO RegistryEntry +selectEntry reference entries = \case + Nothing -> case entries of + [single] -> pure single + _ -> + dieText + ( "Registry " + <> reference + <> " publishes more than one profile; name one.\n" + <> availableExports entries + ) + Just requested -> case findRegistryEntry requested entries of + Just entry -> pure entry + Nothing -> + dieText + ( "No profile named " + <> requested + <> " in registry " + <> reference + <> "\n" + <> availableExports entries + ) + where + availableExports found = + "Available exports: " + <> Text.intercalate ", " [displayExport exportPath | RegistryEntry {export = exportPath} <- found] + +-- | One profile's complete rule set. Every optional field prints as @(none)@ +-- rather than being omitted, so the output shape does not change between +-- profiles and stays reliable to eyeball or grep. Type rules print in the order +-- the profile declares them, since that order is the author's. +renderProfileDetail :: Text -> ProfileSpec -> [Text] +renderProfileDetail + exportPath + ProfileSpec + { name, + description, + okfVersion, + frontmatter = FrontmatterRules {required, recommended}, + allowUnknownTypes, + allowUnknownFields, + idField, + types = typeRules + } = + [ "export: " <> displayExport exportPath, + "name: " <> name, + "description: " <> renderOptional description, + "okfVersion: " <> okfVersion, + "allowUnknownTypes: " <> renderFlag allowUnknownTypes, + "allowUnknownFields: " <> renderFlag allowUnknownFields, + "idField: " <> renderOptional idField + ] + <> renderFieldRules "" "frontmatter.required" required + <> renderFieldRules "" "frontmatter.recommended" recommended + <> concatMap renderTypeRule typeRules + where + -- A field's prose cannot share a comma-joined line with its neighbours, so + -- a non-empty list becomes a headed block. An empty list keeps the + -- single-line @(none)@ form the other optional fields use. + renderFieldRules indent label [] = [indent <> label <> ": " <> renderList []] + renderFieldRules indent label rules = + (indent <> label <> ":") + : concatMap (renderFieldRule indent) rules + + renderFieldRule indent rule = + [ indent <> " - " <> rule ^. #field <> ": " <> renderOptional (rule ^. #description), + indent <> " allowedValues: " <> renderVocabulary (rule ^. #allowedValues), + indent <> " cardinality: " <> renderCardinality (rule ^. #cardinality), + indent <> " format: " <> maybe "(none)" renderFieldFormat (rule ^. #format), + indent <> " reference: " <> maybe "(none)" renderHandleReferenceRule (rule ^. #reference), + indent <> " when: " <> maybe "(none)" renderCondition (rule ^. #when) + ] + <> case rule ^. #elementFields of + Nothing -> [indent <> " elementFields: (none)"] + Just NestedRules {required = nestedRequired, recommended = nestedRecommended} -> + [indent <> " elementFields:"] + <> renderNestedFieldRules (indent <> " ") "required" nestedRequired + <> renderNestedFieldRules (indent <> " ") "recommended" nestedRecommended + + renderNestedFieldRules indent label [] = [indent <> label <> ": " <> renderList []] + renderNestedFieldRules indent label rules = + (indent <> label <> ":") : concatMap (renderNestedFieldRule indent) rules + + renderNestedFieldRule indent rule = + [ indent <> " - " <> rule ^. #field <> ": " <> renderOptional (rule ^. #description), + indent <> " allowedValues: " <> renderVocabulary (rule ^. #allowedValues), + indent <> " cardinality: " <> renderCardinality (rule ^. #cardinality), + indent <> " format: " <> maybe "(none)" renderFieldFormat (rule ^. #format), + indent <> " when: " <> maybe "(none)" renderCondition (rule ^. #when) + ] + + renderTypeRule + TypeRule + { type_ = ruleType, + description = ruleDescription, + frontmatter = FrontmatterRules {required = typeRequired, recommended = typeRecommended}, + pathPattern, + resourceScheme, + requireSchemaSection, + schemaColumns, + idPrefix + } = + [ "", + "type: " <> ruleType, + " description: " <> renderOptional ruleDescription + ] + <> renderFieldRules " " "frontmatter.required" typeRequired + <> renderFieldRules " " "frontmatter.recommended" typeRecommended + <> [ " pathPattern: " <> renderOptional pathPattern, + " resourceScheme: " <> renderOptional resourceScheme, + " requireSchemaSection: " <> renderFlag requireSchemaSection, + " schemaColumns: " <> renderList schemaColumns, + " idPrefix: " <> renderOptional idPrefix + ] + + renderFlag True = "true" + renderFlag False = "false" + renderOptional = fromMaybe "(none)" + renderList [] = "(none)" + renderList values = Text.intercalate ", " values + renderVocabulary [] = "(any)" + renderVocabulary values = Text.intercalate ", " values + renderCondition FieldCondition {field = sourceField, hasValue} = + sourceField <> " in [" <> Text.intercalate ", " hasValue <> "]" + +-- | The two-line descriptor a user writes to consume the profile with +-- @okf validate --profile@. The reference is quoted in Dhall import syntax, not +-- as the user typed it: Dhall only accepts a path that starts with @.\/@, +-- @..\/@, @~\/@, or @\/@, so a bare relative path is prefixed to stay +-- copy-pasteable. +renderProfileUsage :: RegistryRef -> Text -> [Text] +renderProfileUsage ref exportPath = + [ "", + "Use it with:", + " let registry = " <> dhallImport ref, + " in registry" <> selector + ] + where + selector + | Text.null exportPath = "" + | otherwise = "." <> exportPath + + dhallImport (RegistryExpression expression) = expression + dhallImport (RegistryFile path) + | any (`Text.isPrefixOf` rendered) ["./", "../", "~/", "/"] = rendered + | otherwise = "./" <> rendered + where + rendered = renderRegistryRef (RegistryFile path) + runValidate :: ValidateOptions -> IO () runValidate ValidateOptions {bundlePath, strictMode, profilePath, profileEnforce, logEnforce} = do concepts <- loadBundleOrExit bundlePath @@ -430,10 +798,19 @@ loaded <- loadProfileFile path case loaded of Left err -> dieText ("Failed to load profile " <> Text.pack path <> ": " <> err) - Right spec -> do - let violations = validateProfile spec concepts - mapM_ (Text.IO.hPutStrLn stderr . ("profile: " <>) . renderProfileViolation) violations - pure violations + Right spec -> + case compileProfile spec of + Left definitionErrors -> + dieText + ( "Failed to load profile " + <> Text.pack path + <> ": invalid profile definition:\n" + <> Text.intercalate "\n" (map ((" - " <>) . renderProfileDefinitionError) (toList definitionErrors)) + ) + Right compiled -> do + let violations = validateProfile coreProfile compiled concepts + mapM_ (Text.IO.hPutStrLn stderr . ("profile: " <>) . renderProfileViolation compiled concepts) violations + pure violations let coreFailed = any bundleValidationErrorIsFailure coreErrors profileFailed = profileEnforce && not (null profileViolations) @@ -771,12 +1148,104 @@ bundleValidationErrorIsAdvisory :: BundleValidationError -> Bool bundleValidationErrorIsAdvisory = not . bundleValidationErrorIsFailure -renderProfileViolation :: ProfileViolation -> Text -renderProfileViolation = \case +-- | One deviation as one line. The 'ProfileSpec' is here only so a missing +-- required field can carry the profile's own explanation of what that field is +-- for; every other case ignores it. +renderProfileViolation :: CompiledProfile -> [Concept] -> ProfileViolation -> Text +renderProfileViolation compiled concepts = \case TypeNotInProfile cid ctype -> renderConceptId cid <> ": type not in profile vocabulary: " <> ctype - MissingProfileField cid key -> - renderConceptId cid <> ": missing profile-required field: " <> key + MissingProfileField cid key condition -> + renderConceptId cid + <> ": missing profile-required field: " + <> key + <> renderConditionContext condition + <> renderDescription cid key + MissingRecommendedProfileField cid key condition -> + renderConceptId cid + <> ": missing profile-recommended field: " + <> key + <> renderConditionContext condition + <> renderDescription cid key + MissingNestedProfileField cid fieldPath condition -> + renderConceptId cid + <> ": missing profile-required field: " + <> renderFieldPath fieldPath + <> renderConditionContext condition + MissingRecommendedNestedProfileField cid fieldPath condition -> + renderConceptId cid + <> ": missing profile-recommended field: " + <> renderFieldPath fieldPath + <> renderConditionContext condition + ValueNotInVocabulary cid fieldPath allowed actual -> + renderConceptId cid + <> ": frontmatter value at " + <> renderFieldPath fieldPath + <> " must be one of [" + <> Text.intercalate ", " allowed + <> "], found: " + <> Text.pack (LazyByteString.unpack (Aeson.encode actual)) + CardinalityMismatch cid fieldPath expected actual -> + renderConceptId cid + <> ": frontmatter cardinality at " + <> renderFieldPath fieldPath + <> " must be " + <> renderCardinality expected + <> ", found " + <> valueCardinalityName actual + <> ": " + <> Text.pack (LazyByteString.unpack (Aeson.encode actual)) + ValueFormatMismatch cid fieldPath expected actual -> + renderConceptId cid + <> ": frontmatter value at " + <> renderFieldPath fieldPath + <> " must match format " + <> renderFieldFormat expected + <> ", found: " + <> Text.pack (LazyByteString.unpack (Aeson.encode actual)) + DanglingHandleReference cid fieldPath handle -> + renderConceptId cid + <> ": " + <> renderFieldPath fieldPath + <> " references " + <> handle + <> ", which does not exist in this bundle" + ReferenceHandlePrefixMismatch cid fieldPath actual expectedPrefix -> + renderConceptId cid + <> ": " + <> renderFieldPath fieldPath + <> " references " + <> actual + <> ", which must use prefix " + <> expectedPrefix + MalformedDocumentReference cid fieldPath actual -> + renderConceptId cid + <> ": malformed document reference at " + <> renderFieldPath fieldPath + <> ": " + <> Text.pack (LazyByteString.unpack (Aeson.encode actual)) + ExternalReferenceSchemeNotAllowed cid fieldPath actualScheme allowedSchemes -> + renderConceptId cid + <> ": external reference at " + <> renderFieldPath fieldPath + <> " uses scheme " + <> actualScheme + <> ", allowed schemes: " + <> renderList allowedSchemes + SelfDocumentReference cid fieldPath handle -> + renderConceptId cid + <> ": self reference at " + <> renderFieldPath fieldPath + <> " is not allowed: " + <> handle + FieldNotInProfile cid key -> + renderConceptId cid <> ": frontmatter field not declared by profile: " <> key + NestedElementNotRecord cid fieldPath actual -> + renderConceptId cid + <> ": frontmatter element at " + <> renderFieldPath fieldPath + <> " must be a record, found: " + <> Text.pack (LazyByteString.unpack (Aeson.encode actual)) PathPatternMismatch cid ctype patternText -> renderConceptId cid <> ": " <> ctype <> " must match path pattern: " <> patternText MissingResource cid ctype scheme -> @@ -800,7 +1269,163 @@ DuplicateDocumentId handle cid other -> renderConceptId cid <> ": duplicate document ID " <> handle <> " (also on " <> renderConceptId other <> ")" where + renderDescription cid key = + maybe "" (\prose -> " (" <> prose <> ")") $ do + ctype <- lookup cid [(conceptIdOf concept, conceptType concept) | concept <- concepts] + profileFieldDescriptionForType compiled ctype key + renderConditionContext = maybe "" renderCondition + renderCondition FieldCondition {field = sourceField, hasValue = [expected]} = + " (when " <> sourceField <> " is " <> expected <> ")" + renderCondition FieldCondition {field = sourceField, hasValue} = + " (when " <> sourceField <> " is one of [" <> Text.intercalate ", " hasValue <> "])" renderList xs = "[" <> Text.intercalate ", " xs <> "]" + +renderProfileDefinitionError :: ProfileDefinitionError -> Text +renderProfileDefinitionError = \case + DuplicateTypeRule ctype -> "duplicate type rule: " <> ctype + DuplicateFieldRule scope listName key -> + renderScope scope <> ": duplicate " <> listName <> " field: " <> key + ConflictingFieldRequirement scope key -> + renderScope scope <> ": field appears in required and recommended: " <> key + UnsatisfiableVocabulary scope key profileValues typeValues -> + renderScope scope + <> ": disjoint allowed values for " + <> key + <> " (profile: [" + <> Text.intercalate ", " profileValues + <> "], type: [" + <> Text.intercalate ", " typeValues + <> "])" + ConflictingCardinality scope key profileCardinality typeCardinality -> + renderScope scope + <> ": conflicting cardinality for " + <> key + <> " (profile: " + <> renderCardinality profileCardinality + <> ", type: " + <> renderCardinality typeCardinality + <> ")" + ElementFieldsRequireList scope fieldPath actualCardinality -> + renderScope scope + <> ": elementFields at " + <> renderFieldPath fieldPath + <> " requires list cardinality, found: " + <> renderCardinality actualCardinality + InvalidFormatParameter fieldPath fieldFormat parameter -> + "invalid parameter for format " + <> renderFieldFormat fieldFormat + <> " at " + <> renderFieldPath fieldPath + <> ": " + <> parameter + ConflictingFieldFormat fieldPath profileFormat typeFormat -> + "conflicting formats for " + <> renderFieldPath fieldPath + <> " (profile: " + <> renderFieldFormat profileFormat + <> ", type: " + <> renderFieldFormat typeFormat + <> ")" + EmptyConditionValues scope target source -> + renderConditionDefinition scope target source <> " has an empty hasValue list" + ConditionFieldNotDeclared scope target source -> + renderConditionDefinition scope target source <> " names an undeclared source field" + ConditionFieldNotScalar scope target source actualCardinality -> + renderConditionDefinition scope target source + <> " requires scalar cardinality, found: " + <> renderCardinality actualCardinality + ConditionFieldOpenVocabulary scope target source -> + renderConditionDefinition scope target source <> " requires a non-empty allowedValues vocabulary" + ConditionFieldHasUnreachableValues scope target source unreachable allowed -> + renderConditionDefinition scope target source + <> " contains unreachable values [" + <> Text.intercalate ", " unreachable + <> "]; source allows [" + <> Text.intercalate ", " allowed + <> "]" + SelfConditionalField scope target -> + renderScope scope <> ": field cannot condition its own presence: " <> renderFieldPath target + InvalidReferencePrefix scope target prefix -> + renderScope scope <> ": invalid local reference prefix at " <> renderFieldPath target <> ": " <> prefix + ReferencePrefixNotDeclared scope target prefix -> + renderScope scope + <> ": local reference prefix at " + <> renderFieldPath target + <> " is not declared by any type: " + <> prefix + ReferenceRequiresIdField scope target -> + renderScope scope <> ": reference at " <> renderFieldPath target <> " requires profile idField" + InvalidExternalReferenceScheme scope target scheme -> + renderScope scope <> ": invalid external reference scheme at " <> renderFieldPath target <> ": " <> scheme + ConflictingReferencePrefix ctype target profilePrefix typePrefix -> + "type " + <> ctype + <> " frontmatter: conflicting local reference prefixes for " + <> renderFieldPath target + <> " (profile: " + <> profilePrefix + <> ", type: " + <> typePrefix + <> ")" + ReferenceWithFormat scope target fieldFormat -> + renderScope scope + <> ": reference at " + <> renderFieldPath target + <> " cannot also declare format " + <> renderFieldFormat fieldFormat + where + renderScope Nothing = "profile frontmatter" + renderScope (Just ctype) = "type " <> ctype <> " frontmatter" + renderConditionDefinition scope target source = + renderScope scope + <> ": condition for " + <> renderFieldPath target + <> " on " + <> renderFieldPath source + +renderCardinality :: Cardinality -> Text +renderCardinality = \case + Any -> "any" + Scalar -> "scalar" + List -> "list" + +renderFieldFormat :: FieldFormat -> Text +renderFieldFormat = \case + Rfc3339Utc -> "rfc3339-utc" + Date -> "date" + Uri -> "uri" + UriWithScheme scheme -> "uri-with-scheme(" <> scheme <> ")" + DocumentHandle prefix -> "document-handle(" <> prefix <> ")" + +renderHandleReferenceRule :: HandleReferenceRule -> Text +renderHandleReferenceRule HandleReferenceRule {localPrefix, externalUriSchemes, allowSelf} = + "local-prefix(" + <> localPrefix + <> "), external-uri-schemes(" + <> renderList externalUriSchemes + <> "), allow-self(" + <> (if allowSelf then "true" else "false") + <> ")" + where + renderList xs = "[" <> Text.intercalate ", " xs <> "]" + +valueCardinalityName :: Aeson.Value -> Text +valueCardinalityName = \case + Aeson.Array _ -> "list" + Aeson.String _ -> "scalar" + Aeson.Number _ -> "scalar" + Aeson.Bool _ -> "scalar" + Aeson.Object _ -> "object" + Aeson.Null -> "null" + +renderFieldPath :: FieldPath -> Text +renderFieldPath (FieldPath pathSegments) = go (toList pathSegments) + where + go [] = "" + go (FieldName name : rest) = name <> foldMap renderSegment rest + go (ArrayIndex elementIndex : rest) = Text.pack (show elementIndex) <> foldMap renderSegment rest + renderSegment (FieldName name) = "." <> name + renderSegment (ArrayIndex elementIndex) = "[" <> Text.pack (show elementIndex) <> "]" renderValidationErrorText :: ValidationError -> Text renderValidationErrorText = \case diff --git a/src/Okf/Cli/Config.hs b/src/Okf/Cli/Config.hs --- a/src/Okf/Cli/Config.hs +++ b/src/Okf/Cli/Config.hs @@ -3,6 +3,7 @@ ( OkfConfig (..), KitSettings (..), AssistSettings (..), + ProfileSettings (..), OkfProvider (..), ConfigSource (..), defaultOkfConfig, @@ -23,6 +24,7 @@ import Dhall (FromDhall (..), auto, genericAutoWith) import Dhall qualified import Okf.Prelude +import Okf.Profile.Registry (defaultRegistryReference) import System.Directory (doesFileExist, getCurrentDirectory, getHomeDirectory) import System.Environment (lookupEnv) import System.FilePath (()) @@ -59,9 +61,27 @@ deriving stock (Generic, Eq, Show) deriving anyclass (FromDhall) +-- | Profile-related settings: which registry @okf profile@ reads by default. +data ProfileSettings = ProfileSettings + { registry :: !Text + } + deriving stock (Generic, Eq, Show) + deriving anyclass (FromDhall) + -- | The whole okf configuration. data OkfConfig = OkfConfig { kit :: !KitSettings, + assist :: !AssistSettings, + profiles :: !ProfileSettings + } + deriving stock (Generic, Eq, Show) + deriving anyclass (FromDhall) + +-- | The configuration record as okf 0.2.0.0 defined it, before @profiles@ was +-- added. Dhall decodes records strictly, so without this fallback every config +-- file written for 0.2.0.0 would stop loading the moment a field was added. +data LegacyOkfConfig = LegacyOkfConfig + { kit :: !KitSettings, assist :: !AssistSettings } deriving stock (Generic, Eq, Show) @@ -89,9 +109,17 @@ { provider = ProviderClaude, model = Nothing, systemPrompt = Nothing - } + }, + profiles = defaultProfileSettings } +-- | The profile settings a config file that predates @profiles@ is given. +defaultProfileSettings :: ProfileSettings +defaultProfileSettings = + ProfileSettings + { registry = defaultRegistryReference + } + okfConfigEnvVar :: String okfConfigEnvVar = "OKF_CONFIG" @@ -132,16 +160,38 @@ -- | Load the effective configuration and report its source. A parse or type -- error in a found file is returned as 'Left'; a missing file yields defaults. +-- +-- A file that does not decode against the current record is retried against the +-- 0.2.0.0 shape, which had no @profiles@ field; on success the built-in default +-- registry fills the gap, so upgrading okf does not invalidate a config file the +-- user already wrote. If the retry also fails, the /first/ error is reported, +-- because that message describes the schema the user should be writing against. loadOkfConfig :: IO (Either Text (OkfConfig, ConfigSource)) loadOkfConfig = do configSource <- findConfigSource case sourcePath configSource of Nothing -> pure (Right (defaultOkfConfig, configSource)) - Just path -> - ( do - config <- Dhall.inputFile auto path - pure (Right (config, configSource)) - ) + Just path -> do + current <- tryDecode (Dhall.inputFile auto path) + case current of + Right config -> pure (Right (config, configSource)) + Left currentError -> do + legacy <- tryDecode (Dhall.inputFile auto path) + pure $ case legacy of + Left _legacyError -> Left currentError + Right LegacyOkfConfig {kit = legacyKit, assist = legacyAssist} -> + Right + ( OkfConfig + { kit = legacyKit, + assist = legacyAssist, + profiles = defaultProfileSettings + }, + configSource + ) + where + tryDecode :: IO a -> IO (Either Text a) + tryDecode action = + (Right <$> action) `catch` \(exception :: SomeException) -> pure (Left (Text.pack (show exception))) @@ -166,14 +216,16 @@ renderConfig OkfConfig { kit = KitSettings {repoUrl, providers}, - assist = AssistSettings {provider, model, systemPrompt} + assist = AssistSettings {provider, model, systemPrompt}, + profiles = ProfileSettings {registry} } = Text.unlines [ "kit.repoUrl = " <> repoUrl, "kit.providers = " <> renderProviders providers, "assist.provider = " <> renderProvider provider, "assist.model = " <> fromMaybe "(unset)" model, - "assist.systemPrompt = " <> fromMaybe "(unset)" systemPrompt + "assist.systemPrompt = " <> fromMaybe "(unset)" systemPrompt, + "profiles.registry = " <> registry ] renderProviders :: [OkfProvider] -> Text @@ -198,6 +250,9 @@ " { provider = Provider.Claude", " , model = None Text", " , systemPrompt = None Text", + " }", + " , profiles =", + " { registry = \"" <> defaultRegistryReference <> "\"", " }", " }" ] diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -13,6 +13,8 @@ import Okf.Cli.Help (HelpTopic (..), helpTopics) import Okf.ConceptId (parseConceptId) import Okf.Document (parseDocument) +import Okf.Profile (Cardinality (..), FieldCondition (..), FieldFormat (..), FieldRule (..), FrontmatterRules (..), HandleReferenceRule (..), NestedFieldRule (..), NestedRules (..), ProfileSpec (..), TypeRule (..)) +import Okf.Profile.Registry (RegistryEntry (..)) import Options.Applicative import System.Directory (createDirectoryIfMissing, getCurrentDirectory, getTemporaryDirectory, removeDirectoryRecursive, withCurrentDirectory) import System.Environment (lookupEnv, setEnv, unsetEnv) @@ -26,6 +28,7 @@ configDefaults <- testConfigDefaults configProjectPrecedence <- testConfigProjectPrecedence configEnvPrecedence <- testConfigEnvPrecedence + configLegacyWithoutProfiles <- testConfigLegacyWithoutProfiles configInvalidDhall <- testConfigInvalidDhall assistCommandBuilder <- testAssistCommandBuilder assistModelOverride <- testAssistModelOverride @@ -175,12 +178,33 @@ == "'/opt/o'\\''kf/okf' show 'b' {2}", sampleConceptDisplays == ["tables/orders\tTable\tOrders", "x \t \t"], + parseSucceeds ["profile"], + parseSucceeds ["profile", "list"], + parseSucceeds ["profile", "list", "--json"], + parseSucceeds ["profile", "list", "--registry", "./r.dhall"], + parseSucceeds ["profile", "show"], + parseSucceeds ["profile", "show", "postgresql"], + parseProfileMatches ["profile"] (ProfileList (ProfileListOptions Nothing False)), + parseProfileMatches + ["profile", "list", "--registry", "r", "--json"] + (ProfileList (ProfileListOptions (Just "r") True)), + parseProfileMatches + ["profile", "show", "x", "--registry", "r", "--json"] + (ProfileShow (ProfileShowOptions (Just "r") (Just "x") True)), + parseProfileMatches + ["profile", "show"] + (ProfileShow (ProfileShowOptions Nothing Nothing False)), + renderRegistryTable sampleRegistryEntries == sampleRegistryTable, + renderProfileDetail "nested.decisions" sampleDecisionsProfile == sampleProfileDetail, + renderProfileDetail "" samplePostgresqlProfile == sampleUndocumentedProfileDetail, + renderProfileDetail "" sampleNestedProfile == sampleNestedProfileDetail, parseShowsInfo ["--version"], parseFails ["hello"], logAddWrites, configDefaults, configProjectPrecedence, configEnvPrecedence, + configLegacyWithoutProfiles, configInvalidDhall, assistCommandBuilder, assistModelOverride @@ -216,6 +240,265 @@ Success (Options (Validate opts)) -> opts == expected _ -> False +-- | One root-level entry and one nested entry whose columns differ in width, so +-- the padding in 'renderRegistryTable' is actually exercised, and the @(root)@ +-- and @-@ placeholders both appear. +sampleRegistryEntries :: [RegistryEntry] +sampleRegistryEntries = + [ RegistryEntry {export = "", spec = samplePostgresqlProfile}, + RegistryEntry {export = "nested.decisions", spec = sampleDecisionsProfile} + ] + +-- | @DESCRIPTION@ is last and unpadded; the postgresql sample has none, so the +-- @-@ placeholder appears there as well as in @ID FIELD@. +sampleRegistryTable :: [Text.Text] +sampleRegistryTable = + [ "EXPORT NAME OKF TYPES ID FIELD DESCRIPTION", + "(root) shinzui-postgresql 0.1 1 - -", + "nested.decisions decisions 0.1 1 docId How this team records architectural decisions." + ] + +-- | A profile with no descriptions anywhere — the shape an okf 0.2.x descriptor +-- upgrades into. +samplePostgresqlProfile :: ProfileSpec +samplePostgresqlProfile = + ProfileSpec + { name = "shinzui-postgresql", + description = Nothing, + okfVersion = "0.1", + frontmatter = + FrontmatterRules + { required = [undocumentedField "type", undocumentedField "title"], + recommended = [] + }, + allowUnknownTypes = False, + allowUnknownFields = True, + idField = Nothing, + types = + [ TypeRule + { type_ = "PostgreSQL Table", + description = Nothing, + frontmatter = FrontmatterRules {required = [], recommended = []}, + pathPattern = Just "schemas/*/tables/*", + resourceScheme = Just "postgresql", + requireSchemaSection = True, + schemaColumns = ["Column", "Type"], + idPrefix = Nothing + } + ] + } + +sampleDecisionsProfile :: ProfileSpec +sampleDecisionsProfile = + ProfileSpec + { name = "decisions", + description = Just "How this team records architectural decisions.", + okfVersion = "0.1", + frontmatter = + FrontmatterRules + { required = + [ FieldRule + { field = "type", + description = Just "The OKF concept type; must be a type rule below.", + allowedValues = [], + cardinality = Any, + format = Nothing, + elementFields = Nothing, + reference = Nothing, + when = Nothing + }, + undocumentedField "title" + ], + recommended = [] + }, + allowUnknownTypes = False, + allowUnknownFields = True, + idField = Just "docId", + types = + [ TypeRule + { type_ = "Decision Record", + description = Just "One accepted decision, never edited after acceptance.", + frontmatter = + FrontmatterRules + { required = [FieldRule "owner" (Just "Person responsible for the decision.") [] Scalar (Just (DocumentHandle "USR")) Nothing Nothing Nothing], + recommended = [FieldRule "reviewer" Nothing ["Ari", "Bo"] List Nothing Nothing (Just (HandleReferenceRule "ADR" ["mori"] False)) Nothing] + }, + pathPattern = Just "decisions/*", + resourceScheme = Nothing, + requireSchemaSection = False, + schemaColumns = [], + idPrefix = Just "ADR" + } + ] + } + +undocumentedField :: Text.Text -> FieldRule +undocumentedField key = FieldRule {field = key, description = Nothing, allowedValues = [], cardinality = Any, format = Nothing, elementFields = Nothing, reference = Nothing, when = Nothing} + +sampleNestedProfile :: ProfileSpec +sampleNestedProfile = + ProfileSpec + { name = "nested", + description = Nothing, + okfVersion = "0.1", + frontmatter = + FrontmatterRules + { required = + [ FieldRule + "reviews" + Nothing + [] + Any + Nothing + ( Just + NestedRules + { required = [NestedFieldRule "outcome" Nothing ["approved", "rejected"] Any Nothing (Just (FieldCondition "kind" ["model"]))], + recommended = [NestedFieldRule "notes" Nothing [] Scalar Nothing Nothing] + } + ) + Nothing + Nothing + ], + recommended = [] + }, + allowUnknownTypes = True, + allowUnknownFields = True, + idField = Nothing, + types = [] + } + +sampleNestedProfileDetail :: [Text.Text] +sampleNestedProfileDetail = + [ "export: (root)", + "name: nested", + "description: (none)", + "okfVersion: 0.1", + "allowUnknownTypes: true", + "allowUnknownFields: true", + "idField: (none)", + "frontmatter.required:", + " - reviews: (none)", + " allowedValues: (any)", + " cardinality: any", + " format: (none)", + " reference: (none)", + " when: (none)", + " elementFields:", + " required:", + " - outcome: (none)", + " allowedValues: approved, rejected", + " cardinality: any", + " format: (none)", + " when: kind in [model]", + " recommended:", + " - notes: (none)", + " allowedValues: (any)", + " cardinality: scalar", + " format: (none)", + " when: (none)", + "frontmatter.recommended: (none)" + ] + +-- | Every optional field prints, as @(none)@ when absent, so the shape does not +-- shift between profiles. A non-empty frontmatter list becomes a headed block, +-- one key per line, since per-field prose cannot share a comma-joined line. +sampleProfileDetail :: [Text.Text] +sampleProfileDetail = + [ "export: nested.decisions", + "name: decisions", + "description: How this team records architectural decisions.", + "okfVersion: 0.1", + "allowUnknownTypes: false", + "allowUnknownFields: true", + "idField: docId", + "frontmatter.required:", + " - type: The OKF concept type; must be a type rule below.", + " allowedValues: (any)", + " cardinality: any", + " format: (none)", + " reference: (none)", + " when: (none)", + " elementFields: (none)", + " - title: (none)", + " allowedValues: (any)", + " cardinality: any", + " format: (none)", + " reference: (none)", + " when: (none)", + " elementFields: (none)", + "frontmatter.recommended: (none)", + "", + "type: Decision Record", + " description: One accepted decision, never edited after acceptance.", + " frontmatter.required:", + " - owner: Person responsible for the decision.", + " allowedValues: (any)", + " cardinality: scalar", + " format: document-handle(USR)", + " reference: (none)", + " when: (none)", + " elementFields: (none)", + " frontmatter.recommended:", + " - reviewer: (none)", + " allowedValues: Ari, Bo", + " cardinality: list", + " format: (none)", + " reference: local-prefix(ADR), external-uri-schemes([mori]), allow-self(false)", + " when: (none)", + " elementFields: (none)", + " pathPattern: decisions/*", + " resourceScheme: (none)", + " requireSchemaSection: false", + " schemaColumns: (none)", + " idPrefix: ADR" + ] + +-- | A profile carrying no descriptions at all still prints every line, so the +-- output shape does not shift between an okf 0.2.x descriptor and a documented +-- one. +sampleUndocumentedProfileDetail :: [Text.Text] +sampleUndocumentedProfileDetail = + [ "export: (root)", + "name: shinzui-postgresql", + "description: (none)", + "okfVersion: 0.1", + "allowUnknownTypes: false", + "allowUnknownFields: true", + "idField: (none)", + "frontmatter.required:", + " - type: (none)", + " allowedValues: (any)", + " cardinality: any", + " format: (none)", + " reference: (none)", + " when: (none)", + " elementFields: (none)", + " - title: (none)", + " allowedValues: (any)", + " cardinality: any", + " format: (none)", + " reference: (none)", + " when: (none)", + " elementFields: (none)", + "frontmatter.recommended: (none)", + "", + "type: PostgreSQL Table", + " description: (none)", + " frontmatter.required: (none)", + " frontmatter.recommended: (none)", + " pathPattern: schemas/*/tables/*", + " resourceScheme: postgresql", + " requireSchemaSection: true", + " schemaColumns: Column, Type", + " idPrefix: (none)" + ] + +parseProfileMatches :: [String] -> ProfileCommand -> Bool +parseProfileMatches args expected = + case execParserPure defaultPrefs parserInfo args of + Success (Options (Profile profileCommand)) -> profileCommand == expected + _ -> False + parseLogMatches :: [String] -> LogOptions -> Bool parseLogMatches args expected = case execParserPure defaultPrefs parserInfo args of @@ -300,6 +583,34 @@ configSource <- findConfigSource loaded <- loadOkfConfig pure (configSource == SourceEnv envPath && loaded == Right (defaultOkfConfig, SourceEnv envPath)) + +-- | A config file written for okf 0.2.0.0 has no @profiles@ field. It must +-- still load, with the built-in default registry filled in — otherwise adding a +-- field to the record would break every existing config file. +testConfigLegacyWithoutProfiles :: IO Bool +testConfigLegacyWithoutProfiles = + withIsolatedConfigEnv "okf-cli-config-legacy" $ do + projectPath <- projectConfigPath + Text.IO.writeFile projectPath legacyConfigText + loaded <- loadOkfConfig + pure (loaded == Right (defaultOkfConfig, SourceProject projectPath)) + +-- | Verbatim okf 0.2.0.0 configuration: the record before @profiles@ existed. +legacyConfigText :: Text.Text +legacyConfigText = + Text.unlines + [ "let Provider = < Claude | Codex >", + "in { kit =", + " { repoUrl = \"https://github.com/shinzui/okf-kit.git\"", + " , providers = [ Provider.Claude ]", + " }", + " , assist =", + " { provider = Provider.Claude", + " , model = None Text", + " , systemPrompt = None Text", + " }", + " }" + ] testConfigInvalidDhall :: IO Bool testConfigInvalidDhall =