racket/collects/2htdp/batch-io.rkt

#lang racket/base

(require racket/function
         racket/file
         racket/format
         racket/string
         racket/local
         (for-syntax racket/base
                     syntax/parse)
         htdp/error
         (rename-in lang/prim (first-order->higher-order f2h))
         "private/csv/csv.rkt")

;; todo?
;; -- export tokenization?

;; I am tryiing to use these lists to automate the documentation of the
;; functions but my scribble skills are insufficient and my time is running
;; out. 
(module devices racket/base
  (provide *input-devices* *output-devices*)
  (define *input-devices*  `((stdin ,current-input-port)   (standard-in ,current-input-port)))
  (define *output-devices* `((stdout ,current-output-port) (standard-out ,current-output-port))))

(require (submod "." devices))

;;---------------------------------------------------------------------------------------------------
(provide simulate-file) ;; syntax (simulate-file reader string ...)

(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 
 
 read-file ;; String -> String
 ;; read the specified file as a string
 
 read-1strings ;; String -> [Listof 1String]
 ;; read the specified file as a list of 1strings (characters)
 
 read-lines ;; String -> [Listof String]
 ;; read the specified file as a list of strings, one per line
 
 read-words ;; String -> [Listof String]
 ;; read the specified file as a list of white-space separated tokens
 
 read-words/line ;; String -> [Listof [Listof String]]
 ;; read the specified file as a list of lines, each line as a list of words
 
 read-words-and-numbers/line ;; String -> [Listof [Listof (Union Number String)]]
 ;; read the specified file as a list of lines, each line as a list of words and numbers 
 
 read-csv-file ;; String -> [Listof [Listof (U Any)]]
 ;; -- f must be formated as a a file with comma-separated values (Any)
 ;; read the specified file as a list of lists---one per line---of values (Any)
 
 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 
 )

(provide-higher-order-primitive
   read-csv-file/rows (_ row-processor) ;; String ([Listof Any] -> X) -> [Listof X]
   ;; -- f must be formated as a a file with comma-separated values (Any)
   ;; read the specified file as a file of comma-separated values, apply the second
   ;; argument to each row, i.e., list of CSV on one line 
   )

;; -----------------------------------------------------------------------------

(define-syntax-rule
  (def-reader (name f s ...) body ...)
  (define (name f s ...)
    (check-input-file f 'name)
    (let ()
      body ...)))

;; --- exported functions -- 

(def-reader (read-file f)
  (list->string (read-chunks f read-char drop-last-newline)))

(def-reader (read-1strings f)
  (map string (read-chunks f read-char drop-last-newline)))

(def-reader (read-lines f)
  (read-chunks f *read-line reverse))

(def-reader (read-words f)
  (read-words/line/internal f append))

(def-reader (read-words/line f)
  ;; String -> [Listof [Listof String]]
  ;; read the specified file as a list of lines, each line as a list of words
  (read-words/line/internal f cons))

(def-reader (read-words-and-numbers/line f)
  ;; String -> [Listof [Listof (U String Number)]]
  ;; read the specified file as a list of lines, each line as a list of words and numbers
  (read-words/line/internal f (lambda (line1 r)
                                (cons (for/list ((t (in-list line1))) (or (string->number t) t)) r))))

(define (read-words/line/internal f combine)
  (define lines (read-chunks f *read-line (lambda (x) x)))
  (foldl (lambda (f r)
           (define fst (filter (compose not (curry string=? "")) (split f)))
           (combine fst r))
         '() lines))

(def-reader (read-csv-file f)
  (read-csv-file/func f))

(def-reader (read-csv-file/rows f row)
  (check-proc 'read-csv-file row 1 "one argument" "row")
  (read-csv-file/func f row))

(define (*read-line)
  (read-line (current-input-port) 'any))

;; -----------------------------------------------------------------------------
;; tester 

(define-syntax (simulate-file stx)
  (syntax-case stx ()
    [(simulate-file) 
     (raise-syntax-error #f "expects at least one sub-expression" stx)]
    [(simulate-file reader str ...) #'(simulate-file/proc (f2h reader) str ...)]))
     
(define (simulate-file/proc reader . los)
  (define _1 (check-proc "simulate-file" reader 1 "reader" "one argument"))
  (define _2 
    (andmap 
     (lambda (f)
       (check-arg "simulate-file" (string? f) "sequence of strings" "" f))
     los))
  (define t (make-temporary-file "drracket-temporary-file-~a"))
  (dynamic-wind 
   (lambda ()
     (with-output-to-file t 
       (lambda () (for-each displayln los))
       #:mode 'text
       #:exists 'replace))
   (lambda () 
     (reader (path->string t)))
   (lambda ()
     (delete-file t))))

;; -----------------------------------------------------------------------------
;; writer 

(define (write-file f str)
  (check-output-file f 'write-file)
  (check-arg 'write-file (string? str) "string" "second" str)
  (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]

;; 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) 
  (define (rd)
    (let loop ([accu '()])
        (define nxt (read-chunk))
        (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)))

;; effect: ensure that f is a file in current directory or report error for t
(define (check-input-file f t)
  (define d? (assq f *input-devices*))
  (check-arg t (or (string? f) d?) (error-message (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?) (error-message (map car *output-devices*)) "first" f))

;; [Listof Symbol] -> String 
(define (error-message los)
  (string-append "string or one of: " (string-join (map ~e los) ", ")))

;; split : String [Regexp] -> [Listof String]
;; splits a string into a list of substrings using the given delimiter
;; (white space by default)
;;ELI: This shouldn't be needed now, it can use `string-split' as is
;; (also, the trimming doesn't make sense if the pattern is not a
;; space--?)
(define (split str [ptn #rx"[ ]+"])
  (regexp-split ptn (string-trim str)))

;; split-lines : String -> Listof[String]
;; splits a string with newlines into a list of lines
(define (split-lines str)
  (map string-trim (split str "\r*\n")))