#lang zuo

(require "harness.zuo")

(alert "file handles")

(check (not (handle? 1)))
(check (not (handle? '(handle))))
(check eof eof)
(check (eq? eof eof))

(check (handle? (fd-open-input 'stdin)))
(check (handle? (fd-open-output 'stdout (hash))))
(check (handle? (fd-open-output 'stderr (hash))))
(check-arg-fail (fd-open-output 'stdin (hash)) "not a path string")
(check-arg-fail (fd-open-input 'stdout) "not a path string")
(check-arg-fail (fd-open-input 'stderr) "not a path string")
(check-arg-fail (fd-open-output 'stdout (hash 'exists 'truncate)) "unrecognized or unused option")

(let ([out (fd-open-output (build-path tmp-dir "handle1.txt") :truncate)])
  (check (handle? out))
  (check (void? (fd-write out "one")))
  (check (void? (fd-close out)))
  (check (handle? out)))

(check-fail (let ([out (fd-open-output ,(build-path tmp-dir "handle2.txt") :truncate)])
              (fd-close out)
              (fd-close out))
            "not an open")

(let ([in (fd-open-input (build-path tmp-dir "handle1.txt"))])
  (check (handle? in))
  (check (fd-read in 1) "o")
  (check (fd-read in 2) "ne")
  (check (fd-read in 1) eof)
  (check (fd-read in 0) "")
  (check (void? (fd-close in)))
  (check (handle? in)))

(let ([in (fd-open-input (build-path tmp-dir "handle1.txt"))])
  (check (fd-read in eof) "one")
  (check (fd-read in 1) eof)
  (check (fd-read in 'avail) eof)
  (check (fd-read in eof) "")
  (check (void? (fd-close in))))

(check-arg-fail (fd-open-output 'no :error) "not a path string")
(check-arg-fail (fd-open-output "" :error) "not a path string")
(check-arg-fail (fd-open-input 'no) "not a path string")
(check-arg-fail (fd-open-input "") "not a path string")
(check-arg-fail (fd-read 'no 0) "not an open input")
(check-arg-fail (fd-write 'no "") "not an open output")
(check-arg-fail (fd-close 'oops) "not an open input or output")

(check-arg-fail (fd-open-output "file" 'oops) "not a hash table")
(check-arg-fail (fd-open-output "file" (hash 'oops 'truncate)) "unrecognized or unused option")
(check-arg-fail (fd-open-output "file" (hash 'exists 'oops)) "invalid exists mode")

(check-arg-fail (fd-open-output ,(build-path tmp-dir "handle1.txt")
                                :error)
                "file open failed")
(check-arg-fail (fd-open-output ,(build-path (build-path tmp-dir "no-such-dir")
                                             "handle0.txt")
                                :error)
                "file open failed")
(check-arg-fail (fd-open-output ,(build-path tmp-dir "nonesuch.txt")
                                :must-truncate)
                "file open failed")
(check-arg-fail (fd-open-output ,(build-path tmp-dir "nonesuch.txt")
                                :update)
                "file open failed")
(let ([fd (fd-open-output (build-path tmp-dir "handle1.txt")
                          :append)])
  (fd-write fd " two")
  (fd-close fd)
  (define in (fd-open-input (build-path tmp-dir "handle1.txt")))
  (check (fd-read in eof) "one two")
  (fd-close in))
(let ([fd (fd-open-output (build-path tmp-dir "handle1.txt")
                          :must-truncate)])
  (fd-write fd "[three]")
  (fd-close fd)
  (define in (fd-open-input (build-path tmp-dir "handle1.txt")))
  (check (fd-read in eof) "[three]")
  (fd-close in))
(let ([fd (fd-open-output (build-path tmp-dir "handle1.txt")
                          :update)])
  (fd-write fd "4")
  (fd-close fd)
  (define in (fd-open-input (build-path tmp-dir "handle1.txt")))
  (check (fd-read in eof) "4three]")
  (fd-close in))
(let ([fd (fd-open-output (build-path tmp-dir "handle1.txt")
                          :can-update)])
  (fd-write fd "50")
  (fd-close fd)
  (define in (fd-open-input (build-path tmp-dir "handle1.txt")))
  (check (fd-read in eof) "50hree]")
  (fd-close in))
(let ([fd (begin
            (rm (build-path tmp-dir "handle1.txt"))
            (fd-open-output (build-path tmp-dir "handle1.txt")
                            :can-update))])
  (fd-write fd "six")
  (fd-close fd)
  (define in (fd-open-input (build-path tmp-dir "handle1.txt")))
  (check (fd-read in eof) "six")
  (fd-close in))
  
(let ([not-there (build-path tmp-dir "handle0.txt")])
  (when (file-exists? not-there) (rm not-there))
  (check-arg-fail (fd-open-input ,not-there) "file open failed"))

(let ()
  (define path (build-path tmp-dir "handle2.txt"))
  (define out (fd-open-output path :truncate))
  (define big (apply ~a (let loop ([i 10000])
                          (if (= i 0)
                              '()
                              (cons "hello" (loop (- i 1)))))))
  (fd-write out big)
  (fd-close out)
  (let ()
    (define in (fd-open-input path))
    (check (equal? big (fd-read in eof)))
    (check (fd-read in 1) eof)
    (fd-close in))
  (let ()
    (define in (fd-open-input path))
    (define len (quotient (string-length big) 2))
    (check (equal? (fd-read in len) (substring big 0 len)))
    (check (fd-read in 1) (string (string-ref big len)))
    (fd-close in)))

(check (fd-poll '() 0) #f)
(check (fd-poll '() 1) #f)
(check-arg-fail (fd-poll 'stdin) "not a list of")
(check-arg-fail (fd-poll '(stdin)) "not a list of")
(check-arg-fail (fd-poll '() 'oops) "not a nonnegative integer or #f")

(define zuo.exe (hash-ref (runtime-env) 'exe))

(let ([ht (process zuo.exe
                   "-c"
                   (~a "#lang zuo/base\n"
                       (~s '(let ()
                              (define in (fd-open-input 'stdin))
                              (define out (fd-open-output 'stdout))
                              (let loop ()
                                (define msg (fd-read in 1))
                                (unless (eq? msg eof)
                                  (fd-write out msg)
                                  (loop))))))
                   (hash 'stdin 'pipe
                         'stdout 'pipe))])
  (define in (hash-ref ht 'stdout))
  (define out (hash-ref ht 'stdin))
  (check (fd-poll (list in) 0) #f)
  (check (fd-poll (list in out) 0) out)
  (check (fd-poll (list in out)) out)
  (fd-write out "x")
  (check (fd-poll (list in)) in)
  (check (fd-poll (list in) 0) in)
  (check (fd-poll (list in in in) 0) in)
  (check (fd-poll (list in out)) in)
  (check (fd-read in 1) "x")
  (fd-close in)
  (fd-close out)
  (process-wait (hash-ref ht 'process))
  (void))
