(define-module (language python module resource)
  #:use-module (system foreign)
  #:use-module (rnrs bytevectors)
  #:use-module (oop pf-objects)
  #:use-module (language python exceptions)
  #:use-module (language python list)
  #:use-module (language python module errno)
  #:use-module (language python try)
  #:export (RLIM_INFINITY RLIMIT_CORE RLIMIT_CPU RLIMIT_FSIZE RLIMIT_DATA
                          RLIMIT_STACK RLIMIT_RSS RLIMIT_NPROC RLIMIT_NOFILE
                          RLIMIT_MEMLOCK RLIMIT_AS RLIMIT_LOCKS
                          RLIMIT_MSGQUEUE RLIMIT_NICE RLIMIT_RTPRIO
                          RLIMIT_RTTIME RLIMIT_SIGPENDING

                          getrlimit setrlimit prlimit

                          RUSAGE_SELF RUSAGE_CHILDREN RUSAGE_BOTH RUSAGE_THREAD
                          getrusage getpagesize

                          ResUsage
                          ))

(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 (m . mm) ...)
  (let ((r (ca code)))
    (if (< r 0)
        (let ((e (errno)))
          (cond
           ((= e m) mm) ...
           (else
            (raise OSError (pylist-ref errorcode e) ((@ (guile) strerror) e)))))
        (values))))

(define-syntax-rule (defineu f x)
  (define f
    (catch #t
      (lambda () x)
      (lambda z
        (let ((message (format #f "could not define ~a" 'f)))
          (warn message)
          (lambda z (error message)))))))

(define RLIM_INFINITY #xffffffffffffffff)

(define RLIMIT_CORE        4)
(define RLIMIT_CPU         0)
(define RLIMIT_FSIZE       1)
(define RLIMIT_DATA        2)
(define RLIMIT_STACK       3)
(define RLIMIT_RSS         5)
(define RLIMIT_NPROC       6)
(define RLIMIT_NOFILE      7)
(define RLIMIT_MEMLOCK     8)
(define RLIMIT_AS          9)
(define RLIMIT_LOCKS      10)
(define RLIMIT_MSGQUEUE   12)
(define RLIMIT_NICE       13)
(define RLIMIT_RTPRIO     14)
(define RLIMIT_RTTIME     15)
(define RLIMIT_SIGPENDING 11)

(define getrlimit #f)
(defineu getrlimit
  (let ((f (pointer->procedure int
                               (dynamic-func "getrlimit" (dynamic-link))
                               (list int '*))))
    (lambda (resource)
      (let* ((v  (make-bytevector 16))
             (vp (bytevector->pointer v)))
        (rm (f resource vp) (EINVAL (raise ValueError "wrong resource")))
        (list (bytevector-u64-ref v 0 (native-endianness))
              (bytevector-u64-ref v 8 (native-endianness)))))))


(define setrlimit #f)
(defineu setrlimit
  (let ((f (pointer->procedure int
                               (dynamic-func "setrlimit" (dynamic-link))
                               (list int '*))))
    (lambda (resource limits)
      (let* ((v  (make-bytevector 16))
             (vp (bytevector->pointer v)))
        (bytevector-u64-set! v 0 (pylist-ref limits 0) (native-endianness))
        (bytevector-u64-set! v 8 (pylist-ref limits 1) (native-endianness))

        (rm (f resource vp)
            (EINVAL (raise ValueError "wrong resource"))
            (EPERM  (raise ValueError "wrong permission")))
        (values)))))

(define prlimit #f)
(defineu prlimit
  (let ((f (pointer->procedure int
                               (dynamic-func "prlimit" (dynamic-link))
                               (list int int '* '*))))
    (lambda* (pid resource #:optional (limits None))
      (let* ((vnew  (make-bytevector 16))
             (vold  (make-bytevector 16))
             (vpnew (bytevector->pointer vnew))
             (vpold (bytevector->pointer vold)))
        (if (not (equal? limits None))
            (begin
              (bytevector-u64-set! vnew 0 (pylist-ref limits 0)
                                   (native-endianness))
              (bytevector-u64-set! vnew 8 (pylist-ref limits 1)
                                   (native-endianness))))
        (rm (f pid resource
               (if (eq? limits None)
                   (make-pointer 0)
                   vpnew)
               vpold)
            (EINVAL (raise ValueError "wrong resource"))
            (ESRCH  (raise ProcessLookupError "prlimit"))
            (EPERM  (raise PermissionError "prlimit")))
        
        (list (bytevector-u64-ref vold 0 (native-endianness))
              (bytevector-u64-ref vold 8 (native-endianness)))))))


(define RUSAGE_SELF       0)
(define RUSAGE_CHILDREN  -1)
(define RUSAGE_BOTH      -2)
(define RUSAGE_THREAD     1)

(define-python-class ResUsage ()
  (define __init__
    (lambda (self v)
      (define i 0)
      (define-syntax-rule (gettime k)
        (let ((x1 (bytevector-u64-ref v i (native-endianness)))
              (x2 (bytevector-u64-ref v (+ i 8) (native-endianness))))
          (set! i (+ i (* 8 2)))
          (set self k (+ (* x1 1.0) (/ (* x2 1.0) 1000000)))))
      (define-syntax-rule (s k)
        (begin
          (set self k (bytevector-u64-ref v i (native-endianness)))
          (set! i (+ i 8))))
      (gettime 'ru_utime)
      (gettime 'ru_stime)
      (s 'ru_maxrss)
      (s 'ru_ixrss )
      (s 'ru_idrss )
      (s 'ru_isrss )
      (s 'ru_minflt)
      (s 'ru_majflt)
      (s 'ru_nswap)
      (s 'ru_inblock)
      (s 'ru_outblock)
      (s 'ru_msgsnd)
      (s 'ru_msgrcv)
      (s 'ru_nsignals)
      (s 'ru_nvcsw)
      (s 'ru_nivcsw))))

(define getrusage #f)
(defineu getrusage
  (let ((f (pointer->procedure int
                               (dynamic-func "getrusage" (dynamic-link))
                               (list int '*))))
    (lambda (who)
      (let* ((v  (make-bytevector 160))
             (vp (bytevector->pointer v)))
        
        (rm (f who vp)
            (EINVAL (raise ValueError "wrong who in getrusage")))

        (ResUsage v)))))

(define getpagesize #f)
(defineu getpagesize
  (let ((f (pointer->procedure int
                               (dynamic-func "getpagesize" (dynamic-link))
                               '())))
    (lambda ()
      (rm (f)))))