#!/run/current-system/profile/bin/sh
# -*- scheme -*-
exec ${GUILE:-$(which guile)} $GUILE_FLAGS -e '(@@ (guix-channels-update) main)' -s "$0" "$@"
!#

;;;; guix-channels-update --- Update channels.scm.
;;;; Copyright © 2019, 2022 Oleg Pykhalov <go.wigust@gmail.com>
;;;; Released under the GNU GPLv3 or any later version.

(define-module (guix-channels-update)
  #:use-module (guix channels)
  #:use-module (ice-9 match)
  #:use-module (ice-9 pretty-print)
  #:use-module (ice-9 popen)
  #:use-module (ice-9 rdelim)
  #:use-module (srfi srfi-37))

;;; Commentary:
;;;
;;; This script updates channels.scm to latest commits.
;;;
;;; 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-channels-update version 0.0.1\n"))
          (option '(#\h "help") #f #f
                  (display-and-exit-proc
                   "Usage: guix-channels-update ...")))))

(define %default-options
  '())

(define %source-dir (getcwd))

(define (git-output . args)
  "Execute 'git ARGS ...' command and return its output without trailing
newspace."
  (let* ((port   (apply open-pipe* OPEN_READ "git" args))
         (output (read-string port)))
    (close-pipe port)
    (string-trim-right output #\newline)))

(define (git-last-commit repository)
  (match (string-split
          (git-output "ls-remote" repository "refs/heads/master")
          #\tab)
    ((hash _) hash)))

(define (channels)
  (list (channel
         (name 'guix-wigust)
         (url "file:///home/oleg/src/cgit.duckdns.org/git/guix/guix-wigust")
         (commit (git-last-commit url)))
        (channel
         (name 'guix)
         (url "https://git.savannah.gnu.org/git/guix.git")
         (commit (git-last-commit url)))))

(define (main args)
  (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))
  (with-output-to-file (string-append %source-dir "/channels.scm")
    (lambda ()
      (pretty-print
       `(list ,@(map (@@ (gnu services) channel->code) (channels)))))))

;;; guix-channels-update ends here
