guile-vocabulary-trainer/search.scm

(library (search)
  (export make-general-comparator
          default-fallback-comparator
          default-string-comparator
          default-number-comparator
          default-vector-comparator
          default-boolean-comparator)
  (import (rnrs base)
          (only (guile)
                lambda* λ
                simple-format
                current-output-port
                string-contains
                pk)
          (alist-procs)
          (bool-utils)
          ;; SRFIs
          ;; SRFI 1 - list procs
          (srfi srfi-1)
          ;; SRFI 43 - vector procs
          (srfi srfi-43)
          ;; SRFI 69 - hash-table procs
          (srfi srfi-69)))


(define default-string-comparator
  (λ (attr-val searched-val)
      "Either equal to the searched string or containing the
searched string."
      (or (string=? attr-val searched-val)
          (not
           (equal? #f
                   (string-contains attr-val searched-val))))))


(define default-number-comparator
  (λ (attr-val searched-val)
    "Equal to the searched number."
    (cond
     [(string? searched-val)
      (let ([as-num (string->number searched-val)])
        (cond
         [(number? as-num) (= attr-val as-num)]
         [else #f]))]
     [(number? searched-val)
      (= attr-val searched-val)]
     [else
      #f])))


(define default-boolean-comparator
  (λ (attr-val searched-val)
    "Equal to searched string converted to boolean."
    (equal? attr-val
            (string->boolean
             searched-val
             ;; If the searched value cannot be converted to
             ;; a boolean, simply use it as is, which will
             ;; result in the result being #f.
             #:conversion-error-thunk (λ () searched-val)))))


(define default-vector-comparator
  (λ (attr-val searched-val)
    "Equal or containing a value, which is equal according
to on of the other default comparators."
    (vector-fold (λ (index acc elem)
                   (or acc
                       (cond
                        [(boolean? elem)
                         (default-boolean-comparator elem searched-val)]
                        [(number? elem)
                         (default-number-comparator elem searched-val)]
                        [(string? elem)
                         (default-string-comparator elem searched-val)]
                        [else
                         (equal? elem searched-val)])))
                 #f
                 attr-val)))


(define default-fallback-comparator
  (λ (attr-val searched-val)
    "Equal."
    (equal? attr-val searched-val)))


(define make-general-comparator
  (lambda* (#:key
            (number-comparator #f)
            (string-comparator #f)
            (boolean-comparator #f)
            (vector-comparator #f)
            (fallback-comparator #f))
    "Create a general search function using the given
comparators. If one of the comparators is #f the
FALLBACK-COMPARATOR will be used in its stead."
    (λ (attr-val seeked)
      ;; This code looks kind of dumb. Tried a hash-table of
      ;; type predicates and corresponding comparators, but
      ;; that did not look much better. Not sure how to
      ;; improve it.
      (cond
       [(string? attr-val)
        ((or string-comparator default-string-comparator) attr-val seeked)]
       [(number? attr-val)
        ((or number-comparator default-number-comparator) attr-val seeked)]
       [(boolean? attr-val)
        ((or boolean-comparator default-boolean-comparator) attr-val seeked)]
       [(vector? attr-val)
        ((or vector-comparator default-vector-comparator) attr-val seeked)]
       [else
        (fallback-comparator attr-val seeked)]))))