(define-module (ruther environment)
  #:use-module (guix profiles)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (guix build-system trivial)
  #:use-module (gnu packages bash)
  #:export (make-environment))

;; Makes a package that uses the given environment, and wraps the binaries in it.
;; TODO: replace the paths (only in text files!!! not in binaries...) in all extra-paths files,
;; so instead of symlinking some of the files might have to be just copied and substituted.
;; this also means it might come in handy to create all directories instead and symlink only the files.
(define* (make-environment manifest
                           #:key
                           (name "environment")
                           (binary-paths '("bin"))
                           (extra-paths '("share/info" "share/man" "share/doc" "share/applications"))
                           (rename-function #~identity)
                           (filter-function #~(const #t)))
  "Takes a manifest, makes a package that will have all the binaries the profile has, wrapped to use etc/profile
"
  (let ((profile (profile (content manifest))))
    (package
     (name name)
     (version "0")
     (source #f)
     (build-system trivial-build-system)
     (inputs
      (list bash))
     (arguments
      (list
       #:modules '((guix build utils))
       #:builder #~(begin
                     (use-modules (guix build utils)
                                  (ice-9 format)
                                  (ice-9 ftw))
                     (mkdir-p #$output)

                     ;; Iterate all binary-paths under profile and make scripts in output
                     (let ((profile-path #$profile))
                       (define (make-wrapper-script source-file input-file output-file)
                         (call-with-output-file output-file
                           (lambda (port)
                             (format port "!#~a/bin/bash~%"
                                     #$(this-package-input "bash"))
                             (format port "source ~a~%" source-file)
                             (format port "exec ~a \"$@\"~%" input-file)))
                         (chmod output-file #o555))

                       (define (not-directory? base-path)
                         (lambda (path)
                           (let ((s (stat (string-append base-path "/" path))))
                             (not (eq? (stat:type s) 'directory)))))

                       (for-each
                        (lambda (binary-path)
                          (mkdir-p (string-append #$output "/" binary-path))
                          ;; list the files, make scripts in #$output/<binary-path> that call them, with source #$profile/etc/profile prepended
                          (for-each
                           (lambda (file-name)
                             (when (#$filter-function file-name)
                               (make-wrapper-script
                                (string-append profile-path "/etc/profile")
                                (string-append profile-path "/" binary-path "/" file-name)
                                (string-append #$output "/" binary-path "/" (#$rename-function file-name)))))
                           (scandir (string-append profile-path "/" binary-path)
                                    (not-directory? (string-append profile-path "/" binary-path)))))
                        '#$binary-paths)

                       ;; Iterate all extra-paths and symlink them to output.
                       (for-each
                        (lambda (extra-path)
                          (when (string-contains extra-path "/")
                            (mkdir-p (string-append #$output "/" (dirname extra-path))))
                          (symlink (string-append #$profile "/" extra-path)
                                   (string-append #$output "/" extra-path)))
                        '#$extra-paths)))))
     (synopsis #f)
     (description #f)
     (home-page #f)
     (license #f))))