updates

coerce.rkt

@@ -37,6 +37,13 @@
    (except [exn:fail? (make-coercion-error-handler 'string x)])))
 
 
+;; general way of coercing to html
+(define+provide/contract (->html x)
+  (any/c . -> . string?)
+  (try (xexpr->string x)
+   (except [exn:fail? (make-coercion-error-handler 'html x)])))
+
+
 ;; general way of coercing to symbol
 (define+provide/contract (->symbol x)
   (any/c . -> . symbol?)
@@ -109,27 +116,27 @@
                                  expected-sym x))])))))
 
 
-(define/provide coerce/integer?
+(define+provide coerce/integer?
   (make-contract
    #:name 'coerce/integer?
    #:projection (make-blame-handler ->int 'can-be-integer?)))
 
-(define/provide coerce/string?
+(define+provide coerce/string?
   (make-contract
    #:name 'coerce/string?
    #:projection (make-blame-handler ->string 'can-be-string?)))
 
-(define/provide coerce/symbol?
+(define+provide coerce/symbol?
   (make-contract
    #:name 'coerce/symbol?
    #:projection (make-blame-handler ->symbol 'can-be-symbol?)))
 
-(define/provide coerce/path?
+(define+provide coerce/path?
   (make-contract
    #:name 'coerce/path?
    #:projection (make-blame-handler ->path 'can-be-path?)))
 
-(define/provide coerce/boolean?
+(define+provide coerce/boolean?
   (make-contract
    #:name 'coerce/boolean?
    #:projection (make-blame-handler ->boolean 'can-be-boolean?)))

define.rkt

@@ -2,12 +2,12 @@
 (require (for-syntax racket/base))
 (require racket/contract)
 
-(provide define/provide define+provide/contract define/contract+provide)
+(provide define+provide define+provide/contract define/contract+provide)
 
-(define-syntax (define/provide stx)
+(define-syntax (define+provide stx)
   (syntax-case stx ()
     [(_ (proc arg ... . rest-arg) body ...)
-     #'(define/provide proc
+     #'(define+provide proc
          (λ(arg ... . rest-arg) body ...))]
     [(_ name body ...)
      #'(begin

list.rkt

@@ -1,16 +1,15 @@
 #lang racket/base
-(require racket/contract racket/list)
+(require racket/contract racket/list racket/set)
-
+(require "define.rkt" "len.rkt" "coerce.rkt")
-(provide trim splitf-at*)
 
 ;; trim from beginning & end of list
-(define (trim items test-proc)
+(define+provide/contract (trim items test-proc)
   (list? procedure? . -> . list?)
   (dropf-right (dropf items test-proc) test-proc))
 
 
 ;; split list into list of sublists using test-proc
-(define/contract (splitf-at* xs split-test)
+(define+provide/contract (splitf-at* xs split-test)
     
   ;; todo: better error message when split-test is not a predicate
   (list? predicate/c . -> . (listof list?))
@@ -28,4 +27,36 @@
           (&splitf-at* rest (cons item acc)))))
   
   ;; trim off elements matching split-test
-  (&splitf-at* (trim xs split-test)))
+  (&splitf-at* (trim xs split-test)))
+
+
+;; count incidence of elements in a list
+;; returns hash where key is element, value is incidence
+;; todo: move this? Ideally it would be in tools,
+;; but that would create a circular dependency.
+(define+provide/contract (count-incidence x)
+  (list? . -> . hash?)
+  (define counter (make-hash))
+  (for ([item (flatten x)]) 
+    (hash-set! counter item (add1 (hash-ref counter item 0))))
+  counter)
+
+
+(define+provide/contract (members-unique? x)
+  (any/c . -> . boolean?)
+  (cond 
+    [(list? x) (= (len (apply set x)) (len x))]
+    [(vector? x) (members-unique? (->list x))]
+    [(string? x) (members-unique? (string->list x))]
+    [else (error (format "members-unique cannot be determined for ~a" x))]))
+
+(define+provide/contract (members-unique?/error x)
+  (any/c . -> . boolean?)
+  (define result (members-unique? x))
+  (if (not result)
+      (let* ([duplicate-keys (filter-not empty? (hash-map (count-incidence x) 
+                                                          (λ(k v) (if (> v 1) k '()))))])
+        (error (string-append (if (= (len duplicate-keys) 1) 
+                                  "Item isn’t"
+                                  "Items aren’t") " unique:") duplicate-keys))
+      result))

tree.rkt

@@ -0,0 +1,51 @@
+#lang racket/base
+(require racket/list racket/contract)
+(require "define.rkt")
+
+(module+ test (require rackunit))
+
+;; apply filter proc recursively
+(define+provide/contract (filter-tree proc tree)
+  (procedure? list? . -> . list?)
+  (define (remove-empty x)
+    (cond
+      [(list? x) (filter-not empty? (map remove-empty x))]
+      [else x]))
+  
+  (define (filter-tree-inner proc x)
+    (cond
+      [(list? x) (map (λ(i) (filter-tree-inner proc i)) x)]
+      [else (if (proc x) x empty)]))
+  
+  (remove-empty (filter-tree-inner proc tree)))
+
+
+(module+ test
+  (check-equal? (filter-tree string? '(p)) empty)
+  (check-equal? (filter-tree string? '(p "foo" "bar")) '("foo" "bar"))
+  (check-equal? (filter-tree string? '(p "foo" (p "bar"))) '("foo" ("bar")))
+  (check-equal? (filter-tree (λ(i) (and (string? i) (equal? i "\n"))) '("\n" (foo "bar") "\n")) '("\n" "\n"))) 
+
+;; apply filter-not proc recursively
+(define+provide/contract (filter-not-tree proc tree)
+  (procedure? list? . -> . list?)
+  (filter-tree (λ(i) (not (proc i))) tree))
+
+(module+ test
+  (check-equal? (filter-not-tree string? '(p)) '(p))
+  (check-equal? (filter-not-tree string? '(p "foo" "bar")) '(p))
+  (check-equal? (filter-not-tree string? '(p "foo" (p "bar"))) '(p (p)))
+  ;(check-equal? (filter-tree (λ(i) (and (tagged-xexpr? i) (equal? 'em (car i)))) '(p "foo" (em "bar"))) '(p "foo"))
+  )
+
+
+;; todo: doc this function
+(define+provide/contract (map-tree proc tree)
+  (procedure? list? . -> . list?)
+  (cond 
+    [(list? tree) (map (λ(i) (map-tree proc i)) tree)]
+    [else (proc tree)]))
+
+(module+ test
+  (check-equal? (map-tree (λ(i) (if (number? i) (* 2 i) i)) '(p 1 2 3 (em 4 5))) '(p 2 4 6 (em 8 10)))
+  (check-equal? (map-tree (λ(i) (if (symbol? i) 'foo i)) '(p 1 2 3 (em 4 5))) '(foo 1 2 3 (foo 4 5))))