added numbers to Xexpression reading for pragmatic reasons
This commit is contained in:
parent
28b81183de
commit
32bf89dd94
|
@ -249,6 +249,7 @@ X-expression in the following sense:
|
||||||
; @deftech{Xexpr} is one of:
|
; @deftech{Xexpr} is one of:
|
||||||
; -- @racket[symbol?]
|
; -- @racket[symbol?]
|
||||||
; -- @racket[string?]
|
; -- @racket[string?]
|
||||||
|
; -- @racket[number?]
|
||||||
; -- @racket[(cons symbol? (cons [List-of #, @tech{Attribute}] [List-of #, @tech{Xexpr}]))]
|
; -- @racket[(cons symbol? (cons [List-of #, @tech{Attribute}] [List-of #, @tech{Xexpr}]))]
|
||||||
; -- @racket[(cons symbol? [List-of #, @tech{Xexpr}])]
|
; -- @racket[(cons symbol? [List-of #, @tech{Xexpr}])]
|
||||||
;
|
;
|
||||||
|
|
|
@ -80,6 +80,7 @@
|
||||||
; Xexpr is one of:
|
; Xexpr is one of:
|
||||||
; -- Symbol
|
; -- Symbol
|
||||||
; -- String
|
; -- String
|
||||||
|
; -- Number
|
||||||
; -- (cons Symbol (cons [List-of Attribute] [List-of Xexpr]))
|
; -- (cons Symbol (cons [List-of Attribute] [List-of Xexpr]))
|
||||||
; -- (cons Symbol [List-of Xexpr])
|
; -- (cons Symbol [List-of Xexpr])
|
||||||
;
|
;
|
||||||
|
@ -90,7 +91,7 @@
|
||||||
;; Any -> Boolean
|
;; Any -> Boolean
|
||||||
;; is the given value an Xexpr?
|
;; is the given value an Xexpr?
|
||||||
;; effect: display bad piece if x is not an xexpr
|
;; effect: display bad piece if x is not an xexpr
|
||||||
(rename-out (my-xexpr? xexpr?))
|
xexpr?
|
||||||
|
|
||||||
;; String -> Xexpr
|
;; String -> Xexpr
|
||||||
;; given a file name, read an Xexpr from a file that contains at least one XML element
|
;; given a file name, read an Xexpr from a file that contains at least one XML element
|
||||||
|
@ -138,7 +139,7 @@
|
||||||
"private/csv/csv.rkt"
|
"private/csv/csv.rkt"
|
||||||
;; --- xml/html
|
;; --- xml/html
|
||||||
net/url
|
net/url
|
||||||
xml/xml
|
(except-in xml/xml xexpr?)
|
||||||
html
|
html
|
||||||
srfi/13)
|
srfi/13)
|
||||||
|
|
||||||
|
@ -184,11 +185,36 @@
|
||||||
(read-line (current-input-port) 'any))
|
(read-line (current-input-port) 'any))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------------------------------
|
||||||
(define (my-xexpr? x0)
|
(define (xexpr? x0)
|
||||||
|
(define tag (gensym))
|
||||||
|
|
||||||
|
;; Any -> Boolean
|
||||||
|
(define (xexpr-aux? x)
|
||||||
|
(cond
|
||||||
|
[(string? x) #t]
|
||||||
|
[(symbol? x) #t]
|
||||||
|
[(number? x) #t]
|
||||||
|
[(and (cons? x) (symbol? (first x)))
|
||||||
|
(define body (rest x))
|
||||||
|
(or (and (list-of-attributes? (first body)) (list-of-xexpr? (rest body)))
|
||||||
|
(list-of-xexpr? body))]
|
||||||
|
[else (raise (cons tag x))]))
|
||||||
|
|
||||||
|
;; Any -> Boolean
|
||||||
|
(define (list-of-attributes? xs)
|
||||||
|
(and (or (list? xs) (raise (cons tag xs)))
|
||||||
|
(for/and ((x xs))
|
||||||
|
(and (list? x) (= (length x) 2) (symbol? (first x)) (string? (second x))))))
|
||||||
|
|
||||||
|
;; Any -> Boolean
|
||||||
|
(define (list-of-xexpr? xs)
|
||||||
|
(and (or (list? xs) (raise (cons tag xs)))
|
||||||
|
(andmap xexpr-aux? xs)))
|
||||||
|
|
||||||
;; -- IN --
|
;; -- IN --
|
||||||
(with-handlers (((lambda (x) (and (cons? x) (eq? (car x) tag)))
|
(with-handlers (((lambda (x) (and (cons? x) (eq? (car x) tag)))
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(displayln `(,(cdr x) occurs in ,x0))
|
(pretty-print `(,(cdr x) occurs in ,x0))
|
||||||
#f)))
|
#f)))
|
||||||
(xexpr-aux? x0)))
|
(xexpr-aux? x0)))
|
||||||
|
|
||||||
|
@ -299,39 +325,12 @@
|
||||||
(define (split-lines str)
|
(define (split-lines str)
|
||||||
(map string-trim (split str "\r*\n")))
|
(map string-trim (split str "\r*\n")))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------------------------------
|
|
||||||
;; is the given value a
|
|
||||||
|
|
||||||
(define tag (gensym))
|
|
||||||
|
|
||||||
;; Any -> Boolean
|
|
||||||
(define (xexpr-aux? x)
|
|
||||||
(cond
|
|
||||||
[(string? x) #t]
|
|
||||||
[(symbol? x) #t]
|
|
||||||
[(and (cons? x) (symbol? (first x)))
|
|
||||||
(define body (rest x))
|
|
||||||
(or (and (list-of-attributes? (first body)) (list-of-xexpr? (rest body)))
|
|
||||||
(list-of-xexpr? body))]
|
|
||||||
[else (raise (cons tag x))]))
|
|
||||||
|
|
||||||
;; Any -> Boolean
|
|
||||||
(define (list-of-attributes? xs)
|
|
||||||
(and (or (list? xs) (raise (cons tag xs)))
|
|
||||||
(for/and ((x xs))
|
|
||||||
(and (list? x) (= (length x) 2) (symbol? (first x)) (string? (second x))))))
|
|
||||||
|
|
||||||
;; Any -> Boolean
|
|
||||||
(define (list-of-xexpr? xs)
|
|
||||||
(and (or (list? xs) (raise (cons tag xs)))
|
|
||||||
(andmap xexpr? xs)))
|
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------------------------------
|
||||||
;; Symbol String [XML -> XML] -> Xexpr
|
;; Symbol String [XML -> XML] -> Xexpr
|
||||||
;; read an Xexpr from a file that contains one XML element
|
;; read an Xexpr from a file that contains one XML element
|
||||||
(define (read-xexpr-aux tag f fix-up)
|
(define (read-xexpr-aux tag f fix-up)
|
||||||
(define raw (read-from-file-or-device f read-xml/element))
|
(define raw (read-from-file-or-device f read-xml/element))
|
||||||
(check-result 'read-plain-xexpr my-xexpr? 'xexpr (xml->xexpr (fix-up raw))))
|
(check-result 'read-plain-xexpr xexpr? 'xexpr (xml->xexpr (fix-up raw))))
|
||||||
|
|
||||||
;; Symbol String [XML -> XML] -> Xexpr
|
;; Symbol String [XML -> XML] -> Xexpr
|
||||||
(define (read-xexpr/web-aux tag url:string fix-up)
|
(define (read-xexpr/web-aux tag url:string fix-up)
|
||||||
|
@ -342,7 +341,7 @@
|
||||||
[(404? h) #f]
|
[(404? h) #f]
|
||||||
[else
|
[else
|
||||||
(define e (filter element? (call/input-url url get-pure-port read-html-as-xml)))
|
(define e (filter element? (call/input-url url get-pure-port read-html-as-xml)))
|
||||||
(and (cons? e) (check-result tag my-xexpr? 'xexpr (xml->xexpr (fix-up (first e)))))]))))
|
(and (cons? e) (check-result tag xexpr? 'xexpr (xml->xexpr (fix-up (first e)))))]))))
|
||||||
|
|
||||||
(define fix-up (eliminate-whitespace '() (lambda (x) #t)))
|
(define fix-up (eliminate-whitespace '() (lambda (x) #t)))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user