dotfiles/.local/bin/guix-containerize

#!guile \
--no-auto-compile -s
!#

;; This is an example Guix containerization wrapper.

(use-modules (srfi srfi-1)
             (ice-9 receive))

(define program-command "unrar")
(define program-package "unrar")
(define empty-dir "/tmp/empty")
(define user "foo")

(define (usage)
  (display
   (format #f "Usage: ~a COMMAND [OPTIONS] ARCHIVE [FILES...]
                        [@LISTFILES...] [OUTPUT-DIR/]

Run program in a container.  Within the container, the archive is read-only and
the OUTPUT-DIR is shared read-write.

OUTPUT-DIR must end with a '/'.  If unspecified, current directory is used.

See below for the original program options:
"
           (first (command-line))))
  (let ((command-line `("guix" "environment"
                        "--pure"
                        ,(string-append "--user=" user)
                        "--container"
                        "--ad-hoc" program-package
                        "--"
                        program-command "h")))
    (run-command-line command-line)))

(define (parse-args)
  (let ((args (command-line))
        (command "")
        (switches '())
        (archive "")
        (files '())
        (output-directory (getcwd)))
    ;; Skip caller.
    (set! args (cdr args))
    ;; Check for help.
    (when (and (not (null? args))
               (or (string=? (first args) "-h")
                   (string=? (first args) "--help")))
      (usage)
      (exit #t))
    ;; Command.
    (unless (null? args)
      (set! command (first args))
      (set! args (cdr args)))
    ;; Switches.
    (while (and (not (null? args))
                (string=? (string-take (first args) 1) "-"))
      (set! switches (append (list (first args)) files))
      (set! args (cdr args)))
    (set! switches (reverse! switches))
    ;; Archive.
    (unless (null? args)
      (set! archive (first args))
      (set! args (cdr args)))
    ;; Files and filelists.
    (while (and (not (null? args))
                (not (string=? (string-take-right (first args) 1) "/")))
      (set! files (append (list (first args)) files))
      (set! args (cdr args)))
    (set! files (reverse! files))
    ;; Output dir.
    (unless (null? args)
      (set! output-directory (first args))
      (set! args (cdr args)))
    ;; Handy error checking while we are at it.
    (unless (null? args)
      (warn "Possible extraneous arguments:" args))
    (values command switches archive files output-directory)))

(define (expose file)
  (string-append "--expose=" file "=" (basename file)))

(define (run-command-line command-line)
  ;; TODO: Use guix' mkdir-p?
  (unless (file-exists? empty-dir)
    (mkdir empty-dir))
  (apply system* command-line)
  (rmdir empty-dir))

(define (main)
  (receive (command switches archive files output-directory)
      (parse-args)
    (when (or (string=? command "")
              (string=? archive ""))
      (display "Both COMMAND and ARCHIVE arguments are required")
      (newline)
      (usage)
      (exit #f))
    (let ((command-line `("guix" "environment"
                          "--pure"
                          ,(string-append "--user=" user)
                          "--container"
                          ,(expose archive)
                          ,@(map expose files)
                          ,(string-append "--share=" output-directory "=" (basename output-directory))
                          "--ad-hoc" program-package
                          "--"
                          program-command
                          ,command
                          ,@switches
                          ,(basename archive)
                          ,@(map basename files)
                          ;; TODO: This is not the right
                          ,(string-append (basename output-directory) "/")
                          )))
      (display (format #f "Running command: ~a" command-line))
      (newline)
      (newline)
      (run-command-line command-line))))

(main)