From 2727d5f0ba4f9989866eb7987f3c4a67f85bd4d3 Mon Sep 17 00:00:00 2001
From: Matthias Felleisen <matthias@racket-lang.org>
Date: Thu, 15 Apr 2010 20:34:26 -0400
Subject: [PATCH] batch-io finished

---
 collects/2htdp/batch-io.ss                    | 188 +++++++-----------
 collects/2htdp/tests/batch-io.ss              |  19 +-
 .../2htdp/scribblings/batch-io.scrbl          | 127 +++++++++---
 collects/teachpack/2htdp/scribblings/data.csv |   3 +
 collects/teachpack/2htdp/scribblings/data.txt |   3 +
 .../2htdp/scribblings/universe.scrbl          |  25 ++-
 collects/teachpack/data.csv                   |   3 +
 collects/teachpack/data.txt                   |   3 +
 8 files changed, 210 insertions(+), 161 deletions(-)
 create mode 100644 collects/teachpack/2htdp/scribblings/data.csv
 create mode 100644 collects/teachpack/2htdp/scribblings/data.txt
 create mode 100644 collects/teachpack/data.csv
 create mode 100644 collects/teachpack/data.txt

diff --git a/collects/2htdp/batch-io.ss b/collects/2htdp/batch-io.ss
index 2608380c5b..d0e78b4f2e 100644
--- a/collects/2htdp/batch-io.ss
+++ b/collects/2htdp/batch-io.ss
@@ -1,73 +1,90 @@
 #lang scheme
 
-(require (for-syntax syntax/parse)
-         htdp/error
-         "private/csv/csv.ss")
+(require (for-syntax syntax/parse) srfi/13 htdp/error "private/csv/csv.ss")
 
