From 11f6859cb2f225406743415e2db20a0bee5a9e40 Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Tue, 13 Apr 2010 15:34:09 +0000 Subject: [PATCH] more api for batch-io svn: r18808 --- collects/2htdp/batch-io.ss | 90 ++++++++++++++----------- collects/2htdp/tests/batch-io.ss | 26 +++++-- collects/2htdp/tests/on-tick-defined.ss | 29 ++++++-- 3 files changed, 97 insertions(+), 48 deletions(-) diff --git a/collects/2htdp/batch-io.ss b/collects/2htdp/batch-io.ss index 341ebedc03..0481350aad 100644 --- a/collects/2htdp/batch-io.ss +++ b/collects/2htdp/batch-io.ss @@ -2,41 +2,54 @@ (require htdp/error) +;; todo +;; -- read files as "white space separated tokens" +;; -- read csv files +;; -- tokenization? how? map-file? on a string? + +(provide + read-file ;; String -> String + ;; read the file f (in current-directory) as a string + + read-file-as-lines ;; String -> [Listof String] + ;; read the file f (in current-directory) as a list of strings + + 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 + ) + (define (read-file f) (check-file f 'read-file) (check-arg 'read-file (file-exists? f) "name of file in program's folder" "first" f) - (list->string - (with-input-from-file f - (lambda () - (let loop ([accu '()]) - (define nxt (read-char)) - (if (eof-object? nxt) - (reverse (if (char=? (car accu) #\newline) (cdr accu) accu)) - (loop (cons nxt accu)))))))) - -(define (read-file-as-lines f) - (check-file f 'read-file-as-lines) - (with-input-from-file f - (lambda () - (let loop ([accu '()]) - (define nxt (read-line)) - (if (eof-object? nxt) - (reverse accu) - (loop (cons nxt accu))))))) + (list->string (read-chunks f read-char drop-last-newline))) (define (read-file-as-1strings f) (check-file f 'read-file-as-1strings) - (read-chars f string)) + (map string (read-chunks f read-char drop-last-newline))) -;; -(define (read-chars f action) +(define (read-file-as-lines f) + (check-file f 'read-file-as-lines) + (read-chunks f read-line reverse)) + +;; String (-> X) ([Listof X] -> [Listof X]) -> [Listof X] +;; read a file as a list of X where process-accu is applied to accu when eof +(define (read-chunks f read-chunk process-accu) (with-input-from-file f (lambda () (let loop ([accu '()]) - (define nxt (read-char)) - (if (eof-object? nxt) - (reverse (if (char=? (car accu) #\newline) (cdr accu) accu)) - (loop (cons nxt accu))))))) + (define nxt (read-chunk)) + (if (eof-object? nxt) (process-accu accu) (loop (cons nxt accu))))))) + +;; [Listof Char] -> [Listof Char] +(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)" "first" f) @@ -49,25 +62,22 @@ ;; ----------------------------------------------------------------------------- -(provide - read-file-as-lines ;; String -> [Listof String] - ;; read the fule f (in current-directory) as a list of strings - - read-file ;; String -> String - ;; read the file f (in current-directory) as a string - - write-file ;; String String -> Boolean - ;; write str to file f (in current-directory); - ;; false, if f exists - ;; true, if f doesn't exist - ) - ;; 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)) +;; ----------------------------------------------------------------------------- + +#| +(require scheme/class) +(require scheme/gui) + +(define (read-image-file file-name) + (make-object image-snip% file-name)) +|# + ; ; ; @@ -86,7 +96,9 @@ #| -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? +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 diff --git a/collects/2htdp/tests/batch-io.ss b/collects/2htdp/tests/batch-io.ss index fedf11d209..c7109761e6 100644 --- a/collects/2htdp/tests/batch-io.ss +++ b/collects/2htdp/tests/batch-io.ss @@ -19,16 +19,31 @@ eos (second test2-as-list)))) (or (write-file file test1) - (check-true (string=? (read-file file) test1) "read-file 1")) + (check-true (string=? (read-file file) test1) " 1")) (or (write-file file test2) - (check-true (string=? (read-file file) test2) "read-file 2")) + (check-true (string=? (read-file file) test2) " 2")) (or (write-file file test1) - (check-equal? (read-file-as-lines file) (list test1) "read-file-as-lines 1")) + (check-equal? (read-file-as-lines file) (list test1) "-as-lines 1")) (or (write-file file test2) - (check-equal? (read-file-as-lines file) test2-as-list "read-file-as-lines 2")) + (check-equal? (read-file-as-lines file) test2-as-list "-as-lines 2")) + +(define as-1strings1 (map string (string->list test1))) +(or (write-file file test1) + (check-equal? (read-file-as-1strings file) as-1strings1 "-as-1strings 1")) + +(define as-1strings2 + (map string + (apply append + (map string->list + (cdr + (foldr (lambda (f r) (cons "\n" (cons f r))) '() + test2-as-list)))))) + +(or (write-file file test2) + (check-equal? (read-file-as-1strings file) as-1strings2 "-as-lines 2")) (check-exn exn:fail:contract? (lambda () (write-file 0 1))) @@ -41,3 +56,6 @@ eos (check-exn exn:fail:contract? (lambda () (read-file-as-lines 0))) (check-exn exn:fail:contract? (lambda () (read-file-as-lines '("test")))) +(check-exn exn:fail:contract? (lambda () (read-file-as-1strings 0))) +(check-exn exn:fail:contract? (lambda () (read-file-as-1strings '("test")))) + diff --git a/collects/2htdp/tests/on-tick-defined.ss b/collects/2htdp/tests/on-tick-defined.ss index 5142ecb13a..f9a3efb3d3 100644 --- a/collects/2htdp/tests/on-tick-defined.ss +++ b/collects/2htdp/tests/on-tick-defined.ss @@ -6,16 +6,35 @@ (error-print-source-location #f) -(define legal "on-tick: not a legal clause in a world description") -(define double ", on-tick has been redefined") +(define legal "~a: not a legal clause in a world description") +(define double + (string-append (format legal 'on-tick) ", on-tick has been redefined")) (with-handlers ((exn:fail:syntax? (lambda (x) - (unless - (string=? (exn-message x) (string-append legal double)) - (raise x))))) + (unless (string=? (exn-message x) double) (raise x))))) (eval '(module a scheme (require 2htdp/universe) (local ((define (run) (big-bang 0 (on-tick on-tick))) (define (on-tick t) 0)) 10)))) + +;; purpose: catch illegal shapes of the form (kwd . stuff) + +(with-handlers ((exn:fail:syntax? + (lambda (e) + (unless (string=? (exn-message e) (format legal 'on-tic)) + (raise e))))) + (eval '(module a scheme + (require 2htdp/universe) + (big-bang 0 (on-tic add1))))) + +;; purpose: catch illegal atomic clauses + +(with-handlers ((exn:fail:syntax? + (lambda (e) + (unless (string=? (exn-message e) (format legal 'stop-when)) + (raise e))))) + (eval '(module a scheme + (require 2htdp/universe) + (big-bang 0 (on-tick add1) stop-when)))) \ No newline at end of file