;;; icalendar-ast.el --- Syntax trees for iCalendar  -*- lexical-binding: t; -*-

;; Copyright (C) 2024 Free Software Foundation, Inc.

;; Author: Richard Lawrence <rwl@recursewithless.net>
;; Created: October 2024
;; Keywords: calendar
;; Human-Keywords: calendar, iCalendar

;; This file is part of GNU Emacs.

;; This file 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 file 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 file.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This file defines the abstract syntax tree representation for
;; iCalendar data.

\f
;;; Code:
(require 'cl-lib)

;;; Type symbols and metadata

;; All nodes in the syntax treee have a type symbol as their first element.
;; We use the following symbol properties (all prefixed with 'icalendar-')
;; to associate type symbols with various important data about the type:
;;
;; is-type - t (marks this symbol as an icalendar type)
;; is-value, is-param, is-property, or is-component - t
;;   (specifies what sort of value this type represents)
;; list-sep - for property and parameters types, a string (typically
;;   "," or ";") which separates individual printed values, if the
;;   type allows lists of values. If this is non-nil, syntax nodes of
;;   this type should always have a list of values in their VALUE
;;   field (even if there is only one value)
;; matcher - a function to match this type. This function matches the
;;   regular expression defined under the type's name; it is used to provide
;;   syntax highlighting in `icalendar-mode'
;; begin-rx, end-rx - for component-types, an `rx' regular expression which
;;   matches the BEGIN and END lines that form its boundaries
;; value-rx - an `rx' regular expression which matches individual values
;;   of this type, with no consideration for quoting or lists of values.
;;   (For value types, this is just a synonym for the rx definition
;;   under the type's symbol)
;; values-rx - for types that accept lists of values, an `rx' regular
;;   expression which matches the whole list (including quotes, if required)
;; full-value-rx - for property and parameter types, an `rx' regular
;;   expression which matches a valid value expression in group 2, or
;;   an invalid value in group 3
;; value-reader - for value types, a function which creates syntax
;;   nodes of this type given a string representing their value
;; value-printer - for value types, a function to print individual
;;   values of this type. It accepts a value and returns its string
;;   representation.
;; default-value - for property and parameter types, a string
;;   representing a default value for nodes of this type. This is the
;;   value assumed when no node of this type is present in the
;;   relevant part of the syntax tree.
;; substitute-value - for parameter types, a string representing a value
;;   which will be substituted at parse times for unrecognized values.
;;   (This is normally the same as default-value, but differs from it
;;   in at least one case in RFC5545, thus it is stored separately.)
;; default-type - for property types which can have values of multiple
;;   types, this is the default type when no type for the value is
;;   specified in the parameters. Any type of value other than this
;;   one requires a VALUE=... parameter when the property is read or printed.
;; other-types - for property types which can have values of multiple types,
;;   this is a list of other types that the property can accept.
;; child-spec - for property and component types, a plist describing the
;;   required and optional child nodes. See `icalendar-define-property' and
;;   `icalendar-define-component' for details.
;; other-validator - a function to perform type-specific validation
;;   for nodes of this type. If present, this function will be called
;;   by `icalendar-ast-node-valid-p' during validation.
;; type-documentation - a string documenting the type. This documentation is
;;   printed in the help buffer when `describe-symbol' is called on TYPE.
;; link - a hyperlink to the documentation of the type in the relevant standard

(defun ical:type-symbol-p (symbol)
  "Return non-nil if SYMBOL is an iCalendar type symbol.

This function only checks that SYMBOL has been marked as a type;
it returns t for value types defined by `icalendar-define-type',
but also e.g. for types defined by `icalendar-define-param' and
`icalendar-define-property'. To check that SYMBOL names a value
type for property or parameter values, see
`icalendar-value-type-symbol-p' and
`icalendar-printable-value-type-symbol-p'."
  (and (symbolp symbol)
       (get symbol 'ical:is-type)))

(defun ical:value-type-symbol-p (symbol)
  "Return non-nil if SYMBOL is a type symbol representing a value
type, i.e., a type for an iCalendar property or parameter value
defined by `icalendar-define-type'.

This means that SYMBOL must both satisfy
`icalendar-type-symbol-p' and have the property
`icalendar-is-value'. It does not require the type to be
associated with a print name in `icalendar-value-types';
for that see `icalendar-printable-value-type-symbol-p'."
  (and (ical:type-symbol-p symbol)
       (get symbol 'ical:is-value)))

(defun ical:expects-list-of-values-p (type)
  "Return non-nil if the syntax node type named by TYPE accepts a
list of values. This is never t for value types or component
types. For property and parameter types defined with
`ical:define-param' and `ical:define-property', it is true if the
:list-sep argument was specified in the definition."
  (and (ical:type-symbol-p type)
       (get type 'ical:list-sep)))

(defun ical:param-type-symbol-p (type)
  "Return non-nil if TYPE is a type symbol for an iCalendar
parameter."
  (and (ical:type-symbol-p type)
       (get type 'ical:is-param)))

(defun ical:property-type-symbol-p (type)
  "Return non-nil if TYPE is a type symbol for an iCalendar
property."
  (and (ical:type-symbol-p type)
       (get type 'ical:is-property)))

(defun ical:component-type-symbol-p (type)
  "Return non-nil if TYPE is a type symbol for an iCalendar
component."
  (and (ical:type-symbol-p type)
       (get type 'ical:is-component)))

;; TODO: we could define other accessors here for the other metadata
;; properties, but at the moment I see no advantage to this; they would
;; all just be long-winded wrappers around `get'.

\f
;;; AST metadata from parser.

;; This is intended to serve the same role as the
;; `:standard-properties' array in `org-element-ast', though that name
;; would be confusing in the context of RFC5545.
(cl-defstruct (ical:meta (:constructor ical:-make-meta))
  "Structure containing meta information in an iCalendar syntax
node. Do not rely on this representation; it may change."
  (buffer nil
    :type (or null buffer)
    :documentation "The buffer from which this node was parsed")
  (parent nil
    :type ical:ast-node-p
    :documentation "The parent node to which this node belongs")
  (begin nil
    :type (or null integer-or-marker)
    :documentation "The position at which the content of this node begins")
  (end nil
    :type (or null integer-or-marker)
    :documentation "The position at which the content of this node ends")
  (value-begin nil
    :type (or null integer-or-marker)
    :documentation "The position at which the value of this node begins")
  (value-end nil
    :type (or null integer-or-marker)
    :documentation "The position at which the value of this node ends")
  (original-value nil
    :type (or null string)
    :documentation "The original representation of the value as parsed.
This can differ from the value stored in the node if e.g. the
standard requires an unrecognized value to be treated the same as
a certain default")
  (original-name nil
    :type (or null string)
    :documentation
    "The original representation of the parameter, property, or component
name as parsed. This can differ from the name corresponding to the node's type
if e.g. the standard requires parsing a node of an unrecognized type"))

\f
;;; AST representation

;; Every syntax node has the format (TYPE META VALUE CHILDREN) where:
;;
;; TYPE is a type symbol (typically defined with ical:define-type,
;; ical:define-param, ical:define-property, or ical:define-component;
;; see Type Metadata, above)
;;
;; META is a struct containing parsing metadata about the node (see
;; `ical:meta' above)
;;
;; VALUE is the node's value, if any.
;; Depending on TYPE, VALUE can be:
;; - nil (e.g. component nodes have no value)
;; - an Elisp data structure representing one of the basic iCalendar
;;   value types (e.g. a date, a period, or text)
;; - a syntax node
;; - a list of one of the above. This is the case if `ical:values-list-p'
;;   returns t for TYPE.
;;
;; CHILDREN is a list of syntax nodes. For component nodes, a list of
;; property nodes. For property nodes, a list containing parameter
;; nodes. nil for all other nodes.
;;
;; We define general accessors and a constructor `ical:make-ast-node'
;; for this representation here:
(defsubst ical:ast-node-type (node)
  "Return the symbol naming the type of iCalendar syntax node NODE."
  (car node))

(defsubst ical:ast-node-value (node)
  "Return the value of iCalendar syntax node NODE.
In component nodes, this is nil. Otherwise, it is a syntax node
representing an iCalendar (property or parameter) value."
  (nth 2 node))

(defsubst ical:ast-node-children (node)
  "Return the children of iCalendar syntax node NODE.
In component nodes, this is a list of property nodes and/or
subcomponent nodes. In property nodes, this is a list of
parameter nodes. Otherwise the list is nil."
  (nth 3 node))

(defun ical:ast-node-p (val)
  "Return non-nil if VAL is an iCalendar syntax node"
  (and (listp val)
       (length= val 4)
       (ical:type-symbol-p (ical:ast-node-type val))))

(defun ical:-keyword-to-slot-name (kw)
  "Convert a keyword like :slotname to plain symbol \\='slotname"
  (intern (string-trim (downcase (symbol-name kw)) ":")))

(defun ical:ast-node-meta-get (node keyword)
  "Get metadata key KEYWORD from NODE. The possible KEYWORDs are the
slot names of `ical:meta'."
  (let ((meta (cadr node))
        (kw (ical:-keyword-to-slot-name keyword)))
    (cl-struct-slot-value 'ical:meta kw meta)))

(defun ical:ast-node-meta-set (node keyword value)
  "Set metadata key KEYWORD in NODE to VALUE. The possible KEYWORDs
are the slot names of `ical:meta'."
  (let ((meta (cadr node))
        (kw (ical:-keyword-to-slot-name keyword)))
    (setf (cl-struct-slot-value 'ical:meta kw meta) value)))

(defun ical:ast-node-first-child-of (type node)
  "Return the first child of NODE of type TYPE, or nil if there is
no such child."
  (assq type (ical:ast-node-children node)))

(defun ical:ast-node-children-of (type node)
  "Return a list of all the children of NODE of type TYPE, or nil if
there are none."
  (seq-filter (lambda (c) (eq type (ical:ast-node-type c)))
              (ical:ast-node-children node)))

(defun ical:-ast-node-adopt (parent value children)
  "Make syntax node PARENT the parent node of each syntax node in
VALUE and CHILDREN. This sets `:parent' meta property in each
node to PARENT, sets VALUE as PARENT's value, and appends
CHILDREN to any existing children of PARENT's. Returns the
modified PARENT. Both VALUE and CHILDREN may be lists. If VALUE
is nil, PARENT's value is not modified."
  (let* ((is-list-val (ical:expects-list-of-values-p
                       (ical:ast-node-type parent)))
         (to-adopt (cond
                    ((and value is-list-val)
                     (append value children))
                    (value
                     (cons value children))
                    (t children))))
    (dolist (child to-adopt)
      (when (ical:ast-node-p child)
        (ical:ast-node-meta-set child :parent parent))))
  (when value
    (setf (nth 2 parent) value))
  (setf (nth 3 parent) (nconc (ical:ast-node-children parent)
                              children))
  parent)

(cl-defun ical:make-ast-node (type
                              &key value
                                   children
                                   buffer
                                   begin
                                   end
                                   value-begin
                                   value-end
                                   parent
                                   original-value
                                   original-name)
  "Construct an iCalendar syntax node of type TYPE.

The following keyword arguments are accepted:

:value - if given, should be a single syntax node. In value
  nodes, this is the Elisp value parsed from a property or
  parameter's value string. In parameter and property nodes, this
  is a value node. In component nodes, it should be nil.

:children - if given, should be a list of syntax nodes. In
  property nodes, these should be the parameters of the property.
  In component nodes, these should be the properties or
  subcomponents of the component. It should otherwise be nil.

The following keyword arguments, if given, represent syntactic
metadata for the node; see the definition of `ical:meta' for
more:

:buffer - buffer from which VALUE was parsed
:begin - position at which this node begins in BUFFER
:end - position at which this node ends in BUFFER
:value-begin - position at which VALUE begins in BUFFER
:value-end - position at which VALUE ends in BUFFER
:parent - the parent node of the node to be created
:original-value - a string containing the original, uninterpreted value
  of the node. This can differ from (a string represented by) VALUE
  if e.g. a default VALUE was substituted for an unrecognized but
  syntactically correct value.
:original-name - a string containing the original, uninterpreted name
  of the parameter, property or component this node represents.
  This can differ from (a string representing) TYPE
  if e.g. a default TYPE was substituted for an unrecognized but
  syntactically correct one."
  (let* ((meta (ical:-make-meta :buffer buffer
                                :begin begin
                                :value-begin value-begin
                                :end end
                                :value-end value-end
                                :parent parent
                                :original-value original-value
                                :original-name original-name))
         (node (list type meta nil nil)))
    (ical:-ast-node-adopt node value children)))

\f
;;; Validation:

;; Errors at the validation stage:
;; e.g. property/param values did not match, or are of the wrong type,
;; or required properties not present in a component
(define-error 'ical:validation-error "Invalid iCalendar data")

(defun ical:param-node-p (node)
  "Return non-nil if NODE is an iCalendar syntax node whose type
is a parameter type."
  (and (ical:ast-node-p node)
       (ical:param-type-symbol-p (ical:ast-node-type node))))

(defun ical:property-node-p (node)
  "Return non-nil if NODE is an iCalendar syntax node whose type
is a property type."
  (and (ical:ast-node-p node)
       (ical:property-type-symbol-p (ical:ast-node-type node))))

(defun ical:component-node-p (node)
  "Return non-nil if NODE is an iCalendar syntax node whose type
is a component type."
  (and (ical:ast-node-p node)
       (ical:component-type-symbol-p (ical:ast-node-type node))))

(defun ical:ast-node-valid-meta-p (node)
  "Validate that NODE's metadata is an appropriate struct. Signals
an `icalendar-validation-error' if NODE's metadata is invalid, or
returns NODE."
  (unless (cl-typep (nth 1 node) 'ical:meta)
    (signal 'ical:validation-error
            (list "Invalid metadata struct in node"
                  node))))

(defun ical:ast-node-valid-value-p (node)
  "Validate that NODE's value satisfies the requirements of its type.
Signals an `icalendar-validation-error' if NODE's value is
invalid, or returns NODE."
  (let* ((type (ical:ast-node-type node))
         (value (ical:ast-node-value node)))
    (cond ((ical:value-type-symbol-p type)
           (unless (cl-typep value type) ; see `ical:define-type'
             (signal 'ical:validation-error
                     (list (format "Invalid value for `%s' node: %s"
                                   type value)
                           node)))
           node)
          ((ical:component-node-p node)
           ;; component types have no value, so no need to check anything
           node)
          ((and (or (ical:param-type-symbol-p type)
                    (ical:property-type-symbol-p type))
                (null (get type 'ical:value-type))
                (stringp value))
           ;; property and param nodes with no value type are assumed to contain
           ;; strings which match a value regex:
           (unless (string-match (rx-to-string (get type 'ical:value-rx)) value)
             (signal 'ical:validation-error
                     (list (format "Invalid string value for `%s' node: %s"
                                   type value)
                           node)))
           node)
          ;; otherwise this is a param or property node which itself
          ;; should have one or more syntax nodes as a value, so
          ;; recurse on value(s):
          ((ical:expects-list-of-values-p type)
           (unless (listp value) ;; TODO: check elements' types...?
             (signal 'ical:validation-error
                     (list (format "Expected list of values for `%s' node"
                                   type)
                           node)))
           (mapc #'ical:ast-node-valid-value-p value)
           node)
          (t
           (unless (ical:ast-node-p value)
             (signal 'ical:validation-error
                     (list (format "Invalid value for `%s' node: %s"
                                   type value)
                           node)))
           (ical:ast-node-valid-value-p value)))))

(defun ical:count-children-by-type (node)
  "Return an alist mapping type symbols to the number of child nodes
of that type in NODE."
  (let ((children (ical:ast-node-children node))
        (map nil))
    (dolist (child children map)
      (let* ((type (ical:ast-node-type child))
             (n (alist-get type map)))
        (setf (alist-get type map) (1+ (or n 0)))))))

(defun ical:ast-node-valid-children-p (node)
  "Validate that NODE's children satisfy the :child-spec associated
with its type by `icalendar-define-component',
`icalendar-define-property', `icalendar-define-param', or
`icalendar-define-type'. Signals an `icalendar-validation-error'
if NODE is invalid, or returns NODE.

Note that this function does not check that the children of NODE
are themselves valid; for that, see `ical:ast-node-valid-p'."
  (let* ((type (ical:ast-node-type node))
         (child-spec (get type 'ical:child-spec))
         (child-counts (ical:count-children-by-type node)))

    (when child-spec

      (dolist (child-type (plist-get child-spec :one))
        (unless (= 1 (alist-get child-type child-counts 0))
          (signal 'ical:validation-error
                  (list (format "iCalendar `%s' node must contain exactly one `%s'"
                                type child-type)
                        node))))

      (dolist (child-type (plist-get child-spec :one-or-more))
        (unless (<= 1 (alist-get child-type child-counts 0))
          (signal 'ical:validation-error
                  (list (format "iCalendar `%s' node must contain one or more `%s'"
                                type child-type)
                        node))))

      (dolist (child-type (plist-get child-spec :zero-or-one))
        (unless (<= (alist-get child-type child-counts 0)
                    1)
          (signal 'ical:validation-error
                  (list (format "iCalendar `%s' node may contain at most one `%s'"
                                type child-type)
                        node))))

      ;; check that all child nodes are allowed:
      (unless (plist-get child-spec :allow-others)
        (let ((allowed-types (append (plist-get child-spec :one)
                                     (plist-get child-spec :one-or-more)
                                     (plist-get child-spec :zero-or-one)
                                     (plist-get child-spec :zero-or-more)))
              (appearing-types (mapcar #'car child-counts)))

          (dolist (child-type appearing-types)
            (unless (member child-type allowed-types)
              (signal 'ical:validation-error
                      (list (format "`%s' may not contain `%s'"
                                    type child-type)
                            node)))))))
    ;; success:
    node))

(defun ical:ast-node-valid-p (node &optional recursively)
  "Check that NODE is a valid iCalendar syntax node.
By default, the check will only validate NODE itself, but if
RECURSIVELY is non-nil, it will recursively check all its
descendants as well. Signals an `icalendar-validation-error' if
NODE is invalid, or returns NODE."
  (unless (ical:ast-node-p node)
    (signal 'ical:validation-error
            (list "Not an iCalendar syntax node"
                  node)))

  (ical:ast-node-valid-meta-p node)
  (ical:ast-node-valid-value-p node)
  (ical:ast-node-valid-children-p node)

  (let* ((type (ical:ast-node-type node))
         (other-validator (get type 'ical:other-validator)))

    (unless (ical:type-symbol-p type)
      (signal 'ical:validation-error
              (list (format "Node's type `%s' is not an iCalendar type symbol"
                            type)
                    node)))

    (when (and other-validator (not (functionp other-validator)))
      (signal 'ical:validation-error
              (list (format "Bad validator function `%s' for type `%s'"
                            other-validator type))))

    (when other-validator
      (funcall other-validator node)))

  (let ((children (ical:ast-node-children node)))
    (when (and recursively (not (null children)))
      (dolist (c children)
        (ical:ast-node-valid-p c recursively))))

  ;; success:
  node)

(provide 'icalendar-ast)
;; Local Variables:
;; read-symbol-shorthands: (("ical:" . "icalendar-"))
;; End:
;;; icalendar-ast.el ends here