path: root/modules/language/python/module/io.scm

(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)
  (if (number? path)
      path
      (scm-str
       (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)))
       (let ((r (if (member #\b (string->list mode))
                    F
                    (TextIOWrapper F encoding errors))))
         (set r '_closefd closefd)
         r)))
                   

(define-syntax check
  (syntax-rules ()
    ((_ (self) . l)
     (check (self a b) . l))
    
    ((_ (self port) . l)
     (check (self port b) . l))
    
    ((_ (self port it) . l)
     (let lp ((it self))
       (aif it2 (ref it 'raw)
            (lp it2)
            (begin
              (if (ref self 'closed)
                  (raise ValueError "IO operation on closed port"))
              (let ((port (ref it '_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 port)
             port)))
  
  (define close
    (lambda (self)      
      (check (self port it)
         (close-port port)
         (set it '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 port)
        (if ((ref self 'readable))  (drain-input  port))
        (if ((ref self 'writeable)) (force-output port)))))

  (define isatty
    (lambda (self)
      (check (self port)
        (isatty? port))))

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

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

  (define readable
    (lambda (self)
      (check (self port)
        (output-port? 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 port)
         (catch #t
           (lambda  () (seek port 0 SEEK_CUR) #t)
           (lambda  x  #f)))))
                          
  (define seek
    (lambda* (self offset #:optional (whence SEEK_SET))
      (check (self port)
        (if (not ((ref self seekable)))
            (raise (ValueError "Not seekable")))
        (seek port offset whence))))


  (define tell
    (lambda (self)
      (check (self port)
        (ftell port))))

  (define truncate
    (lam (self (= size None))
         (check (self port)
           (if (eq? size None)
               (truncate-file port)
               (truncate-file port size)))))

             
  (define writeable
    (lambda (self)
      (check (self port)
         (input-port? port))))

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

  (define __repr__
    (lambda (self)
      (let lp ((it self))
        (aif it2 (ref it 'raw)
             (lp it2)
             (let* ((port (ref it   '_port    ))
                    (cln  (ref self '__name__ ))
                    (nm   (port-filename port ))
                    (mod  (port-mode     port )))
               (format #f "~a ~a : ~a" cln nm mod))))))
  
  (define __del__
    (lambda (self)
      ((ref self 'close)))))



(define (wrap  x) (if (eof-object? x) #vu8() x))
(define (wraps x) (if (eof-object? x) "" x))

  
(define-python-class RawIOBase (IOBase)
  (define __next__
    (lambda (self)
      (let ((x (read self 1)))
        (if (= (len x) 0)
            StopIteration
            x))))
        
  (define read
    (lam (self (= size -1))
      (check (self port)
        (bytes
         (if (< size 0)
             ((ref self 'readall))
             (wrap (get-bytevector-n port size)))))))
        

  (define readall
    (lambda (self)
      (check (self port)
        (bytes
         (wrap (get-bytevector-all port))))))

  (define readinto
    (lambda (self b)
      (check (self port)
        (let* ((n (len b))
               (b (scm-bytevector b))
               (m (get-bytevector-n! 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 port)
        (let ((n (len b))
              (b (scm-bytevector b)))
          (put-bytevector 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 (port? name)
             (set self '_port name)
             (begin
               (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
                (scm-bytevector 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 #:optional (size 1))
      (check (self port)
        (list->string
         (let ((r (peek-char port)))
           (if (char? r)
               (list r)
               (list))))))))

(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)
      (let ((x ((ref self 'read) 1)))
        (if (= (len x) 0)
            StopIteration
            x))))
  
  (define read
    (lam (self (= size -1))
      (check (self port)
        (if (< size 0)
            (wraps (get-string-all port))
            (wraps (get-string-n port size))))))

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

  (define write
    (lambda (self s)
      (check (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 port)
        (get-output-string port)))))