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

(define-module (language python module io)
  #:use-module (language python module exceptions)
  #:use-module ((language python module os)
                #:select (get_blocking))  
  #:re-export (BlockingIOError)
  #:export (UnsupportedOperation scm-port open DEFAULT_BUFFER_SIZE
                                 IOBase RawIOBase BufferedIOBase FileIO
                                 BytesIO BufferedReader BufferedWriter
                                 BufferedRandom TextIOBase TextIOWrapper
                                 StringIO))

                                 

(define (scm-port x)
  (if (port? x)
      x
      (aif it (ref x '_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-it 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 self '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))))
                   

;;ABC

(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)))

(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 writable
    (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 read
    (lambda (self #:optional (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 (eof? m)
              (if (get_blocking port)
                  0
                  None))))))
  
  (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_ it
                         #: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))))

(use-modules (ice-9 textual-ports))
(use-modules (ice-9 rdelim))

(define-python-class TextIOBase (IOBase)
  (define read
    (lambda (self size)
      (check self
        (let ((port (ref self '_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_trough write_trough)))))

(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-str))
             (set self '_port (open-input-str initial_value)))))

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




         
         





        


      


  
(define-python-class TextIOWrapper (TextIOBase))
(define-python-class StringIO (TextIOBase))