-;; todo
-;; -- read files as "white space separated tokens"
-;; -- tokenization? how? map-file? on a string? 
+;; todo?
+;; -- export tokenization? 
+
+;; -----------------------------------------------------------------------------
+(provide
+ ;; all reader functions consume the name of a file f:
+ ;; -- f must be a file name (string) in the same folder as the program 
 
-(provide 
  read-file ;; String -> String
- ;; read the file f (in current-directory) as a string
+ ;; read the file f as a string
  
  read-file-as-lines ;; String -> [Listof String]
- ;; read the file f (in current-directory) as a list of strings
+ ;; read the file f as a list of strings, one per line 
+ 
+ read-file-as-words ;; String -> [Listof String]
+ ;; read the file f as a list of white-space separated tokens
  
  read-file-as-1strings ;; String -> [Listof 1String]
- ;; read the file f (in current-directory) as a list of 1strings
- 
- write-file ;; String String -> Boolean
- ;; write str to file f (in current-directory); 
- ;; false, if f exists
- ;; true, if f doesn't exist
- )
+ ;; read the file f as a list of 1strings (characters)
 
-(provide 
- read-file-as-csv turn-row-into
- ;; (read-file-as-csv f:expr)
- ;; f must evaluate to the name of a file name (string) in the program's folder
- ;; read the file f as a file of comma-separated values; i.e., 
- ;; a list of rows, where each row is a list of strings, numbers, etc. 
+ read-file-as-csv ;; String -> [Listof [Listof (U Any)]]
+ ;; -- f must be formated as a a file with comma-separated values (Any)
+ ;; read the file f as a list of lists---one per line---of values (Any)
  
- ;; (read-file-as-csv f:expr (turn-row-into row:expr))
- ;; row must evaluate to a function of one argument; the function is applied 
- ;; to each row, meaning the result is now a list of results produces by row
+ read-file-as-csv/rows ;; String ([Listof Any] -> X) -> [Listof X]
+ ;; -- f must be formated as a a file with comma-separated values (Any)
+ ;; read the file f as a file of comma-separated values, apply the second
+ ;; argument to each row, i.e., list of CSV on one line 
+
+ write-file ;; String String -> Boolean
+ ;; write the second argument to file f in the same folder as the program
+ ;; produce false, if f exists
+ ;; produce true, if f doesn't exist
  )      
 
 ;; -----------------------------------------------------------------------------
 
-(define (read-file f)
-  (check-file f 'read-file)
+(define-syntax-rule
+  (def-reader (name f s ...) body ...)
+  (define (name f s ...)
+    (check-file f 'name)
+    (let ()
+      body ...)))
+
+;; --- exported functions -- 
+
+(def-reader (read-file f)
   (list->string (read-chunks f read-char drop-last-newline)))
 
-(define (read-file-as-1strings f)
-  (check-file f 'read-file-as-1strings)
+(def-reader (read-file-as-1strings f)
   (map string (read-chunks f read-char drop-last-newline)))
 
-(define (read-file-as-lines f)
-  (check-file f 'read-file-as-lines)
+(def-reader (read-file-as-lines f)
   (read-chunks f read-line reverse))
 
-(define-syntax (turn-row-into stx)
-  (raise-syntax-error 'turn-row-into "used out of context" stx))
+(def-reader (read-file-as-words f)
+  (define lines (read-chunks f read-line reverse))
+  (foldr (lambda (f r) (append (split f) r)) '() lines))
 
-(define-syntax (read-file-as-csv stx)
-  (syntax-parse stx #:literals (turn-row-into)
-    [(_ f:expr) #'(read-file-as-csv/func f (lambda (x) x))]
-    [(_ f:expr (turn-row-into s:expr))
-     #'(let ([row s]
-             [error->syntax-error 
-              (lambda (x)
-                (raise-syntax-error 'turn-row-into (exn-message x) #'s))])
-         (check-file f 'read-file-as-csv)
-         (with-handlers ((exn? error->syntax-error))
-           (check-proc 'read-file-as-cvs row 1 "one argument" "turn-row-into"))
-         (read-file-as-csv/func f s))]))
+(def-reader (read-file-as-csv f)
+  (read-file-as-csv/func f))
+
+(def-reader (read-file-as-csv/rows f row)
+  (check-proc 'read-file-as-cvs row 1 "one argument" "row")
+  (read-file-as-csv/func f row))
+
+;; -----------------------------------------------------------------------------
+;; writer 
+
+(define (write-file f str)
+  (check-arg 'write-file (string? f) "string (name of file)" "first" f)
+  (check-arg 'write-file (string? str) "string" "second" str)
+  (let ([result (not (file-exists? f))])
+    (with-output-to-file f 
+      (lambda () (printf "~a" str))
+      #:exists 'truncate)
+    result))
+
+;; -----------------------------------------------------------------------------
+;; auxiliaries 
 
 ;; String [([Listof X] -> Y)] -> [Listof Y]
-(define (read-file-as-csv/func f row)  
+(define (read-file-as-csv/func f [row (lambda (x) x)])
   (local ((define (reader o)
             (make-csv-reader o '((strip-leading-whitespace?  . #t)
                                  (strip-trailing-whitespace? . #t)))))
@@ -86,80 +103,19 @@
 (define (drop-last-newline accu)
   (reverse (if (char=? (car accu) #\newline) (cdr accu) accu)))
 
-;; -----------------------------------------------------------------------------
-
-(define (write-file f str)
-  (check-arg 'write-file (string? f) "name of file (string) in program's folder" "first" f)
-  (check-arg 'write-file (string? str) "string" "second" str)
-  (let ([result (not (file-exists? f))])
-    (with-output-to-file f 
-      (lambda () (printf "~a" str))
-      #:exists 'truncate)
-    result))
-
-;; -----------------------------------------------------------------------------
-
 ;; String[file name] Symbol -> Void
 ;; effect: ensure that f is a file in current directory or report error for t
 (define (check-file f t)
   (check-arg t (string? f) "string" "first" f)
   (check-arg t (file-exists? f) "name of file in program's folder" "first" f))
 
-;; -----------------------------------------------------------------------------
+;; split : String [Regexp] -> [Listof String]
+;; splits a string into a list of substrings using the given delimiter
+;; (white space by default)
+(define (split str [ptn #rx"[ ]+"])
+  (regexp-split ptn (string-trim-both str)))
 
-;                                                                               
-;                                                                               
-;                                                                               
-;                                                      ;                        
-;                                              ;                                
-;    ;;;;  ;   ;   ;; ;   ;; ;   ;;;    ;;;;  ;;;;;  ;;;     ;;;   ; ;;    ;;;; 
-;   ;      ;   ;  ;  ;;  ;  ;;  ;   ;  ;       ;       ;    ;   ;  ;;  ;  ;     
-;   ;      ;   ;  ;   ;  ;   ;  ;   ;  ;       ;       ;    ;   ;  ;   ;  ;     
-;    ;;;   ;   ;  ;   ;  ;   ;  ;;;;;   ;;;    ;       ;    ;   ;  ;   ;   ;;;  
-;       ;  ;   ;  ;   ;  ;   ;  ;          ;   ;       ;    ;   ;  ;   ;      ; 
-;       ;  ;  ;;  ;  ;;  ;  ;;  ;          ;   ;       ;    ;   ;  ;   ;      ; 
-;   ;;;;    ;; ;   ;; ;   ;; ;   ;;;;  ;;;;     ;;;    ;     ;;;   ;   ;  ;;;;  
-;                     ;      ;                                                  
-;                  ;;;    ;;;                                                   
-;                                                                               
-
-#|
-
-For basic i/o, I find the following two functions extremely helpful to provide as a 
-  teachpack along with what batch-io gives. Perhaps it would be possible to include 
-  them in the standard teachpack?
-
- ;; split : String String -> Listof[String]
- ;; splits a string into a list of substrings using the given delimiter (space
- ;;   by default)
- (define (split str [ptn "[ ]+"])
-   (unless (string? str)
-     (error 'split "expects string as first argument"))
-   (unless (string? ptn)
-     (error 'split "expects string as second argument"))
-   (regexp-split ptn (string-trim-both str)))
-
- ;; split : String -> Listof[String]
- ;; splits a string into a list of lines
- (define (split-lines str)
-   (map string-trim-both (split str "\r*\n")))
-
-These are some other functions that I've also found helpful... the first two
- because sometimes it's handy to be able to use the GUI dialog box to figure 
- out the complete pathname of a file; the third to be able to load images from 
- a program:
-
- (define (pick-a-file)
-   (path->string (get-file)))
-
- (define (pick-a-save-file)
-   (path->string (put-file)))
-
-I realize that it might not be good to provide too much i/o stuff from the HtDP 
- perspective, because it could start to distract from the more important issues 
- that are to be taught/learned.
-
-;; --- 
-
-
-|#
\ No newline at end of file
+;; split-lines : String -> Listof[String]
+;; splits a string with newlines into a list of lines
+(define (split-lines str)
+  (map string-trim-both (split str "\r*\n")))
diff --git a/collects/2htdp/tests/batch-io.ss b/collects/2htdp/tests/batch-io.ss
index 617d8bba3d..5aa26638f5 100644
--- a/collects/2htdp/tests/batch-io.ss
+++ b/collects/2htdp/tests/batch-io.ss
@@ -19,20 +19,20 @@ eos
                (second test2-as-list))))
 
 (write-file file test1)
-(check-true (string=? (read-file file) test1) " 1")
+(check-true (string=? (read-file file) test1) "read-file 1")
 
 (write-file file test2)
-(check-true (string=? (read-file file) test2) " 2")
+(check-true (string=? (read-file file) test2) "read-file 2")
 
 (write-file file test1)
-(check-equal? (read-file-as-lines file) (list test1) "-as-lines 1")
+(check-equal? (read-file-as-lines file) (list test1) "as-lines 1")
 
 (write-file file test2)
-(check-equal? (read-file-as-lines file) test2-as-list "-as-lines 2")
+(check-equal? (read-file-as-lines file) test2-as-list "as-lines 2")
 
 (define as-1strings1 (map string (string->list test1)))
 (write-file file test1)
-(check-equal? (read-file-as-1strings file) as-1strings1 "-as-1strings 1")
+(check-equal? (read-file-as-1strings file) as-1strings1 "as-1strings 1")
 
 (define as-1strings2 
   (map string
@@ -43,7 +43,7 @@ eos
                            test2-as-list))))))
 
 (write-file file test2)
-(check-equal? (read-file-as-1strings file) as-1strings2 "-as-lines 2")
+(check-equal? (read-file-as-1strings file) as-1strings2 "as-lines 2")
 
 (define test3 #<< eos
  word1, word2 
@@ -52,7 +52,10 @@ eos
   )
 
 (write-file file test3)
-(check-equal? (read-file-as-csv file) '(("word1" "word2") ("word3" "word4")))
+(check-equal? (read-file-as-csv file) '(("word1" "word2") ("word3" "word4"))
+  "as-cvs 1")
+(check-equal? (read-file-as-words file) '("word1," "word2" "word3," "word4")
+  "as-words 1")
 
 (check-exn exn:fail:contract? (lambda () (write-file 0 1)))
 (check-exn exn:fail:contract? (lambda () (write-file '("test") 1)))
@@ -74,4 +77,4 @@ eos
                         (module a scheme 
                           (require 2htdp/batch-io) 
                           (read-file-as-csv "batch-io.ss" (turn-row-into cons)))
-                        (require 'a))))))
\ No newline at end of file
+                        (require 'a))))))
diff --git a/collects/teachpack/2htdp/scribblings/batch-io.scrbl b/collects/teachpack/2htdp/scribblings/batch-io.scrbl
index 9843424076..08b28739e0 100644
--- a/collects/teachpack/2htdp/scribblings/batch-io.scrbl
+++ b/collects/teachpack/2htdp/scribblings/batch-io.scrbl
@@ -1,16 +1,34 @@
 #lang scribble/doc
 
 @(require (for-label scheme teachpack/2htdp/batch-io))
-@(require scribble/manual "shared.ss")
-@(require scribble/struct)
+@(require scheme/sandbox scribble/manual scribble/eval scribble/core)
+@(require "shared.ss")
+
+@(require 2htdp/batch-io)
+@(define (file-is f)
+  (define x (read-file f))
+  (centered
+    (tabular #:style "searchbox"
+      (list (list (verbatim x))))))
+
+@(define-syntax examples-batch-io
+  (syntax-rules ()
+    [(_ d ...)
+     (let ()
+       (define me (make-base-eval))
+       (begin
+         (interaction-eval #:eval me (require 2htdp/batch-io))
+         (interaction-eval #:eval me d)
+         ...)
+       (interaction-eval #:eval me (require lang/htdp-intermediate-lambda))
+       me)]))
+
 
 @; -----------------------------------------------------------------------------
 
 @(define-syntax-rule (reading name ctc s)
    @defproc[(@name [f (and/c string? file-exists?)]) @ctc ]{
- reads the content of file @scheme[f] and produces it as @s .
- The file @scheme[f] must exist and must be located in the same folder
- (directory) as the program; otherwise the function signals an error.} )
+ reads the content of file @scheme[f] and produces it as @s .} )
 
 @teachpack["batch-io"]{Batch Input/Output}
 
@@ -21,37 +39,92 @@
 The batch-io teachpack introduces several functions and a form for reading
  content from files and one function for writing to a file.
 
-@reading[read-file-as-string string?]{a string, including newlines}
+All functions that read a file consume the name of a file and possibly
+ additional arguments. They assume that the specified file exists in the
+ same folder as the program; if not they signal an error:
+@itemlist[
 
-@reading[read-file-as-lines (listof string?)]{a list of strings, one per line}
+@item{@reading[read-file string?]{a string, including newlines}
 
-@reading[read-file-as-1strings (listof 1string?)]{a list of one-char strings, one per character}
+@examples[#:eval (examples-batch-io)
+(read-file "data.txt")
+]
+assuming the file named @scheme["data.txt"] has this shape: 
+@(file-is "data.txt")
+Note how the leading space in the second line translates into the space
+between the newline indicator and the word @scheme["good"] in the result.}
 
-@defform/subs[#:id read-file-as-csv 
-              #:literals 
-	      (turn-row-into)
-              (read-file-as-csv f-expr clause)
-              ([clause
-		 (turn-row-into row-expr)
-		 ])]{
- reads the content of file @scheme[f] and produces it as a list of rows. 
- The file @scheme[f] must be a file of comma-separated values (csv).
- It must exist and must be located in the same folder
- (directory) as the program; otherwise the function signals an error.
+@item{@reading[read-file-as-lines (listof string?)]{a list of strings, one per line}
+@examples[#:eval (examples-batch-io)
+(read-file-as-lines "data.txt")
+]
+when @scheme["data.txt"] is the name of the same file as in the preceding
+item. And again, the leading space of the second line shows up in the
+second string in the list.}
 
- The form comes with one optional clause: @scheme[turn-into-row], which is
- described next.}
+@item{@reading[read-file-as-words (listof string?)]{a list of strings, one per white-space separated token in the file}
 
- @defform[(turn-row-into row-expr)
-          #:contracts
-          ([row-expr (-> (listof (or/c string? number?)) any)])]{
- requests that each row is processed by the result of @scheme[row-expr]
- before it is added to the result of @scheme[read-file-as-csv].}
+@examples[#:eval (examples-batch-io)
+(read-file-as-words "data.txt")
+]
+This time, however, the extra leading space of the second line of
+@scheme["data.txt"] has disappeared in the result. The space is considered
+a part of the separator that surrounds the word @scheme["good"].
+}
 
+@item{@reading[read-file-as-1strings (listof 1string?)]{a list of one-char strings, one per character}
 
-@defproc[(write-file [f string?] [cntnt string?]) boolean?]{
+@examples[#:eval (examples-batch-io)
+(read-file-as-1strings "data.txt")
+]
+Note how this function reproduces all parts of the file faithfully,
+including spaces and newlines.}
+
+@item{@reading[read-file-as-csv (listof (listof any/c))]{a list of lists of comma-separated values}
+
+@examples[#:eval (examples-batch-io)
+(read-file-as-csv "data.csv")
+]
+where the file named @scheme["data.csv"] has this shape: 
+@(file-is "data.csv")
+It is important to understand that the rows don't have to have the same
+length. Here the third line of the file turns into a row of three
+elements. 
+}
+
+@item{@defproc[(@read-file-as-csv/rows [f (and/c string? file-exists?)][s
+ (-> (listof any/c) X?)]) (listof X?)]{reads the content of file @scheme[f] and
+ produces it as list of rows, each constructed via @scheme[s]}
+
+@examples[#:eval (examples-batch-io)
+(read-file-as-csv/rows "data.csv" (lambda (x) x))
+(read-file-as-csv/rows "data.csv" length)
+]
+ The first example shows how @scheme[read-file-as-csv] is just a short form
+ for @scheme[read-file-as-csv/rows]; the second one simply counts the
+ number of separated tokens and the result is just a list of numbers. 
+ In many cases, the function argument is used to construct a structure from
+ a row.}
+]
+
+There is only one writer function at the moment: 
+@itemlist[
+
+@item{@defproc[(write-file [f string?] [cntnt string?]) boolean?]{
  turns @scheme[cntnt] into the content of file @scheme[f], located in the
  same folder (directory) as the program. If the file exists when the
  function is called, the function produces @scheme[true]; otherwise it
  produces @scheme[false].}
 
+@examples[#:eval (examples-batch-io)
+(if (write-file "output.txt" "good bye")
+    (write-file "output.txt" "cruel world")
+    (write-file "output.txt" "cruel world"))
+]
+ After evaluating this examples, the file named @scheme["output.txt"]
+ looks like this: 
+ @(file-is "output.txt")
+ Explain why.
+}
+]
+
diff --git a/collects/teachpack/2htdp/scribblings/data.csv b/collects/teachpack/2htdp/scribblings/data.csv
new file mode 100644
index 0000000000..38f045a27b
--- /dev/null
+++ b/collects/teachpack/2htdp/scribblings/data.csv
@@ -0,0 +1,3 @@
+hello, world 
+ good, bye 
+i, am, done 
diff --git a/collects/teachpack/2htdp/scribblings/data.txt b/collects/teachpack/2htdp/scribblings/data.txt
new file mode 100644
index 0000000000..dda98f1b07
--- /dev/null
+++ b/collects/teachpack/2htdp/scribblings/data.txt
@@ -0,0 +1,3 @@
+hello world 
+ good bye 
+i am done 
diff --git a/collects/teachpack/2htdp/scribblings/universe.scrbl b/collects/teachpack/2htdp/scribblings/universe.scrbl
index 04daca0d84..f21fb3fa5d 100644
--- a/collects/teachpack/2htdp/scribblings/universe.scrbl
+++ b/collects/teachpack/2htdp/scribblings/universe.scrbl
@@ -154,7 +154,7 @@ The design of a world program demands that you come up with a data
 
 @defform/subs[#:id big-bang
               #:literals 
-	      (on-tick on-draw on-key on-release on-mouse on-receive stop-when
+	      (on-tick to-draw on-draw on-key on-release on-mouse on-receive stop-when
 	      check-with register record? state name)
               (big-bang state-expr clause ...)
               ([clause
@@ -163,8 +163,8 @@ The design of a world program demands that you come up with a data
 		 (on-key key-expr)
 		 (on-release release-expr)
 		 (on-mouse key-expr)
-		 (on-draw draw-expr)
-		 (on-draw draw-expr width-expr height-expr)
+		 (to-draw draw-expr)
+		 (to-draw draw-expr width-expr height-expr)
 		 (stop-when stop-expr) (stop-when stop-expr last-scene-expr)	   
 		 (check-with world?-expr)	   
 		 (record? boolean-expr)
@@ -183,7 +183,7 @@ The design of a world program demands that you come up with a data
  itself as a scene; when the program must shut down; where to register the
  world with a universe; and whether to record the stream of events. A world
  specification may not contain more than one @scheme[on-tick],
- @scheme[on-draw], or @scheme[register] clause. A @scheme[big-bang]
+ @scheme[to-draw], or @scheme[register] clause. A @scheme[big-bang]
  expression returns the last world when the stop condition is satisfied
  (see below) or when the programmer clicks on the @tt{Stop} button or
  closes the canvas.
@@ -389,7 +389,7 @@ All @tech{MouseEvent}s are represented via strings:
 
 @item{
  
-@defform[(on-draw render-expr)
+@defform[(to-draw render-expr)
          #:contracts
          ([render-expr (-> (unsyntax @tech{WorldState}) scene?)])]{ 
 
@@ -398,8 +398,8 @@ All @tech{MouseEvent}s are represented via strings:
  dealt with an event. Its size is determined by the size of the first
  generated @tech{scene}.}
 
-@defform/none[#:literals (on-draw)
-              (on-draw render-expr width-expr height-expr)
+@defform/none[#:literals (to-draw)
+              (to-draw render-expr width-expr height-expr)
               #:contracts
               ([render-expr (-> (unsyntax @tech{WorldState}) scene?)]
 	       [width-expr natural-number/c]
@@ -407,7 +407,12 @@ All @tech{MouseEvent}s are represented via strings:
 
  tell DrScheme to use a @scheme[width-expr] by @scheme[height-expr]
  canvas instead of one determine by the first generated @tech{scene}.
-}}
+}
+
+For compatibility reasons, the teachpack also supports the keyword
+@tt{on-draw} in lieu of @scheme[to-draw] but the latter is preferred
+now. 
+}
 
 @item{
 
@@ -497,7 +502,7 @@ a short-hand for three lines of code:
 ;; (run-simulation create-UFO-scene) is short for: 
 (big-bang 0 
           (on-tick add1)
-	  (on-draw create-UFO-scene))
+	  (to-draw create-UFO-scene))
 ])
 
 Exercise: Add a condition for stopping the flight of the UFO when it
@@ -1637,7 +1642,7 @@ Finally, here is the third function, which renders the state as a scene:
 (define (create-world n)
   (big-bang WORLD0
            (on-receive receive)
-	   (on-draw (draw n))
+	   (to-draw (draw n))
 	   (on-tick move)
            (name n)
 	   (register LOCALHOST)))
diff --git a/collects/teachpack/data.csv b/collects/teachpack/data.csv
new file mode 100644
index 0000000000..38f045a27b
--- /dev/null
+++ b/collects/teachpack/data.csv
@@ -0,0 +1,3 @@
+hello, world 
+ good, bye 
+i, am, done 
diff --git a/collects/teachpack/data.txt b/collects/teachpack/data.txt
new file mode 100644
index 0000000000..dda98f1b07
--- /dev/null
+++ b/collects/teachpack/data.txt
@@ -0,0 +1,3 @@
+hello world 
+ good bye 
+i am done