(define-module (ruther build wrappers)
  #:use-module (guix build utils)
  #:use-module (ice-9 format)
  #:export (replace-script-wrapper-with-binary
            replace-wrappers-with-binaries))

(define* (executable-wrapped? executable)
  (let ((folder (dirname executable))
        (filename (basename executable)))
    (file-exists?
     (string-append folder "/." filename "-real"))))

(define* (make-c-wrapper-program target)
  (mkdir-p (dirname target))
  (call-with-output-file target
    (lambda (port)
      (display "#include <unistd.h>
int main (int argc, char* argv[])
{
  execv(\"%SCRIPT%\", argv);
} " port))))

(define* (replace-script-wrapper-with-binary wrapper target)
  (let ((wrapper-program "wrapper.c")
        (wrapper-new (or (and
                          (equal? wrapper target)
                          (string-append
                           (dirname wrapper)
                           "/."
                           (basename wrapper)
                           "-wrapper"))
                         wrapper)))
    (when (equal? wrapper target)
      (rename-file wrapper wrapper-new))
    (format #t "Replacing wrapper ~a with target ~a.~%"
            wrapper-new target)
    (make-c-wrapper-program wrapper-program)
    (substitute* wrapper-program
      (("%SCRIPT%")
       wrapper-new))
    (when (file-exists? target)
      (delete-file target))
    (invoke "gcc" wrapper-program "-o" target)))

(define* (replace-wrappers-with-binaries binaries)
  (for-each
   (lambda (binary)
     (format #t "Investigating binary ~a for wrapping.~%" binary)
     (when (executable-wrapped? binary)
       (replace-script-wrapper-with-binary binary binary)))
   binaries))