;; Build an extlinux.conf for the Pi on the workstation.
;;
;; Usage (from deploy-rpi.sh):
;;   guix repl -L packages -- scripts/extlinux-conf.scm OS-FILE \
;;     DEFAULT-SYSTEM DEFAULT-PARAMS [OLD-SYSTEM OLD-PARAMS]...
;;
;; Each SYSTEM is a /gnu/store/…-system path on the Pi and PARAMS a local copy
;; of its `parameters' file.  Prints the store path of the generated
;; extlinux.conf.  This is what `guix system switch-generation' does on the
;; device, but that would need a native aarch64 Guile there (PITFALLS #28).

(use-modules (gnu bootloader)
             (gnu system)
             (guix gexp)
             (guix monads)
             (guix store)
             (guix derivations)
             (ice-9 match))

(define (system+params->menu-entry system file)
  ;; Like read-boot-parameters-file, which needs SYSTEM to be local: add
  ;; root=, gnu.system= and gnu.load= to the stored kernel arguments.
  (let ((params (call-with-input-file file read-boot-parameters)))
    (boot-parameters->menu-entry
     (boot-parameters
      (inherit params)
      (kernel-arguments
       ;; Not exported by (gnu system).
       (append ((@@ (gnu system) bootable-kernel-arguments) system
                (boot-parameters-root-device params)
                (boot-parameters-version params))
               (boot-parameters-kernel-arguments params)))))))

(define (pairs->menu-entries args)
  (match args
    (() '())
    ((system file rest ...)
     (cons (system+params->menu-entry system file)
           (pairs->menu-entries rest)))))

(match (command-line)
  ((_ os-file default-system default-params old ...)
   ;; rpi4.scm evaluates to the operating-system as its last expression.
   (let* ((os (load (canonicalize-path os-file)))
          (config (operating-system-bootloader os))
          (generator (bootloader-configuration-file-generator
                      (bootloader-configuration-bootloader config)))
          (file (generator config
                           (list (system+params->menu-entry default-system
                                                            default-params))
                           #:old-entries (pairs->menu-entries old))))
     (with-store store
       (run-with-store store
         (mlet %store-monad ((drv (lower-object file)))
           (mbegin %store-monad
             (built-derivations (list drv))
             (return (format #t "~a~%" (derivation->output-path drv)))))))))
  (_
   (format (current-error-port)
           "usage: extlinux-conf.scm OS-FILE SYSTEM PARAMS [SYSTEM PARAMS]...~%")
   (exit 1)))