From 148b53c9da4c4dfcfff44dbe34eefb5be352bb96 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Mon, 19 Aug 2013 12:47:45 -0700
Subject: [PATCH] simplified pmap parser

---
 main.rkt        |  5 ++---
 pmap.rkt        | 11 ++---------
 predicates.rkt  | 23 +++++++++++++++++++----
 tests/test.pmap |  6 +++---
 tools.rkt       |  1 +
 5 files changed, 27 insertions(+), 19 deletions(-)

diff --git a/main.rkt b/main.rkt
index 4a4c030..c9b97c7 100644
--- a/main.rkt
+++ b/main.rkt
@@ -28,7 +28,6 @@
      ;; use same requires as top of main.rkt 
      ;; (can't import them from surrounding module due to submodule rules)
      (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
      
      ;; #%top binding catches ids that aren't defined
@@ -53,10 +52,10 @@
    (require 'pollen-inner) ; provides doc & #%top, among other things
    
    ;; prepare the elements, and append inner-here as meta.
-   (define all-elements (append 
+   (define all-elements (cons 
                          ;; append inner-here as meta
                          ;; put it first so it can be overridden by custom meta later on
-                         (list `(meta "here" ,inner-here)) 
+                         `(meta "here" ,inner-here)
                          (cond
                            ;; doc is probably a list, but might be a single string
                            [(string? doc) (list doc)] 
diff --git a/pmap.rkt b/pmap.rkt
index cdcd8ae..39dc01c 100644
--- a/pmap.rkt
+++ b/pmap.rkt
@@ -10,13 +10,6 @@
 (define pmap-file (build-path START_DIR DEFAULT_MAP))
 (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
 (if (file-exists? pmap-file)
@@ -45,7 +38,7 @@
     [else (make-tagged-xexpr (->symbol x) (make-xexpr-attr 'parent (->string parent)))]))
 
 (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) 
                 '(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
-  (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) 
                 '(pmap-root ((parent "")) (foo ((parent "pmap-root"))) (bar ((parent "pmap-root"))) (one ((parent "pmap-root")) (two ((parent "one")) (three ((parent "two"))))))))
 
diff --git a/predicates.rkt b/predicates.rkt
index 9d40532..ffb3d2c 100644
--- a/predicates.rkt
+++ b/predicates.rkt
@@ -1,6 +1,5 @@
 #lang racket/base
 (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 "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))))
 
+
+;; 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
 (define/contract (elements-unique? x #:loud [loud #f])
   ((any/c) (#:loud boolean?) . ->* . boolean?)
@@ -123,8 +136,11 @@
       [(string? x) (elements-unique? (string->list x))]
       [else #t]))
   (if (and (not result) loud)
-      ;; todo: calculate nonunique keys
-      (error "Not unique keys:" x)
+      ;; using dynamic-require to avoid circular dependency
+      ;; 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 aren’t" "Key isn’t") " unique:") duplicate-keys))
       result))
 
 (module+ test
@@ -173,7 +189,6 @@
 
 
 ;; recursive whitespace test
-;; Scribble's version misses whitespace in a list
 (define/contract (whitespace? x)
   (any/c . -> . boolean?)
   (cond
diff --git a/tests/test.pmap b/tests/test.pmap
index 22b4a24..b85c901 100644
--- a/tests/test.pmap
+++ b/tests/test.pmap
@@ -7,15 +7,15 @@ foreword
 introduction
 how-to-use
 how-to-pay-for-this-book
-◊pmap-subtopic{why-typography-matters
+◊why-typography-matters{
                what-is-typography
                where-do-the-rules-come-from}
-◊pmap-subtopic{type-composition
+◊type-composition{
                straight-and-curly-quotes
                one-space-between-sentences
                trademark-and-copyright-symbols
                ligatures}
-◊pmap-subtopic{appendix
+◊appendix{
                printers-and-paper
                how-to-make-a-pdf
                typewriter-habits
diff --git a/tools.rkt b/tools.rkt
index 87f6cc1..84e69f0 100644
--- a/tools.rkt
+++ b/tools.rkt
@@ -214,3 +214,4 @@
                 (hash "foo" "bar" "hee" "haw"))
   (check-equal? (make-meta-hash '((meta "foo" "bar")(meta "foo" "haw")))
                 (hash "foo" "haw")))
+