;;; vulpea-schema.el --- Note schema definition and validation -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2015-2026 Boris Buliga <boris@d12frosted.io>
;;
;; Author: Boris Buliga <boris@d12frosted.io>
;; Maintainer: Boris Buliga <boris@d12frosted.io>
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see
;; <http://www.gnu.org/licenses/>.
;;
;; This file is not part of GNU Emacs.
;;
;; Created: 12 Jun 2026
;;
;; URL: https://github.com/d12frosted/vulpea
;;
;; License: GPLv3
;;
;;; Commentary:
;;
;; Declarative schemas for vulpea notes.
;;
;; A schema describes the structured expectations for a class of notes:
;; which notes it applies to (a predicate) and which metadata fields they
;; should carry, with types, required-ness, and allowed values.
;;
;; This file provides schema definition and the registry.  The validation
;; engine (`vulpea-schema-validate' and friends) is layered on top in the
;; same module.
;;
;; A field spec is a plist with keys:
;;
;;   :key       metadata key string (required)
;;   :type      value type: `string' (default), `number', `symbol',
;;              `note', `link', `date', or `datetime'.  Values are read
;;              with `vulpea-note-meta-get', so the type vocabulary
;;              matches the rest of vulpea.  A `date' field holds a
;;              plain org timestamp without a time part, a `datetime'
;;              field one with a time part; both accept active and
;;              inactive brackets and read as a `vulpea-timestamp'.
;;   :active    for a `date' / `datetime' field, whether the authoring
;;              prompts write an active timestamp (default t; nil
;;              writes inactive).  Prompt-side only: validation accepts
;;              both forms either way, and an existing value keeps its
;;              brackets.
;;   :default   a default value, or a function (note) -> value.  The
;;              guided flow (`vulpea-schema-insert-fields') writes it
;;              silently instead of prompting; the single-field command
;;              prompts with it prefilled.  For a `date' / `datetime'
;;              field a string default is `org-read-date' input,
;;              relative (\"+3d\", \"+1w\", \"+3d 14:00\") or absolute
;;              (\"2026-12-31\"), honoring :active; any other string
;;              shape errors rather than silently resolving to today.
;;              A function returning nil declines, falling back to
;;              prompting.  Defaults do not affect validation.
;;   :required  t/nil, or a function (note) -> boolean for conditional
;;              requiredness (e.g. required only for sparkling wines).
;;   :one-of    a list of allowed values, or a function (note) -> list for
;;              a dependent enum (e.g. sweetness levels depend on
;;              carbonation).
;;   :multiple  non-nil when the field holds a list of values.
;;   :target-tags  for a `note' field, a list of tags its target must
;;              carry (all of them); a missing tag yields an
;;              `invalid-target' violation.
;;   :target-tags-any  same, but the target only has to carry one of
;;              the listed tags.  Declared next to :target-tags both
;;              hold: every tag of the former, at least one of the
;;              latter.
;;   :validate  optional function (value note) -> t, or an error message
;;              string, for arbitrary checks.
;;
;; Example:
;;
;;   (vulpea-schema-define 'wine
;;     :predicate (lambda (note) (member "wine" (vulpea-note-tags note)))
;;     :fields
;;     '((:key "producer" :type note   :required t)
;;       (:key "name"     :type string :required t)
;;       (:key "colour"   :type symbol :required t :one-of (red white rose))
;;       (:key "grapes"   :type note   :multiple t)
;;       (:key "carbonation method" :type symbol
;;             :required (lambda (note)
;;                         (eq (vulpea-note-meta-get note "carbonation" 'symbol)
;;                             'sparkling)))))
;;
;; To read a sibling field inside a :required / :one-of function, use
;; `vulpea-note-meta-get' directly so you control the value type.
;;
;; A schema may inherit fields from others with `:include' (a schema
;; name or a list of names).  Included fields are merged in before the
;; schema's own; on a :key collision the later definition wins, so a
;; schema's own field overrides an included one.  See
;; `vulpea-schema-define' for the full merge rules.
;;
;; A schema may omit :predicate entirely.  Such a schema is abstract:
;; it applies to no note and exists to be included - the way to share
;; a set of fields between schemas:
;;
;;   (vulpea-schema-define 'common
;;     :fields '((:key "status" :one-of (todo done))
;;               (:key "duration" :type number)))
;;
;;   (vulpea-schema-define 'book
;;     :predicate (lambda (note) (member "book" (vulpea-note-tags note)))
;;     :include 'common
;;     :fields '((:key "status" :one-of (unread read))))
;;
;; Two schemas can share a key yet differ in detail, since the later
;; definition wins.  Includes resolve at definition time: define
;; mixins first, and re-defining a mixin does not update schemas that
;; already included it - re-evaluate them too.
;;
;;; Code:

(require 'cl-lib)
(require 'ol)
(require 'vulpea-note)
(require 'vulpea-timestamp)
(require 'vulpea-utils)
(require 'vulpea-db-query)

;;; Schema structure

(cl-defstruct (vulpea-schema (:constructor vulpea-schema--create)
                             (:copier nil))
  "A schema describing structured expectations for a class of notes.

Slots:
  name      - symbol identifying the schema
  predicate - function (note) -> non-nil selecting notes it applies to
  fields    - list of field spec plists (see Commentary)
  includes  - names of the schemas this one inherits fields from"
  name
  predicate
  fields
  includes)

;;; Registry

(defvar vulpea-schema--registry (make-hash-table :test 'eq)
  "Registry of defined schemas, keyed by name symbol.")

(defun vulpea-schema--merge-fields (field-lists)
  "Merge FIELD-LISTS, a list of field-spec lists, into a single list.
The lists are processed in order; a later field spec overrides an
earlier one with the same :key, whether the duplicate falls within a
single list or across lists, while an overridden field keeps the
position of its first appearance.  Used to fold the fields of included
schemas into a schema that names them in :include."
  (let ((order nil)
        (by-key (make-hash-table :test 'equal)))
    (dolist (fields field-lists)
      (dolist (field fields)
        (let ((key (plist-get field :key)))
          (unless (gethash key by-key)
            (push key order))
          (puthash key field by-key))))
    (mapcar (lambda (key) (gethash key by-key)) (nreverse order))))

(cl-defun vulpea-schema-define (name &key predicate fields include)
  "Define and register a schema called NAME.

PREDICATE is a function (note) -> non-nil when the schema applies to
the note.  It may be omitted: a schema without a predicate is
abstract - it applies to no note and exists to be named in another
schema's INCLUDE, as a mixin of shared fields (see
`vulpea-schema-abstract-p').  FIELDS is a list of field spec plists
\(see Commentary for the supported keys).

INCLUDE names another schema to inherit fields from - a schema name
symbol, a `vulpea-schema' object, or a list of either.  The included
schemas contribute their fields first (multiple includes merged
left-to-right), then FIELDS.  When a :key appears more than once the
later definition wins, so FIELDS overrides an included field and a
later include overrides an earlier one; an overridden field keeps the
position of its first appearance.  Includes are resolved now, so an
included schema must already be registered, and re-defining it later
does not retroactively update schemas that included it.

Registering a schema with an existing NAME replaces it.  Returns the
`vulpea-schema' object."
  (unless (symbolp name)
    (error "Schema name must be a symbol: %S" name))
  (unless (or (null predicate) (functionp predicate))
    (error "Schema :predicate must be a function"))
  (dolist (field fields)
    (unless (and (plist-member field :key)
                 (stringp (plist-get field :key)))
      (error "Schema field must have a string :key: %S" field)))
  (let* ((includes (cond
                    ((null include) nil)
                    ((or (symbolp include) (vulpea-schema-p include)) (list include))
                    ((listp include) include)
                    (t (error "Schema :include must be a symbol, a schema, or a list of them: %S"
                              include))))
         (inherited (mapcar (lambda (s)
                              (vulpea-schema-fields (vulpea-schema--resolve s)))
                            includes))
         (include-names (mapcar (lambda (s)
                                  (if (vulpea-schema-p s) (vulpea-schema-name s) s))
                                includes))
         (schema (vulpea-schema--create
                  :name name
                  :predicate predicate
                  :includes include-names
                  :fields (vulpea-schema--merge-fields
                           (append inherited (list fields))))))
    (puthash name schema vulpea-schema--registry)
    schema))

(defun vulpea-schema-get (name)
  "Return the registered schema called NAME, or nil."
  (gethash name vulpea-schema--registry))

(defun vulpea-schema-list ()
  "Return the list of registered schema names."
  (let (names)
    (maphash (lambda (k _v) (push k names)) vulpea-schema--registry)
    (nreverse names)))

(defun vulpea-schema-unregister (name)
  "Remove the schema called NAME from the registry."
  (remhash name vulpea-schema--registry))

(defun vulpea-schema--resolve (schema-or-name)
  "Return a `vulpea-schema' from SCHEMA-OR-NAME.

SCHEMA-OR-NAME is either a `vulpea-schema' object or the symbol name of
a registered schema.  Signals an error when a name is not registered."
  (cond
   ((vulpea-schema-p schema-or-name) schema-or-name)
   ((symbolp schema-or-name)
    (or (vulpea-schema-get schema-or-name)
        (error "No schema registered as %S" schema-or-name)))
   (t (error "Not a schema or schema name: %S" schema-or-name))))

;;; Field access

(defun vulpea-schema-field-value (note field)
  "Return the value of FIELD for NOTE, read with the field's declared type.

FIELD is a field spec plist or a bare metadata key string (in which
case the type defaults to `string').  Reads from the note's
already-extracted metadata via `vulpea-note-meta-get'.  When the field
spec is :multiple, returns a list of values."
  (let* ((spec (if (stringp field) (list :key field) field))
         (key (plist-get spec :key))
         (type (or (plist-get spec :type) 'string)))
    (if (plist-get spec :multiple)
        (vulpea-note-meta-get-list note key type)
      (vulpea-note-meta-get note key type))))

;;; Predicate

(defun vulpea-schema-applies-p (note schema-or-name)
  "Return non-nil when SCHEMA-OR-NAME's predicate matches NOTE.

SCHEMA-OR-NAME is a `vulpea-schema' object or a registered schema
name.  An abstract schema (one defined without a predicate) applies
to nothing."
  (let* ((schema (vulpea-schema--resolve schema-or-name))
         (predicate (vulpea-schema-predicate schema)))
    (and predicate (funcall predicate note))))

(defun vulpea-schema-abstract-p (schema-or-name)
  "Return non-nil when SCHEMA-OR-NAME is abstract (has no predicate).

An abstract schema applies to no note; it exists to be included by
other schemas as a mixin of shared fields.  It can still be validated
against directly (`vulpea-schema-validate' never consults the
predicate) and is offered by `vulpea-schema-insert-fields' when no
schema applies to the buffer."
  (null (vulpea-schema-predicate (vulpea-schema--resolve schema-or-name))))

;;; Validation

(cl-defstruct (vulpea-violation (:copier nil))
  "A single schema violation found on a note.

Slots:
  note-id    - id of the offending note
  note-title - title of the offending note
  schema     - name of the schema that was violated
  field      - metadata key of the offending field
  type       - violation type symbol (see `vulpea-schema-validate')
  message    - human-readable description
  value      - the offending value, when applicable"
  note-id note-title schema field type message value)

(defun vulpea-schema--call-or-value (spec note)
  "Resolve SPEC for NOTE: call it when a function, otherwise return it.
Used for field keys like :required and :one-of that accept either a
literal or a function of the note."
  (if (functionp spec) (funcall spec note) spec))

(defun vulpea-schema--coerce (raw type)
  "Coerce the RAW string value to TYPE for comparison."
  (pcase type
    ('number (string-to-number raw))
    ('symbol (intern raw))
    ((or 'date 'datetime) (or (vulpea-timestamp-parse raw) raw))
    (_ raw)))

(defun vulpea-schema--link-id (raw)
  "Return the note id referenced by RAW, or nil when RAW is not an id link.
Accepts a bracket link \"[[id:UUID][desc]]\" or a bare UUID."
  (cond
   ((string-match org-link-bracket-re raw)
    (let ((link (match-string 1 raw)))
      (when (string-prefix-p "id:" link)
        (string-remove-prefix "id:" link))))
   ((string-match-p (concat "\\`" vulpea-utils--uuid-regexp "\\'") raw)
    raw)))

(defun vulpea-schema--violation (note schema field type message value)
  "Build a `vulpea-violation' for NOTE on SCHEMA's FIELD of TYPE.
MESSAGE describes the problem and VALUE is the offending value."
  (make-vulpea-violation
   :note-id (vulpea-note-id note)
   :note-title (vulpea-note-title note)
   :schema (vulpea-schema-name schema)
   :field (plist-get field :key)
   :type type
   :message message
   :value value))

(defun vulpea-schema--target-tags-violation (target id field note schema)
  "Return a violation on FIELD's target-tag restrictions, or nil when met.

TARGET is the resolved `vulpea-note' referenced by FIELD on NOTE, and ID
is its id (used in the message and as the offending value).  SCHEMA owns
the field.  Every tag in :target-tags must be present (all-of) and at
least one tag in :target-tags-any (any-of); the two compose when both
are declared.  The all-of check names the missing tags, the any-of one
names the whole set."
  (let* ((tags (vulpea-note-tags target))
         (key (plist-get field :key))
         (required (plist-get field :target-tags))
         (any (plist-get field :target-tags-any))
         (missing (cl-remove-if (lambda (tag) (member tag tags)) required)))
    (cond
     (missing
      (vulpea-schema--violation
       note schema field 'invalid-target
       (format "Field %S target %s is missing required tag(s) %S"
               key id missing)
       id))
     ((and any (not (cl-some (lambda (tag) (member tag tags)) any)))
      (vulpea-schema--violation
       note schema field 'invalid-target
       (format "Field %S target %s carries none of the required tag(s) %S"
               key id any)
       id)))))

(defun vulpea-schema--value-violation (raw field note schema)
  "Return a violation for the RAW value of FIELD on NOTE, or nil when valid.
SCHEMA is the owning schema.  Checks, in order: type, reference
resolution and target-tag restrictions (for `note' fields), allowed
values, then a custom :validate function.  Returns the first problem
found."
  (let* ((key (plist-get field :key))
         (type (or (plist-get field :type) 'string))
         (one-of (vulpea-schema--call-or-value (plist-get field :one-of) note))
         (validate (plist-get field :validate)))
    (or
     ;; type / reference checks
     (pcase type
       ('number
        (unless (string-match-p "\\`[ \t]*-?[0-9][0-9.]*[ \t]*\\'" raw)
          (vulpea-schema--violation
           note schema field 'wrong-type
           (format "Field %S expected a number, got %S" key raw) raw)))
       ((or 'note 'link)
        (let ((id (vulpea-schema--link-id raw)))
          (cond
           ((null id)
            (vulpea-schema--violation
             note schema field 'wrong-type
             (format "Field %S expected an id link, got %S" key raw) raw))
           ;; `link' fields only check the id-link shape; `note' fields
           ;; additionally resolve the target and enforce its tags.
           ((eq type 'note)
            (let ((target (vulpea-db-get-by-id id)))
              (if (not target)
                  (vulpea-schema--violation
                   note schema field 'invalid-reference
                   (format "Field %S references missing note %s" key id) id)
                (vulpea-schema--target-tags-violation
                 target id field note schema)))))))
       ((or 'date 'datetime)
        (let ((ts (vulpea-timestamp-parse raw)))
          (cond
           ((null ts)
            (vulpea-schema--violation
             note schema field 'wrong-type
             (format "Field %S expected an org timestamp, got %S" key raw)
             raw))
           ((and (eq type 'date) (vulpea-timestamp-with-time ts))
            (vulpea-schema--violation
             note schema field 'wrong-type
             (format "Field %S expected a date without time, got %S" key raw)
             raw))
           ((and (eq type 'datetime) (not (vulpea-timestamp-with-time ts)))
            (vulpea-schema--violation
             note schema field 'wrong-type
             (format "Field %S expected a date with time, got %S" key raw)
             raw))))))
     ;; allowed values (not meaningful for references and dates)
     (when (and one-of (not (memq type '(note link date datetime))))
       (let ((typed (vulpea-schema--coerce raw type)))
         (unless (member typed one-of)
           (vulpea-schema--violation
            note schema field 'disallowed-value
            (format "Field %S value %S is not one of %S" key typed one-of)
            typed))))
     ;; custom validator
     (when validate
       (let* ((typed (vulpea-schema--coerce raw type))
              (result (funcall validate typed note)))
         (unless (eq result t)
           (vulpea-schema--violation
            note schema field 'invalid-value
            (if (stringp result) result
              (format "Field %S failed validation" key))
            typed)))))))

(defun vulpea-schema--field-violations (note field schema)
  "Return the list of violations for FIELD on NOTE against SCHEMA."
  (let* ((key (plist-get field :key))
         (required (vulpea-schema--call-or-value (plist-get field :required) note))
         (raws (vulpea-note-meta-get-list note key 'string)))
    (cond
     ((and required (null raws))
      (list (vulpea-schema--violation
             note schema field 'missing-required
             (format "Required field %S is missing" key) nil)))
     ((null raws) nil)
     (t (delq nil
              (mapcar (lambda (raw)
                        (vulpea-schema--value-violation raw field note schema))
                      raws))))))

(defun vulpea-schema-validate (note schema-or-name)
  "Return the list of `vulpea-violation' for NOTE against SCHEMA-OR-NAME.

SCHEMA-OR-NAME is a `vulpea-schema' object or a registered schema name.
Each field is checked for the following problem types:

- `missing-required'   a required field has no value
- `wrong-type'         a value does not match the field's declared type
- `invalid-reference'  a `note' field links to a non-existent note
- `invalid-target'     a `note' field's target fails its tag restrictions
- `disallowed-value'   a value is not in the field's :one-of set
- `invalid-value'      a value is rejected by the field's :validate function

The note is validated as given; the schema's predicate is not consulted
here (see `vulpea-schema-validate-all')."
  (let ((schema (vulpea-schema--resolve schema-or-name)))
    (cl-loop for field in (vulpea-schema-fields schema)
             append (vulpea-schema--field-violations note field schema))))

(defun vulpea-schema-validate-notes (notes schema-or-name)
  "Return all violations for NOTES against SCHEMA-OR-NAME.

NOTES is any list of `vulpea-note' objects; every note is validated
regardless of the schema's predicate.  To validate only the notes a
schema applies to, filter with `vulpea-schema-applies-p' first, or use
`vulpea-schema-validate-all'."
  (let ((schema (vulpea-schema--resolve schema-or-name)))
    (cl-loop for note in notes
             append (vulpea-schema-validate note schema))))

(defun vulpea-schema-validate-all (schema-or-name)
  "Return all violations for every note matched by SCHEMA-OR-NAME.

Notes are selected with the schema's predicate, then validated.  This
is sugar for `vulpea-schema-validate-notes' over the matching notes."
  (let ((schema (vulpea-schema--resolve schema-or-name)))
    (vulpea-schema-validate-notes
     (vulpea-db-query (lambda (note) (vulpea-schema-applies-p note schema)))
     schema)))

;;; Authoring

(defun vulpea-schema-applicable (note)
  "Return the names of registered schemas whose predicate matches NOTE.
Schemas are tested in registration order."
  (cl-remove-if-not (lambda (name) (vulpea-schema-applies-p note name))
                    (vulpea-schema-list)))

(defun vulpea-schema-missing-fields (note schema-or-name &optional required-only)
  "Return the fields of SCHEMA-OR-NAME that NOTE has no value for.

Required fields come first (in declared order), then optional ones;
with REQUIRED-ONLY non-nil only required fields are returned.
Requiredness is evaluated against NOTE, so a function :required is
honored.  A field counts as present when NOTE has any value for its
:key, so this never proposes a field the note already carries."
  (let ((schema (vulpea-schema--resolve schema-or-name))
        (required nil)
        (optional nil))
    (dolist (field (vulpea-schema-fields schema))
      (when (null (vulpea-note-meta-get-list note (plist-get field :key) 'string))
        (if (vulpea-schema--call-or-value (plist-get field :required) note)
            (push field required)
          (unless required-only (push field optional)))))
    (append (nreverse required) (nreverse optional))))

(defun vulpea-schema-note-violations (note)
  "Return all violations of NOTE across the schemas that apply to it.

Validates NOTE against each schema named by `vulpea-schema-applicable'
and concatenates the results.  Returns nil when no schema applies or the
note conforms to all that do.  This is the per-note counterpart to
`vulpea-schema-validate-all' and the shared entry point for surfacing a
single note's violations (sync warnings, in-buffer linting, health
widgets)."
  (cl-loop for name in (vulpea-schema-applicable note)
           append (vulpea-schema-validate note name)))

;;; Collection health

(cl-defstruct (vulpea-schema-health (:constructor vulpea-schema-health--create)
                                    (:copier nil))
  "Aggregated health of a single schema across a set of notes.

Slots:
  schema        - schema name symbol
  covered       - number of notes the schema applies to
  invalid       - number of covered notes with at least one violation
  invalid-notes - list of (note . violations) for the invalid notes
  includes      - schema names this schema inherits fields from
  included-by   - schema names that inherit fields from this schema"
  schema covered invalid invalid-notes includes included-by)

(cl-defun vulpea-schema-collection-health (&optional (notes (vulpea-db-query)))
  "Return the health of every registered schema across NOTES.

NOTES defaults to all notes in the database.  The result is a list of
`vulpea-schema-health' structures, one per registered schema in
registration order, each carrying how many notes the schema covers, how
many of those are invalid, the invalid notes paired with their
violations, and the schema's include relationships.  Pure apart from the
default `vulpea-db-query'; pass NOTES to aggregate an explicit set."
  (let ((by-name (make-hash-table :test 'eq))
        (included-by (make-hash-table :test 'eq))
        result)
    (dolist (name (vulpea-schema-list))
      (let ((includes (vulpea-schema-includes (vulpea-schema-get name))))
        (puthash name (vulpea-schema-health--create
                       :schema name :covered 0 :invalid 0
                       :invalid-notes nil :includes includes)
                 by-name)
        (dolist (inc includes)
          (push name (gethash inc included-by)))))
    (dolist (note notes)
      (dolist (name (vulpea-schema-applicable note))
        (let ((h (gethash name by-name)))
          (when h
            (cl-incf (vulpea-schema-health-covered h))
            (let ((vs (vulpea-schema-validate note name)))
              (when vs
                (cl-incf (vulpea-schema-health-invalid h))
                (push (cons note vs) (vulpea-schema-health-invalid-notes h))))))))
    (dolist (name (vulpea-schema-list))
      (let ((h (gethash name by-name)))
        (setf (vulpea-schema-health-invalid-notes h)
              (nreverse (vulpea-schema-health-invalid-notes h)))
        (setf (vulpea-schema-health-included-by h)
              (nreverse (gethash name included-by)))
        (push h result)))
    (nreverse result)))

(provide 'vulpea-schema)
;;; vulpea-schema.el ends here
