<commit_before>;;; emacsql-compile.el --- s-expression SQL compiler -*- lexical-binding: t; -*-

;;; Code:

(require 'cl-lib)

;;; Error symbols

(defmacro emacsql-deferror (symbol parents message)
  "Defines a new error symbol  for EmacSQL."
  (declare (indent 2))
  (let ((conditions (cl-remove-duplicates
                     (append parents (list symbol 'emacsql-error 'error)))))
    `(prog1 ',symbol
       (setf (get ',symbol 'error-conditions) ',conditions
             (get ',symbol 'error-message) ,message))))

(emacsql-deferror emacsql-error () ;; parent condition for all others
  "EmacSQL had an unhandled condition")

(emacsql-deferror emacsql-syntax () "Invalid SQL statement")
(emacsql-deferror emacsql-internal () "Internal error")
(emacsql-deferror emacsql-locked () "Database locked")
(emacsql-deferror emacsql-fatal () "Fatal error")
(emacsql-deferror emacsql-memory () "Out of memory")
(emacsql-deferror emacsql-corruption () "Database corrupted")
(emacsql-deferror emacsql-access () "Database access error")
(emacsql-deferror emacsql-timeout () "Query timeout error")
(emacsql-deferror emacsql-warning () "Warning message")

(defun emacsql-error (format &rest args)
  "Like `error', but signal an emacsql-syntax condition."
  (signal 'emacsql-syntax (list (apply #'format format args))))

;;; Escaping functions

