|
|
@ -1,5 +1,5 @@
|
|
|
|
#lang debug racket/base
|
|
|
|
#lang debug racket/base
|
|
|
|
(require racket/class racket/match racket/list txexpr racket/dict racket/function
|
|
|
|
(require racket/string racket/class racket/match racket/list txexpr racket/dict racket/function
|
|
|
|
"quad.rkt" "param.rkt")
|
|
|
|
"quad.rkt" "param.rkt")
|
|
|
|
(provide (all-defined-out))
|
|
|
|
(provide (all-defined-out))
|
|
|
|
(module+ test (require rackunit))
|
|
|
|
(module+ test (require rackunit))
|
|
|
@ -16,15 +16,15 @@
|
|
|
|
((hasheq 'foo "bar" 'zim "zam") . update-with . (hasheq 'zim "BANG") (hasheq 'toe "jam") (hasheq 'foo "zay"))
|
|
|
|
((hasheq 'foo "bar" 'zim "zam") . update-with . (hasheq 'zim "BANG") (hasheq 'toe "jam") (hasheq 'foo "zay"))
|
|
|
|
(make-hasheq '((zim . "BANG") (foo . "zay") (toe . "jam")))))
|
|
|
|
(make-hasheq '((zim . "BANG") (foo . "zay") (toe . "jam")))))
|
|
|
|
|
|
|
|
|
|
|
|
(define (merge-whitespace aqs [white-aq? (λ (aq) (char-whitespace? (car (get-field elems aq))))])
|
|
|
|
(define (merge-whitespace qs [white-q? (λ (aq) (char-whitespace? (car (get-field elems aq))))])
|
|
|
|
;; collapse each sequence of whitespace aqs to the first one, and make it a space
|
|
|
|
;; collapse each sequence of whitespace qs to the first one, and make it a space
|
|
|
|
;; also drop leading & trailing whitespaces
|
|
|
|
;; also drop leading & trailing whitespaces
|
|
|
|
;; (same behavior as web browsers)
|
|
|
|
;; (same behavior as web browsers)
|
|
|
|
(let loop ([acc null][aqs aqs])
|
|
|
|
(let loop ([acc null][qs qs])
|
|
|
|
(if (null? aqs)
|
|
|
|
(if (null? qs)
|
|
|
|
(flatten acc)
|
|
|
|
(flatten acc)
|
|
|
|
(let*-values ([(bs rest) (splitf-at aqs (negate white-aq?))]
|
|
|
|
(let*-values ([(bs rest) (splitf-at qs (negate white-q?))]
|
|
|
|
[(ws rest) (splitf-at rest white-aq?)])
|
|
|
|
[(ws rest) (splitf-at rest white-q?)])
|
|
|
|
(loop (list acc bs (if (and (pair? rest) ;; we precede bs (only #t if rest starts with bs, because we took the ws)
|
|
|
|
(loop (list acc bs (if (and (pair? rest) ;; we precede bs (only #t if rest starts with bs, because we took the ws)
|
|
|
|
(pair? bs) ;; we follow bs
|
|
|
|
(pair? bs) ;; we follow bs
|
|
|
|
(pair? ws)) ;; we have ws
|
|
|
|
(pair? ws)) ;; we have ws
|
|
|
@ -53,7 +53,7 @@
|
|
|
|
[else (raise-argument-error 'atomize "valid item" x)])))
|
|
|
|
[else (raise-argument-error 'atomize "valid item" x)])))
|
|
|
|
(merge-whitespace atomic-quads))
|
|
|
|
(merge-whitespace atomic-quads))
|
|
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
#;(module+ test
|
|
|
|
(require rackunit)
|
|
|
|
(require rackunit)
|
|
|
|
(check-equal? (atomize (q "Hi")) (list (q #\H) (q #\i)))
|
|
|
|
(check-equal? (atomize (q "Hi")) (list (q #\H) (q #\i)))
|
|
|
|
(check-equal? (atomize (q "Hi " (q "You"))) (list (q #\H) (q #\i) (q #\space) (q #\Y) (q #\o) (q #\u)))
|
|
|
|
(check-equal? (atomize (q "Hi " (q "You"))) (list (q #\H) (q #\i) (q #\space) (q #\Y) (q #\o) (q #\u)))
|
|
|
@ -81,20 +81,18 @@
|
|
|
|
(quad (hasheq 'k1 "v2" 'k2 42 'k3 "foo") #\u))))
|
|
|
|
(quad (hasheq 'k1 "v2" 'k2 42 'k3 "foo") #\u))))
|
|
|
|
|
|
|
|
|
|
|
|
(define whitespace-pat #px"\\s+")
|
|
|
|
(define whitespace-pat #px"\\s+")
|
|
|
|
(define (merge-white str) (regexp-replace* whitespace-pat str " "))
|
|
|
|
(define (merge-and-isolate-white str)
|
|
|
|
|
|
|
|
(for/list ([(m idx) (in-indexed (regexp-match* whitespace-pat str #:gap-select? #t))]
|
|
|
|
(define (isolate-white str)
|
|
|
|
#:when (non-empty-string? m))
|
|
|
|
(for/list ([m (in-list (regexp-match* " " str #:gap-select? #t))]
|
|
|
|
(if (even? idx) m " ")))
|
|
|
|
#:when (positive? (string-length m)))
|
|
|
|
|
|
|
|
m))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define (merge-adjacent-strings xs [isolate-white? #false])
|
|
|
|
(define (merge-adjacent-strings xs [isolate-white? #false])
|
|
|
|
(let loop ([xs xs][acc null])
|
|
|
|
(let loop ([xs xs][acc null])
|
|
|
|
(match xs
|
|
|
|
(match xs
|
|
|
|
[(== empty) (reverse acc)]
|
|
|
|
[(list) (reverse acc)]
|
|
|
|
[(list (? string? strs) ..1 others ...)
|
|
|
|
[(list (? string? strs) ..1 others ...)
|
|
|
|
(loop others (append (reverse ((if isolate-white?
|
|
|
|
(loop others (append (reverse ((if isolate-white?
|
|
|
|
(compose1 isolate-white merge-white)
|
|
|
|
merge-and-isolate-white
|
|
|
|
list) (apply string-append strs))) acc))]
|
|
|
|
list) (apply string-append strs))) acc))]
|
|
|
|
[(cons x others) (loop others (cons x acc))])))
|
|
|
|
[(cons x others) (loop others (cons x acc))])))
|
|
|
|
|
|
|
|
|
|
|
|