;;; phony.el --- Define voice commands           -*- lexical-binding: t; -*-

;; Copyright (C) 2024, 2025, 2026 Erik Präntare

;; Author: Erik Präntare
;; Keywords: files
;; Package-Version: 1.0.1
;; Package-Revision: b155ee3686c7
;; Homepage: https://github.com/ErikPrantare/phony.el
;; Package-Requires: ((emacs "29.1") (simulacrum "1.0.0"))
;; Created: 13 Jul 2024

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Affero 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 Affero General Public License for more details.

;; You should have received a copy of the GNU Affero General Public
;; License along with this program.  If not, see
;; <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Phony is a framework for defining voice commands in Emacs.  It
;; bridges Emacs with speech recognition backends to allow you to
;; control Emacs by voice.
;;
;; Quick example:
;;
;;   (phony-defun say-hello "hello world"
;;     (message "Hello!"))
;;
;; After defining this function, saying "hello world" will display
;; "Hello!" in the message area.
;;
;; Phony provides three types of rules for mapping utterances to values
;; and side effects:
;;
;;   1. Procedure rules (`phony-defun') - Map utterances to code with
;;      optional arguments bound from other rules.
;;
;;   2. Dictionaries (`phony-define-dictionary') - Map utterances to
;;      values (e.g., numbers, symbols).
;;
;;   3. Open rules (`phony-define-open-rule') - Match any of multiple
;;      alternatives, allowing extensible grammars.
;;
;; Rules can reference other rules to compose complex speech patterns.
;; The module system (`phony-module') allows you to organize and
;; enable/disable groups of rules.
;;
;; See README.org for setup instructions and detailed usage examples.

;;; Code:

(require 'cl-lib)
(require 'subr-x)
(require 'map)
(require 'server)
(require 'multisession)

(require 'phony-element-syntax)
(require 'simulacrum)

(defgroup phony nil
  "Functionality for defining speech bindings."
  :group 'files)

(defcustom phony-output-directory (locate-user-emacs-file "phony")
  "Directory for files generated by phony."
  :type 'directory
  :group 'phony)

(defcustom phony-ast-evaluation-function #'phony-generate-event
  "Function used to evaluate ASTs generated by phony.
Anytime a command is executed, this function is invoked with an AST
representing the recognized utterance."
  :type 'function
  :group 'phony)

(simulacrum-define-event-type phony-command)

;;;###autoload
(define-minor-mode phony-mode
  "Toggle phony mode.

When phony mode is enabled, rules will be exported to the speech
recognition backend."
  :global t
  :group 'phony
  (if phony-mode
      (progn
        (phony-request-export)
        (keymap-global-set "<phony-command>"
                           (simulacrum-command #'phony--evaluate-ast)))
    (keymap-global-unset "<phony-command>" t)))

(defun phony-generate-event (ast)
  "Evaluate AST via `simulacrum-generate-event'."
  (simulacrum-generate-event 'phony-command ast))

(defun phony--evaluate (ast)
  "Evaluate AST using `phony-ast-evaluation-function'.

This is the actual function that gets invoked when a command is
recognized.  This function exists as a proxy to the evaluation function
so that it may be changed without reloading the grammar."
  (funcall phony-ast-evaluation-function ast))

(defun phony--output-directory (&rest components)
  "Get path to output directory.

If provided, COMPONENTS are appended as components in the returned path."
  (apply
   #'file-name-concat
   (expand-file-name phony-output-directory)
   components))

(defun phony--to-python-identifier (symbol)
  "Generate a fitting python identifier for SYMBOL.

This function is used to automatically generate external names for
rules."
  (concat "phony_" (replace-regexp-in-string (rx (not alnum)) "_" (symbol-name symbol))))

(cl-defstruct (phony--module
               (:constructor phony--make-module))
  "Modules group rules defined in a file into a unit.
See `phony-module' for information on how to define modules."
  ( name nil
    :type symbol
    :documentation
    "Name of this module.")
  ( utterance nil
    :type string
    :documentation
    "Utterance for referring to this module.")
  ( file-name nil
    :type string
    :documentation
    "Filename of the file defining this module.")
  ( enabled-p nil
    :type boolean
    :documentation
    "Whether the rules of this module should be exported."))

(defvar phony--modules-by-file-name (make-hash-table :test #'equal)
  "All modules, indexed by filename.")

(defun phony--current-file-name ()
  "Return the filename of the current evaluation context.

Returns `load-file-name' if non-nil, otherwise the value of the variable
`buffer-file-name'.  Therefore, if both are nil, this function also
returns nil.

The same file always returns the same path, unless the file has more
than one hardlink."
  (and-let* ((file-name (or load-file-name buffer-file-name)))
    (file-truename file-name)))

(define-multisession-variable phony--enabled-modules '()
  "Names of modules that are enabled across sessions.")

(defun phony--declare-module-of-current-file (name utterance)
  "Declare module named NAME for the current file.

UTTERANCE is a string specifying how this module is referred to as an
utterance."
  (let ((file-name (phony--current-file-name)))
    (cl-assert file-name nil "No current file could be found")
    (puthash file-name
             (phony--make-module
              :name name
              :utterance utterance
              :file-name file-name
              :enabled-p (memq name (multisession-value phony--enabled-modules)))
             phony--modules-by-file-name)
    (phony-dictionary-put utterance 'phony-module name))
  name)

(defmacro phony-module (name &optional utterance)
  "Declare current file a phony module.

This will define a new module named NAME.  Rules declared in the file
that this form is evaluated in will be assigned to that module.

A module can be disabled or enabled.  If it is disabled, the rules
belonging to the module are not exported.  By default, newly defined
modules are disabled.  To enable a module, use `phony-enable-module'.

If given, UTTERANCE is a string specifying how this module is referred
to as an utterance."
  `(phony--declare-module-of-current-file ',name ',utterance))

(defun phony--current-module ()
  "Return the current module.

If the currently loaded or visited file does not define a module with
`phony-module', this function returns nil."
  (gethash (phony--current-file-name) phony--modules-by-file-name))

(defun phony--modules ()
  "Return list of all modules."
  (map-values phony--modules-by-file-name))

(defun phony--get-module (name)
  "Return module with NAME.

If no such module exists, this function returns nil."
  (seq-find (lambda (module) (eq (phony--module-name module) name))
            (phony--modules)))

(defun phony-enable-module (name &optional persist)
  "Enable module NAME.

If PERSIST is non-nil, the module will stay enabled across sessions.

Unless a module is enabled, the rules belonging to it are not
exported.  Rules not belonging to a module are always exported."
  (interactive (let* ((name (intern (completing-read
                                     "Enable phony module: "
                                     (seq-map #'phony--module-name
                                              (seq-remove #'phony--module-enabled-p
                                                          (phony--modules))))))
                      (persist (y-or-n-p (format "Enable %s for future sessions? " name))))
                 (list name persist)))
  (cl-assert (phony--get-module name) nil
             "No module named %s" name)
  (setf (phony--module-enabled-p (phony--get-module name)) t)
  (when persist
    (cl-pushnew name (multisession-value phony--enabled-modules)))
  (phony-request-export)
  (message "Enabled %s module" name))

(defun phony-disable-module (name &optional persist)
  "Disable module NAME.

If PERSIST is non-nil, the module will stay disabled across sessions.

Rules belonging to disabled modules are never exported."
  (interactive (let* ((name (intern (completing-read
                                     "Disable phony module: "
                                     (seq-map #'phony--module-name
                                              (seq-filter #'phony--module-enabled-p
                                                          (phony--modules))))))
                      (persist (y-or-n-p (format "Disable %s for future sessions? " name))))
                 (list name persist)))
  (cl-assert (phony--get-module name) nil
             "No module named %s" name)
  (setf (phony--module-enabled-p (phony--get-module name)) nil)
  (when persist
    (setf (multisession-value phony--enabled-modules)
          (delq name (multisession-value phony--enabled-modules))))
  (phony-request-export)
  (message "Disabled %s module" name))

(cl-defstruct (phony--rule
               (:constructor nil)
               (:copier nil))
  "A rule for matching an utterance."
  ( name nil
    :type symbol
    :documentation "The name of this rule.")
  ( documentation nil
    :type string
    :documentation "The documentation string for this rule.")
  ( module nil
    :type phony--module
    :documentation "The module this rule belongs to.
Modules are specified with `phony-module'.  Its value is nil if it is
not part of a module.")
  ( file-name nil
    :type string
    :documentation "The filename of the file where this rule was defined.
Its value is nil if it was not evaluated from a file.")
  ( modes '(global)
    :type list
    :documentation "A list of modes under which this rule is active.
If none of the modes are active, this rule cannot be matched.  A
special case is the \\='global symbol, which indicates that the rule
should always be active.")
  ( external-name nil
    :type string
    :documentation "The name this rule will have for the speech recognition engine.")
  ( contributes-to '()
    :type list
    :documentation "A list of open rules that this rule contributes to.")
  ( virtual-p nil
    :type boolean
    :documentation "Whether this rule was generated by a compilation pass."))

(defun phony--rule-active-p (rule)
  "Return non-nil if RULE is active.

A rule is inactive if it belongs to a disabled module or none of its
modes are currently active."
  (and
   (let ((modes (phony--rule-modes rule)))
     (or
      (memq 'global modes)
      (derived-mode-p modes)
      (seq-some (lambda (mode)
                  (or
                   (memq mode local-minor-modes)
                   (memq mode global-minor-modes)))
                modes)))
   (if-let* ((module (phony--rule-module rule)))
       (phony--module-enabled-p module)
     t)))

(defun phony--rule-always-active-p (rule)
  "Return non-nil if RULE is guaranteed to always be active.

A rule is always active if it is global and is part of an enabled
module (or no module)."
  (and (memq 'global (phony--rule-modes rule))
       (if-let* ((module (phony--rule-module rule)))
           (phony--module-enabled-p module)
         t)))

(cl-defstruct (phony--procedure-rule
               (:include phony--rule)
               (:constructor phony--make-procedure-rule))
  "A rule mapping an utterance pattern to a function call."
  ( function '()
    :type function
    :documentation "Function to call when the utterance is matched.")
  ( element nil
    :type phony--element-sequence
    :documentation "Parsed element tree for the utterance pattern.")
  ( arglist '()
    :type (repeat symbol)
    :documentation "List of argument symbols extracted from the pattern.")
  ( interactive-p t
    :type boolean
    :documentation "\
Whether this rule can be invoked directly.
Non-interactive rules are only reachable as sub-rules within other rules.")
  ( anchor-beginning-p nil
    :type boolean
    :documentation "\
Constrain matching to the start of an utterance, like `^' in regex.")
  ( anchor-end-p nil
    :type boolean
    :documentation "\
Constrain matching to the end of an utterance, like `$' in regex."))

(cl-defstruct (phony--open-rule
               (:include phony--rule)
               (:constructor phony--make-open-rule))
  "A rule that matches any of its alternatives."
  ( alternatives nil
    :type (repeat symbol)
    :documentation "List of symbols naming the alternative rules."))

(cl-defstruct (phony--dictionary
               (:include phony--rule)
               (:constructor nil)
               (:constructor phony--make-dictionary))
  "A dictionary mapping utterances to values.

MAPING is an alist mapping utterances, given as strings, to values.

FORMAT-RAW-P is t if this dictionary is intended to be used on the
speech recognition side.  In that case, the mapping may only map to
strings."
  (format-raw-p nil :type boolean)
  (mapping nil :type list))

(defun phony--copy-rule-base-inplace (source target)
  "Copy base `phony--rule' slots from SOURCE into TARGET."
  (setf (phony--rule-name target) (phony--rule-name source))
  (setf (phony--rule-documentation target) (phony--rule-documentation source))
  (setf (phony--rule-module target) (phony--rule-module source))
  (setf (phony--rule-file-name target) (phony--rule-file-name source))
  (setf (phony--rule-modes target)
        (copy-sequence (phony--rule-modes source)))
  (setf (phony--rule-external-name target) (phony--rule-external-name source))
  (setf (phony--rule-contributes-to target)
        (copy-sequence (phony--rule-contributes-to source)))
  (setf (phony--rule-virtual-p target) (phony--rule-virtual-p source))
  target)

(cl-defgeneric phony--copy-rule (rule)
  "Return a deep copy of RULE.")

(cl-defmethod phony--copy-rule ((rule phony--procedure-rule))
  "Return a deep copy of RULE."
  (let ((copy (phony--make-procedure-rule
               :function (phony--procedure-rule-function rule)
               :element (phony--procedure-rule-element rule)
               :arglist (copy-sequence (phony--procedure-rule-arglist rule))
               :interactive-p (phony--procedure-rule-interactive-p rule)
               :anchor-beginning-p (phony--procedure-rule-anchor-beginning-p rule)
               :anchor-end-p (phony--procedure-rule-anchor-end-p rule))))
    (phony--copy-rule-base-inplace rule copy)))

(cl-defmethod phony--copy-rule ((rule phony--open-rule))
  "Return a deep copy of RULE."
  (let ((copy (phony--make-open-rule
               :alternatives (copy-sequence
                              (phony--open-rule-alternatives rule)))))
    (phony--copy-rule-base-inplace rule copy)))

(cl-defmethod phony--copy-rule ((rule phony--dictionary))
  "Return a deep copy of RULE."
  (let ((copy (phony--make-dictionary
               :format-raw-p (phony--dictionary-format-raw-p rule)
               :mapping (copy-alist (phony--dictionary-mapping rule)))))
    (phony--copy-rule-base-inplace rule copy)))

(defun phony--normalize-rule (rule-or-name)
  "Return rule specified by RULE-OR-NAME.
RULE-OR-NAME must be a `phony--rule' or a symbol naming a rule."
  (if (symbolp rule-or-name)
      (phony--get-rule rule-or-name)
    rule-or-name))

(defun phony--external-name (rule-or-name)
  "Return the external name for RULE-OR-NAME.

The external name of a rule is a string, representing how the function
is identified when exported to the speech engine."
  (phony--rule-external-name
   (phony--normalize-rule rule-or-name)))

(cl-defstruct (phony--grammar
               (:constructor phony--make-grammar)
               (:copier nil))
  "A collection of rules."
  (rules (make-hash-table)
         :type hash-table
         :documentation "Hash table of rules, indexed by name."))

(defun phony--compile-grammar (grammar)
  "Return a compiled copy of GRAMMAR.

The returned grammar is safe to mutate; it contains no references
to the original rules."
  (let ((compiled (phony--make-grammar)))
    (maphash
     (lambda (name rule)
       (puthash name (phony--copy-rule rule)
                (phony--grammar-rules compiled)))
     (phony--grammar-rules grammar))
    compiled))

(defvar phony--default-grammar (phony--make-grammar)
  "The default grammar for all grammar operations.")

(defun phony--get-rules (&optional grammar)
  "Return a list containing the rules of GRAMMAR.

If GRAMMAR is omitted or nil, it defaults to `phony--default-grammar'."
  (setq grammar (or grammar phony--default-grammar))
  (hash-table-values (phony--grammar-rules grammar)))

(defun phony--get-rule (name &optional grammar)
  "Return the rule named NAME in GRAMMAR.
Return nil if no such rule exists.

If GRAMMAR is omitted or nil, it defaults to `phony--default-grammar'."
  (setq grammar (or grammar phony--default-grammar))
  (gethash name (phony--grammar-rules grammar)))

(defun phony--add-rule (rule &optional grammar)
  "Add RULE to GRAMMAR.

If GRAMMAR is omitted or nil, it defaults to `phony--default-grammar'.
If RULE was declared in a file with a `phony-module' declaration, then
RULE is put into that module.

This function must be invoked every time a rule is declared."
  (setq grammar (or grammar phony--default-grammar))
  (setf (phony--rule-module rule) (phony--current-module))
  (setf (phony--rule-file-name rule) (phony--current-file-name))
  (puthash (phony--rule-name rule)
           rule
           (phony--grammar-rules grammar)))

(defun phony-remove-rule (rule-name &optional grammar)
  "Remove rule named RULE-NAME from GRAMMAR.
If GRAMMAR is omitted or nil, it defaults to `phony--default-grammar'."
  (interactive (list
                (intern (completing-read
                         "Remove rule: "
                         (hash-table-keys
                          (phony--grammar-rules phony--default-grammar))))))
  (setq grammar (or grammar phony--default-grammar))
  (remhash rule-name (phony--grammar-rules grammar))
  (seq-doseq (open-rule (seq-filter
                         #'phony--open-rule-p
                         (phony--get-rules grammar)))
    (setf (phony--open-rule-alternatives open-rule)
          (remove rule-name (phony--open-rule-alternatives open-rule))))
  (phony-request-export))


(defun phony--add-new-rule (constructor parameters)
  "Add a new rule from CONSTRUCTOR with PARAMETERS.

Instead of constructing the rule directly, functions that add rules
invoke this function.  This function validates that the parameters are
correcly formed, and performs some standard transformations from
interface sugar to the form used internally."
  ;; TODO: Document what is meant by "sugar".

  ;; We will be destructively modifying the parameter list, so copy
  ;; it.  All modifications are shallow.
  (setq parameters (apply #'list parameters))

  ;; NOTE: The external parameter is named :mode, but internally we
  ;; normalize it to a list :modes.
  (when-let* ((mode (map-elt parameters :mode)))
    (when (and (listp mode) (eq (car mode) 'quote))
      (error ":mode keyword argument must be unquoted"))
    (setf (map-elt parameters :modes)
          (ensure-list (map-elt parameters :mode)))
    (cl-remf parameters :mode))

  (when-let* ((contributes-to (map-elt parameters :contributes-to)))
    (when (and (listp contributes-to) (eq (car contributes-to) 'quote))
      (error ":contributes-to keyword argument must be unquoted"))
    (setf (map-elt parameters :contributes-to)
          (ensure-list (map-elt parameters :contributes-to))))

  ;; TODO: Check if this can be handled directly in the constructor.
  ;; I would guess that custom constructors are ignored when
  ;; constructing substructs.
  (with-memoization (map-elt parameters :external-name)
    (phony--to-python-identifier (map-elt parameters :name)))

  (phony--add-rule (apply constructor parameters)))

(defun phony-dictionary-get (utterance dictionary)
  "Return the value corresponding to UTTERANCE in DICTIONARY.
If no such value exists, return nil.

DICTIONARY is the name of the dictionary to modify."
  (alist-get utterance
             (phony--dictionary-mapping (phony--get-rule dictionary))
             nil nil #'string-equal))

(defun phony-dictionary-put (utterance dictionary value)
  "Set the value of UTTERANCE in DICTIONARY to VALUE.

DICTIONARY is the name of the dictionary to modify.

Invoking this function will resync the dictionary to the external speech
recognition engine."
  (setf (alist-get utterance
                   (phony--dictionary-mapping (phony--get-rule dictionary))
                   nil nil #'string-equal)
        value)
  (phony--request-export-dictionaries))

(defun phony-dictionary-remove (utterance dictionary)
  "Remove UTTERANCE from DICTIONARY.

DICTIONARY is the name of the dictionary to modify.

Invoking this function will resync the dictionary to the external speech
recognition engine."
  (setf (alist-get utterance
                   (phony--dictionary-mapping (phony--get-rule dictionary))
                   nil t #'string-equal)
        nil)
  (phony--request-export-dictionaries))

(defun phony-dictionary-alist (dictionary)
  "Return the mapping of DICTIONARY as an alist.

DICTIONARY is the name of the dictionary to modify."
  (phony--dictionary-mapping (phony--get-rule dictionary)))

(defun phony-set-dictionary-alist (dictionary alist)
  "Set the mapping of DICTIONARY to ALIST.

DICTIONARY is the name of the dictionary to modify.

Invoking this function will resync the dictionary to the external speech
recognition engine."
  (setf (phony--dictionary-mapping (phony--get-rule dictionary)) alist)
  (phony--request-export-dictionaries))

(gv-define-setter phony-dictionary-get (value utterance dictionary)
  `(phony-dictionary-put ,utterance ,dictionary ,value))

(gv-define-setter phony-dictionary-alist (value dictionary)
  `(phony-set-dictionary-alist ,dictionary ,value))

(defun phony--create-lookup-representation (entry dictionary)
  "Create lookup string for ENTRY in DICTIONARY.

When evaluating the returned string from emacsclient, this performs
the lookup."
  (if (phony--dictionary-format-raw-p dictionary)
      (cdr entry)
    (format "(%s \"%s\")"
            (phony--dictionary-name dictionary)
            (car entry))))

(defun phony--prepare-dictionary-for-serialization (dictionary)
  "Return DICTIONARY as an entry for `json-serialize'.

This represents one key-value pair, mapping the external dictionary name
to its dictionary."
  (cons (make-symbol (phony--external-name dictionary))
        (mapcar (lambda (entry)
                  (cons
                   (make-symbol (car entry))
                   ;; Each value is a string, encoding a form that
                   ;; will evaluate to the actual value.
                   (phony--create-lookup-representation
                    entry dictionary)))
                (phony--dictionary-mapping dictionary))))

;; TODO: Handle IO errors
(defun phony--write-dictionaries-to-file ()
  "Write dictionaries to dictionaries.json.

The speech recognition backend can read this file to register the
dictionaries."
  (mkdir (phony--output-directory) t)
  (with-temp-file (phony--output-directory "dictionaries.json")
    (json-insert
     (mapcar #'phony--prepare-dictionary-for-serialization
             (seq-filter #'phony--dictionary-p (phony--get-rules))))))

(defvar phony--dictionary-export-function #'phony--write-dictionaries-to-file
  "Function called to export dictionaries.")

(defun phony--export-dictionaries ()
  "Export dictionaries using `phony--dictionary-export-function'."
  (funcall phony--dictionary-export-function))

(defvar phony--debounce-export-requests t
  "Non-nil to debounce export requests via idle timers.
When nil, export requests are executed synchronously.")

(defun phony--request-export-dictionaries ()
  "Sync DICTIONARY-NAMES when next idle.

If `phony-mode' is disabled, this function does nothing."
  (interactive)
  (when phony-mode
    (if phony--debounce-export-requests
        (phony--debounce #'phony--export-dictionaries)
      (phony--export-dictionaries))))

(cl-defun phony--define-dictionary (arguments)
  "Define a dictionary from ARGUMENTS.

See documentation of `phony-define-dictionary' for more information."
  (let ((mapping (plist-get arguments :mapping))
        (name (plist-get arguments :name)))
    (unless (plist-member arguments :mapping)
      (error "Required mapping for %s not provided" name))

    (unless (proper-list-p mapping)
      (error "The mapping of %s must be a list" name))

    (when-let* ((non-cons (seq-find (lambda (x) (not (consp x))) mapping)))
      (error "The mapping of %s must be a alist, but %S is not a cons cell"
             name non-cons))

    (when-let* ((non-string-key (seq-find
                                 (lambda (entry) (not (stringp (car-safe entry))))
                                 mapping)))
      (error "The keys of %s must be strings, but %S is not a string"
             name (car non-string-key))))

  (when (plist-member arguments :format-raw)
    (setf (plist-get arguments :format-raw-p)
          (plist-member arguments :format-raw))
    (cl-remf arguments :format-raw))

  (phony--add-new-rule #'phony--make-dictionary arguments)

  (if (or (map-elt arguments :contributes-to)
          (and (map-elt arguments :mode)
               (not (memq 'global (ensure-list (map-elt arguments :mode))))))
      (phony-request-export)
    (phony--request-export-dictionaries)))

(eval-and-compile
  ;; This function is used in the rule defining macros.  The byte
  ;; compiler does not evaluate function definitions, so when we later
  ;; in this file define some rules, an error is emitted if we don't
  ;; wrap the definition in eval-and-compile.
  (defun phony--split-keywords-rest (declaration-args)
    "Split DECLARATION-ARGS into keyword arguments and rest arguments.

Keyword arguments are assumed to occur first.  Returns a cons-cell with
the car being a plist of the keyword arguments and the cdr the rest
arguments."
    (let ((arguments '()))
      (while (keywordp (car declaration-args))
        (push (seq-take declaration-args 2) arguments)
        (setq declaration-args (seq-drop declaration-args 2)))
      (cons (apply #'append arguments) declaration-args))))

(defmacro phony-define-dictionary (name &rest arguments)
  ;; checkdoc-params: (arguments)
  "Define a dictionary with NAME containing ALIST.

ALIST is an alist mapping utterances to values.  An utterance is a
string containing the spoken form for referencing the value.  The
defined rule matches on any of the keys and evaluates to the
corresponding value.

Optional arguments are given as named arguments before ALIST.  They can
be one of the following:

  :format-raw       Export values in a form usable by the engine,
                    not Emacs.  This only works when the values are
                    strings.
  :mode             Same as for `phony-defun'.
  :external-name    Same as for `phony-defun'.
  :contributes-to   Same as for `phony-defun'.

\(fn NAME [DOCSTRING] [KEY VALUE]... ALIST)"
  (declare (indent defun)
           (doc-string 2))
  (let ((documentation (and (stringp (car arguments)) (pop arguments))))
    (pcase-let* ((`(,optional-arguments . (,mapping))
                  (phony--split-keywords-rest arguments)))
      `(phony--define-dictionary
        (append (list :name ',name
                      :documentation ,documentation
                      :mapping ,mapping)
                ',optional-arguments)))))

(defun phony--add-alternative (alternative open-rule-name)
  "Add rule ALTERNATIVE as an alternative for open rule OPEN-RULE-NAME."
  (let ((rule (phony--get-rule open-rule-name)))
    (unless rule
      (error "No rule %s defined" open-rule-name))
    (unless (phony--open-rule-p rule)
      (error "No open rule %s defined" open-rule-name))
    (cl-pushnew alternative (phony--open-rule-alternatives rule))))

(cl-defun phony--define-open-rule (arguments)
  "Define an open rule from ARGUMENTS.

See documentation of `phony-define-open-rule' for more information."
  (phony--add-new-rule #'phony--make-open-rule arguments)
  (phony-request-export)
  (map-elt arguments :name))

(defmacro phony-define-open-rule (name &rest arguments)
  ;; checkdoc-params: (arguments)
  "Define NAME as an open rule.

Open rules match any of the rules specified in ALTERNATIVES, an unquoted
list.  Other rules may add themselves to the list of alternatives by
specifying this rule in their CONTRIBUTES-TO argument.

The value of matching this rule is the value of matching the
corresponding alternative.

Optional keyword arguments MODE, CONTRIBUTES-TO and EXTERNAL-NAME are
the same as for `phony-defun'.

\(fn NAME [DOCSTRING] &key ALTERNATIVES CONTRIBUTES-TO MODE EXTERNAL-NAME)"
  (declare (indent defun)
           (doc-string 2))
  (let ((documentation (and (stringp (car arguments)) (pop arguments))))
    `(phony--define-open-rule
      (append (list :name ',name
                    :documentation ,documentation)
              ',arguments))))

(defun phony--element-children (element)
  "Return all direct sub-elements of ELEMENT."
  (cl-typecase element
    (phony--element-sequence
     (phony--element-sequence-elements element))
    (phony--element-optional
     (list (phony--element-optional-element element)))
    (phony--element-zero-or-more
     (list (phony--element-zero-or-more-element element)))
    (phony--element-one-or-more
     (list (phony--element-one-or-more-element element)))
    (phony--element-argument
     (list (phony--element-argument-element element)))
    (t nil)))

(defun phony--collect (predicate element)
  "Return list of descendants of ELEMENT matching PREDICATE.

If ELEMENT matches PREDICATE, it will be part of the list.  Matches are
returned in the same order that they occur in ELEMENT."
  (let ((collected-children
         (seq-mapcat
          (apply-partially #'phony--collect predicate)
          (phony--element-children element))))
    (if (funcall predicate element)
        (cons element collected-children)
      collected-children)))

(defun phony--dependencies (rule-or-name)
  "Return list of names of the rules RULE-OR-NAME depends on."
  (phony--dependencies-implementation
   (phony--normalize-rule rule-or-name)))

(cl-defgeneric phony--dependencies-implementation (rule)
  "Return list of rule names RULE depends on.")

(cl-defmethod phony--dependencies-implementation ((rule phony--procedure-rule))
  "Return list of rule names RULE depends on.

Names in the returned list occur the same amount of times they are
mentioned in RULE."
  (seq-map #'phony--element-rule-name
           (phony--collect
            #'phony--element-rule-p
            (phony--procedure-rule-element rule))))

(cl-defmethod phony--dependencies-implementation ((rule phony--open-rule))
  "Return names of the alternatives of RULE."
  (phony--open-rule-alternatives rule))

(cl-defmethod phony--dependencies-implementation ((_rule phony--dictionary))
  "Return nil."
  '())

(cl-defgeneric phony--references (rule-or-name)
  "Return list of rules mentioned by RULE-OR-NAME in its declaration.

Each element of the list is a cons cell (NAME . IS-PRODUCER).  NAME is
the name of the mentioned rule.  If IS-PRODUCER is nil, NAME is a
production of RULE-OR-NAME, otherwise it is a producer of it."
  (let ((rule (phony--normalize-rule rule-or-name)))
    (append (seq-map (lambda (reference) (cons reference nil))
                     (phony--dependencies rule))
            (seq-map (lambda (reference) (cons reference t))
                     (phony--rule-contributes-to rule)))))

(cl-defstruct (phony--analysis-data
               (:constructor nil)
               (:constructor phony--make-analysis-data))
  "Storage struct for results of statically analyzing the grammar."
  (mentions
   (make-hash-table)
   :type hash-table
   :documentation "Hash table mapping a rule to a list of rules it names in its declaration.
If a rule is mentioned multiple times, it is duplicated.")
  (mentioners
   (make-hash-table)
   :type hash-table
   :documentation "Hash table mapping a rule to a list of rules that name it in their declaration.
If a rule mentions this rule multiple times, it is duplicated.")
  (productions
   (make-hash-table)
   :type hash-table
   :documentation "Hash table mapping a rule to a list of its submatches.
A production of a rule is a rule whose match is included in the
producing rule's match.  If a production is matched multiple times, it
is duplicated.")
  (producers
   (make-hash-table)
   :type hash-table
   :documentation "Hash table mapping a rule to a list of rules it is a submatch of.
A producer of a rule is a rule whose match includes this rule's match.
If a rule is produced multiple times, it is duplicated.")
  (cycle
   nil
   :type list
   :documentation "If non-nil, a sequence of rule names forming a dependency cycle.")
  (contains-errors
   nil
   :type boolean
   :documentation "Whether the analysis detected errors in the grammar.")
  (linear-extension
   nil
   :type list
   :documentation "Linear extension of the dependency graph.
Also commonly known as topological order.  Rules occurring in this list
are guaranteed to only depend on preceding rules."))

(defun phony--get-mentions (analysis-data rule-or-name)
  ;; checkdoc-params: (analysis-data)
  "Get list of rules mentioned by RULE-OR-NAME in its declaration.

If a rule is mentioned multiple times, it will also occur as many times
in the returned list."
  (gethash (phony--normalize-rule rule-or-name)
           (phony--analysis-data-mentions analysis-data)))

(defun phony--get-mentioners (analysis-data rule-or-name)
  ;; checkdoc-params: (analysis-data)
  "Get list of rules that mention RULE-OR-NAME in their declaration.

If a rule mentions RULE-OR-NAME multiple times, it will also occur as
many times in the returned list."
  (gethash (phony--normalize-rule rule-or-name)
           (phony--analysis-data-mentioners analysis-data)))

(defun phony--get-productions (analysis-data rule-or-name)
  ;; checkdoc-params: (analysis-data)
  "Get list of rules that are submatches of RULE-OR-NAME.

If a rule is a submatch multiple times, it will also occur as many times
in the returned list."
  (gethash (phony--normalize-rule rule-or-name)
           (phony--analysis-data-productions analysis-data)))

(defun phony--get-producers (analysis-data rule-or-name)
  ;; checkdoc-params: (analysis-data)
  "Get list of rules whose match includes RULE-OR-NAME as a submatch.

If a rule includes RULE-OR-NAME multiple times, it will also occur as
many times in the returned list."
  (gethash (phony--normalize-rule rule-or-name)
           (phony--analysis-data-producers analysis-data)))

(defun phony--maximum-producer-multiplicity (analysis-data rule)
  ;; checkdoc-params: (analysis-data)
  "Return maximum amount of times RULE is produced by a single rule."
  (thread-last
    (phony--get-producers analysis-data rule)
    (seq-map #'phony--rule-name)
    (seq-map #'symbol-name)
    (seq-sort #'string<)
    (seq-group-by #'identity)
    (seq-map #'cdr)
    (seq-map #'length)
    (apply #'max 0)))

(defun phony--populate-dependency-graph (analysis-data grammar)
  "Populate the dependency graph of ANALYSIS-DATA from GRAMMAR.

If an undefined rule is mentioned in some element, a warning will be
emitted and `phony--analysis-data-contains-errors' will be set to t."
  (let ((mentions (make-hash-table))
        (mentioners (make-hash-table))
        (productions (make-hash-table))
        (producers (make-hash-table)))
    (seq-doseq (rule (phony--get-rules grammar))
      (puthash rule '() mentions)
      (puthash rule '() mentioners)
      (puthash rule '() productions)
      (puthash rule '() producers))
    (seq-doseq (rule (phony--get-rules grammar))
      (seq-doseq (reference (phony--references rule))
        (if-let* ((reference-rule (phony--get-rule (car reference) grammar)))
            (progn
              (push reference-rule (gethash rule mentions))
              (push rule (gethash reference-rule mentioners))
              (if (cdr reference)
                  (progn
                    (push rule (gethash reference-rule productions))
                    (push reference-rule (gethash rule producers)))
                (push reference-rule (gethash rule productions))
                (push rule (gethash reference-rule producers))))
          (display-warning 'phony
                           (format "Rule %S (mentioned in %S) is not defined"
                                   (car reference)
                                   (phony--rule-name rule)))
          (oset analysis-data contains-errors t)))
      (oset analysis-data mentions mentions)
      (oset analysis-data mentioners mentioners)
      (oset analysis-data productions productions)
      (oset analysis-data producers producers))))

(defun phony--try-linear-extension-impl (rule visited finished analysis-data)
  "Find linear extension of dependency graph in ANALYSIS-DATA.

This function assumes that `phony--analysis-data-productions' has been
populated in ANALYSIS-DATA.

This function populates `phony--analysis-data-linear-extension' in
ANALYSIS-DATA.  If a cycle is detected
`phony--analysis-data-contains-errors' is set to t and the cycle is
returned without visiting any more rules.  Otherwise, this function
returns nil.

RULE is the currently visited rule.  VISITED is a hash table of the
already visited rules.  FINISHED is a hash table of rules that have been
fully processed.  This function adds RULE to VISITED before recusing to
its children, and to FINISHED afterwards."
  (let ((dependencies (oref analysis-data productions)))
    (cl-block nil
      (when (gethash rule finished)
        (cl-return nil))
      (when (gethash rule visited)
        (cl-return (list rule)))

      (puthash rule t visited)
      (seq-doseq (dependency (gethash rule dependencies))
        (when-let* ((path (phony--try-linear-extension-impl
                           dependency visited finished analysis-data)))
          (if (and (not (length= path 1))
                   (eq (seq-first path) (car (last path))))
              (cl-return path)
            (cl-return (cons rule path)))))

      (puthash rule t finished)
      (push rule (oref analysis-data linear-extension))
      (cl-return nil))))

(cl-defun phony--try-linear-extension (analysis-data grammar)
  "Try to construct the linear extension of GRAMMAR's dependency graph.

This function assumes that `phony--analysis-data-productions' has been
populated in ANALYSIS-DATA.

If it is not possible to create a linear extension because of a cycle,
`phony--analysis-data-cycle' of ANALYSIS-DATA is set to that cycle and
`phony--analysis-data-contains-errors' is set to t.  Otherwise,
`phony--analysis-data-linear-extension' is populated with a valid linear
extension."
  (let ((visited (make-hash-table))
        (finished (make-hash-table)))
    (seq-doseq (rule (phony--get-rules grammar))
      (when-let* ((cycle (phony--try-linear-extension-impl
                          rule visited finished
                          analysis-data)))
        (oset analysis-data cycle (seq-map #'phony--rule-name cycle))
        (cl-return-from phony--try-linear-extension)))))

(defvar phony--last-analysis nil
  "Results of the last performed analysis.")

(defun phony--analyze-grammar (grammar)
  "Analyze GRAMMAR.

This returns a `phony--analysis-data' structure populated with the
results of the analysis."
  (let ((analysis-data (phony--make-analysis-data)))
    (phony--populate-dependency-graph analysis-data grammar)
    (phony--try-linear-extension analysis-data grammar)
    (setf (phony--analysis-data-linear-extension analysis-data)
          (reverse
           (phony--analysis-data-linear-extension analysis-data)))
    (when-let* ((cycle (phony--analysis-data-cycle analysis-data)))
      (display-warning 'phony (concat "Cycle found: "
                                      (string-join
                                       (seq-map #'symbol-name cycle)
                                       " -> ")))
      (setf (phony--analysis-data-contains-errors analysis-data) t))
    (setq phony--last-analysis analysis-data)
    analysis-data))

(defun phony--producers (rule-or-name)
  "Return producers of RULE-OR-NAME.

Producers are rules whose match includes RULE-OR-NAME as a submatch.

This function depends on `phony--last-analysis'.  If an analysis has not
been performed, the returned value may be out of date."
  (gethash
   (phony--normalize-rule rule-or-name)
   (phony--analysis-data-producers phony--last-analysis)))

(defcustom phony-export-function #'phony-talon-export
  "Function to be used for exporting spoken rules."
  ;; Using radio instead of choice did not display :tag
  :type '(choice (function-item :tag "Dragonfly exporter"
                                phony-dragonfly-export)
                 (function-item :tag "Talon exporter"
                                phony-talon-export))
  :tag "Phony Rule Exporter"
  :risky t
  :group 'phony)

(defun phony--export-all ()
  "Export all rules to the speech recognition engine.

If any errors are detected in the grammar, the rules are not exported.

If no rules are defined, this function does nothing."
  (when (phony--get-rules)
    (let* ((compiled-grammar (phony--compile-grammar phony--default-grammar))
           (analysis-data (phony--analyze-grammar compiled-grammar))
           (phony--default-grammar compiled-grammar))
      (if (phony--analysis-data-contains-errors analysis-data)
          (display-warning 'phony "Grammar contains errors, not exporting")
        (phony--export-dictionaries)
        (when (and (not (server-running-p))
                   (y-or-n-p "Emacs needs to run as a daemon for phony to work.  Start daemon?"))
          (server-start))
        (cancel-function-timers #'phony--sync-state)
        (run-with-idle-timer 0.1 t #'phony--sync-state)
        (funcall phony-export-function analysis-data)
        (phony-parser--rebuild analysis-data)))))

(defun phony--debounce (f)
  "Debounce the invocation of F by waiting until next idle.

Multiple invocations to F will collapse into one invocation upon idle
timer activation."
  (cancel-function-timers f)
  (run-with-idle-timer 0.0 nil f))

(defun phony-request-export ()
  "Export all rules when next idle.

If `phony-mode' is not enabled, this function does nothing."
  (interactive)
  (when phony-mode
    (if phony--debounce-export-requests
        (phony--debounce #'phony--export-all)
      (phony--export-all))))

(defun phony--define-procedure-rule (arguments)
  "Define a procedure rule from ARGUMENTS.

See `phony-defun' for more information."
  (if (plist-member arguments :interactive)
      (progn (setf (plist-get arguments :interactive-p)
                   (plist-get arguments :interactive))
             (cl-remf arguments :interactive))
    (setf (plist-get arguments :interactive-p)
          (not (map-contains-key arguments :contributes-to))))
  (when (plist-member arguments :anchor-beginning)
    (setf (plist-get arguments :anchor-beginning-p)
          (plist-get arguments :anchor-beginning))
    (cl-remf arguments :anchor-beginning))
  (when (plist-member arguments :anchor-end)
    (setf (plist-get arguments :anchor-end-p)
          (plist-get arguments :anchor-end))
    (cl-remf arguments :anchor-end))
  (phony--add-new-rule #'phony--make-procedure-rule arguments)
  (phony-request-export)
  (plist-get arguments :name))

(defmacro phony-defun (name pattern &rest rest)
  ;; checkdoc-params: (rest)
  "Define a procedure rule invokeable by voice.

NAME is the unquoted name of the rule.

When PATTERN is matched, BODY is evaluated.  This can be done to perform
actions through side effects, or to provide values for other rules.  The
value of matching the procedure rule is the value returned by BODY.

PATTERN is either a string literal, in which case the rule is matched
when that string is uttered, or it is an unquoted list of elements.  In
that case the rule is matched when each element is uttered in sequence.
An element can take the following forms:

  STRING           Match a literal STRING.
  RULE             Match a rule named RULE.
  (ARG RULE)       Match RULE, bind its value to argument ARG when
                   evaluating BODY.
  (seq ELEMS...)   Match elements ELEMS in sequence.
  (? ELEMS...)     Optionally match elements ELEMS.
  (* ELEMS...)     Match elements ELEMS zero or more times.
  (+ ELEMS...)     Match elements ELEMS one or more times.

Optional argument DOCSTRING is a documentation string for the rule.

Optional keyword arguments or provided as an alternating sequence of KEY
and VALUE.  Optional keyword arguments are:

  :interactive       If nil, this rule cannot be spoken directly but may
                     occur as part of other rules.  Default is t unless
                     `:contributes-to' is set, in which case the default
                     is nil.
  :mode              An unquoted mode or list of modes for which this
                     rule should be active.  If none of the modes match,
                     this rule can't match.  As a special case, `global'
                     always matches.  Default is `global'.
  :contributes-to    An unquoted symbol or list of symbols of open
                     rules that this procedure should contribute to.
                     See `phony-define-open-rule' for open rules.
                     Default is nil.
  :anchor-beginning  If t, this rule must occur first in an utterance.
                     Default is nil.
  :anchor-end        If t, this rule must occur last in an utterance.
                     Default is nil.
  :external-name     If given, this rule will be given this name for
                     the external speech engine.  Otherwise, it gets
                     assigned an unspecified auto-generated name.

\(fn NAME PATTERN [DOCSTRING] [KEY VALUE]... BODY...)"
  (declare (indent 2)
           (doc-string 3)
           (debug (&define
                   name
                   [&or stringp sexp]
                   [&rest keywordp sexp]
                   def-body)))
  ;; Syntactical design decisions:
  ;; - Automatic argument deduction: Explicitly specifying the
  ;;   argument list meant that adding a parameter necessitated a
  ;;   change in two places.  Things like optional arguments were not
  ;;   semantically relevant in the argument list, as they would
  ;;   always be populated with nil anyway.
  ;; - Optional parameters after docstring: The doc-string declare
  ;;   form only allows a constant, so comment syntax highlighting
  ;;   would not be possible the other way around.
  ;; - Elision of parentheses when pattern is just a literal: Allows the
  ;;   following nice looking syntax:
  ;;   (phony-defun chuck-line "chuck line"
  ;;     (kill-line))
  ;; - Pattern after name, before doc-string:
  ;;   - I want the pattern to be indented specially, but not the
  ;;     docstring.  The indent declare form allows this if
  ;;     pattern is before documentation.
  ;;   - If it was the other way around and documentation was omitted,
  ;;     the elision of parentheses for string literals could trick
  ;;     the syntax highlighting to treat it as documentation.
  ;; - Implicit argument naming: This allows the following terse
  ;;   syntax for simple rules:
  ;;   (phony-defun chuck-thing ("chuck" thing)
  ;;     (kill-thing thing))
  ;; - Name phony-defun: Chosen because of the similarity with defun.
  ;;   However, this could potentially give the impression that we are
  ;;   defining a function, something that may not be true in the future.
  ;; - Implicit seq for sequence of elements: In practice, this is the
  ;;   most common construction to use at the top level (perhaps
  ;;   excepts a single string literal, which is also covered by
  ;;   shorthand).  Might as well allow eliding it.
  ;; - Unquoted :contributes-to: By restricting the legal forms that
  ;;   may be passed to it, we can better utilize capf and xref.  For
  ;;   example, we know that function names cannot appear in the form,
  ;;   so those may be filtered out from completion and
  ;;   go-to-definition.

  ;; TODO: Move more of the logic to phony--define-procedure-rule:
  ;; - Implicit argument deduction
  ;; - Adding implicit 'seq (if not already done)
  ;; - Sanity checks
  ;; - Consider removing implicit argument naming.  In the presence of
  ;;   namespaces, the default argument name is too clunky anyway.
  (let* ((doc (and (stringp (car rest)) (pop rest)))
         (split-arguments (phony--split-keywords-rest rest))
         (optional-arguments (car split-arguments))
         (body (cdr split-arguments))
         (expanded-pattern
          (phony--expand-implicit-arguments
           (cons 'seq (ensure-list pattern))))
         (arguments (phony--collect-arguments expanded-pattern))
         (unused-arguments
          (seq-remove (lambda (argument)
                        (or (string-prefix-p "_" (symbol-name argument))
                            (memq argument (flatten-tree body))))
                      arguments)))

    (cond
     (unused-arguments
      `(display-warning
        'phony
        ,(concat
          (format "Unused arguments in %s: %s\n"
                  name
                  (mapconcat #'symbol-name unused-arguments ", "))
          "Either use it in the body or prefix the argument with \"_\" (underscore)")))
     ((not (equal (seq-uniq arguments) arguments))
      ;; TODO: Do not emit this warning if duplication is implicit and
      ;; not used in body.
      `(display-warning
        'phony
        ,(concat
          (format "Duplicate arguments in %s\n" name)
          "If you use implicit argument names, make them explicit")))
     (t `(phony--define-procedure-rule
          (append
           (list :name ',name
                 ;; Why the ensure-list?  Probably fine to just splice
                 ;; doc...
                 :function (lambda ,arguments ,@(ensure-list doc) ,@body)
                 :arglist ',arguments
                 :element ,(phony--parse-speech-element expanded-pattern arguments)
                 :documentation ,doc)
           ',optional-arguments))))))

(eval-and-compile
  (defun phony--expand-implicit-arguments (element-form)
    "Expand implicit arguments in ELEMENT-FORM.

A bare symbol `foo' is expanded to `(foo foo)', binding the rule's
match value to an argument of the same name.  Recurses into `seq',
`?', `+', `*' forms."
    (cond
     ((and (listp element-form) (memq (car element-form) '(seq ? + *)))
      `(,(car element-form)
        ,@(seq-map #'phony--expand-implicit-arguments (cdr element-form))))
     ((symbolp element-form)
      `(,element-form ,element-form))
     (t element-form)))

  (defun phony--collect-arguments (element-form)
    "Collect argument names from ELEMENT-FORM.
Return a list of symbols, one per argument binding found in the
element tree."
    (cond
     ((and (listp element-form) (memq (car element-form) '(seq ? + *)))
      (seq-mapcat #'phony--collect-arguments (cdr element-form)))
     ((listp element-form)
      (list (car element-form)))
     (t '()))))

(phony-define-dictionary phony-module
  "Dictionary of defined modules.
Whenever a module is defined with `phony-module', it is added to this
dictionary."
  '())

(phony-defun phony-enable-module ("phony enable" (? (module phony-module)))
  "Enable MODULE.
If MODULE is not given, prompt for it before enabling it."
  (if module
      (phony-enable-module
       module
       (y-or-n-p (format "Enable %s for future sessions? " module)))
    (call-interactively #'phony-enable-module)))

(phony-defun phony-disable-module ("phony disable" (? (module phony-module)))
  "Disable MODULE.
If MODULE is not given, prompt for it before disabling it."
  (if module
      (phony-disable-module
       module
       (y-or-n-p (format "Disable %s for future sessions? " module)))
    (call-interactively #'phony-disable-module)))

(defun phony--sync-state ()
  "Export information about which rules are currently active."
  ;; We must filter the enabled rules before doing with-temp-file, as
  ;; that may otherwise influence which rules are enabled.
  (let ((active-rules (seq-filter #'phony--rule-active-p (phony--get-rules))))
    (with-temp-file (phony--output-directory "active-rules")
      (insert (string-join
               (seq-map #'phony--rule-external-name
                        (seq-remove #'phony--rule-always-active-p active-rules))
               "\n")
              "\n"))))

(defun phony--evaluate-ast (ast)
  "Evaluate AST constructed from an utterance."
  (if (atom ast)
      ast
    (let* ((type (car ast))
           (arguments (cdr ast))
           (rule (phony--get-rule type)))
      (cond
       ((eq type 'list)
        (seq-map #'phony--evaluate-ast
                 arguments))
       ((phony--dictionary-p rule)
        (phony-dictionary-get (car arguments) type))
       ((phony--procedure-rule-p rule)
        (apply (phony--procedure-rule-function rule)
               (seq-map #'phony--evaluate-ast
                        arguments)))
       ((phony--open-rule-p rule)
        (phony--evaluate-ast (cadr ast)))
       (t (error "Failed to evaluate AST: %S" ast))))))

(autoload 'phony-talon-export "phony-talon")
(autoload 'phony-dragonfly-export "phony-dragonfly")

(provide 'phony)
(require 'phony-parser)
;;; phony.el ends here
