cl-bible/search.lisp

;;;; search.lisp

(in-package #:cl-bible.search)

(defun find-in-bible (bible phrase)
  (remove-if-not (lambda (verse) (search phrase (v:text verse)))
                 bible))

(defmethod find-book (bible book)
  (remove-if-not (lambda (verse) (search book (v:bname verse))) bible))

(defmethod find-chapter (book chapter)
  (remove-if-not (lambda (verse) (string= chapter (v:chapter verse))) book))

(defmethod find-verse (chapter verse)
  (remove-if-not (lambda (v) (string= verse (v:vnumber v))) chapter))

(defclass pos ()
  ((book :initarg :book
          :reader book)
   (start :initarg :start
          :initform nil
          :reader start)
   (end :initarg :end
        :initform nil
        :reader end)))
   
(defclass verse-pos ()
  ((chapter :initarg :chapter
            :reader chapter)
   (verse :initarg :verse
          :initform nil
          :reader verse)))

(defmethod parse-position :around ((position string))
  (cond ((string= position "") nil)
        ((find #\space position) (call-next-method))
        (t (make-instance 'pos :book position))))

(defmethod parse-position ((position string))
  (let* ((first-split (uiop:split-string position :separator '(#\space)))
         (split (if (ignore-errors (parse-integer (first first-split)))
                    (cons (format nil "~A ~A" (first first-split)
                                  (second first-split))
                          (cddr first-split))
                    first-split)))
    (if (cdr split)
        (parse-position split)
        (make-instance 'pos :book (first split)))))

(defmethod parse-position ((position cons))
  (destructuring-bind (book rest)
      position
    (if (find #\- rest)
        (destructuring-bind (start end)
            (uiop:split-string rest :separator '(#\-))
          (make-instance 'pos :book book
                              :start (parse-verse-pos start)
                              :end (parse-verse-pos end)))
        (make-instance 'pos :book book
                            :start (parse-verse-pos rest)))))

(defun parse-verse-pos (verse-pos)
  (if (find #\, verse-pos)
      (destructuring-bind (chapter verse)
          (uiop:split-string verse-pos :separator '(#\,))
        (make-instance 'verse-pos :chapter (parse-integer chapter)
                                  :verse (parse-integer verse)))
      (make-instance 'verse-pos :chapter (parse-integer verse-pos))))

(defmethod bookp ((pos pos))
  (if (start pos) nil t))

(defmethod rangep ((pos pos))
  (if (end pos) t nil))

(defmethod versep ((pos verse-pos))
  (if (verse pos) t nil))

(defmethod versep ((pos pos))
  (versep (start pos)))

(defun find-position (bible position)
  "Accepts a bible citation of the form \"Genesis 18,32\" and returns
the requested verse/s"
  (let ((pos (parse-position position)))
    (with-accessors ((book book)
                     (start start)
                     (end end))
        pos
      (let* ((book (find-book bible book))
             (chapter (if (rangep pos)
                          (loop :for chapter :from (chapter start) :to (chapter end)
                                :append (find-chapter book (format nil "~A" chapter)))
                          (find-chapter book (format nil "~A" (chapter start))))))
        (if (versep pos)
            (if (rangep pos)
                (loop :for verse :from (verse start) :to (verse end)
                      :append (find-verse chapter (format nil "~A" verse)))
                (find-verse chapter (format nil "~A" (verse start))))
            chapter)))))

(defmethod find-book (bible (pos pos))
  (find-book bible (book pos)))

(defmethod find-chapter (bible (pos pos))
  (let ((book (find-book bible pos)))
    (if (bookp pos)
        book
        (with-accessors ((start start)
                         (end end))
            pos
          (if (rangep pos)
              (loop :for chapter :from (chapter start) :to (chapter end)
                    :append (find-chapter book (format nil "~A" chapter)))
              (find-chapter book (format nil "~A" (chapter start))))))))

(defmethod find-verse (bible (pos pos))
  (let ((chapter (find-chapter bible pos)))
    (if (bookp pos)
        chapter
        (with-accessors ((start start)
                         (end end))
            pos
          (if (versep pos)
              (if (rangep pos)
                  (loop :for verse :from (verse start) :to (verse end)
                        :append (find-verse chapter (format nil "~A" verse)))
                  (find-verse chapter (format nil "~A" (verse start))))
              chapter)))))