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.
51 lines
1.7 KiB
Racket
51 lines
1.7 KiB
Racket
5 years ago
|
#lang debug racket
|
||
|
|
(require quad/base "struct.rkt")
|
||
|
|
|
||
|
|
(verbose-quad-printing? #t)
|
||
|
|
|
||
|
|
(define-syntax-rule (factory type proc)
|
||
|
|
(make-quad #:type type
|
||
|
|
#:elems (for/list ([i (in-range 2)])
|
||
|
|
(quad-update! (proc)
|
||
|
|
[tag (format "~a[~a]" 'proc (add1 i))]))))
|
||
|
|
|
||
|
|
(define (line) (make-quad #:type line-quad))
|
||
|
|
(define (block) (factory block-quad line))
|
||
|
|
(define (col) (factory column-quad block))
|
||
|
|
(define (sec) (factory section-quad col))
|
||
|
|
(define doc (factory doc-quad sec))
|
||
|
|
|
||
|
|
(define (parse-query-str str)
|
||
|
|
(define (string->pred str)
|
||
|
|
(match str
|
||
|
|
["doc" doc-quad?]
|
||
|
|
["section" section-quad?]
|
||
|
|
["page" page-quad?]
|
||
|
|
["column" column-quad?]
|
||
|
|
["block" block-quad?]
|
||
|
|
["line" line-quad?]))
|
||
|
|
(for/list ([piece (in-list (string-split str ":"))])
|
||
|
|
(match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece)
|
||
|
|
[#false (cons (string->pred piece) #false)]
|
||
|
|
[(list all name arg) (cons (string->pred name) (or (string->number arg)
|
||
|
|
(string->symbol arg)))])))
|
||
|
|
|
||
|
|
(define (query q query-str)
|
||
|
|
(define query-assocs (parse-query-str query-str))
|
||
|
|
#R query-assocs
|
||
|
|
(for/fold ([ctx q]
|
||
|
|
#:result #R ctx)
|
||
|
|
([(pred count) (in-dict query-assocs)])
|
||
|
|
#R pred
|
||
|
|
(define matches null)
|
||
|
|
(let loop ([this ctx])
|
||
|
|
#R this
|
||
|
|
(cond
|
||
|
|
[(= (length matches) count) #R (car matches)]
|
||
|
|
[(quad? this)
|
||
|
|
(when (pred this)
|
||
|
|
(set! matches (cons this matches)))
|
||
|
|
(for-each loop (quad-elems this))]
|
||
|
|
[else this]))))
|
||
|
|
|
||
|
|
(query doc "section[1]:line[2]")
|