(uiop:define-package ambrevar/guix
  (:documentation "Guix helpers.")
  (:use #:common-lisp)
  (:use #:trivia)
  (:import-from #:serapeum #:export-always)
  (:import-from #:ambrevar/shell))
(in-package ambrevar/guix)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria)
  (trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum))

(export-always 'share-setup-files)
(defun share-setup-files (&key (port 8081))
  (unless (uiop:file-exists-p "/etc/guix/signing-key.pub")
    (error "TODO: Implement `sudo guix archive --generate'"))
  ;; TODO: Generate unique temp file.
  ;; TODO: Use ambrevar/shell.
  ;; TODO: Overwrite existing file?
  (let ((setup-file "/tmp/guix-system-setup.tar")
        (channel-file "/tmp/channels.scm"))
    (uiop:run-program (list "guix" "describe" "--format=channels")
                      :output channel-file)
    (uiop:with-current-directory ((format nil "~a/guix/" (uiop:xdg-config-home)))
      (uiop:run-program (list "tar" "--dereference" "-cvf" setup-file
                              "/etc/guix/signing-key.pub"
                              channel-file "system")
                        :output t))
    ;; TODO: Restart when port is occupied.
    (format t (str:concat "Guix installation can fetch the setup files with~%"
                          "  guix download http://~a:~a -o setup.tar && tar xf setup.tar~%")
            (ambrevar/shell:current-ip)
            port)
    (uiop:run-program (list "woof" "-p" (write-to-string  port)
                            setup-file)
                      :output :interactive)
    (delete-file setup-file)))

(export-always 'publish)
(defun publish ()
  (error "TODO: Implement `sudo guix publish'...")
  ;; (uiop:run-program `("guix" "publish" "--advertise"
  ;;                            ,(str:concat "--user=" (uiop:getenv "USER"))))
  )

(export-always 'setup-all)
(defun setup-all ()
  (share-setup-files)
  (publish))

(export-always 'disk-usage-store)
(defun disk-usage-store (&key (limit 30)
                           dead?)
  (flet ((size->human (pair)
           (list (first pair)
                 (sera:format-human-size nil (second pair))))
         (pair-item-with-disk-usage (path)
           ;; TODO: Replace `du' with native version? `disk-usage' only work on files.
           (list path
                 (parse-integer
                  (first (first
                          (ambrevar/shell:tokenize
                           (cmd:$cmd "du" "-sb" path))))))))
    (mapcar
     #'size->human
     (sera:take
      limit
      (sort (mapcar #'pair-item-with-disk-usage
                    (if dead?
                        (alex:flatten (ambrevar/shell:tokenize (cmd:$cmd "guix" "gc" "--list-dead")))
                        (ambrevar/file:list-directory "/gnu/store" :sort)))
            #'> :key #'second)))))

(export-always 'delete-store-items)
(declaim (ftype (function ((cons (or string pathname)))) delete-store-items))
(defun delete-store-items (items)
  "Garbage-collect items."
  (apply #'cmd:$cmd "guix" "gc" "--delete" items))

(export-always 'guix-run)
(defun guix-run (package &optional (executable package) &rest args) ; TODO: Rename to `run'?
  "Garbage-collect items.
If EXECUTABLE is nil, PACKAGE is used instead."
  (apply #'cmd:cmd
         "guix" "environment" "--ad-hoc" package
         "--"
         (or executable package)
         args))