diff --git a/info.rkt b/info.rkt
index 70f980f..5ad8e4c 100644
--- a/info.rkt
+++ b/info.rkt
@@ -1,4 +1,6 @@
#lang info
(define collection 'multi)
-(define deps '("base" "sugar"))
-(define build-deps '("scribble-lib" "racket-doc"))
+(define deps '("base" "sugar" "typed-racket-lib"
+ "typed-racket-more"
+ "rackunit-lib"))
+(define build-deps '("scribble-lib" "racket-doc" "typed-racket-doc"))
\ No newline at end of file
diff --git a/txexpr/core-predicates.rkt b/txexpr/core-predicates.rkt
index aa49d61..9830c90 100644
--- a/txexpr/core-predicates.rkt
+++ b/txexpr/core-predicates.rkt
@@ -1,3 +1,54 @@
#lang racket/base
+(require sugar/define xml racket/match)
+(provide (all-defined-out) valid-char? cdata? cdata xexpr->string xexpr?)
+
+(define (txexpr-short? x)
+ (match x
+ [(list (? symbol? name) (? xexpr?) ...) #t]
+ [else #f]))
+
+(define (txexpr? x)
+ (or (txexpr-short? x)
+ (match x
+ [(list (? symbol?) (list (list (? symbol?) (? string?)) ...) (? xexpr?) ...) #t]
+ [else #f])))
+
+(define (txexpr-tag? x)
+ (symbol? 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)
+ (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)))
-;; zilch
\ No newline at end of file
diff --git a/txexpr/main.rkt b/txexpr/main.rkt
index 737559e..2c06c40 100644
--- a/txexpr/main.rkt
+++ b/txexpr/main.rkt
@@ -1,15 +1,42 @@
#lang racket/base
-(require sugar/include sugar/define xml)
+(require sugar/define)
-(define+provide+safe (txexpr? x)
- (any/c . -> . boolean?)
- (with-handlers ([exn:fail? (λ(exn) #f)])
- (and (validate-txexpr x) #t)))
+(require-via-wormhole "../typed/txexpr/main.rkt")
-(define+provide+safe (txexpr-attr? x)
- (any/c . -> . boolean?)
- (match x
- [(list (? symbol?) (? string?)) #t]
- [else #f]))
-
-(include-without-lang-line "../typed/txexpr/main.rkt")
+(provide+safe
+ [xexpr? predicate/c]
+ [txexpr? predicate/c]
+ [txexpr-short? predicate/c]
+ [txexpr-tag? 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?)])
\ No newline at end of file
diff --git a/txexpr/scribblings/txexpr.scrbl b/txexpr/scribblings/txexpr.scrbl
index d866f22..b31dce2 100644
--- a/txexpr/scribblings/txexpr.scrbl
+++ b/txexpr/scribblings/txexpr.scrbl
@@ -1,6 +1,6 @@
#lang scribble/manual
-@(require scribble/eval (for-label racket txexpr xml))
+@(require scribble/eval (for-label racket txexpr xml (only-in typed/racket require/typed)))
@(define my-eval (make-base-eval))
@(my-eval `(require txexpr xml))
@@ -10,7 +10,7 @@
@author[(author+email "Matthew Butterick" "mb@mbtype.com")]
-@defmodule[#:multi (txexpr (submod txexpr safe))]
+@defmodule[#:multi (txexpr (submod txexpr safe) typed/txexpr)]
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).
@@ -24,10 +24,14 @@ After that, you can update the package from the command line:
@section{Importing the module}
-The module operates in two modes: fast and safe. Fast mode is the default, which you get by importing the module in the usual way: @code{(require txexpr)}.
+The module can be invoked three ways: fast, safe, and typed.
+
+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))}.
+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.
+
@section{What’s a txexpr?}
diff --git a/txexpr/tests.rkt b/txexpr/tests.rkt
index 2e10cb3..f320836 100644
--- a/txexpr/tests.rkt
+++ b/txexpr/tests.rkt
@@ -1,158 +1,192 @@
#lang racket/base
-(require (for-syntax racket/base))
-(require (submod "main.rkt" safe) rackunit)
+(require (for-syntax racket/base racket/syntax))
-(define-syntax (values->list stx)
+(define-syntax (eval-as-untyped stx)
(syntax-case stx ()
- [(_ values-expr) #'(call-with-values (λ () values-expr) list)]))
-
-(check-true (txexpr-tag?'foo))
-(check-false (txexpr-tag? "foo"))
-(check-false (txexpr-tag? 3))
-
-(check-true (txexpr-attr? '(key "value")))
-(check-false (txexpr-attr? '(key "value" "another")))
-(check-false (txexpr-attr? '(key 0 "value")))
-
-(check-true (txexpr-attrs? '()))
-(check-true (txexpr-attrs? '((key "value"))))
-(check-true (txexpr-attrs? '((key "value") (foo "bar"))))
-(check-false (txexpr-attrs? '((key "value") "foo" "bar"))) ; content, not attr
-(check-false (txexpr-attrs? '(key "value"))) ; not a nested list
-(check-false (txexpr-attrs? '(("key" "value")))) ; two strings
-(check-false (txexpr-attrs? '((key value)))) ; two symbols
-
-(check-true (txexpr-element? "string"))
-(check-true (txexpr-element? 'amp))
-(check-true (txexpr-element? '(p "string")))
-(check-true (txexpr-element? 65)) ;; a valid-char
-(check-false (txexpr-element? 0)) ;; not a valid-char
-
-(check-true (txexpr-elements? '("p" "foo" "123")))
-(check-true (txexpr-elements? '("p" "foo" 123))) ; includes number
-(check-true (txexpr-elements? '(p "foo" "123"))) ; includes symbol
-(check-false (txexpr-elements? "foo")) ; not a list
-(check-false (txexpr-elements? '(((key "value")) "foo" "bar"))) ; includes attr
-(check-false (txexpr-elements? '("foo" "bar" ((key "value"))))) ; malformed
-
-(check-true (txexpr? '(p)))
-(check-true (txexpr? '(p "foo" "bar")))
-(check-true (txexpr? '(p ((key "value")) "foo" "bar")))
-(check-true (txexpr? '(p 123))) ; content is a number
-(check-false (txexpr? "foo")) ; not a list with symbol
-(check-false (txexpr? '(p "foo" "bar" ((key "value"))))) ; malformed
-(check-false (txexpr? '("p" "foo" "bar"))) ; no name
-
-(check-equal? (make-txexpr 'p) '(p))
-(check-equal? (make-txexpr 'p '((key "value"))) '(p ((key "value"))))
-(check-equal? (make-txexpr 'p null '("foo" "bar")) '(p "foo" "bar"))
-(check-equal? (make-txexpr 'p '((key "value")) (list "foo" "bar"))
- '(p ((key "value")) "foo" "bar"))
-
-(check-equal? (values->list (txexpr->values '(p)))
- (values->list (values 'p null null)))
-(check-equal? (values->list (txexpr->values '(p "foo")))
- (values->list (values 'p null '("foo"))))
-(check-equal? (values->list (txexpr->values '(p ((key "value")))))
- (values->list (values 'p '((key "value")) null)))
-(check-equal? (values->list (txexpr->values '(p ((key "value")) "foo")))
- (values->list (values 'p '((key "value")) '("foo"))))
-
-(check-equal? (values->list (txexpr->values '(p)))
- (txexpr->list '(p)))
-(check-equal? (values->list (txexpr->values '(p "foo")))
- (txexpr->list '(p "foo")))
-(check-equal? (values->list (txexpr->values '(p ((key "value")))))
- (txexpr->list '(p ((key "value")))))
-(check-equal? (values->list (txexpr->values '(p ((key "value")) "foo")))
- (txexpr->list '(p ((key "value")) "foo")))
-
-(check-equal? (get-tag '(p ((key "value"))"foo" "bar" (em "square"))) 'p)
-(check-equal? (get-attrs '(p ((key "value"))"foo" "bar" (em "square"))) '((key "value")))
-(check-equal? (get-elements '(p ((key "value"))"foo" "bar" (em "square")))
- '("foo" "bar" (em "square")))
-
-
-(check-equal? (->txexpr-attr-key "foo") 'foo)
-(check-equal? (->txexpr-attr-key 'foo) 'foo)
-
-(check-equal? (->txexpr-attr-value "foo") "foo")
-(check-equal? (->txexpr-attr-value 'foo) "foo")
-
-(check-equal? (attrs->hash '((foo "bar"))) '#hash((foo . "bar")))
-(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw")) '#hash((foo . "fraw")))
-(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw") 'foo "dog") '#hash((foo . "dog")))
-
-(check-equal? (hash->attrs '#hash((foo . "bar")(hee . "haw"))) '((foo "bar")(hee "haw")))
-
-(check-equal? (attr-ref '(p ((foo "bar"))) 'foo) "bar")
-(check-equal? (attr-set '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw"))))
-
-(check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) 'color))
-(check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) "color"))
-(check-false (attrs-have-key? '((color "red")(shape "circle")) 'nonexistent))
-
-(check-true (attrs-equal? '(p ((color "red")(shape "circle")))
- '(foo ((color "red")(shape "circle")))))
-
-(check-false (attrs-equal? '(p ((color "red")(shape "circle")))
- '(foo ((color "blue")(shape "circle")))))
-
-(check-true (attrs-equal? '(p ((color "red")(shape "circle")))
- '(foo ((shape "circle")(color "red")))))
-
-(check-false (attrs-equal? '(p ((color "red")(shape "circle")))
- '(foo ((color "red")))))
-
-(check-true (attrs-equal? '((color "red")(shape "circle"))
- '((color "red")(shape "circle"))))
-
-(check-false (attrs-equal? '((color "red")(shape "circle"))
- '((color "blue")(shape "circle"))))
-
-(check-true (attrs-equal? '((color "red")(shape "circle"))
- '((shape "circle")(color "red"))))
-
-(check-false (attrs-equal? '((color "red")(shape "circle"))
- '((color "red"))))
-
-
-
-(check-equal? (merge-attrs 'foo "bar") '((foo "bar")))
-(check-equal? (merge-attrs '(foo "bar")) '((foo "bar")))
-(check-equal? (merge-attrs '((foo "bar"))) '((foo "bar")))
-(check-equal? (merge-attrs "foo" 'bar) '((foo "bar")))
-(check-equal? (merge-attrs "foo" "bar" "goo" "gar") '((foo "bar")(goo "gar")))
-(check-equal? (merge-attrs (merge-attrs "foo" "bar" "goo" "gar") "hee" "haw")
- '((foo "bar")(goo "gar")(hee "haw")))
-(check-equal? (merge-attrs '((foo "bar")(goo "gar")) "foo" "haw") '((foo "haw")(goo "gar")))
-
-
-(check-equal? (remove-attrs '(p ((foo "bar")) "hi")) '(p "hi"))
-(check-equal? (remove-attrs '(p ((foo "bar")) "hi" (p ((foo "bar")) "hi"))) '(p "hi" (p "hi")))
-
-
-(check-equal? (map-elements (λ(x) (if (string? x) "boing" x))
- '(p "foo" "bar" (em "square")))
- '(p "boing" "boing" (em "boing")))
-
-
-(check-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2")
- (em ((foo "zam")) "goodnight" "moon")) 'foo) '("bar" "zam" "zam"))
-
-(check-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2")
- (em ((foo "zam")) "goodnight" "moon")) 'nonexistent-key) '())
-
-
-(define split-this-tx '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2")
- (em "goodnight" "moon" (meta "foo3" "bar3"))))
-(define split-predicate (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))
-(check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate)) list)
- (list '(root "hello" "world" (em "goodnight" "moon")) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
-
-(define split-proc (λ(x) '(div "foo")))
-(check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate split-proc)) list)
- (list '(root (div "foo") "hello" "world" (div "foo") (em "goodnight" "moon" (div "foo"))) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
-
-(check-equal? (xexpr->html '(root (script "3 > 2") "Why is 3 > 2?"))
- "Why is 3 > 2?")
\ No newline at end of file
+ [(_ exprs ...)
+ (with-syntax ([sym (generate-temporary)])
+ #'(begin
+ (module sym racket
+ (require rackunit (submod txexpr safe))
+ exprs ...)
+ (require 'sym)))]))
+
+(define-syntax (eval-as-typed stx)
+ (syntax-case stx ()
+ [(_ exprs ...)
+ (with-syntax ([sym (generate-temporary)])
+ #'(begin
+ (module sym typed/racket
+ (require typed/rackunit typed/txexpr)
+ exprs ...)
+ (require 'sym)))]))
+
+(define-syntax-rule (eval-as-typed-and-untyped exprs ...)
+ (begin
+ (eval-as-typed exprs ...)
+ (eval-as-untyped exprs ...)))
+
+
+(eval-as-typed-and-untyped
+ (define-syntax (values->list stx)
+ (syntax-case stx ()
+ [(_ values-expr) #'(call-with-values (λ () values-expr) list)]))
+ (check-true (txexpr-tag? 'foo))
+ (check-false (txexpr-tag? "foo"))
+ (check-false (txexpr-tag? 3))
+
+ (check-true (txexpr-attr? '(key "value")))
+ (check-false (txexpr-attr? '(key "value" "another")))
+ (check-false (txexpr-attr? '(key 0 "value")))
+
+ (check-true (txexpr-attrs? '()))
+ (check-true (txexpr-attrs? '((key "value"))))
+ (check-true (txexpr-attrs? '((key "value") (foo "bar"))))
+ (check-false (txexpr-attrs? '((key "value") "foo" "bar"))) ; content, not attr
+ (check-false (txexpr-attrs? '(key "value"))) ; not a nested list
+ (check-false (txexpr-attrs? '(("key" "value")))) ; two strings
+ (check-false (txexpr-attrs? '((key value)))) ; two symbols
+
+ (check-true (txexpr-element? "string"))
+ (check-true (txexpr-element? 'amp))
+ (check-true (txexpr-element? '(p "string")))
+ (check-true (txexpr-element? 65)) ;; a valid-char
+ (check-false (txexpr-element? 0)) ;; not a valid-char
+
+ (check-true (txexpr-elements? '("p" "foo" "123")))
+ (check-true (txexpr-elements? '("p" "foo" 123))) ; includes number
+ (check-true (txexpr-elements? '(p "foo" "123"))) ; includes symbol
+ (check-false (txexpr-elements? "foo")) ; not a list
+ (check-false (txexpr-elements? '(((key "value")) "foo" "bar"))) ; includes attr
+ (check-false (txexpr-elements? '("foo" "bar" ((key "value"))))) ; malformed
+
+ (check-true (txexpr? '(p)))
+ (check-true (txexpr? '(p "foo" "bar")))
+ (check-true (txexpr? '(p ((key "value")) "foo" "bar")))
+ (check-true (txexpr? '(p 123))) ; content is a number
+ (check-false (txexpr? "foo")) ; not a list with symbol
+ (check-false (txexpr? '(p "foo" "bar" ((key "value"))))) ; malformed
+ (check-false (txexpr? '("p" "foo" "bar"))) ; no name
+
+ (check-not-exn (λ _ (validate-txexpr '(p))))
+ (check-not-exn (λ _ (validate-txexpr '(p "foo" "bar"))))
+ (check-not-exn (λ _ (validate-txexpr '(p ((key "value")) "foo" "bar"))))
+ (check-not-exn (λ _ (validate-txexpr '(p 123)))) ; content is a valid-char
+ ;(check-exn (λ _ (validate-txexpr "foo"))) ; not a list with symbol
+ ;(check-exn (λ _ (validate-txexpr '(p "foo" "bar" ((key "value")))))) ; malformed
+ ;(check-exn (λ _ (validate-txexpr '("p" "foo" "bar")))) ; no name
+
+
+ (check-equal? (make-txexpr 'p) '(p))
+ (check-equal? (make-txexpr 'p '((key "value"))) '(p ((key "value"))))
+ (check-equal? (make-txexpr 'p null '("foo" "bar")) '(p "foo" "bar"))
+ (check-equal? (make-txexpr 'p '((key "value")) (list "foo" "bar"))
+ '(p ((key "value")) "foo" "bar"))
+
+ (check-equal? (values->list (txexpr->values '(p)))
+ (values->list (values 'p null null)))
+ (check-equal? (values->list (txexpr->values '(p "foo")))
+ (values->list (values 'p null '("foo"))))
+ (check-equal? (values->list (txexpr->values '(p ((key "value")))))
+ (values->list (values 'p '((key "value")) null)))
+ (check-equal? (values->list (txexpr->values '(p ((key "value")) "foo")))
+ (values->list (values 'p '((key "value")) '("foo"))))
+
+ (check-equal? (values->list (txexpr->values '(p)))
+ (txexpr->list '(p)))
+ (check-equal? (values->list (txexpr->values '(p "foo")))
+ (txexpr->list '(p "foo")))
+ (check-equal? (values->list (txexpr->values '(p ((key "value")))))
+ (txexpr->list '(p ((key "value")))))
+ (check-equal? (values->list (txexpr->values '(p ((key "value")) "foo")))
+ (txexpr->list '(p ((key "value")) "foo")))
+
+ (check-equal? (get-tag '(p ((key "value"))"foo" "bar" (em "square"))) 'p)
+ (check-equal? (get-attrs '(p ((key "value"))"foo" "bar" (em "square"))) '((key "value")))
+ (check-equal? (get-elements '(p ((key "value"))"foo" "bar" (em "square")))
+ '("foo" "bar" (em "square")))
+
+
+ (check-equal? (->txexpr-attr-key "foo") 'foo)
+ (check-equal? (->txexpr-attr-key 'foo) 'foo)
+
+ (check-equal? (->txexpr-attr-value "foo") "foo")
+ (check-equal? (->txexpr-attr-value 'foo) "foo")
+
+ (check-equal? (attrs->hash '((foo "bar"))) '#hash((foo . "bar")))
+ (check-equal? (attrs->hash '((foo "bar")) '(foo "fraw")) '#hash((foo . "fraw")))
+ (check-equal? (attrs->hash '((foo "bar")) '(foo "fraw") 'foo "dog") '#hash((foo . "dog")))
+
+ (check-equal? (hash->attrs '#hash((foo . "bar")(hee . "haw"))) '((foo "bar")(hee "haw")))
+
+ (check-equal? (attr-ref '(p ((foo "bar"))) 'foo) "bar")
+ (check-equal? (attr-set '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw"))))
+
+ (check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) 'color))
+ (check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) "color"))
+ (check-false (attrs-have-key? '((color "red")(shape "circle")) 'nonexistent))
+
+ (check-true (attrs-equal? '(p ((color "red")(shape "circle")))
+ '(foo ((color "red")(shape "circle")))))
+
+ (check-false (attrs-equal? '(p ((color "red")(shape "circle")))
+ '(foo ((color "blue")(shape "circle")))))
+
+ (check-true (attrs-equal? '(p ((color "red")(shape "circle")))
+ '(foo ((shape "circle")(color "red")))))
+
+ (check-false (attrs-equal? '(p ((color "red")(shape "circle")))
+ '(foo ((color "red")))))
+
+ (check-true (attrs-equal? '((color "red")(shape "circle"))
+ '((color "red")(shape "circle"))))
+
+ (check-false (attrs-equal? '((color "red")(shape "circle"))
+ '((color "blue")(shape "circle"))))
+
+ (check-true (attrs-equal? '((color "red")(shape "circle"))
+ '((shape "circle")(color "red"))))
+
+ (check-false (attrs-equal? '((color "red")(shape "circle"))
+ '((color "red"))))
+
+
+
+ (check-equal? (merge-attrs 'foo "bar") '((foo "bar")))
+ (check-equal? (merge-attrs '(foo "bar")) '((foo "bar")))
+ (check-equal? (merge-attrs '((foo "bar"))) '((foo "bar")))
+ (check-equal? (merge-attrs "foo" 'bar) '((foo "bar")))
+ (check-equal? (merge-attrs "foo" "bar" "goo" "gar") '((foo "bar")(goo "gar")))
+ (check-equal? (merge-attrs (merge-attrs "foo" "bar" "goo" "gar") "hee" "haw")
+ '((foo "bar")(goo "gar")(hee "haw")))
+ (check-equal? (merge-attrs '((foo "bar")(goo "gar")) "foo" "haw") '((foo "haw")(goo "gar")))
+
+
+ (check-equal? (remove-attrs '(p ((foo "bar")) "hi")) '(p "hi"))
+ (check-equal? (remove-attrs '(p ((foo "bar")) "hi" (p ((foo "bar")) "hi"))) '(p "hi" (p "hi")))
+
+
+ (check-equal? (map-elements (λ(x) (if (string? x) "boing" x))
+ '(p "foo" "bar" (em "square")))
+ '(p "boing" "boing" (em "boing")))
+
+
+ (check-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2")
+ (em ((foo "zam")) "goodnight" "moon")) 'foo) '("bar" "zam" "zam"))
+
+ (check-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2")
+ (em ((foo "zam")) "goodnight" "moon")) 'nonexistent-key) '())
+
+
+ (define split-this-tx '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2")
+ (em "goodnight" "moon" (meta "foo3" "bar3"))))
+ (define split-predicate (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))
+ (check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate)) list)
+ (list '(root "hello" "world" (em "goodnight" "moon")) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
+
+ (define split-proc (λ(x) '(div "foo")))
+ (check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate split-proc)) list)
+ (list '(root (div "foo") "hello" "world" (div "foo") (em "goodnight" "moon" (div "foo"))) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
+
+ (check-equal? (xexpr->html '(root (script "3 > 2") "Why is 3 > 2?"))
+ "Why is 3 > 2?"))
\ No newline at end of file
diff --git a/typed/txexpr/core-predicates.rkt b/typed/txexpr/core-predicates.rkt
index 593c6f6..847e4dc 100644
--- a/typed/txexpr/core-predicates.rkt
+++ b/typed/txexpr/core-predicates.rkt
@@ -26,8 +26,6 @@
(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)
diff --git a/typed/txexpr/main.rkt b/typed/txexpr/main.rkt
index 5c74062..45389a2 100644
--- a/typed/txexpr/main.rkt
+++ b/typed/txexpr/main.rkt
@@ -2,7 +2,7 @@
(require (for-syntax typed/racket/base) typed/sugar/define)
(require racket/match racket/string racket/list racket/bool "core-predicates.rkt")
(provide (all-defined-out) (all-from-out "core-predicates.rkt"))
-
+(require typed/sugar/debug)
(define/typed (validate-txexpr-attrs x #:context [txexpr-context #f])
((Txexpr-Attrs) (#:context Any) . ->* . Txexpr-Attrs)
(define/typed (make-reason)
@@ -14,7 +14,7 @@
"are not valid attributes"
"is not in the form '(symbol \"string\")")))))
(cond
- [(and (list? x) (> 0 (length x)) (andmap txexpr-attr? x)) x]
+ [(and (list? x) (> (length x) 0) (andmap txexpr-attr? x)) x]
[else (error (string-append "validate-txexpr-attrs: "
(if txexpr-context (format "in ~v, " txexpr-context) "")
(format "~v is not a valid list of attributes ~a" x (make-reason))))]))
diff --git a/typed/txexpr/tests.rkt b/typed/txexpr/tests.rkt
deleted file mode 100644
index 55a0b28..0000000
--- a/typed/txexpr/tests.rkt
+++ /dev/null
@@ -1,159 +0,0 @@
-#lang typed/racket/base
-(require (for-syntax racket/base))
-(require "main.rkt" typed/rackunit)
-
-(define-syntax (values->list stx)
- (syntax-case stx ()
- [(_ values-expr) #'(call-with-values (λ () values-expr) list)]))
-
-(check-true (txexpr-tag?'foo))
-(check-false (txexpr-tag? "foo"))
-(check-false (txexpr-tag? 3))
-
-(check-true (txexpr-attr? '(key "value")))
-(check-false (txexpr-attr? '(key "value" "another")))
-(check-false (txexpr-attr? '(key 0 "value")))
-
-(check-true (txexpr-attrs? '()))
-(check-true (txexpr-attrs? '((key "value"))))
-(check-true (txexpr-attrs? '((key "value") (foo "bar"))))
-(check-false (txexpr-attrs? '((key "value") "foo" "bar"))) ; content, not attr
-(check-false (txexpr-attrs? '(key "value"))) ; not a nested list
-(check-false (txexpr-attrs? '(("key" "value")))) ; two strings
-(check-false (txexpr-attrs? '((key value)))) ; two symbols
-
-(check-true (txexpr-element? "string"))
-(check-true (txexpr-element? 'amp))
-(check-true (txexpr-element? '(p "string")))
-(check-true (txexpr-element? 65)) ;; a valid-char
-(check-false (txexpr-element? 0)) ;; not a valid-char
-
-(check-true (txexpr-elements? '("p" "foo" "123")))
-(check-true (txexpr-elements? '("p" "foo" 123))) ; includes number
-(check-true (txexpr-elements? '(p "foo" "123"))) ; includes symbol
-(check-false (txexpr-elements? "foo")) ; not a list
-(check-false (txexpr-elements? '(((key "value")) "foo" "bar"))) ; includes attr
-(check-false (txexpr-elements? '("foo" "bar" ((key "value"))))) ; malformed
-
-(check-true (txexpr? '(p)))
-(check-true (txexpr? '(p "foo" "bar")))
-(check-true (txexpr? '(p ((key "value")) "foo" "bar")))
-(check-true (txexpr? '(p 123))) ; content is a number
-(check-false (txexpr? "foo")) ; not a list with symbol
-(check-false (txexpr? '(p "foo" "bar" ((key "value"))))) ; malformed
-(check-false (txexpr? '("p" "foo" "bar"))) ; no name
-
-(check-equal? (make-txexpr 'p) '(p))
-(check-equal? (make-txexpr 'p '((key "value"))) '(p ((key "value"))))
-(check-equal? (make-txexpr 'p null '("foo" "bar")) '(p "foo" "bar"))
-(check-equal? (make-txexpr 'p '((key "value")) (list "foo" "bar"))
- '(p ((key "value")) "foo" "bar"))
-
-(check-equal? (values->list (txexpr->values '(p)))
- (values->list (values 'p null null)))
-(check-equal? (values->list (txexpr->values '(p "foo")))
- (values->list (values 'p null '("foo"))))
-(check-equal? (values->list (txexpr->values '(p ((key "value")))))
- (values->list (values 'p '((key "value")) null)))
-(check-equal? (values->list (txexpr->values '(p ((key "value")) "foo")))
- (values->list (values 'p '((key "value")) '("foo"))))
-
-(check-equal? (values->list (txexpr->values '(p)))
- (txexpr->list '(p)))
-(check-equal? (values->list (txexpr->values '(p "foo")))
- (txexpr->list '(p "foo")))
-(check-equal? (values->list (txexpr->values '(p ((key "value")))))
- (txexpr->list '(p ((key "value")))))
-(check-equal? (values->list (txexpr->values '(p ((key "value")) "foo")))
- (txexpr->list '(p ((key "value")) "foo")))
-
-(check-equal? (get-tag '(p ((key "value"))"foo" "bar" (em "square"))) 'p)
-(check-equal? (get-attrs '(p ((key "value"))"foo" "bar" (em "square"))) '((key "value")))
-(check-equal? (get-elements '(p ((key "value"))"foo" "bar" (em "square")))
- '("foo" "bar" (em "square")))
-
-
-(check-equal? (->txexpr-attr-key "foo") 'foo)
-(check-equal? (->txexpr-attr-key 'foo) 'foo)
-
-(check-equal? (->txexpr-attr-value "foo") "foo")
-(check-equal? (->txexpr-attr-value 'foo) "foo")
-
-(check-equal? (attrs->hash '((foo "bar"))) '#hash((foo . "bar")))
-(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw")) '#hash((foo . "fraw")))
-(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw") 'foo "dog") '#hash((foo . "dog")))
-
-(check-equal? (hash->attrs '#hash((foo . "bar")(hee . "haw"))) '((foo "bar")(hee "haw")))
-
-(check-equal? (attr-ref '(p ((foo "bar"))) 'foo) "bar")
-(check-equal? (attr-set '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw"))))
-
-(check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) 'color))
-(check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) "color"))
-(check-false (attrs-have-key? '((color "red")(shape "circle")) 'nonexistent))
-
-(check-true (attrs-equal? '(p ((color "red")(shape "circle")))
- '(foo ((color "red")(shape "circle")))))
-
-(check-false (attrs-equal? '(p ((color "red")(shape "circle")))
- '(foo ((color "blue")(shape "circle")))))
-
-(check-true (attrs-equal? '(p ((color "red")(shape "circle")))
- '(foo ((shape "circle")(color "red")))))
-
-(check-false (attrs-equal? '(p ((color "red")(shape "circle")))
- '(foo ((color "red")))))
-
-(check-true (attrs-equal? '((color "red")(shape "circle"))
- '((color "red")(shape "circle"))))
-
-(check-false (attrs-equal? '((color "red")(shape "circle"))
- '((color "blue")(shape "circle"))))
-
-(check-true (attrs-equal? '((color "red")(shape "circle"))
- '((shape "circle")(color "red"))))
-
-(check-false (attrs-equal? '((color "red")(shape "circle"))
- '((color "red"))))
-
-
-
-(check-equal? (merge-attrs 'foo "bar") '((foo "bar")))
-(check-equal? (merge-attrs '(foo "bar")) '((foo "bar")))
-(check-equal? (merge-attrs '((foo "bar"))) '((foo "bar")))
-(check-equal? (merge-attrs "foo" 'bar) '((foo "bar")))
-(check-equal? (merge-attrs "foo" "bar" "goo" "gar") '((foo "bar")(goo "gar")))
-(check-equal? (merge-attrs (merge-attrs "foo" "bar" "goo" "gar") "hee" "haw")
- '((foo "bar")(goo "gar")(hee "haw")))
-(check-equal? (merge-attrs '((foo "bar")(goo "gar")) "foo" "haw") '((foo "haw")(goo "gar")))
-
-
-
-(check-equal? (remove-attrs '(p ((foo "bar")) "hi")) '(p "hi"))
-(check-equal? (remove-attrs '(p ((foo "bar")) "hi" (p ((foo "bar")) "hi"))) '(p "hi" (p "hi")))
-
-
-(check-equal? (map-elements (λ(x) (if (string? x) "boing" x))
- '(p "foo" "bar" (em "square")))
- '(p "boing" "boing" (em "boing")))
-
-
-(check-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2")
- (em ((foo "zam")) "goodnight" "moon")) 'foo) '("bar" "zam" "zam"))
-
-(check-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2")
- (em ((foo "zam")) "goodnight" "moon")) 'nonexistent-key) '())
-
-
-(define split-this-tx '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2")
- (em "goodnight" "moon" (meta "foo3" "bar3"))))
-(define split-predicate (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))
-(check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate)) list)
- (list '(root "hello" "world" (em "goodnight" "moon")) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
-
-(define split-proc (λ(x) '(div "foo")))
-(check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate split-proc)) list)
- (list '(root (div "foo") "hello" "world" (div "foo") (em "goodnight" "moon" (div "foo"))) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
-
-(check-equal? (xexpr->html '(root (script "3 > 2") "Why is 3 > 2?"))
- "Why is 3 > 2?")
\ No newline at end of file