(defvar emacsql-reserved (make-hash-table :test 'equal)
  "Collection of all known reserved words, used for escaping.")

(defun emacsql-register-reserved (seq)
  "Register sequence of keywords as reserved words, returning SEQ."
  (cl-loop for word being the elements of seq
           do (setf (gethash (upcase (format "%s" word)) emacsql-reserved) t)
           finally (cl-return seq)))

(defun emacsql-reserved-p (name)
  "Returns non-nil if string NAME is a SQL keyword."
  (gethash (upcase name) emacsql-reserved))

(defun emacsql-quote-scalar (string)
  "Single-quote (scalar) STRING for use in a SQL expression."
  (format "'%s'" (replace-regexp-in-string "'" "''" string)))

(defun emacsql-quote-identifier (string)
  "Double-quote (identifier) STRING for use in a SQL expression."
  (format "\"%s\"" (replace-regexp-in-string "\"" "\"\"" string)))

(defun emacsql-escape-identifier (identifier)
  "Escape an identifier, if needed, for SQL."
  (when (or (null identifier)
            (keywordp identifier)
            (not (symbolp identifier)))
    (emacsql-error "Invalid identifier: %S" identifier))
  (let ((name (symbol-name identifier)))
    (if (string-match-p ":" name)
        (mapconcat #'emacsql-escape-identifier
                   (mapcar #'intern (split-string name ":")) ".")
      (let ((print (replace-regexp-in-string "-" "_" (format "%S" identifier)))
            (special "[]-\000-\040!\"#%&'()*+,./:;<=>?@[\\^`{|}~\177]"))
        (if (or (string-match-p special print)
                (string-match-p "^[0-9$]" print)
                (emacsql-reserved-p print))
            (emacsql-quote-identifier print)
          print)))))

(defun emacsql-escape-scalar (value)
  "Escape VALUE for sending to SQLite."
  (let ((print-escape-newlines t))
    (cond ((null value) "NULL")
          ((numberp value) (prin1-to-string value))
          ((emacsql-quote-scalar (prin1-to-string value))))))

(defun emacsql-escape-vector (vector)
  "Encode VECTOR into a SQL vector scalar."
  (cl-typecase vector
    (null   (emacsql-error "Empty SQL vector expression."))
    (list   (mapconcat #'emacsql-escape-vector vector ", "))
    (vector (concat "(" (mapconcat #'emacsql-escape-scalar vector ", ") ")"))
    (otherwise (emacsql-error "Invalid vector %S" vector))))

(defun emacsql-escape-format (thing &optional kind)
  "Escape THING for use as a `format' spec, pre-escaping for KIND.
KIND should be :scalar or :identifier."
  (replace-regexp-in-string
   "%" "%%" (cl-case kind
              (:scalar (emacsql-escape-scalar thing))
              (:identifier (emacsql-escape-identifier thing))
              (:vector (emacsql-escape-vector thing))
              (otherwise thing))))

;;; Schema compiler

(defvar emacsql-type-map
  '((integer "&INTEGER")
    (float "&REAL")
    (object "&TEXT")
    (nil "&NONE"))
  "An alist mapping EmacSQL types to SQL types.")

(defun emacsql--from-keyword (keyword)
  "Convert KEYWORD into SQL."
  (let ((name (substring (symbol-name keyword) 1)))
    (upcase (replace-regexp-in-string "-" " " name))))

(defun emacsql--prepare-constraints (constraints)
  "Compile CONSTRAINTS into a partial SQL expresson."
  (mapconcat
   #'identity
   (cl-loop for constraint in constraints collect<commit_msg>Drop emacsql-escape-format's KIND argument.<commit_after>;;; emacsql-compile.el --- s-expression SQL compiler -*- lexical-binding: t; -*-

;;; Code:

(require 'cl-lib)

;;; Error symbols

(defmacro emacsql-deferror (symbol parents message)
  "Defines a new error symbol  for EmacSQL."
  (declare (indent 2))
  (let ((conditions (cl-remove-duplicates
                     (append parents (list symbol 'emacsql-error 'error)))))
    `(prog1 ',symbol
       (setf (get ',symbol 'error-conditions) ',conditions
             (get ',symbol 'error-message) ,message))))

(emacsql-deferror emacsql-error () ;; parent condition for all others
  "EmacSQL had an unhandled condition")

(emacsql-deferror emacsql-syntax () "Invalid SQL statement")
(emacsql-deferror emacsql-internal () "Internal error")
(emacsql-deferror emacsql-locked () "Database locked")
(emacsql-deferror emacsql-fatal () "Fatal error")
(emacsql-deferror emacsql-memory () "Out of memory")
(emacsql-deferror emacsql-corruption () "Database corrupted")
(emacsql-deferror emacsql-access () "Database access error")
(emacsql-deferror emacsql-timeout () "Query timeout error")
(emacsql-deferror emacsql-warning () "Warning message")

(defun emacsql-error (format &rest args)
  "Like `error', but signal an emacsql-syntax condition."
  (signal 'emacsql-syntax (list (apply #'format format args))))

;;; Escaping functions

(defvar emacsql-reserved (make-hash-table :test 'equal)
  "Collection of all known reserved words, used for escaping.")

(defun emacsql-register-reserved (seq)
  "Register sequence of keywords as reserved words, returning SEQ."
  (cl-loop for word being the elements of seq
           do (setf (gethash (upcase (format "%s" word)) emacsql-reserved) t)
           finally (cl-return seq)))

(defun emacsql-reserved-p (name)
  "Returns non-nil if string NAME is a SQL keyword."
  (gethash (upcase name) emacsql-reserved))

(defun emacsql-quote-scalar (string)
  "Single-quote (scalar) STRING for use in a SQL expression."
  (format "'%s'" (replace-regexp-in-string "'" "''" string)))

(defun emacsql-quote-identifier (string)
  "Double-quote (identifier) STRING for use in a SQL expression."
  (format "\"%s\"" (replace-regexp-in-string "\"" "\"\"" string)))

(defun emacsql-escape-identifier (identifier)
  "Escape an identifier, if needed, for SQL."
  (when (or (null identifier)
            (keywordp identifier)
            (not (symbolp identifier)))
    (emacsql-error "Invalid identifier: %S" identifier))
  (let ((name (symbol-name identifier)))
    (if (string-match-p ":" name)
        (mapconcat #'emacsql-escape-identifier
                   (mapcar #'intern (split-string name ":")) ".")
      (let ((print (replace-regexp-in-string "-" "_" (format "%S" identifier)))
            (special "[]-\000-\040!\"#%&'()*+,./:;<=>?@[\\^`{|}~\177]"))
        (if (or (string-match-p special print)
                (string-match-p "^[0-9$]" print)
                (emacsql-reserved-p print))
            (emacsql-quote-identifier print)
          print)))))

(defun emacsql-escape-scalar (value)
  "Escape VALUE for sending to SQLite."
  (let ((print-escape-newlines t))
    (cond ((null value) "NULL")
          ((numberp value) (prin1-to-string value))
          ((emacsql-quote-scalar (prin1-to-string value))))))

(defun emacsql-escape-vector (vector)
  "Encode VECTOR into a SQL vector scalar."
  (cl-typecase vector
    (null   (emacsql-error "Empty SQL vector expression."))
    (list   (mapconcat #'emacsql-escape-vector vector ", "))
    (vector (concat "(" (mapconcat #'emacsql-escape-scalar vector ", ") ")"))
    (otherwise (emacsql-error "Invalid vector %S" vector))))

(defun emacsql-escape-format (thing)
  "Escape THING for use as a `format' spec."
  (replace-regexp-in-string "%" "%%" thing))

;;; Schema compiler

(defvar emacsql-type-map
  '((integer "&INTEGER")
    (float "&REAL")
    (object "&TEXT")
    (nil "&NONE"))
  "An alist mapping EmacSQL types to SQL types.")

(defun emacsql--from-keyword (keyword)
  "Convert KEYWORD into SQL."
  (let ((name (substring (symbol-name keyword) 1)))
    (upcase (replace-regexp-in-string "-" " " name))))

(defun emacsql--prepare-constraints (constraints)
  "Compile CONSTRAINTS into a partial SQL expresson."
  (mapconcat
   #'identity
   (cl-loop for constraint in constraints collect
{'fraction_non_alphanumeric': 0.15543344174049567, 'fraction_numerical': 0.003588650891555456, 'mean_word_length': 3.4994954591321896, 'pattern_counts': {'":': 4, '<': 5, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5131167', 'n_tokens_mistral': 2949, 'n_tokens_neox': 2870, 'n_words': 815}