remove typed/txexpr

pull/2/head
Matthew Butterick 9 years ago
parent 82bf50554d
commit 8c1723e87a

@ -15,8 +15,4 @@ In safe mode (with contracts):
(require (submod txexpr safe)) (require (submod txexpr safe))
Or in typed mode:
(require typed/txexpr)
Full docs are installed with the package. You can also [read the docs here](http://pkg-build.racket-lang.org/doc/txexpr). Full docs are installed with the package. You can also [read the docs here](http://pkg-build.racket-lang.org/doc/txexpr).

@ -1,7 +1,7 @@
#lang info #lang info
(define collection 'multi) (define collection "txexpr")
(define deps '("base" "sugar" "typed-racket-lib" (define deps '("base" "sugar" "rackunit-lib"))
"typed-racket-more"
"rackunit-lib"))
(define update-implies '("sugar")) (define update-implies '("sugar"))
(define build-deps '("scribble-lib" "racket-doc" "typed-racket-doc")) (define build-deps '("scribble-lib" "racket-doc"))
(define scribblings '(("scribblings/txexpr.scrbl" ())))
(define compile-omit-paths '("tests.rkt"))

@ -1,12 +1,90 @@
#lang typed/racket/base #lang racket/base
(require (for-syntax typed/racket/base) typed/sugar/define) (require sugar/define racket/string racket/list racket/match xml)
(require racket/match racket/string racket/list racket/bool "core-predicates.rkt") (provide cdata? cdata valid-char? xexpr->string xexpr?) ; from xml
(provide (all-defined-out) (all-from-out "core-predicates.rkt"))
;; Section 2.2 of XML 1.1
(define/typed (validate-txexpr-attrs x #:context [txexpr-context #f]) ;; (XML 1.0 is slightly different and more restrictive)
(Txexpr-Attrs [#:context Any] -> Txexpr-Attrs) ;; make private version of my-valid-char to get consistent results with Racket 6.0
(define/typed (make-reason) (define (my-valid-char? i)
(-> String) (and (exact-nonnegative-integer? i)
(or (<= #x1 i #xD7FF)
(<= #xE000 i #xFFFD)
(<= #x10000 i #x10FFFF))))
(define (my-xexpr? x)
(or (txexpr? x) (xexpr? x) (my-valid-char? x)))
(define+provide+safe (txexpr-short? x)
predicate/c
(match x
[(list (? symbol? name) (? my-xexpr?) ...) #t]
[else #f]))
(define+provide+safe (txexpr? x)
predicate/c
(or (txexpr-short? x)
(match x
[(list (? symbol?) (list (list (? symbol?) (? string?)) ...) (? my-xexpr?) ...) #t]
[else #f])))
(define+provide+safe (txexpr-tag? x)
predicate/c
(symbol? x))
(define+provide+safe (txexpr-tags? x)
predicate/c
(and (list? x) (andmap txexpr-tag? x)))
(define+provide+safe (txexpr-attr? x)
predicate/c
(match x
[(list (? symbol?) (? string?)) #t]
[else #f]))
(define+provide+safe (txexpr-attrs? x)
predicate/c
(and (list? x) (andmap txexpr-attr? x)))
(define+provide+safe (txexpr-element? x)
predicate/c
(my-xexpr? x))
(define+provide+safe (txexpr-elements? x)
predicate/c
(and (list? x) (andmap txexpr-element? x)))
(define+provide+safe (txexpr-attr-key? x)
predicate/c
(symbol? x))
(define+provide+safe (can-be-txexpr-attr-key? x)
predicate/c
(or (symbol? x) (string? x)))
(define+provide+safe (txexpr-attr-value? x)
predicate/c
(string? x))
(define+provide+safe (txexpr-attr-values? x)
predicate/c
(and (list? x) (andmap txexpr-attr-value? x)))
(define+provide+safe (can-be-txexpr-attr-value? x)
predicate/c
(or (symbol? x) (string? x)))
(define+provide+safe (can-be-txexpr-attrs? x)
predicate/c
(ormap (λ(test) (test x)) (list txexpr-attr? txexpr-attrs? can-be-txexpr-attr-key? can-be-txexpr-attr-value?)))
(define+provide+safe (list-of-can-be-txexpr-attrs? xs)
predicate/c
(and (list? xs) (andmap can-be-txexpr-attrs? xs)))
(define (validate-txexpr-attrs x #:context [txexpr-context #f])
(define (make-reason)
(if (not (list? x)) (if (not (list? x))
(format "because ~v is not a list" x) (format "because ~v is not a list" x)
(let ([bad-attrs (filter (λ(i) (not (txexpr-attr? i))) x)]) (let ([bad-attrs (filter (λ(i) (not (txexpr-attr? i))) x)])
@ -20,8 +98,7 @@
(format "~v is not a valid list of attributes ~a" x (make-reason))))])) (format "~v is not a valid list of attributes ~a" x (make-reason))))]))
(define/typed (validate-txexpr-element x #:context [txexpr-context #f]) (define (validate-txexpr-element x #:context [txexpr-context #f])
(Txexpr-Element [#:context Any] -> Txexpr-Element)
(cond (cond
[(or (string? x) (txexpr? x) (symbol? x) [(or (string? x) (txexpr? x) (symbol? x)
(valid-char? x) (cdata? x)) x] (valid-char? x) (cdata? x)) x]
@ -32,22 +109,20 @@
;; is it a named x-expression? ;; is it a named x-expression?
;; todo: rewrite this recurively so errors can be pinpointed (for debugging) ;; todo: rewrite this recurively so errors can be pinpointed (for debugging)
(define/typed (validate-txexpr x) (define+provide+safe (validate-txexpr x)
(Any -> (Option Txexpr)) (any/c . -> . txexpr?)
(define-syntax-rule (validate-txexpr-attrs-with-context e) (validate-txexpr-attrs e #:context x)) (define-syntax-rule (validate-txexpr-attrs-with-context e) (validate-txexpr-attrs e #:context x))
(define-syntax-rule (validate-txexpr-element-with-context e) (validate-txexpr-element e #:context x)) (define-syntax-rule (validate-txexpr-element-with-context e) (validate-txexpr-element e #:context x))
(cond (cond
[(txexpr-short? x) x] [(txexpr-short? x) x]
[(txexpr? x) (and [(txexpr? x) (and
(validate-txexpr-attrs-with-context (get-attrs x)) (validate-txexpr-attrs-with-context (get-attrs x))
(andmap (λ:([e : Txexpr-Element]) (validate-txexpr-element-with-context e)) (get-elements x)) x)] (andmap (λ(e) (validate-txexpr-element-with-context e)) (get-elements x)) x)]
[else (error 'validate-txexpr (format "~v is not a list starting with a symbol" x))])) [else (error 'validate-txexpr (format "~v is not a list starting with a symbol" x))]))
(define/typed (make-txexpr tag [attrs null] [elements null]) (define+provide+safe (make-txexpr tag [attrs null] [elements null])
(case-> (Symbol -> Txexpr) ((symbol?) (txexpr-attrs? txexpr-elements?) . ->* . txexpr?)
(Symbol Txexpr-Attrs -> Txexpr)
(Symbol Txexpr-Attrs (Listof Txexpr-Element) -> Txexpr))
(define result (cons tag (append (if (empty? attrs) empty (list attrs)) elements))) (define result (cons tag (append (if (empty? attrs) empty (list attrs)) elements)))
(if (txexpr? result) (if (txexpr? result)
result result
@ -62,66 +137,63 @@
[else ""])))) [else ""]))))
(define/typed (txexpr->values x) (define+provide+safe (txexpr->values x)
(Txexpr -> (values Txexpr-Tag Txexpr-Attrs Txexpr-Elements)) (txexpr? . -> . (values symbol? txexpr-attrs? txexpr-elements?))
(if (txexpr-short? x) (if (txexpr-short? x)
(values (car x) '() (cdr x)) (values (car x) '() (cdr x))
(values (car x) (cadr x) (cddr x)))) (values (car x) (cadr x) (cddr x))))
(define/typed (txexpr->list x) (define+provide+safe (txexpr->list x)
(Txexpr -> (List Txexpr-Tag Txexpr-Attrs Txexpr-Elements)) (txexpr? . -> . list?)
(define-values (tag attrs content) (txexpr->values x)) (define-values (tag attrs content) (txexpr->values x))
(list tag attrs content)) (list tag attrs content))
;; convenience functions to retrieve only one part of txexpr ;; convenience functions to retrieve only one part of txexpr
(define/typed (get-tag x) (define+provide+safe (get-tag x)
(Txexpr -> Txexpr-Tag) (txexpr? . -> . txexpr-tag?)
(car x)) (car x))
(define/typed (get-attrs x) (define+provide+safe (get-attrs x)
(Txexpr -> Txexpr-Attrs) (txexpr? . -> . txexpr-attrs?)
(define-values (tag attrs content) (txexpr->values x)) (define-values (tag attrs content) (txexpr->values x))
attrs) attrs)
(define/typed (get-elements x) (define+provide+safe (get-elements x)
(Txexpr -> Txexpr-Elements) (txexpr? . -> . txexpr-elements?)
(define-values (tag attrs elements) (txexpr->values x)) (define-values (tag attrs elements) (txexpr->values x))
elements) elements)
;; helpers. we are getting a string or symbol ;; helpers. we are getting a string or symbol
(define/typed (->txexpr-attr-key x) (define+provide+safe (->txexpr-attr-key x)
(Can-Be-Txexpr-Attr-Key -> Txexpr-Attr-Key) (can-be-txexpr-attr-key? . -> . txexpr-attr-key?)
(if (string? x) (string->symbol x) x)) (if (string? x) (string->symbol x) x))
(define/typed (->txexpr-attr-value x) (define+provide+safe (->txexpr-attr-value x)
(Can-Be-Txexpr-Attr-Value -> Txexpr-Attr-Value) (can-be-txexpr-attr-value? . -> . txexpr-attr-value?)
(->string x)) (->string x))
(define/typed (->string x) (define (->string x)
((U Symbol String) -> String)
(if (symbol? x) (symbol->string x) x)) (if (symbol? x) (symbol->string x) x))
(define/typed (attrs->hash . items-in) (define+provide+safe (attrs->hash . items-in)
(Can-Be-Txexpr-Attr * -> Txexpr-Attr-Hash) (() #:rest (listof can-be-txexpr-attrs?) . ->* . hash?)
;; can be liberal with input because they're all just nested key/value pairs ;; can be liberal with input because they're all just nested key/value pairs
;; but still need this function to make sure that 'foo and "foo" are treated as the same hash key ;; but still need this function to make sure that 'foo and "foo" are treated as the same hash key
(define items (reverse (define items (reverse
(for/fold: ([items : (Listof (U Can-Be-Txexpr-Attr-Key Can-Be-Txexpr-Attr-Value)) null]) (for/fold ([items null]) ([i (in-list items-in)])
([i (in-list items-in)])
(cond (cond
[(txexpr-attr? i) (append (reverse i) items)] [(txexpr-attr? i) (append (reverse i) items)]
[(txexpr-attrs? i) (append (append* (map (λ:([a : Txexpr-Attr]) (reverse a)) i)) items)] [(txexpr-attrs? i) (append (append* (map (λ(a) (reverse a)) i)) items)]
[else (cons i items)])))) [else (cons i items)]))))
(define/typed (make-key-value-list items) (define (make-key-value-list items)
((Listof (U Can-Be-Txexpr-Attr-Key Can-Be-Txexpr-Attr-Value)) -> (Listof (Pairof Txexpr-Attr-Key Txexpr-Attr-Value)))
(if (< (length items) 2) (if (< (length items) 2)
null null
(let ([key (->txexpr-attr-key (car items))] (let ([key (->txexpr-attr-key (car items))]
@ -131,62 +203,62 @@
(make-immutable-hash (make-key-value-list items))) (make-immutable-hash (make-key-value-list items)))
(define/typed (hash->attrs attr-hash) (define+provide+safe (hash->attrs attr-hash)
(Txexpr-Attr-Hash -> Txexpr-Attrs) (hash? . -> . txexpr-attrs?)
(map (λ:([k : Txexpr-Attr-Key]) (list k (hash-ref attr-hash k))) (hash-keys attr-hash))) (map (λ(k) (list k (hash-ref attr-hash k))) (hash-keys attr-hash)))
(define/typed (attrs-have-key? x key) (define+provide+safe (attrs-have-key? x key)
((U Txexpr-Attrs Txexpr) Can-Be-Txexpr-Attr-Key -> Boolean) ((or/c txexpr-attrs? txexpr?) can-be-txexpr-attr-key? . -> . boolean?)
(define attrs (if (txexpr-attrs? x) x (get-attrs x))) (define attrs (if (txexpr-attrs? x) x (get-attrs x)))
(hash-has-key? (attrs->hash attrs) (->txexpr-attr-key key))) (hash-has-key? (attrs->hash attrs) (->txexpr-attr-key key)))
(define/typed (attrs-equal? x1 x2) (define+provide+safe (attrs-equal? x1 x2)
((U Txexpr-Attrs Txexpr) (U Txexpr-Attrs Txexpr) -> Boolean) ((or/c txexpr-attrs? txexpr?) (or/c txexpr-attrs? txexpr?) . -> . boolean?)
(define attrs-tx1 (attrs->hash (if (txexpr-attrs? x1) x1 (get-attrs x1)))) (define attrs-tx1 (attrs->hash (if (txexpr-attrs? x1) x1 (get-attrs x1))))
(define attrs-tx2 (attrs->hash (if (txexpr-attrs? x2) x2 (get-attrs x2)))) (define attrs-tx2 (attrs->hash (if (txexpr-attrs? x2) x2 (get-attrs x2))))
(and (and
(= (length (hash-keys attrs-tx1)) (length (hash-keys attrs-tx2))) (= (length (hash-keys attrs-tx1)) (length (hash-keys attrs-tx2)))
(for/and ([(key value) (in-hash attrs-tx1)]) (for/and ([(key value) (in-hash attrs-tx1)])
(equal? (hash-ref attrs-tx2 key) value)))) (equal? (hash-ref attrs-tx2 key) value))))
(define/typed (attr-set tx key value) (define+provide+safe (attr-set tx key value)
(Txexpr Can-Be-Txexpr-Attr-Key Can-Be-Txexpr-Attr-Value -> Txexpr) (txexpr? can-be-txexpr-attr-key? can-be-txexpr-attr-value? . -> . txexpr?)
(define new-attrs (define new-attrs
(hash->attrs (hash-set (attrs->hash (get-attrs tx)) (->txexpr-attr-key key) (->txexpr-attr-value value)))) (hash->attrs (hash-set (attrs->hash (get-attrs tx)) (->txexpr-attr-key key) (->txexpr-attr-value value))))
(make-txexpr (get-tag tx) new-attrs (get-elements tx))) (make-txexpr (get-tag tx) new-attrs (get-elements tx)))
(define/typed (attr-ref tx key) (define+provide+safe (attr-ref tx key)
(Txexpr Can-Be-Txexpr-Attr-Key -> Txexpr-Attr-Value) (txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-value?)
(with-handlers ([exn:fail? (λ(e) (error (format "attr-ref: no value found for key ~v" key)))]) (with-handlers ([exn:fail? (λ(e) (error (format "attr-ref: no value found for key ~v" key)))])
(hash-ref (attrs->hash (get-attrs tx)) (->txexpr-attr-key key)))) (hash-ref (attrs->hash (get-attrs tx)) (->txexpr-attr-key key))))
(define/typed (attr-ref* tx key) (define+provide+safe (attr-ref* tx key)
(Txexpr Can-Be-Txexpr-Attr-Key -> (Listof Txexpr-Attr-Value)) (txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-values?)
(define: results : (Listof Txexpr-Attr-Value) empty) (define results empty)
(let: loop : Void ([tx : Xexpr tx]) (let loop ([tx tx])
(when (and (txexpr? tx) (attrs-have-key? tx key) (attr-ref tx key)) (when (and (txexpr? tx) (attrs-have-key? tx key) (attr-ref tx key))
(set! results (cons (attr-ref tx key) results)) (set! results (cons (attr-ref tx key) results))
(map (λ:([e : Txexpr-Element]) (loop e)) (get-elements tx)) (map (λ(e) (loop e)) (get-elements tx))
(void))) (void)))
(reverse results)) (reverse results))
;; convert list of alternating keys & values to attr ;; convert list of alternating keys & values to attr
(define/typed (merge-attrs . items) (define+provide+safe (merge-attrs . items)
(Can-Be-Txexpr-Attr * -> Txexpr-Attrs) (() #:rest list-of-can-be-txexpr-attrs? . ->* . txexpr-attrs?)
(define attrs-hash (apply attrs->hash items)) (define attrs-hash (apply attrs->hash items))
;; sort needed for predictable results for unit tests ;; sort needed for predictable results for unit tests
(define sorted-hash-keys (sort (hash-keys attrs-hash) (λ:([a : Txexpr-Tag][b : Txexpr-Tag]) (string<? (->string a) (->string b))))) (define sorted-hash-keys (sort (hash-keys attrs-hash) (λ(a b) (string<? (->string a) (->string b)))))
`(,@(map (λ:([key : Txexpr-Tag]) (list key (hash-ref attrs-hash key))) sorted-hash-keys))) `(,@(map (λ(key) (list key (hash-ref attrs-hash key))) sorted-hash-keys)))
(define/typed (remove-attrs x) (define+provide+safe (remove-attrs x)
(Xexpr -> Xexpr) (txexpr? . -> . txexpr?)
(if (txexpr? x) (if (txexpr? x)
(let-values ([(tag attr elements) (txexpr->values x)]) (let-values ([(tag attr elements) (txexpr->values x)])
(make-txexpr tag null (map remove-attrs elements))) (make-txexpr tag null (map remove-attrs elements)))
@ -194,58 +266,54 @@
(define/typed (map-elements/exclude proc x exclude-test) (define+provide+safe (map-elements/exclude proc x exclude-test)
((Xexpr -> Xexpr) Xexpr (Xexpr -> Boolean) -> Xexpr) (procedure? txexpr? procedure? . -> . txexpr?)
(cond (cond
[(txexpr? x) [(txexpr? x)
(if (exclude-test x) (if (exclude-test x)
x x
(let-values ([(tag attr elements) (txexpr->values x)]) (let-values ([(tag attr elements) (txexpr->values x)])
(make-txexpr tag attr (make-txexpr tag attr
(map (λ:([x : Xexpr])(map-elements/exclude proc x exclude-test)) elements))))] (map (λ(x)(map-elements/exclude proc x exclude-test)) elements))))]
;; externally the function only accepts txexpr, ;; externally the function only accepts txexpr,
;; but internally we don't care ;; but internally we don't care
[else (proc x)])) [else (proc x)]))
(define/typed (map-elements proc x) (define+provide+safe (map-elements proc x)
((Xexpr -> Xexpr) Xexpr -> Xexpr) (procedure? txexpr? . -> . txexpr?)
(map-elements/exclude proc x (λ(x) #f))) (map-elements/exclude proc x (λ(x) #f)))
;; function to split tag out of txexpr ;; function to split tag out of txexpr
(define deleted-signal (gensym)) (define deleted-signal (gensym))
(define/typed (splitf-txexpr tx pred [proc (λ:([x : Xexpr]) deleted-signal)]) (define+provide+safe (splitf-txexpr tx pred [proc (λ(x) deleted-signal)])
(case-> (Txexpr (Xexpr -> Boolean) -> (values Txexpr Txexpr-Elements)) ((txexpr? procedure?) (procedure?) . ->* . (values txexpr? txexpr-elements?))
(Txexpr (Xexpr -> Boolean) (Xexpr -> Xexpr) -> (values Txexpr Txexpr-Elements))) (define matches null)
(define: matches : Txexpr-Elements null) (define (do-extraction x)
(define/typed (do-extraction x)
(Xexpr -> Xexpr)
(cond (cond
[(pred x) (begin ; store matched item and return processed value [(pred x) (begin ; store matched item and return processed value
(set! matches (cons x matches)) (set! matches (cons x matches))
(proc x))] (proc x))]
[(txexpr? x) (let-values([(tag attr elements) (txexpr->values x)]) [(txexpr? x) (let-values([(tag attr elements) (txexpr->values x)])
(make-txexpr tag attr (filter (λ:([e : Xexpr]) (not (equal? e deleted-signal))) (map do-extraction elements))))] (make-txexpr tag attr (filter (λ(e) (not (equal? e deleted-signal))) (map do-extraction elements))))]
[else x])) [else x]))
(define: tx-extracted : Xexpr (do-extraction tx)) ;; do this first to fill matches (define tx-extracted (do-extraction tx)) ;; do this first to fill matches
(values (if (txexpr? tx-extracted) (values (if (txexpr? tx-extracted)
tx-extracted tx-extracted
(error 'splitf-txexpr "Bad input")) (reverse matches))) (error 'splitf-txexpr "Bad input")) (reverse matches)))
(define/typed (xexpr->html x) (define+provide+safe (xexpr->html x)
(Xexpr -> String) (xexpr? . -> . string?)
(define/typed (->cdata x) (define (->cdata x)
(Xexpr -> Xexpr)
(cond (cond
[(cdata? x) x] [(cdata? x) x]
[(string? x) (cdata #f #f x)] ; don't use "![CDATA[...]]" wrapper in HTML, it's not consistent with the spec [(string? x) (cdata #f #f x)] ; don't use "![CDATA[...]]" wrapper in HTML, it's not consistent with the spec
[else x])) [else x]))
(xexpr->string (let: loop : Xexpr ([x : Xexpr x]) (xexpr->string (let loop ([x x])
(cond (cond
[(txexpr? x) (if (member (get-tag x) '(script style)) [(txexpr? x) (if (member (get-tag x) '(script style))
(make-txexpr (get-tag x) (get-attrs x) (map ->cdata (get-elements x))) (make-txexpr (get-tag x) (get-attrs x) (map ->cdata (get-elements x)))
(make-txexpr (get-tag x) (get-attrs x) (map loop (get-elements x))))] (make-txexpr (get-tag x) (get-attrs x) (map loop (get-elements x))))]
[else x])))) [else x]))))

@ -3,7 +3,7 @@
@; for documentation purposes, use the xexpr? from xml. @; for documentation purposes, use the xexpr? from xml.
@; the one in txexpr is just to patch over an issue with @; the one in txexpr is just to patch over an issue with
@; `valid-char?` in Racket 6. @; `valid-char?` in Racket 6.
@(require scribble/eval (for-label racket txexpr xml (only-in typed/racket require/typed))) @(require scribble/eval (for-label racket txexpr xml))
@(define my-eval (make-base-eval)) @(define my-eval (make-base-eval))
@(my-eval `(require txexpr xml)) @(my-eval `(require txexpr xml))
@ -13,12 +13,10 @@
@author[(author+email "Matthew Butterick" "mb@mbtype.com")] @author[(author+email "Matthew Butterick" "mb@mbtype.com")]
@defmodule[#:multi (txexpr (submod txexpr safe) typed/txexpr)] @defmodule[#:multi (txexpr (submod txexpr safe))]
A set of small but handy functions for improving the readability and reliability of programs that operate on tagged X-expressions (for short, @italic{txexpr}s). A set of small but handy functions for improving the readability and reliability of programs that operate on tagged X-expressions (for short, @italic{txexpr}s).
I thank Alexis King for helpful suggestions on the typed version.
@section{Installation} @section{Installation}
@ -30,16 +28,12 @@ After that, you can update the package from the command line:
@section{Importing the module} @section{Importing the module}
The module can be invoked three ways: fast, safe, and typed. The module can be invoked two ways: fast or safe.
Fast mode is the default, which you get by importing the module in the usual way: @code{(require txexpr)}. Fast mode is the default, which you get by importing the module in the usual way: @code{(require txexpr)}.
Safe mode enables the function contracts documented below. Use safe mode by importing the module as @code{(require (submod txexpr safe))}. Safe mode enables the function contracts documented below. Use safe mode by importing the module as @code{(require (submod txexpr safe))}.
The typed version is invoked as @code{(require typed/txexpr)}. The typed version is implemented ``natively'' in the sense that it is compiled separately with type annotations. It is not a @racket[require/typed] wrapper around the untyped code. This avoids the contract barrier that is otherwise automatically imposed between typed and untyped code.
@margin-note{I explain more about this cross-compiling technique in @link["http://unitscale.com/mb/technique/dual-typed-untyped-library.html"]{Making a dual typed / untyped Racket library}.}
@section{Whats a txexpr?} @section{Whats a txexpr?}

@ -16,24 +16,7 @@
,@(syntax->datum #'(exprs ...))) ,@(syntax->datum #'(exprs ...)))
(require ',(syntax->datum #'sym2))) stx))])) (require ',(syntax->datum #'sym2))) stx))]))
(eval-as-untyped
(define-syntax (eval-as-typed stx)
(syntax-case stx ()
[(_ exprs ...)
(with-syntax ([sym (syntax-e (generate-temporary))])
(datum->syntax stx `(begin
(module ,(syntax->datum #'sym) typed/racket
(require typed/rackunit "../typed/txexpr.rkt")
,@(syntax->datum #'(exprs ...)))
(require ',(syntax->datum #'sym))) stx))]))
(define-syntax-rule (eval-as-typed-and-untyped exprs ...)
(begin
(eval-as-typed exprs ...)
(eval-as-untyped exprs ...)))
(eval-as-typed-and-untyped
(require racket/set) (require racket/set)
(define-syntax (values->list stx) (define-syntax (values->list stx)
(syntax-case stx () (syntax-case stx ()

@ -1,69 +0,0 @@
#lang racket/base
(require sugar/define xml racket/match)
(provide (all-defined-out) cdata? cdata valid-char? xexpr->string xexpr?)
;; Section 2.2 of XML 1.1
;; (XML 1.0 is slightly different and more restrictive)
;; make private version of my-valid-char to get consistent results with 6.0
(define (my-valid-char? i)
(and (exact-nonnegative-integer? i)
(or (<= #x1 i #xD7FF)
(<= #xE000 i #xFFFD)
(<= #x10000 i #x10FFFF))))
(define (my-xexpr? x)
(or (txexpr? x) (xexpr? x) (my-valid-char? x)))
(define (txexpr-short? x)
(match x
[(list (? symbol? name) (? my-xexpr?) ...) #t]
[else #f]))
(define (txexpr? x)
(or (txexpr-short? x)
(match x
[(list (? symbol?) (list (list (? symbol?) (? string?)) ...) (? my-xexpr?) ...) #t]
[else #f])))
(define (txexpr-tag? x)
(symbol? x))
(define (txexpr-tags? x)
(and (list? x) (andmap txexpr-tag? x)))
(define (txexpr-attr? x)
(match x
[(list (? symbol?) (? string?)) #t]
[else #f]))
(define (txexpr-attrs? x)
(and (list? x) (andmap txexpr-attr? x)))
(define (txexpr-element? x)
(my-xexpr? x))
(define (txexpr-elements? x)
(and (list? x) (andmap txexpr-element? x)))
(define (txexpr-attr-key? x)
(symbol? x))
(define (can-be-txexpr-attr-key? x)
(or (symbol? x) (string? x)))
(define (txexpr-attr-value? x)
(string? x))
(define (txexpr-attr-values? x)
(and (list? x) (andmap txexpr-attr-value? x)))
(define (can-be-txexpr-attr-value? x)
(or (symbol? x) (string? x)))
(define (can-be-txexpr-attrs? x)
(ormap (λ(test) (test x)) (list txexpr-attr? txexpr-attrs? can-be-txexpr-attr-key? can-be-txexpr-attr-value?)))
(define (list-of-can-be-txexpr-attrs? xs)
(and (list? xs) (andmap can-be-txexpr-attrs? xs)))

@ -1,3 +0,0 @@
#lang info
(define scribblings '(("scribblings/txexpr.scrbl" ())))
(define compile-omit-paths '("tests.rkt"))

@ -1,43 +0,0 @@
#lang racket/base
(require sugar/define)
(require-via-wormhole "../typed/txexpr/main.rkt")
(provide+safe
[xexpr? predicate/c]
[txexpr? predicate/c]
[txexpr-short? predicate/c]
[txexpr-tag? predicate/c]
[txexpr-tags? predicate/c]
[txexpr-attr? predicate/c]
[txexpr-attrs? predicate/c]
[txexpr-element? predicate/c]
[txexpr-elements? predicate/c]
[validate-txexpr (any/c . -> . txexpr?)]
[make-txexpr ((symbol?) (txexpr-attrs? txexpr-elements?) . ->* . txexpr?)]
[txexpr->values (txexpr? . -> . (values symbol? txexpr-attrs? txexpr-elements?))]
[txexpr->list (txexpr? . -> . list?)]
[get-tag (txexpr? . -> . txexpr-tag?)]
[get-attrs (txexpr? . -> . txexpr-attrs?)]
[get-elements (txexpr? . -> . txexpr-elements?)]
[txexpr-attr-key? predicate/c]
[txexpr-attr-value? predicate/c]
[can-be-txexpr-attr-key? predicate/c]
[can-be-txexpr-attr-value? predicate/c]
[->txexpr-attr-key (can-be-txexpr-attr-key? . -> . txexpr-attr-key?)]
[->txexpr-attr-value (can-be-txexpr-attr-value? . -> . txexpr-attr-value?)]
[can-be-txexpr-attrs? predicate/c]
[list-of-can-be-txexpr-attrs? predicate/c]
[attrs->hash (() #:rest (listof can-be-txexpr-attrs?) . ->* . hash?)]
[hash->attrs (hash? . -> . txexpr-attrs?)]
[attr-ref (txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-value?)]
[attr-ref* (txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-values?)]
[attrs-have-key? ((or/c txexpr-attrs? txexpr?) can-be-txexpr-attr-key? . -> . boolean?)]
[attrs-equal? ((or/c txexpr-attrs? txexpr?) (or/c txexpr-attrs? txexpr?) . -> . boolean?)]
[attr-set (txexpr? can-be-txexpr-attr-key? can-be-txexpr-attr-value? . -> . txexpr?)]
[merge-attrs (() #:rest list-of-can-be-txexpr-attrs? . ->* . txexpr-attrs?)]
[remove-attrs (txexpr? . -> . txexpr?)]
[map-elements/exclude (procedure? txexpr? procedure? . -> . txexpr?)]
[map-elements (procedure? txexpr? . -> . txexpr?)]
[splitf-txexpr ((txexpr? procedure?) (procedure?) . ->* . (values txexpr? txexpr-elements?))]
[xexpr->html (xexpr? . -> . string?)])

@ -1,4 +0,0 @@
#lang typed/racket/base
(require "txexpr/main.rkt")
(provide (all-from-out "txexpr/main.rkt"))

@ -1,76 +0,0 @@
#lang typed/racket/base
(require (for-syntax racket/base) racket/match typed/sugar/define)
(provide (all-defined-out))
; Section 2.2 of XML 1.1
; (XML 1.0 is slightly different and more restrictive)
(define/typed (valid-char? i)
(Any -> Boolean)
(and (exact-nonnegative-integer? i)
(or (<= #x1 i #xD7FF)
(<= #xE000 i #xFFFD)
(<= #x10000 i #x10FFFF))))
(require/typed
xml
[#:struct location ([line : (Option Natural)]
[char : (Option Natural)]
[offset : Natural])]
[#:struct source ([start : (U location Symbol #f)]
[stop : (U location Symbol #f)])]
[#:struct (cdata source) ([string : String])]
[#:struct comment ([text : String])]
[#:struct (p-i source) ([target-name : Symbol]
[instruction : String])]
[xexpr->string (Xexpr -> String)])
(provide (all-from-out xml) cdata? xexpr->string)
(define-type Valid-Char Natural) ;; overinclusive but that's as good as it gets
(define-type Txexpr-Tag Symbol)
(define-type Txexpr-Attr-Key Symbol)
(define-type Txexpr-Attr-Value String)
(define-type Txexpr-Attr (List Txexpr-Attr-Key Txexpr-Attr-Value))
(define-predicate Txexpr-Attr? Txexpr-Attr)
(define-type Can-Be-Txexpr-Attr-Key (U Symbol String))
(define-type Can-Be-Txexpr-Attr-Value (U Symbol String))
(define-type Txexpr-Attrs (Listof Txexpr-Attr))
(define-type Txexpr-Attr-Hash (HashTable Txexpr-Attr-Key Txexpr-Attr-Value))
(define-type Txexpr-Element Xexpr)
(define-type Txexpr-Elements (Listof Txexpr-Element))
(define-type Txexpr-Full (List* Txexpr-Tag Txexpr-Attrs (Listof Xexpr)))
(define-type Txexpr-Short (Pairof Txexpr-Tag (Listof Xexpr)))
(define-type Txexpr (U Txexpr-Full Txexpr-Short))
(define-type Xexpr (Rec X
(U String
(List* Txexpr-Tag Txexpr-Attrs (Listof X))
(Pairof Txexpr-Tag (Listof X))
Symbol
Valid-Char
cdata
comment
p-i)))
(define-predicate xexpr? Xexpr)
(define-predicate txexpr? Txexpr)
(define-predicate txexpr-short? Txexpr-Short)
(define-predicate txexpr-tag? Txexpr-Tag)
(define-predicate txexpr-tags? (Listof Txexpr-Tag))
(define-predicate txexpr-attr? Txexpr-Attr)
(define-predicate txexpr-attrs? Txexpr-Attrs)
(define-predicate Valid-Char? Valid-Char)
(define/typed (txexpr-element? x)
(Any -> Boolean)
(if (xexpr? x)
(if (Valid-Char? x) (valid-char? x) #t)
#f))
(define-predicate txexpr-elements? (Listof Xexpr))
(define-predicate txexpr-attr-key? Txexpr-Attr-Key)
(define-predicate txexpr-attr-value? Txexpr-Attr-Value)
(define-predicate txexpr-attr-values? (Listof Txexpr-Attr-Value))
(define-predicate can-be-txexpr-attr-key? Can-Be-Txexpr-Attr-Key)
(define-predicate can-be-txexpr-attr-value? Can-Be-Txexpr-Attr-Value)
(define-predicate can-be-txexpr-attr? (List Can-Be-Txexpr-Attr-Key Can-Be-Txexpr-Attr-Value))
(define-type Can-Be-Txexpr-Attr (U Txexpr-Attr Txexpr-Attrs Can-Be-Txexpr-Attr-Key Can-Be-Txexpr-Attr-Value))
(define-predicate can-be-txexpr-attrs? Can-Be-Txexpr-Attr)
(define-predicate list-of-can-be-txexpr-attrs? (Listof Can-Be-Txexpr-Attr))
Loading…
Cancel
Save