You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
116 lines
4.0 KiB
116 lines
4.0 KiB
;;;; search.lisp |
|
|
|
(in-package #:cl-bible.search) |
|
|
|
(defun find-in-bible (bible phrase) |
|
(remove-if-not (lambda (verse) (search phrase (v:get-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 position () |
|
((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))) |
|
|
|
(defun parse-position (position) |
|
(if (find #\space position) |
|
(destructuring-bind (book rest) |
|
(uiop:split-string position :separator '(#\space)) |
|
(if (find #\- rest) |
|
(destructuring-bind (start end) |
|
(uiop:split-string rest :separator '(#\-)) |
|
(make-instance 'position :book book |
|
:start (parse-verse-pos start) |
|
:end (parse-verse-pos end))) |
|
(make-instance 'position :book book |
|
:start (parse-verse-pos rest)))) |
|
(make-instance 'position :book position))) |
|
|
|
(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 position)) |
|
(if (start pos) nil t)) |
|
|
|
(defmethod rangep ((pos position)) |
|
(if (end pos) t nil)) |
|
|
|
(defmethod versep ((pos verse-pos)) |
|
(if (verse pos) t nil)) |
|
|
|
(defmethod versep ((pos position)) |
|
(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 position)) |
|
(find-book bible (book pos))) |
|
|
|
(defmethod find-chapter (bible (pos position)) |
|
(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 position)) |
|
(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)))))
|
|
|