You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
typesetting/quad/quadwriter/query.rkt

128 lines
5.1 KiB
Racket

5 years ago
#lang debug racket
5 years ago
(require quad/base "struct.rkt" "param.rkt")
5 years ago
(provide (all-defined-out))
5 years ago
(define (make-query-index q)
(define qs (let loop ([q q])
(cons q (append* (for/list ([elem (in-list (quad-elems q))]
#:when (quad? elem))
5 years ago
(loop elem))))))
5 years ago
(list->vector qs))
5 years ago
5 years ago
(define (string->key str)
5 years ago
(match str
5 years ago
["doc" 'doc]
[(or "section" "sec" "s") 'section]
[(or "page" "pg" "p") 'page]
[(or "column" "col" "c") 'column]
[(or "block" "b") 'block]
[(or "line" "ln" "l") 'line]))
(define preds (hasheq 'doc doc-quad?
'section section-quad?
'page page-quad?
'column column-quad?
'block block-quad?
'line line-quad?))
5 years ago
(define (parse-query str)
5 years ago
(for/list ([piece (in-list (string-split str ":"))])
5 years ago
(match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece)
[#false (cons (string->key piece) #false)]
5 years ago
[(list _ name arg) (cons (hash-ref preds (string->key name))
(or (string->number arg) (string->symbol arg)))])))
5 years ago
5 years ago
(define (find-inclusive vec pred start-arg end-arg [count 1])
;; search from lidx to ridx inclusive
(define-values (start end step)
(cond
;; if lidx is bigger, search backward
[(> start-arg end-arg) (values start-arg (sub1 end-arg) -1)]
[else (values start-arg (add1 end-arg) 1)]))
5 years ago
(for/fold ([adjusted-start (- start step)]) ; remove step for reason below
5 years ago
([seen (in-range count)]
5 years ago
#:break (not adjusted-start))
5 years ago
;; add step so we find next matcher
;; and won't re-find the last one immediately
5 years ago
(for/first ([idx (in-range (+ adjusted-start step) end step)]
5 years ago
#:when (pred (vector-ref vec idx)))
idx)))
5 years ago
(define (query quad-or-index query-str [starting-q #false])
(define vec (match quad-or-index
[(? quad? q) (make-query-index q)]
[idx idx]))
5 years ago
(for/fold ([vidx 0]
5 years ago
[maxidx (sub1 (vector-length vec))]
5 years ago
#:result (and vidx (vector-ref vec vidx)))
5 years ago
([query-piece (in-list (parse-query query-str))]
#:break (not vidx))
5 years ago
(match-define (cons pred subscript) query-piece)
(define (find start end count) (find-inclusive vec pred start end count))
5 years ago
(define res-idx
5 years ago
(let loop ([subscript subscript])
(match subscript
[(== 'this eq?) ; start at querying quad, then search 1 back
(find (vector-memq starting-q vec) 0 1)]
[(== 'last eq?) (loop -1)]
[(== 'prev eq?) ; search 2 back. same algo if starting-q is pred or not.
(find (vector-memq starting-q vec) 0 2)]
[(== 'next eq?) ; search 1 ahead, but if starting-q is also pred, search 2 ahead
(find (vector-memq starting-q vec) maxidx (if (pred starting-q) 2 1))]
5 years ago
[(? number? count)
(cond
[(negative? count) ; search backward from end
(find maxidx vidx (abs count))]
[else ; seach forward
(find vidx maxidx count)])]
5 years ago
[_ #false])))
5 years ago
(define next-maxidx
(cond
[(not res-idx) maxidx]
;; try searching for next occurence after this one, up to max.
5 years ago
[(find (add1 res-idx) maxidx 1)]
5 years ago
[else maxidx]))
(values res-idx next-maxidx)))
5 years ago
5 years ago
(module+ test
(require rackunit)
(define counter 0)
(define-syntax-rule (factory type proc)
(make-quad #:type type
#:elems (for/list ([i (in-range 3)])
5 years ago
(set! counter (add1 counter))
(define new-q (proc))
(quad-update! new-q
[tag (format "~a[~a]-~a" 'proc counter (gensym))])
(hash-set! (quad-attrs new-q) 'count counter)
new-q)))
5 years ago
(define (line) (make-quad #:type line-quad))
(define (block) (factory block-quad line))
(define (col) (factory column-quad block))
(define (page) (factory page-quad col))
(define (sec) (factory section-quad page))
5 years ago
(define (count q) (and q (quad-ref q 'count)))
5 years ago
(define doc (factory doc-quad sec))
5 years ago
5 years ago
(check-equal? (count (query doc "sec[2]")) 242)
5 years ago
(check-false (query doc "sec[102]:line[1]"))
5 years ago
(check-equal? (count (query doc "sec[2]:pg[1]")) 162)
5 years ago
(check-equal? (count (query doc "sec[2]:pg[1]:ln[3]")) 128)
(check-eq? (query doc "page[this]" (query doc "line[2]")) (query doc "page[1]"))
(check-equal? (count (query doc "page[this]:line[last]" (query doc "line[2]"))) 41)
5 years ago
(check-equal? (count (query doc "sec[next]" (query doc "sec[1]"))) (count (query doc "sec[2]")) )
(check-equal? (count (query doc "sec[prev]" (query doc "sec[2]"))) (count (query doc "sec[1]")))
5 years ago
5 years ago
(check-equal? (count (query doc "page[prev]" (query doc "page[2]:line[1]")))
(count (query doc "page[1]")))
(check-equal? (count (query doc "page[next]" (query doc "page[2]:line[1]")))
(count (query doc "page[3]")))
5 years ago
(check-equal? (count (query doc "page[next]" (query doc "page[2]:line[1]")))
(count (query doc "page[3]")))
5 years ago
5 years ago
)