(define-module (language python module io)
  #:use-module (oop pf-objects)
  #:use-module (system foreign)
  #:use-module (ice-9 binary-ports)
  #:use-module (ice-9 textual-ports)
  #:use-module (ice-9 rdelim)

  #:use-module (language python exceptions)
  #:use-module (language python def)
  #:use-module (language python try)
  #:use-module (language python string)
  #:use-module (language python list)
  #:use-module (language python bytes)
  #:use-module (language python bool)
  
  #:use-module (language python module errno)
  #:re-export (BlockingIOError)
  #:replace (open)
  #:export (UnsupportedOperation scm-port DEFAULT_BUFFER_SIZE
                                 IOBase RawIOBase BufferedIOBase FileIO
                                 BytesIO BufferedReader BufferedWriter
                                 BufferedRandom TextIOBase TextIOWrapper
                                 StringIO))

(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))

(define-syntax-rule (ca code)
  (catch #t
    (lambda () code)
    (lambda x (raise error x))))

(define-syntax-rule (rm code)
  (let ((r (ca code)))
    (if (< r 0)
        (raise error (errno) ((@ (guile) strerror) (errno)))
        r)))

(define F_GETFL 3)

(define fcntl2 (pointer->procedure int
                                   (dynamic-func "fcntl" (dynamic-link))
                                   (list int int)))
(define fcntl3 (pointer->procedure int
                                   (dynamic-func "fcntl" (dynamic-link))
                                   (list int int int)))

