simplified pmap parser

pull/9/head
Matthew Butterick 11 years ago
parent edb0c49f46
commit 148b53c9da

@ -28,7 +28,6 @@
;; use same requires as top of main.rkt ;; use same requires as top of main.rkt
;; (can't import them from surrounding module due to submodule rules) ;; (can't import them from surrounding module due to submodule rules)
(require (planet mb/pollen/tools) (planet mb/pollen/main-helper)) (require (planet mb/pollen/tools) (planet mb/pollen/main-helper))
(require (only-in (planet mb/pollen/pmap) pmap-subtopic))
(require-extras #:provide #t) ; brings in the project require files (require-extras #:provide #t) ; brings in the project require files
;; #%top binding catches ids that aren't defined ;; #%top binding catches ids that aren't defined
@ -53,10 +52,10 @@
(require 'pollen-inner) ; provides doc & #%top, among other things (require 'pollen-inner) ; provides doc & #%top, among other things
;; prepare the elements, and append inner-here as meta. ;; prepare the elements, and append inner-here as meta.
(define all-elements (append (define all-elements (cons
;; append inner-here as meta ;; append inner-here as meta
;; put it first so it can be overridden by custom meta later on ;; put it first so it can be overridden by custom meta later on
(list `(meta "here" ,inner-here)) `(meta "here" ,inner-here)
(cond (cond
;; doc is probably a list, but might be a single string ;; doc is probably a list, but might be a single string
[(string? doc) (list doc)] [(string? doc) (list doc)]

@ -10,13 +10,6 @@
(define pmap-file (build-path START_DIR DEFAULT_MAP)) (define pmap-file (build-path START_DIR DEFAULT_MAP))
(define pmap-main empty) (define pmap-main empty)
;; handle pmap-subtopics
(define/contract (pmap-subtopic topic . subtopics)
((string?) #:rest (listof xexpr-element?) . ->* . tagged-xexpr?)
(make-tagged-xexpr (->symbol topic) empty subtopics))
;; todo: tests for pmap-subtopics
;; todo: this ain't a function ;; todo: this ain't a function
(if (file-exists? pmap-file) (if (file-exists? pmap-file)
@ -45,7 +38,7 @@
[else (make-tagged-xexpr (->symbol x) (make-xexpr-attr 'parent (->string parent)))])) [else (make-tagged-xexpr (->symbol x) (make-xexpr-attr 'parent (->string parent)))]))
(module+ test (module+ test
(define test-pmap-main `(pmap-main "foo" "bar" ,(pmap-subtopic "one" (pmap-subtopic "two" "three")))) (define test-pmap-main `(pmap-main "foo" "bar" (one (two "three"))))
(check-equal? (main->pmap test-pmap-main) (check-equal? (main->pmap test-pmap-main)
'(pmap-main ((parent "")) (foo ((parent "pmap-main"))) (bar ((parent "pmap-main"))) (one ((parent "pmap-main")) (two ((parent "one")) (three ((parent "two")))))))) '(pmap-main ((parent "")) (foo ((parent "pmap-main"))) (bar ((parent "pmap-main"))) (one ((parent "pmap-main")) (two ((parent "one")) (three ((parent "two"))))))))
@ -75,7 +68,7 @@
(module+ test (module+ test
(define sample-main `(pmap-root "foo" "bar" ,(pmap-subtopic "one" (pmap-subtopic "two" "three")))) (define sample-main `(pmap-root "foo" "bar" (one (two "three"))))
(check-equal? (main->pmap sample-main) (check-equal? (main->pmap sample-main)
'(pmap-root ((parent "")) (foo ((parent "pmap-root"))) (bar ((parent "pmap-root"))) (one ((parent "pmap-root")) (two ((parent "one")) (three ((parent "two")))))))) '(pmap-root ((parent "")) (foo ((parent "pmap-root"))) (bar ((parent "pmap-root"))) (one ((parent "pmap-root")) (two ((parent "one")) (three ((parent "two"))))))))

@ -1,6 +1,5 @@
#lang racket/base #lang racket/base
(require racket/contract racket/match racket/list xml racket/set) (require racket/contract racket/match racket/list xml racket/set)
(require (prefix-in scribble: (only-in scribble/decode whitespace?)))
(require (prefix-in html: "library/html.rkt")) (require (prefix-in html: "library/html.rkt"))
(require "world.rkt" "readability.rkt" "pollen-file-tools.rkt") (require "world.rkt" "readability.rkt" "pollen-file-tools.rkt")
@ -113,6 +112,20 @@
(check-false (meta-xexpr? '(meta "key" "value" "foo"))) (check-false (meta-xexpr? '(meta "key" "value" "foo")))
(check-false (meta-xexpr? '(meta)))) (check-false (meta-xexpr? '(meta))))
;; count incidence of elements in a list
;; returns hash where key is element, value is incidence
(define/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)
(module+ test
(check-equal? (hash-ref (count-incidence '(a b c d b c)) 'b) 2)
(check-equal? (hash-ref (count-incidence '(a b c d b c)) 'a) 1))
;; exploit uniqueness constraint of set data structure ;; exploit uniqueness constraint of set data structure
(define/contract (elements-unique? x #:loud [loud #f]) (define/contract (elements-unique? x #:loud [loud #f])
((any/c) (#:loud boolean?) . ->* . boolean?) ((any/c) (#:loud boolean?) . ->* . boolean?)
@ -123,8 +136,11 @@
[(string? x) (elements-unique? (string->list x))] [(string? x) (elements-unique? (string->list x))]
[else #t])) [else #t]))
(if (and (not result) loud) (if (and (not result) loud)
;; todo: calculate nonunique keys ;; using dynamic-require to avoid circular dependency
(error "Not unique keys:" x) ;; todo: better way of handling this?
(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) "Keys arent" "Key isnt") " unique:") duplicate-keys))
result)) result))
(module+ test (module+ test
@ -173,7 +189,6 @@
;; recursive whitespace test ;; recursive whitespace test
;; Scribble's version misses whitespace in a list
(define/contract (whitespace? x) (define/contract (whitespace? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
(cond (cond

@ -7,15 +7,15 @@ foreword
introduction introduction
how-to-use how-to-use
how-to-pay-for-this-book how-to-pay-for-this-book
pmap-subtopic{why-typography-matters ◊why-typography-matters{
what-is-typography what-is-typography
where-do-the-rules-come-from} where-do-the-rules-come-from}
pmap-subtopic{type-composition ◊type-composition{
straight-and-curly-quotes straight-and-curly-quotes
one-space-between-sentences one-space-between-sentences
trademark-and-copyright-symbols trademark-and-copyright-symbols
ligatures} ligatures}
pmap-subtopic{appendix ◊appendix{
printers-and-paper printers-and-paper
how-to-make-a-pdf how-to-make-a-pdf
typewriter-habits typewriter-habits

@ -214,3 +214,4 @@
(hash "foo" "bar" "hee" "haw")) (hash "foo" "bar" "hee" "haw"))
(check-equal? (make-meta-hash '((meta "foo" "bar")(meta "foo" "haw"))) (check-equal? (make-meta-hash '((meta "foo" "bar")(meta "foo" "haw")))
(hash "foo" "haw"))) (hash "foo" "haw")))

Loading…
Cancel
Save