;; SPDX-FileCopyrightText: 2026 Andrew Oberstar <andrew@ajoberstar.org>
;; SPDX-License-Identifier: AGPL-3.0-only

(in-package #:org.ajoberstar.quixote.search)

(defparameter +types+ (list :author :edition :part :collection))

(defun parse-query (query)
  (let ((start 0)
        (point 0))
    (labels ((empty-p ()
               (eql start point))
             (peek ()
               (cond
                 ((< point start)
                  nil)
                 ((<= (length query) point)
                  :eof)
                 (t
                  (elt query point))))
             (forward ()
               (incf point)
               (peek))
             (result ()
               (subseq query start point))
             (consume ()
               (let ((result (result)))
                 (setf start point)
                 result))
             (whitespace-p (char)
               (member char '(#\Space #\Tab #\Newline #\Return) :test #'eql))
             (separator ()
               (loop for char = (peek) then (peek)
                     while (whitespace-p char)
                     do (forward)
                     finally (return (if (empty-p)
                                         nil
                                         (progn
                                           (consume)
                                           t)))))
             (unquoted ()
               (loop for char = (peek) then (peek)
                     until (or (whitespace-p char) (eql #\" char) (eql :eof char))
                     do (forward)
                     finally (return (if (empty-p)
                                         nil
                                         (consume)))))
             (quoted ()
               (when (eql #\" (peek))
                 (forward)
                 (loop for char = (peek) then (peek)
                       until (eql :eof char)
                       do (forward)
                       until (eql #\" char)
                       when (and (eql #\\ char) (or (eql #\\ (peek))
                                                    (eql #\" (peek))))
                         do (forward)
                       finally (return (if (empty-p)
                                           nil
                                           (with-output-to-string (out)
                                             (loop for i from (1+ start) below (1- point)
                                                   when (and (eql #\\ (char query i))
                                                             (or (eql #\\ (char query (1+ i)))
                                                                 (eql #\" (char query (1+ i)))))
                                                     do (incf i)
                                                   do (write-char (char query i) out))
                                             (let ((last-char (char query (1- point))))
                                               (unless (eql #\" last-char)
                                                 (write-char last-char out)))
                                             (setf start point)))))))
             (value ()
               (or (quoted) (unquoted)))
             (key ()
               (loop for char = (peek) then (peek)
                     until (or (whitespace-p char) (member char '(#\" #\: :eof)))
                     do (forward)
                     finally (return (if (or (empty-p) (not (eql #\: char)))
                                         nil
                                         (consume)))))
             (field ()
               (let* ((old-start start)
                      (key (key))
                      (colon (when (and key (eql #\: (peek)))
                               (forward)
                               (consume)))
                      (value (when (and key colon)
                               (value))))
                 (cond
                   ((not (and key colon value))
                    (setf start old-start)
                    (setf point old-start)
                    nil)
                   ((string-equal "is" key)
                    (list :flag value))
                   (t
                    (list :field key value)))))
             (bare ()
               (let ((result (value)))
                 (when result
                   (list :bare result))))
             (term ()
               (or (field) (bare) (separator))))
      (when (< 0 (length query))
        (loop for term = (term) then (term)
              when (not (eql t term))
                collect term
              until (eql :eof (peek)))))))

(defun search-parsed (parsed &key (types +types+) limit offset)
  (when parsed
    (loop with kinds = (loop for (tag key value) in parsed
                             when (and (eql :field tag) (string-equal "kind" key))
                               collect (intern (string-upcase value) :keyword))
          with terms = (loop for term in parsed
                             unless (string-equal "kind" (second term))
                               collect term)
          for type in (if kinds (intersection types kinds) types)
          collect (ecase type
                    (:author (cons :authors (db:search-authors terms :limit limit :offset offset)))
                    (:edition (cons :editions (db:search-editions terms :limit limit :offset offset)))
                    (:part (cons :parts (db:search-parts terms :limit limit :offset offset)))
                    (:collection (cons :collections (db:search-collections terms :limit limit :offset offset)))))))

(defun search (query &key (types +types+) limit offset)
  (search-parsed (parse-query query)
                 :types types
                 :limit (or limit 0)
                 :offset (or offset 0)))