(define (get_blocking fd)
  (let ((fd (if (port? fd) (port->fdes fd) fd)))
    (if (= (logand O_NONBLOCK (rm (fcntl2 fd F_GETFL))) 0)
        #f
        #t)))

(define (scm-port x)
  (if (port? x)
      x
      (aif it (ref x '_port)
           it
           (aif it (ref x 'raw)
                (scm-port it)
                (raise ValueError "no port in scm-port")))))

(define-python-class UnsupportedOperation (OSError ValueError))

(define DEFAULT_BUFFER_SIZE 4096)

(define (path-it path)
  (aif it (ref path '__fspath__)
       (it)
       path))

(def (open- path
           (= mode      "r")
           (= buffering -1 )
           (= encoding   None)
           (= errors     None)
           (= newline    None)
           (= closefd    #t)
           (= opener     None))
     
     (define modelist (string->list mode))
     (define path*    (path-it path))
     (define (clean ch l)
       (filter (lambda (c) (not (eq? ch c))) l))

     (let* ((port (if (number? path)
                      (begin
                        (if (member #\a modelist)
                            (seek path* 0 SEEK_END))
                        (if (member #\x modelist)
                            (error "cannot use mode 'x' for fd input"))
                        (cond
                         ((member #\r modelist)
                          (fdes->inport path*))
                         ((member #\w modelist)
                          (fdes->outport path*))))
                      (begin
                        (if (member #\x modelist)
                            (if (file-exists? path*)
                                (raise OSError "mode='x' and file exists")
                                (set mode (list->string
                                           (clean #\x modelist)))))
                        ((@ (guile) open-file) path* mode))))
            
            (errors   (if (bool errors)
                          (scm-str errors)
                          (let ((s (port-conversion-strategy port)))
                            (cond
                             ((eq? s 'error)      "strict")
                             ((eq? s 'substitute) "replace")
                             ((eq? s 'escape)     "basckslashreplace")))))
           
            (encoding (if (eq? encoding None)
                          (port-encoding port)
                          encoding)))
       
       
       ;; encoding
       (set-port-encoding! port encoding)

       (case buffering
         ((-1)
          (setvbuf port 'block DEFAULT_BUFFER_SIZE))
         ((0)
          (setvbuf port 'none))
         ((1)
          (setvbuf port 'line))
         (else
          (setvbuf port 'block buffering)))

       (cond
        ((equal? errors "strict")
         (set-port-conversion-strategy! port 'error))
        ((equal? errors "replace")
         (set-port-conversion-strategy! port 'substitute))
        ((equal? errors "basckslashreplace")
         (set-port-conversion-strategy! port 'escape))
        (else
         (set-port-conversion-strategy! port 'escape)))

       port))


(def (open path
           (= mode      "r")
           (= buffering -1 )
           (= encoding   None)
           (= errors     None)
           (= newline    None)
           (= closefd    #t)
           (= opener     None))

     (let ((F
            (FileIO (cons
                     (open path mode buffering encoding errors
                           newline closefd opener)
                     path)
                    mode)))
       (if (member #\b (string->list mode))
           F
           (TextIOWrapper F encoding errors))))
                   

(define-syntax-rule (check self . l)
  (aif it (ref self 'raw)
       (let ((self it))
         (if (ref self 'closed)
             (raise ValueError "IO operation on closed port"))
         . l)
       (begin
         (if (ref self 'closed)
             (raise ValueError "IO operation on closed port"))
         . l)))

;; ABC


(define-python-class IOBase ()
  (define __init__
    (lambda (self port)
      (set self '_port  port)
      (set self 'closed (port-closed? port))))

  (define __getport__
    (lambda (self)
      (check self
        (ref self '_port))))
  
  (define close
    (lambda (self)      
      (check self
         (close-port (ref self '_port))
         (set self 'closed #t))))
  
  (define __enter__
    (lambda (self)
      (check self)
      self))

  (define __exit__
    (lambda (self . x)
      (check self
         ((ref self 'close)))))

  (define flush
    (lambda (self)
      (check self
        (if ((ref self 'readable))  (drain-input  (ref self '_port)))
        (if ((ref self 'writeable)) (force-output (ref self '_port))))))

  (define isatty
    (lambda (self)
      (check self
        (isatty? (ref self '_port)))))

  (define __iter__
    (lambda (self)
      (check self)
      self))

  (define __next__
    (lambda (self)
      (check self
             (raise StopIteration))))

  (define readable
    (lambda (self)
      (check self
        (output-port? (ref self '_port)))))

  (define readline
    (lam (self (= size -1))
         (check self
           (raise UnsupportedOperation))))

  (define readlines
    (lam (self (= hint -1))
         (check self
            (raise UnsupportedOperation))))
  
  (define seekable
    (lambda (self)
      (check self
         (catch #t
           (lambda  () (seek (ref self '_port) 0 SEEK_CUR) #t)
           (lambda  x  #f)))))
                          
  (define seek
    (lambda* (self offset #:optional (whence SEEK_SET))
      (check self
        (if (not ((ref self seekable)))
            (raise (ValueError "Not seekable")))
        (seek (ref self '_port) offset whence))))


  (define tell
    (lambda (self)
      (check self
        (ftell (ref self '_port)))))

  (define truncate
    (lam (self (= size None))
         (check self
           (if (eq? size None)
               (truncate-file (ref self '_port))
               (truncate-file (ref self '_port) size)))))

             
  (define writeable
    (lambda (self)
      (check self
         (input-port? (ref self '_port)))))

  (define writelines
    (lambda (self lines)
      (check self
        (raise UnsupportedOperation))))

  (define __del__
    (lambda (self)
      ((ref self 'close)))))



      

  
(define-python-class RawIOBase (IOBase)
  (define __next__
    (lambda (self)
      (read self 1)))
        
  (define read
    (lam (self (= size -1))
      (check self
      (bytes
       (if (< size 0)
           ((ref self 'readall))
           (get-bytevector-n (ref self '_port) size))))))
        

  (define readall
    (lambda (self)
      (check self
        (bytes
         (get-bytevector-all (ref self '_port))))))

  (define readinto
    (lambda (self b)
      (check self
        (let* ((n (len b))
               (b (scm-bytevector b))
               (m (get-bytevector-n! (ref self '_port) b 0 n)))
          (if (eq?  m eof-object)
              (if (get_blocking (ref self '_port))
                  0
                  None)
              m)))))
            
  (define write
    (lambda (self b)
      (check self
        (let ((n (len b))
              (b (scm-bytevector b)))
          (put-bytevector (ref self '_port) b 0 n)
          n)))))

            
(define-python-class BufferedIOBase (RawIOBase)
  (define detach
    (lambda (self)
      (check self
        (raise UnsupportedOperation "detach"))))

  (define read1
    (lambda* (self #:optional (size -1))
      (check self
        ((ref self 'read) size))))

  (define readinto1
    (lambda (self b)
      (check self 
        ((ref self 'readinto) b)))))

(define-python-class FileIO (RawIOBase)
  (define __init__
    (lam (self name (= mode 'r') (= closefd #t) (= opener None))
         (if (pair? name)
             (set self '_port (car name))
             (set self '_port
                  (open- (path-it name)
                         #:mode      mode
                         #:closefd   closefd
                         #:opener    opener)))
         (set self 'mode mode)
         (set self 'name (cdr name)))))


(define-python-class BytesIO (BufferedIOBase)
  (define __init__
    (lambda* (self #:optional (initial_bytes None))
      (if (eq? initial_bytes None)
          (call-with-values open-bytevector-output-port
            (lambda (port get-bytevector)
              (set self '_port port)
              (set self '_gtbv get-bytevector)))
          (set self '_port
               (open-bytevector-input-port initial_bytes)))))

  (define getvalue
    (lambda (self)
      (check self
             (bytes ((ref self '_gtbv)))))))

(define-python-class BufferedReader (BufferedIOBase)
  (define __init__
    (lambda* (self raw #:optional (buffer_size DEFAULT_BUFFER_SIZE))
      (let ((port (ref raw '_port)))
        (case buffer_size
          ((0)
           (setvbuf port 'none))
          ((1)
           (setvbuf port 'line))
          (else
           (setvbuf port 'block buffer_size))))
      (set self 'raw raw)))

  (define peek
    (lambda (self)
      (raise UnsupportedOperation peek))))

(define-python-class BufferedWriter (BufferedIOBase)
  (define __init__
    (lambda* (self raw #:optional (buffer_size DEFAULT_BUFFER_SIZE))
      (let ((port (ref raw '_port)))
        (case buffer_size
          ((0)
           (setvbuf port 'none))
          ((1)
           (setvbuf port 'line))
          (else
           (setvbuf port 'block buffer_size))))
      (set self 'raw raw))))

(define-python-class BufferedRandom (BufferedIOBase)
  (define __init__
    (lambda* (self raw #:optional (buffer_size DEFAULT_BUFFER_SIZE))
      (let ((port (ref raw '_port)))
        (case buffer_size
          ((0)
           (setvbuf port 'none))
          ((1)
           (setvbuf port 'line))
          (else
           (setvbuf port 'block buffer_size))))
      (set self 'raw raw)))
  
  (define peek
    (lambda (self)
      (raise UnsupportedOperation peek))))

(define-python-class TextIOBase (IOBase)
  (define __next__
    (lambda (self)
      (read self 1)))
  
  (define read
    (lam (self (= size -1))
      (check self
        (let ((port (ref self '_port)))
          (if (< size 0)
              (get-string-all port)
              (get-string-n port size))))))

  (define readline
    (lam (self (= size -1))
         (check self
           (let ((port (ref self '_port)))
             (read-line port 'concat)))))

  (define write
    (lambda (self s)
      (check self
        (let ((port (ref self '_port)))
          (put-string port (scm-str s) 0 (len s))
          (len s))))))

(define (get-port x)
  (aif it (ref x '_port)
       it
       (aif it (ref x 'raw)
            (get-port it)
            (raise (ValueError "No port associated to IO wrapper")))))

(define-python-class TextIOWrapper (TextIOBase)
  (define __init__
    (lam (self buffer
               (= encoding       None)
               (= errors         None)
               (= newline        None)
               (= line_buffering #f)
               (= write_through  #f))
         (set self 'raw buffer)
         (let* ((port     (get-port buffer))
                (errors   (if (bool errors)
                              (scm-str errors)
                              (let ((s (port-conversion-strategy port)))
                                (cond
                                 ((eq? s 'error)      "strict")
                                 ((eq? s 'substitute) "replace")
                                 ((eq? s 'escape)     "basckslashreplace")))))
                (encoding (if (eq? encoding None)
                              (port-encoding port)
                              encoding)))
           ;; encoding
           (set self 'encoding encoding)
           (set-port-encoding! port encoding)

           ;; buffering
           (if line_buffering
               (setvbuf port 'line))
           
           (set self 'line_buffering line_buffering)
           
           ;; errors
           (set self 'error errors)        
           (cond
            ((equal? errors "strict")
             (set-port-conversion-strategy! port 'error))
            ((equal? errors "replace")
             (set-port-conversion-strategy! port 'substitute))
            ((equal? errors "basckslashreplace")
             (set-port-conversion-strategy! port 'escape))
            (else
             (set-port-conversion-strategy! port 'escape)))

           ;; write trough
           (set self 'write_through write_through)))))

(define-python-class StringIO (TextIOBase)
  (define __init__
    (lam (self (= initial_value "") (= newline "\n"))
         (set self 'newline newline)
         (if (equal? initial_value "")
             (set self '_port (open-output-string))
             (set self '_port (open-input-string initial_value)))))

  (define getvalue
    (lambda (self)
      (check self
        (get-output-string (ref self '_port))))))