dotfiles/dot_local/bin/executable_guix-latest

#!/run/current-system/profile/bin/guile \
--no-auto-compile -e (guix-latest) -s
!#

;;;; guix-latest --- Build Guix system with latest channels.
;;;; Copyright © 2021, 2022, 2023, 2024 Oleg Pykhalov <go.wigust@gmail.com>
;;;; Released under the GNU GPLv3 or any later version.

(define-module (guix-latest)
  #:use-module (gnu system)
  #:use-module (guix channels)
  #:use-module (guix ci)
  #:use-module (guix inferior)
  #:use-module (guix profiles)
  #:use-module (guix records)
  #:use-module (guix scripts pull)
  #:use-module (guix store)
  #:use-module (guix ui)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (ice-9 popen)
  #:use-module (ice-9 pretty-print)
  #:use-module (ice-9 rdelim)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-37)
  #:autoload   (guix openpgp) (openpgp-format-fingerprint)
  #:export (main))

;;; Commentary:
;;;
;;; Example:
;;; guix-latest --channels=/home/alice/channels-current.scm /home/alice/src/guix/gnu/system/examples/bare-bones.tmpl
;;;
;;; Code:

(define %options
  (let ((display-and-exit-proc (lambda (msg)
                                 (lambda (opt name arg loads)
                                   (display msg) (quit)))))
    (list (option '(#\v "version") #f #f
                  (display-and-exit-proc "guix-latest version 0.0.1\n"))
          (option '(#\C "channels") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'channel-file arg result)))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'dry-run? #t result)))
          (option '(#\N "without-substitutes") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'without-substitutes? #t result)))
          (option '(#\F "local-file") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'local-file? #t result)))
          (option '(#\L "load-path") #f #t
                  (lambda (opt name arg loads)
                    (alist-cons 'load-path arg loads)))
          (option '(#\h "help") #f #f
                  (display-and-exit-proc
                   "Usage: guix-latest ...")))))

(define %default-options
  '())

(define %home
  (and=> (getenv "HOME")
         (lambda (home)
           home)))

(define (main args)

  (define (load-channels file)
    (let ((result (load* file (make-user-module '((guix channels))))))
      (if (and (list? result) (every channel? result))
          result
          (leave (G_ "'~a' did not return a list of channels~%") file))))


  (define opts
    (args-fold (cdr (program-arguments))
               %options
               (lambda (opt name arg loads)
                 (error "Unrecognized option `~A'" name))
               (lambda (op loads)
                 (cons op loads))
               %default-options))

  (define local-file?
    (assoc-ref opts 'local-file?))

  (define channels
    (cons (cond ((assoc-ref opts 'without-substitutes?)
                 %default-guix-channel)
                (local-file?
                 (channel
                  (inherit %default-guix-channel)
                  (url "https://cgit.wugi.info/git/guix/guix")))
                (else (channel-with-substitutes-available
                       %default-guix-channel
                       "http://ci.guix.gnu.org.wugi.info")))
          (map (lambda (channel)
                 (match-record channel (@@ (guix channels) <channel>)
                   (name url introduction)
                   (if introduction
                       ((@ (guix channels) channel)
                        (name name)
                        (url url)
                        (introduction introduction))
                       ((@ (guix channels) channel)
                        (name name)
                        (url url)))))
               (filter (lambda (channel)
                         (not (string= (symbol->string (channel-name channel)) "guix")))
                       (channel-list opts)))))

  (define store
    (open-connection))

  (define cached
    (cached-channel-instance store
                             channels
                             #:authenticate? (not local-file?)
                             #:cache-directory (%inferior-cache-directory)
                             #:ttl (* 3600 24 30)))

  (define inferior
    (open-inferior cached #:error-port (current-error-port)))

  (define (file->store-path file)
    (inferior-eval
     `(begin
        (use-modules (guix profiles)
                     (guix ui))
        (define %store (open-connection))
        (format (current-error-port) "Loading `~a'.~%" ,file)
        (let ((load-path ,(assoc-ref opts 'load-path)))
          (when load-path
            (add-to-load-path load-path)))
        (define file-derivation
          (run-with-store %store
            (let ((definition (load* ,file (make-user-module '()))))
              (cond ((operating-system? definition)
                     (operating-system-derivation definition))
                    (((@@ (guix profiles) manifest?) definition)
                     (profile-derivation definition #:allow-collisions? #t))
                    (else #f)))))
        (if (build-derivations %store (list file-derivation))
            `(list ,(derivation->output-path file-derivation)
                   ,@(map (@@ (gnu services) channel->code)
                          (sort ((@@ (guix describe) current-channels))
                                (lambda (c1 c2)
                                  (string< (symbol->string ((@ (guix channels) channel-name) c1))
                                           (symbol->string ((@ (guix channels) channel-name) c2)))))))
            #f))
     inferior))

  (define outputs
    (map file->store-path (filter string? opts)))

  (define channel-file
    (assoc-ref opts 'channel-file))

  (for-each
   (match-lambda
     ((list drv channels ...)
      (display drv)
      (newline)
      (let ((display-channels (lambda ()
                                (pretty-print `(list ,@channels)))))
        (if (assoc-ref opts 'dry-run?)
            (display-channels)
            (begin
              (with-output-to-file channel-file
                (lambda ()
                  (display-channels))))))))
   outputs)

  (system* "git" "add" channel-file)
  (system* "git" "commit"
           (format #f "--message=Update ~a." channel-file)))

;;; guix-latest ends here