guile-vocabulary-explorer/lib/search.scm

(library (search)
  (export search
          searches
          string-contains-whole-word)
  (import (except (rnrs base) vector-map)
          (only (guile)
                lambda* λ
                ;; string
                string-downcase
                string-suffix?
                string-prefix?
                string-contains
                display
                simple-format)
          ;; lists
          (srfi srfi-1)
          ;; vectors
          (srfi srfi-43)
          ;; custom
          (alist-utils)
          (vector-utils)
          (model)
          (contract))

  ;; idea: search should return a vocabulary
  ;; if anything contains the string
  ;; if anything contains the string as a whole word
  ;; ignored attributes for search
  ;; string edit distance
  (define-with-contract string-contains-whole-word
    (require (string? str)
             (string? seeked))
    (ensure (boolean? <?>))
    (lambda* (str seeked #:key (ignore-case #t))
      (let ([str (if ignore-case (string-downcase str) str)]
            [seeked (if ignore-case (string-downcase seeked) seeked)])
        (or (string=? str seeked)
            (string-suffix? (string-append " " seeked) str)
            (string-prefix? (string-append seeked " ") str)
            ;; string-contains returns an index in case of the string
            ;; containing the searched string or false otherwise. `or`
            ;; will take it as a truthy value, but we really want a
            ;; boolean.
            (number?
             (string-contains str (string-append " " seeked " ")))))))

  (define default-search-attr-refs
    '(("metadata" "description")
      ("metadata" "tags")
      ("metadata" "usage-examples")
      ("translation-data" "native")
      ("translation-data" "phonetic-script")
      ("translation-data" "simplified")
      ("translation-data" "traditional")))

  (define-with-contract in-vector-attribute?
    (require (vector? attr-val)
             (procedure? contains?))
    (ensure (boolean? <?>))
    (λ (attr-val search-term contains?)
      (vector-fold (λ (ind cur acc) (or acc cur))
                   #f
                   (vector-map (λ (index element)
                                 (contains? element search-term))
                               attr-val))))

  (define-with-contract search
    (require (vocabulary? voc)
             (string? term))
    (ensure (vocabulary? <?>))
    (lambda* (voc term
                  #:key
                  (whole-word #f)
                  (ignore-case #t)
                  (attr-refs default-search-attr-refs))
      "Search for words in the vocabulary."
      (let ([string-compare
             (if whole-word
                 (λ (str seeked)
                   (string-contains-whole-word str seeked #:ignore-case ignore-case))
                 ;; string-contains returns an index in case of the
                 ;; string containing the searched string or false
                 ;; otherwise. `or` will take it as a truthy value,
                 ;; but we really want a boolean.
                 (λ (string sought)
                   (number?
                    (string-contains string sought))))])
        (vocabulary-filter voc
                           (λ (words)
                             (vector-filter
                              (λ (_index word)
                                (reduce (λ (cur acc) (or acc cur))
                                        #f
                                        (map (λ (attr-ref)
                                               (let ([attr-val (alist-refs word attr-ref)])
                                                 (cond
                                                  [(vector? attr-val)
                                                   (in-vector-attribute? attr-val term string-compare)]
                                                  [else
                                                   (string-compare attr-val term)])))
                                             attr-refs)))
                              words))))))

  (define searches
    (lambda* (voc
              #:key
              (whole-word #f)
              (ignore-case #t)
              (attr-refs default-search-attr-refs)
              .
              terms)
      (display (simple-format #f "~a\n" terms))
      (cond
       [(null? terms) voc]
       [else
        (apply searches
               (search voc
                       (first terms)
                       #:whole-word whole-word
                       #:ignore-case ignore-case
                       #:attr-refs attr-refs)
               (drop terms 1))]))))