From aaf7e32a11b04be1d5d5a72a452cc76582fdcd7b Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Fri, 5 Nov 2010 13:24:10 -0600
Subject: [PATCH] Easier graph maker

---
 collects/meta/drdr/graph.ss | 26 ++++++++++++++++++++++++++
 collects/meta/drdr/time.ss  | 20 ++------------------
 2 files changed, 28 insertions(+), 18 deletions(-)
 create mode 100644 collects/meta/drdr/graph.ss

diff --git a/collects/meta/drdr/graph.ss b/collects/meta/drdr/graph.ss
new file mode 100644
index 0000000000..9ea774c973
--- /dev/null
+++ b/collects/meta/drdr/graph.ss
@@ -0,0 +1,26 @@
+#lang scheme
+(require scheme/system
+         "config.ss"
+         "path-utils.ss"
+         "dirstruct.ss")
+
+(define rebaser
+  (rebase-path (plt-data-directory) "/data"))
+
+(define (main filename)
+  (define prefix
+    (path-timing-png-prefix filename))
+  (system*/exit-code
+   (path->string
+    (build-path (plt-directory) "plt" "bin" "mred-text"))
+   "-t"
+   (path->string (build-path (drdr-directory) "graphs" "build-graph.ss"))
+   "--"
+   "-l" (string-append "http://drdr.racket-lang.org/~a/" (path->string* filename)) ; XXX
+   "--image-loc" "/graph-images/"
+   (path->string (path-timing-log filename))
+   (path->string prefix)
+   (path->string (rebaser prefix))
+   (path->string (path-timing-html filename))))
+
+(provide main)
\ No newline at end of file
diff --git a/collects/meta/drdr/time.ss b/collects/meta/drdr/time.ss
index 301d119be1..7c9e13588f 100644
--- a/collects/meta/drdr/time.ss
+++ b/collects/meta/drdr/time.ss
@@ -1,9 +1,9 @@
 #lang scheme
 (require (planet jaymccarthy/job-queue)
          scheme/system
+         (prefix-in graph-one: "graph.ss")
          "config.ss"
          "notify.ss"
-         "path-utils.ss"
          "dirstruct.ss"
          "sema.ss"
          "cache.ss")
@@ -28,17 +28,12 @@
   (init-revisions!)
   (set! start-revision (newest-revision)))
 
-(define rebaser
-  (rebase-path (plt-data-directory) "/data"))
-
 (define count-sema (make-semaphore 0))
 
 (define (make-log! filename)
   (submit-job!
    test-workers
    (lambda ()
-     (define prefix
-       (path-timing-png-prefix filename))
      (unless just-graphs?
        (notify! "Dropping timing for ~a" filename)
        (apply 
@@ -55,18 +50,7 @@
          (list
           (path->string filename)))))
      (notify! "Generating graph for ~a" filename)
-     (system*/exit-code
-      (path->string
-       (build-path (plt-directory) "plt" "bin" "mred-text"))
-      "-t"
-      (path->string (build-path (drdr-directory) "graphs" "build-graph.ss"))
-      "--"
-      "-l" (string-append "http://drdr.racket-lang.org/~a/" (path->string* filename)) ; XXX
-      "--image-loc" "/graph-images/"
-      (path->string (path-timing-log filename))
-      (path->string prefix)
-      (path->string (rebaser prefix))
-      (path->string (path-timing-html filename)))
+     (graph-one:main filename)
      (notify! "Done with ~a" filename)
      (semaphore-post count-sema))))