suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

batch io functions now accept 'standard-[in,out] in lieu of file name

Browse Source
This commit is contained in:
Matthias Felleisen 2013-01-04 19:05:51 -05:00
parent d53d3c3528
commit 69800aa580
5 changed files with 213 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
collects/2htdp/batch-io.rkt
View File

@ -13,6 +13,9 @@
;; todo?
;; -- export tokenization?
(define *input-devices* `((standard-in ,current-input-port)))
(define *output-devices* `((standard-out ,current-output-port)))
;; -----------------------------------------------------------------------------
(provide simulate-file) ;; syntax (simulate-file reader string ...)
@ -50,6 +53,9 @@
write-file ;; String String -> String
;; (write-file filename str) writes str to filename;
;; produces the file name as a confirmation that the write succeeded
;; *input-devives*: symbols that redirect input from an input-port
;; *output-devives*: symbols that redirect output from a output-port
)
;; -----------------------------------------------------------------------------
@ -57,7 +63,7 @@
(define-syntax-rule
(def-reader (name f s ...) body ...)
(define (name f s ...)
(check-file f 'name)
(check-input-file f 'name)
(let ()
body ...)))
@ -135,44 +141,57 @@
;; writer
(define (write-file f str)
(check-arg 'write-file (string? f) "string (name of file)" "first" f)
(check-output-file f 'write-file)
(check-arg 'write-file (string? str) "string" "second" str)
(let ([result (not (file-exists? f))])
(with-output-to-file f
(lambda () (printf "~a" str))
#:mode 'text
#:exists 'replace)
f))
(define (wt) (printf "~a" str))
(define device (assq f *output-devices*))
(if device
(parameterize ((current-output-port [(cadr device)])) (wt))
(with-output-to-file f wt #:mode 'text #:exists 'replace))
f)
;; -----------------------------------------------------------------------------
;; auxiliaries
;; String [([Listof X] -> Y)] -> [Listof Y]
(define (read-csv-file/func f [row (lambda (x) x)])
(local ((define (reader o)
(make-csv-reader o '((strip-leading-whitespace? . #t)
(strip-trailing-whitespace? . #t)))))
(map row (call-with-input-file f (compose csv->list reader)))))
;; 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
#:mode 'text
(lambda ()
(let loop ([accu '()])
(define (rd)
(let loop ([accu '()])
(define nxt (read-chunk))
(if (eof-object? nxt) (process-accu accu) (loop (cons nxt accu)))))))
(if (eof-object? nxt) (process-accu accu) (loop (cons nxt accu)))))
(define device (assq f *input-devices*))
(if device
(parameterize ((current-input-port [(cadr device)])) (rd))
(with-input-from-file f #:mode 'text rd)))
(define (read-csv-file/func f [row (lambda (x) x)])
(define (reader o)
(csv->list
(make-csv-reader o '((strip-leading-whitespace? . #t)
(strip-trailing-whitespace? . #t)))))
(define device (assq f *input-devices*))
(map row
(if device
(reader [(cadr device)])
(call-with-input-file f #:mode 'text reader))))
;; [Listof Char] -> [Listof Char]
(define (drop-last-newline accu)
(reverse (if (and (pair? accu) (char=? (car accu) #\newline)) (cdr accu) accu)))
;; 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))
(define (check-input-file f t)
(define d? (assq f *input-devices*))
(check-arg t (or (string? f) d?) (format "string or one of: ~a" (map car *input-devices*)) "first" f)
(check-arg t (or d? (file-exists? f)) "name of file in program's folder" "first" f))
;; effect: ensure that f is a file in current directory or report error for t
(define (check-output-file f t)
(define d? (assq f *output-devices*))
(check-arg t (or (string? f) d?) (format "string or one of: ~a" (map car *output-devices*)) "first" f))
;; split : String [Regexp] -> [Listof String]
;; splits a string into a list of substrings using the given delimiter

216
collects/2htdp/tests/batch-io.rkt
View File

@ -1,8 +1,11 @@
#lang scheme/load
#lang racket
(require rackunit)
(require 2htdp/batch-io)
;; ---------------------------------------------------------------------------------------------------
;; use simulate file to test the I/O functions
(check-equal?
(simulate-file read-file
"hello world"
@ -33,77 +36,84 @@
(check-equal? (simulate-file read-file) "")
(define file "batch-io.txt")
;; ---------------------------------------------------------------------------------------------------
;; manipulate an actual file on disk
(define test1 #<<eos
(let ()
(define file "batch-io.txt")
(define test1 #<<eos
test1
eos
)
(define test2-as-list '("test1" "test2"))
(define test2
(apply string-append
(list (first test2-as-list)
(string #\newline)
(second test2-as-list))))
(write-file file test1)
(check-true (string=? (simulate-file read-file test1) test1) "read-file 1")
(write-file file test2)
(check-true (string=? (simulate-file read-file test2) test2) "read-file 2")
(write-file file test1)
(check-equal? (read-lines file) (list test1) "as-lines 1")
(write-file file test2)
(check-equal? (read-lines file) test2-as-list "as-lines 2")
(define as-1strings1 (map string (string->list test1)))
(write-file file test1)
(check-equal? (read-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))))))
(write-file file test2)
(check-equal? (read-1strings file) as-1strings2 "as-lines 2")
(define test2-a-as-list '("test1" "" "test2"))
(define test2-a
(apply string-append
(list (first test2-as-list)
(string #\newline)
(string #\newline)
(second test2-as-list))))
(write-file file test2-a)
(check-equal? (read-lines file) test2-a-as-list "as-lines 2-a")
(check-equal? (read-words file) '("test1" "test2") "as-words 2-a")
(define test3 #<< eos
)
(define test2-as-list '("test1" "test2"))
(define test2
(apply string-append
(list (first test2-as-list)
(string #\newline)
(second test2-as-list))))
(write-file file test1)
(check-true (string=? (simulate-file read-file test1) test1) "read-file 1")
(write-file file test2)
(check-true (string=? (simulate-file read-file test2) test2) "read-file 2")
(write-file file test1)
(check-equal? (read-lines file) (list test1) "as-lines 1")
(write-file file test2)
(check-equal? (read-lines file) test2-as-list "as-lines 2")
(define as-1strings1 (map string (string->list test1)))
(write-file file test1)
(check-equal? (read-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))))))
(write-file file test2)
(check-equal? (read-1strings file) as-1strings2 "as-lines 2")
(define test2-a-as-list '("test1" "" "test2"))
(define test2-a
(apply string-append
(list (first test2-as-list)
(string #\newline)
(string #\newline)
(second test2-as-list))))
(write-file file test2-a)
(check-equal? (read-lines file) test2-a-as-list "as-lines 2-a")
(check-equal? (read-words file) '("test1" "test2") "as-words 2-a")
(define test3 #<< eos
word1, word2
word3, word4
eos
)
(write-file file test3)
(check-equal? (read-words file) '("word1," "word2" "word3," "word4")
"as-words")
(check-equal? (read-words/line file) '(("word1," "word2") ("word3," "word4"))
"as-words")
(check-equal? (read-csv-file file) '(("word1" "word2") ("word3" "word4"))
"as-cvs 1")
(check-equal? (read-csv-file/rows file length) '(2 2)
"as-csv/rows")
)
(write-file file test3)
(check-equal? (read-words file) '("word1," "word2" "word3," "word4")
"as-words")
(check-equal? (read-words/line file) '(("word1," "word2") ("word3," "word4"))
"as-words")
(check-equal? (read-csv-file file) '(("word1" "word2") ("word3" "word4"))
"as-cvs 1")
(check-equal? (read-csv-file/rows file length) '(2 2)
"as-csv/rows")
(delete-file file))
;; ---------------------------------------------------------------------------------------------------
;; check failure more of functions.
(check-exn exn:fail:contract? (lambda () (simulate-file cons)))
;; (check-exn exn:fail:contract? (lambda () (simulate-file))) ;; <--- figure this out
@ -120,3 +130,79 @@ eos
(check-exn exn:fail:contract? (lambda () (read-1strings 0)))
(check-exn exn:fail:contract? (lambda () (read-1strings '("test"))))
;; ---------------------------------------------------------------------------------------------------
;; read from stdio
(let ()
(define *standard-out* "")
(define-syntax-rule
(catch-stdo e)
(set! *standard-out* (with-output-to-string (lambda () e))))
(define-syntax-rule
(pipe-stdi e)
(with-input-from-string *standard-out* (lambda () e)))
(define test1 #<<eos
test1
eos
)
(define test2-as-list '("test1" "test2"))
(define test2
(apply string-append
(list (first test2-as-list)
(string #\newline)
(second test2-as-list))))
(catch-stdo (write-file 'standard-out test1))
(check-equal? (pipe-stdi (read-lines 'standard-in)) (list test1) "as-lines 1")
(catch-stdo (write-file 'standard-out test2))
(check-equal? (pipe-stdi (read-lines 'standard-in)) test2-as-list "as-lines 2")
(define as-1strings1 (map string (string->list test1)))
(catch-stdo (write-file 'standard-out test1))
(check-equal? (pipe-stdi (read-1strings 'standard-in)) 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))))))
(catch-stdo (write-file 'standard-out test2))
(check-equal? (pipe-stdi (read-1strings 'standard-in)) as-1strings2 "as-lines 2")
(define test2-a-as-list '("test1" "" "test2"))
(define test2-a
(apply string-append
(list (first test2-as-list)
(string #\newline)
(string #\newline)
(second test2-as-list))))
(catch-stdo (write-file 'standard-out test2-a))
(check-equal? (pipe-stdi (read-lines 'standard-in)) test2-a-as-list "as-lines 2-a")
(check-equal? (pipe-stdi (read-words 'standard-in)) '("test1" "test2") "as-words 2-a")
(define test3 #<< eos
word1, word2
word3, word4
eos
)
(catch-stdo (write-file 'standard-out test3))
(check-equal? (pipe-stdi (read-words 'standard-in)) '("word1," "word2" "word3," "word4")
"as-words")
(check-equal? (pipe-stdi (read-words/line 'standard-in)) '(("word1," "word2") ("word3," "word4"))
"as-words")
(check-equal? (pipe-stdi (read-csv-file 'standard-in)) '(("word1" "word2") ("word3" "word4"))
"as-cvs 1")
(check-equal? (pipe-stdi (read-csv-file/rows 'standard-in length)) '(2 2)
"as-csv/rows"))

11
collects/2htdp/tests/batch-io2.rkt
View File

@ -4,14 +4,17 @@
(require 2htdp/batch-io)
(with-output-to-file "batch-io2.txt"
(define file "batch-io2.txt")
(with-output-to-file file
(lambda ()
(display "hello")
(display #\return)
(display #\linefeed))
#:exists 'replace)
(read-lines "batch-io2.txt")
(require rackunit)
(check-equal? (read-lines "batch-io2.txt") '("hello"))
(when (file-exists? file)
(delete-file file))

1
collects/2htdp/tests/batch-io2.txt
View File

@ -1 +0,0 @@
hello

20
collects/teachpack/2htdp/scribblings/batch-io.scrbl
View File

@ -32,9 +32,16 @@
@; -----------------------------------------------------------------------------
@(define-syntax-rule (reading name ctc s)
@defproc[(@name [f (and/c string? file-exists?)]) @ctc ]{
reads the content of file @racket[f] and produces it as @s .} )
@(define-syntax reading
(syntax-rules ()
[(_ name ctc s)
@defproc[(@name [f (or/c 'standard-out (and/c string? file-exists?))]) @ctc ]{
reads the standard input device (until closed) or the content of file
@racket[f] and produces it as @list[s].}]
[(_ name ctc [x ctc2] s ...)
@defproc[(@name [f (or/c 'standard-out (and/c string? file-exists?))] [@x @ctc2]) @ctc ]{
reads the standard input device (until closed) or the content of file
@racket[f] and produces it as @list[s ...].}]))
@teachpack["batch-io"]{Batch Input/Output}
@ -119,8 +126,7 @@ length. Here the third line of the file turns into a row of three
elements.
}
@item{@defproc[(@read-csv-file/rows [f (and/c string? exists?)][s
(-> (listof any/c) X?)]) (listof X?)]{reads the content of file @racket[f] and
@item{@reading[read-csv-file/rows (listof X?) [s (-> (listof any/c) X?)]]{reads the content of file @racket[f] and
produces it as list of rows, each constructed via @racket[s]}
@examples[#:eval (examples-batch-io)
@ -132,12 +138,14 @@ elements.
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?]) string?]{
@item{@defproc[(write-file [f (or/c 'standard-out string?)] [cntnt string?]) string?]{
sends @racket[cntnt] to the standard output device or
turns @racket[cntnt] into the content of file @racket[f], located in the
same folder (directory) as the program. If the write succeeds, the
function produces the name of the file (@racket[f]); otherwise it signals