(use-modules (guix)
             (guix profiles)
             (gnu packages base)
             (gnu packages compression)
             (gnu packages package-management))

(define* (self-contained-tarball #:key (guix guix))
  (mlet %store-monad ((profile (profile-derivation
                                (manifest
                                 (list (package->manifest-entry guix))))))
    (gexp->derivation "guix-tarball.tar.lz"
                      #~(begin
                          (use-modules (guix build store-copy)
                                       (guix build utils)
                                       (gnu build install)
                                       (srfi srfi-26))

                          (define %root
                            (string-append (getcwd) "/root"))
                          (define %root-profile
                            "/var/guix/profiles/per-user/root")

                          (define (mkdir-p* dir)
                            (mkdir-p (string-append %root "/" dir)))

                          (define (symlink* old new)
                            (symlink old (string-append %root "/" new)))

                          (setenv "PATH"
                                  (string-append #$guix "/sbin:"
                                                 #$tar "/bin:" #$lzip "/bin"))

                          ;; Populate the store.
                          (populate-store '("profile") %root)
                          (for-each (cut register-closure %root <>)
                                    '("profile"))

                          ;; 'guix-register' registers profiles as GC roots
                          ;; but the symlink target uses $TMPDIR.  Fix that.
                          (delete-file
                           (string-append %root
                                          "/var/guix/gcroots/profiles"))
                          (symlink* "/var/guix/profiles"
                                    "/var/guix/gcroots/profiles")

                          ;; Make root's profile, which makes it a GC root.
                          (mkdir-p* %root-profile)
                          (symlink* #$profile
                                    (string-append %root-profile
                                                   "/guix-profile-1-link"))
                          (symlink* (string-append %root-profile
                                                   "/guix-profile-1-link")
                                    (string-append %root-profile
                                                   "/guix-profile"))

                          (mkdir-p* "/root")
                          (symlink* (string-append %root-profile
                                                   "/guix-profile")
                                    "/root/.guix-profile")

                          ;; Create the tarball.  Use GNU format so there's no
                          ;; file name length limitation.
                          (chdir %root)
                          (zero? (system* "tar" "--lzip" "--format=gnu"
                                          "-cvf" #$output ".")))
                      #:references-graphs `(("profile" ,profile))
                      #:modules '((guix build utils)
                                  (guix build store-copy)
                                  (gnu build install)))))

;; (pk (with-store store
;;       (run-with-store store (self-contained-tarball))))