#lang racket
(require
 racket/generator
 (planet murphy/packed-io:1:1)
 "../main.rkt"
 "../network.rkt"
 "../errno.rkt")

(define client-file-handle%
  (class* object% (file-handle<%>)
    
    (super-new)
    
    (init-field fs fid [current-offset #f])
    
    (define/public-final (call-with-tag proc)
      (send fs call-with-tag proc))
    
    (define/public-final (call-with-tag+fid proc)
      (send fs call-with-tag+fid proc))
    
    (define/public-final (request message)
      (send fs request message))
    
    (define/public-final (fid->file fid qid [position #f])
      (send fs fid->file fid qid position))
    
    (define/public-final (->fid)
      (or fid (raise-9p-error ESTALE)))
    
    (define/public-final (walk . names)
      (call-with-tag+fid
       (λ (tag to-fid)
         (let ([names (list->vector names)])
           (match (request (make-message:t:walk tag (->fid) to-fid names))
             [(struct message:r:walk (_ qids))
              (if (= (vector-length qids) (vector-length names))
                  (fid->file (unbox to-fid) (vector-ref qids (- (vector-length qids) 1)))
                  (raise-9p-error ENOENT))]
             [_
              (raise-9p-error EPROTO)])))))
    
    (define/public-final (read-stat)
      (call-with-tag
       (λ (tag)
         (match (request (make-message:t:stat tag (->fid)))
           [(struct message:r:stat (_ stat))
            stat]
           [_
            (raise-9p-error EPROTO)]))))
    
    (define/public-final (write-stat stat)
      (call-with-tag
       (λ (tag)
         (match (request (make-message:t:wstat tag (->fid) stat))
           [(? message:r:wstat?)
            (void)]
           [_
            (raise-9p-error EPROTO)]))))
    
    (define/public-final offset
      (case-lambda
        [()
         current-offset]
        [(offset)
         (if current-offset
             (set! current-offset offset)
             (raise-9p-error ENOTCONN))]))
    
    (define/public-final (open mode)
      (call-with-tag
       (λ (tag)
         (match (request (make-message:t:open tag (->fid) mode))
           [(struct message:r:open (_ _ i/o-unit))
            (set! current-offset 0)
            i/o-unit]
           [_
            (raise-9p-error EPROTO)]))))
    
    (define/public-final (read size [at-offset (offset)])
      (if current-offset
          (call-with-tag
           (λ (tag)
             (match (request (make-message:t:read tag (->fid) at-offset size))
               [(struct message:r:read (_ data))
                (let ([size (bytes-length data)])
                  (offset (+ at-offset (bytes-length data)))
                  (if (not (zero? size)) data eof))]
               [_
                (raise-9p-error EPROTO)])))
          (raise-9p-error ENOTCONN)))
    
    (define/public-final (write data [at-offset (offset)])
      (if current-offset
          (call-with-tag
           (λ (tag)
             (match (request (make-message:t:write tag (->fid) at-offset data))
               [(struct message:r:write (_ size))
                (offset (+ at-offset size))
                size]
               [_
                (raise-9p-error EPROTO)])))
          (raise-9p-error ENOTCONN)))
    
    (define/private (invalidate thunk)
      (when fid
        (let ([pending-exn #f])
          (define (recording-exceptions thunk)
            (let/ec return
              (call-with-exception-handler
               (λ (exn)
                 (set! pending-exn exn)
                 (return))
               thunk)))
          (recording-exceptions
           (λ () (inner (void) clunk)))
          (recording-exceptions
           thunk)
          (set!-values (fid current-offset)
            (values #f #f))
          (when pending-exn
            (raise pending-exn)))))
    
    (define/pubment (clunk)
      (invalidate
       (λ ()
         (call-with-tag
          (λ (tag)
            (match (request (make-message:t:clunk tag (->fid)))
              [(? message:r:clunk?)
               (void)]
              [_
               (raise-9p-error EPROTO)]))))))
    
    (define/public-final (remove)
      (invalidate
       (λ ()
         (call-with-tag
          (λ (tag)
            (match (request (make-message:t:remove tag (->fid)))
              [(? message:r:remove?)
               (void)]
              [_
               (raise-9p-error EPROTO)]))))))
    
    ))

(define client-directory-handle%
  (class* client-file-handle% (directory-handle<%>)
    
    (super-new)
    
    (inherit call-with-tag call-with-tag+fid request fid->file ->fid offset read)
    
    (define/public (in-entries)
      (define (read-some-entries offset)
        (let ([chunk (read (- (max-message-size) 24) offset)])
          (if (not (eof-object? chunk))
              (port->list (λ (in) (read-packed stat/p in)) (open-input-bytes chunk))
              eof)))
      (in-generator
       (let loop ([entries (read-some-entries 0)])
         (match entries
           [(cons entry rest)
            (yield entry)
            (loop rest)]
           [(list)
            (loop (read-some-entries (offset)))]
           [(? eof-object?)
            (void)]))))
    
    (define/public-final (create name perm mode)
      (call-with-tag+fid
       (λ (tag dup-fid)
         (match (request (make-message:t:walk tag (->fid) dup-fid '#()))
           [(? message:r:walk?)
            (call-with-exception-handler
             (λ (exn)
               (set-box! tag #f)
               (match (request (make-message:t:clunk tag (unbox dup-fid)))
                 [(? message:r:clunk?)
                  exn]
                 [_
                  (raise-9p-error EPROTO)]))
             (λ ()
               (set-box! tag #f)
               (match (request (make-message:t:create tag (unbox dup-fid) name perm mode))
                 [(struct message:r:create (_ qid i/o-unit))
                  (values
                   (fid->file (unbox dup-fid) qid 0)
                   i/o-unit)]
                 [_
                  (raise-9p-error EPROTO)])))]
           [_
            (raise-9p-error EPROTO)]))))
    
    ))

(provide
 client-file-handle% client-directory-handle%)