From 126c7d1a0d36dba9d73649b5f9306b5201a2ed82 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Fri, 17 Sep 2010 21:31:52 -0400
Subject: [PATCH] Change the people/places structs and way they are made.

It's also possible to use this as a central place to hold the list of
plt people for other purposes, works for the bib authors now (requires
making an organized list of the people).
---
 collects/meta/web/www/learning.rkt    |  19 ++-
 collects/meta/web/www/people.rkt      | 170 +++++++++++++-------------
 collects/meta/web/www/techreports.rkt |  18 ++-
 3 files changed, 101 insertions(+), 106 deletions(-)

diff --git a/collects/meta/web/www/learning.rkt b/collects/meta/web/www/learning.rkt
index deb3f7e290..cc4cb0cae0 100644
--- a/collects/meta/web/www/learning.rkt
+++ b/collects/meta/web/www/learning.rkt
@@ -20,7 +20,7 @@
     @(apply parlist @strong{PLT Publications}
             (cons techreports
                   (for*/list ([place (in-list all-places)]
-                              [pubs (in-value (place-pubs-url place))]
+                              [pubs (in-value (place-pubs place))]
                               #:when pubs)
                     @a[href: pubs]{@(place-name place)})))
     @parlist[@strong{Graduate Study}
@@ -40,17 +40,12 @@
               string<?)
         " / "))
     @(define responsible-people
-       (let ([people
-              (for/list ([p (in-list all-places)])
-                (define edu (place-edu p))
-                (ormap (lambda (p)
-                         (and (equal? edu (person-responsible-for p)) p))
-                       all-people))])
-         (add-between
-          (for/list ([person (sort people string<? #:key person-name)])
-            @a[href: (person-url person)]{
-              @(regexp-replace #rx" .*$" (person-name person) "")})
-          ", ")))
+       (add-between
+        (for/list ([person (sort (map (compose car place-people) all-places)
+                                 string<? #:key person-name)])
+          @a[href: (person-url person)]{
+            @(regexp-replace #rx" .*$" (person-name person) "")})
+        ", "))
     @h1{Graduate Study with PLT}
     @p{An open letter to graduate applicants:}
     @div[style: (box-style 3 "#ddd")]{
diff --git a/collects/meta/web/www/people.rkt b/collects/meta/web/www/people.rkt
index 745de768de..6c1430ea64 100644
--- a/collects/meta/web/www/people.rkt
+++ b/collects/meta/web/www/people.rkt
@@ -1,93 +1,97 @@
 #lang at-exp s-exp "shared.rkt"
 
-(define -all-people- ; "First Last" bib-name|#f responsible-for|#f url
-  '(["Shriram Krishnamurthi" #f "brown"
-     "http://www.cs.brown.edu/~sk/"]
-    ["Jay McCarthy" #f "byu"
-     "http://faculty.cs.byu.edu/~jay/"]
-    ["John Clements" #f "calpoly"
-     "http://users.csc.calpoly.edu/~clements/"]
-    ["Matthias Felleisen" #f "neu"
-     "http://www.ccs.neu.edu/home/matthias/"]
-    ["Robby Findler" "Robert Bruce Findler" "northwestern"
-     "http://www.eecs.northwestern.edu/~robby/"]
-    ["Matthew Flatt" #f "utah"
-     "http://www.cs.utah.edu/~mflatt/"]
-    ["Kathi Fisler" #f "wpi"
-     "http://web.cs.wpi.edu/~kfisler/"]))
+(define (make-all place person)
+  ;; The first person in a place is the one responsible for it
+  (list
+   (place ; -------------------------------------------------------------------
+    'neu "Northeastern University"
+    #:location "Boston, MA"
+    #:url "http://www.ccs.neu.edu/scheme/"
+    #:pubs "http://www.ccs.neu.edu/scheme/pubs/"
+    (person 'matthias "Matthias Felleisen"
+            #:url "http://www.ccs.neu.edu/home/matthias/")
+    (person 'eli "Eli Barzilay"
+            #:url "http://barzilay.org/"))
+   (place ; -------------------------------------------------------------------
+    'utah "University of Utah"
+    #:location "Salt Lake City, UT"
+    #:url "http://www.cs.utah.edu/plt/"
+    #:pubs "http://www.cs.utah.edu/plt/publications/"
+    (person 'mflatt "Matthew Flatt"
+            #:url "http://www.cs.utah.edu/~mflatt/"))
+   (place ; -------------------------------------------------------------------
+    'nwu "Northwestern University"
+    #:location "Evanston, IL"
+    #:url "http://plt.eecs.northwestern.edu/"
+    #:pubs "http://www.eecs.northwestern.edu/~robby/pubs/"
+    (person 'robby "Robby Findler"
+            #:bibname "Robert Bruce Findler"
+            #:url "http://www.eecs.northwestern.edu/~robby/"))
+   (place ; -------------------------------------------------------------------
+    'brown "Brown University"
+    #:location "Providence, RI"
+    #:url "http://www.cs.brown.edu/research/plt/"
+    #:pubs "http://www.cs.brown.edu/~sk/Publications/Papers/"
+    (person 'shriram "Shriram Krishnamurthi"
+            #:url "http://www.cs.brown.edu/~sk/"))
+   (place ; -------------------------------------------------------------------
+    'byu "Brigham Young University"
+    #:location "Provo, UT"
+    #:url "http://faculty.cs.byu.edu/~jay/"
+    (person 'jay "Jay McCarthy"
+            #:url "http://faculty.cs.byu.edu/~jay/"))
+   (place ; -------------------------------------------------------------------
+    'calpoly "California Polytechnic State University"
+    #:location "San Luis Obispo, CA"
+    #:url "http://users.csc.calpoly.edu/~clements/"
+    (person 'clements "John Clements"
+            #:url "http://users.csc.calpoly.edu/~clements/"))
+   (place ; -------------------------------------------------------------------
+    'wpi "Worcester Polytechnic Institute"
+    #:location "Worcester, MA"
+    #:url "http://web.cs.wpi.edu/~kfisler/"
+    (person 'kathi "Kathi Fisler"
+            #:url "http://web.cs.wpi.edu/~kfisler/"))))
 
-(define -all-places- ; "Name" "Location, ST" url pubs-url|#
-  '(["Brown University" "Providence, RI"
-     "http://www.cs.brown.edu/research/plt/"
-     "http://www.cs.brown.edu/~sk/Publications/Papers/"]
-    ["Brigham Young University" "Provo, UT"
-     "http://faculty.cs.byu.edu/~jay/"
-     #f]
-    ["California Polytechnic State University" "San Luis Obispo, CA"
-     "http://users.csc.calpoly.edu/~clements/"
-     #f]
-    ["Northeastern University" "Boston, MA"
-     "http://www.ccs.neu.edu/scheme/"
-     "http://www.ccs.neu.edu/scheme/pubs/"]
-    ["Northwestern University" "Evanston, IL"
-     "http://plt.eecs.northwestern.edu/"
-     "http://www.eecs.northwestern.edu/~robby/pubs/"]
-    ["University of Utah" "Salt Lake City, UT"
-     "http://www.cs.utah.edu/plt/"
-     "http://www.cs.utah.edu/plt/publications/"]
-    ["Worcester Polytechnic Institute" "Worcester, MA"
-     "http://web.cs.wpi.edu/~kfisler/"
-     #f]))
+;; ----------------------------------------------------------------------------
 
-(require racket/list racket/string)
+(struct person (nick name url bibname place) #:prefab)
+(struct place  (nick name location url pubs people) #:prefab)
 
-(provide (struct-out person) (struct-out place))
-(struct person (name bib-name responsible-for url edu search-string))
-(struct place  (name location url pubs-url edu search-string))
+(provide (struct-out place)  all-places find-place
+         (struct-out person) all-people find-person)
 
-;; list of all people and places, and functions to search them with some
-;; (unique) word
-(provide all-people all-places find-person find-place)
-(define-values (all-people all-places find-person find-place)
+(require racket/list)
+
+(define-values (all-places find-place all-people find-person)
   (let ()
-    (define (make maker url-pos args-list)
-      (for/list ([args (in-list args-list)])
-        (let ([url (list-ref args url-pos)]
-              [search (string-downcase (string-join (filter values args)
-                                                    "; "))]
-              [rx #rx"^http://[^/]*[.]([^.]+)[.]edu/"])
-          (apply maker `(,@args
-                         ,(cadr (or (regexp-match rx url)
-                                    (error 'person/place
-                                           "no X.edu found in ~a" url)))
-                         ,search)))))
-    (define people (make person 3 -all-people-))
-    (define places (make place  2 -all-places-))
-    (unless (equal? places (remove-duplicates places #:key place-edu))
-      (error 'places "found multiple places with the same X.edu url"))
-    (unless (equal? (sort (map place-edu places) string<?)
-                    (sort (map person-responsible-for people) string<?))
-      (error 'places/people "no direct mapping between `edu' of places and ~a"
-             "responsible-for of people"))
-    (define (finder name all get-search-string)
-      (let ([t (make-hasheq)])
-        (lambda (x)
-          (let ([x (if (string? x) (string->symbol x) x)])
-            (hash-ref!
-             t x
-             (lambda ()
-               (let* ([rx (regexp-quote (string-downcase (symbol->string x)))]
-                      [rx (pregexp (string-append "\\b" rx "\\b"))])
-                 (let loop ([found #f] [l all])
-                   (cond
-                     [(null? l) (or found (error name "couldn't find: ~.a" x))]
-                     [(not (regexp-match? rx (get-search-string (car l))))
-                      (loop found (cdr l))]
-                     [found (error name "ambiguous search: ~.a" x)]
-                     [else (loop (car l) (cdr l))])))))))))
-    (values people places
-            (finder 'find-person people person-search-string)
-            (finder 'find-place  places place-search-string))))
+    (define places0
+      (make-all
+       ;; make a place
+       (lambda (nick name #:location loc #:url url #:pubs [pubs #f] . people)
+         (place nick name loc url pubs people))
+       ;; make a person
+       (lambda (nick name #:url url #:bibname [bibname name])
+         (person nick name url bibname (make-placeholder #f)))))
+    (for* ([place (in-list places0)]
+           [person (in-list (place-people place))])
+      (placeholder-set! (person-place person) place))
+    (define places (make-reader-graph places0))
+    (define people (append-map place-people places))
+    (when (ormap (lambda (p) (null? (place-people p))) places)
+      (error 'places "all places should have people in them"))
+    (define (make-finder what xs get-nick)
+      (define t (make-hasheq))
+      (for ([x (in-list xs)])
+        (hash-update! t (get-nick x)
+                      (lambda (old)
+                        (if old (error what "got duplicate nicks") x))
+                      #f))
+      (lambda (nick)
+        (or (hash-ref t nick #f)
+            (error what "nick not found: ~s" nick))))
+    (values places (make-finder 'places places place-nick)
+            people (make-finder 'people people person-nick))))
 
 (provide people)
 (define people
diff --git a/collects/meta/web/www/techreports.rkt b/collects/meta/web/www/techreports.rkt
index ddecff4f53..6957aca046 100644
--- a/collects/meta/web/www/techreports.rkt
+++ b/collects/meta/web/www/techreports.rkt
@@ -1,7 +1,7 @@
 #lang at-exp s-exp "shared.rkt"
 
 (require "bib.rkt" (prefix-in - version/utils) racket/list
-         "../download/data.rkt")
+         "people.rkt" "../download/data.rkt")
 
 (provide techreports)
 (define techreports
@@ -20,25 +20,20 @@
 
 (define authors
   '([plt      "PLT"]
-    [mflatt   "Matthew Flatt"]
-    [robby    "Robert Bruce Findler"]
     [ff       mflatt robby]
     [fplt     mflatt plt]
     [rplt     robby plt]
     [ffplt    ff plt]
     [ffc      ff clements]
     [fb       mflatt eli]
-    [eli      "Eli Barzilay"]
-    [clements "John Clements"]
     [dorai    "Dorai Sitaram"]
     [wright   "Andrew K. Wright"]
     [flanagan "Cormac Flanagan"]
-    [web      burns gregp jaym]
+    [web      burns gregp jay]
     [burns    "Mike Burns"]
-    [jaym     "Jay McCarthy"]
     [gregp    "Greg Pettyjohn"]
     [dyoo     "Danny Yoo"]
-    [ym       dyoo jaym]
+    [ym       dyoo jay]
     [kathyg   "Kathryn E. Gray"]
     [jacobm   "Jacob Matthews"]
     [sowens   "Scott Owens"]
@@ -107,7 +102,7 @@
     (redex      "4.1...!"  robby  "Redex: Debugging Operational Semantics")
     (scribble   "*...!"    fb     "Scribble: PLT Documentation Tool")
     (slideshow  "*...!"    ff     "Slideshow: PLT Figure and Presentation Tools")
-    (web-server "*...!"    jaym   "Web Server: PLT HTTP Server")
+    (web-server "*...!"    jay    "Web Server: PLT HTTP Server")
     (tools      "*...!"    robby  "Plugins: Extending DrScheme")
     (gui        "*...!"    ffc    "GUI: PLT Graphics Toolkit")
     (framework  "*...!"    ff     "Framework: PLT GUI Application Framework")
@@ -175,7 +170,7 @@
     (drracket   "!..."    rplt   "DrRacket: Programming Environment")
     (scribble   "!..."    fb     "Scribble: Racket Documentation Tool")
     (slideshow  "!..."    ff     "Slideshow: Racket Figure and Presentation Tools")
-    (web-server "!..."    jaym   "Web Server: Racket HTTP Server")
+    (web-server "!..."    jay    "Web Server: Racket HTTP Server")
     (foreign    "!..."    eli    "FFI: Racket Foreign Interface")
     (inside     "!..."    mflatt "Inside: Racket C API")
 
@@ -258,7 +253,8 @@
     t))
 
 (define (author->string author)
-  (let ([r (hash-ref authors* author)])
+  (let ([r (hash-ref authors* author
+                     (lambda () (person-bibname (find-person author))))])
     (if (string? r)
       r
       (let ([r (apply string-append