Set up maintainer code

9 files changed, 916 insertions, 0 deletions

diff --git a/disfluid/maintainer/bootstrap-guix.scm b/disfluid/maintainer/bootstrap-guix.scm
new file mode 100644
index 0000000..370d262
--- /dev/null
+++ b/disfluid/maintainer/bootstrap-guix.scm
@@ -0,0 +1,58 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2022  Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (disfluid maintainer bootstrap-guix)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages guile-xyz)
+  #:declarative? #t
+  #:export (guix.scm))
+
+;; guix.scm is the file that has been generated by hall
+;; distribution-system. It is very incomplete yet, because it lacks
+;; the extra phases to make hall work correctly.
+
+;; We are expected to have cwd to the top of the checkout of a git
+;; repository, possibly modified. The scan argument should be obtained
+;; from ((@ disfluid maintainer scan-source) scan-source).
+
+(define (hall.scm scan)
+  (computed-file
+   "hall.scm"
+   (with-imported-modules
+       (source-module-closure '((guix build utils)))
+     #~(begin
+         (use-modules (guix build utils))
+         (copy-file #$(local-file (string-append (getcwd) "/hall.scm"))
+                    "hall.scm")
+         (invoke #$(file-append sed "/bin/sed")
+                 "-i"
+                 (format #f "s/SNAPSHOT/~a/g" #$(assq-ref scan 'version))
+                 "hall.scm")
+         (copy-file "hall.scm" #$output)))))
+
+(define (guix.scm scan)
+  (computed-file
+   "guix.scm"
+   (with-imported-modules
+       (source-module-closure '((guix build utils)))
+     #~(begin
+         (use-modules (guix build utils))
+         (copy-file #$(hall.scm scan) "hall.scm")
+         (setenv "HOME" (getcwd))
+         (invoke #$(file-append guile-hall "/bin/hall") "distribution-system" "-x")
+         (copy-file "guix.scm" #$output)))))
diff --git a/disfluid/maintainer/channel-code.scm b/disfluid/maintainer/channel-code.scm
new file mode 100644
index 0000000..4b8d4ac
--- /dev/null
+++ b/disfluid/maintainer/channel-code.scm
@@ -0,0 +1,173 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2022  Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (disfluid maintainer channel-code)
+  #:use-module (disfluid maintainer bootstrap-guix)
+  #:use-module (disfluid maintainer new-phases)
+  #:use-module (guix gexp)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages guile-xyz)
+  #:declarative? #t
+  #:export (channel-code))
+
+;; channel-code is a file-like object that contains all the code that
+;; must go to the "guix" branch. It is based on the output from hall
+;; distribution-system, with new phases added and new inputs that hall
+;; does not know about.
+
+(define (vkraus/packages/disfluid.scm scan)
+  (define disfluid-commit
+    (assq-ref scan 'commit))
+  (define disfluid-translations-commit
+    (assq-ref scan 'translations-commit))
+  (define disfluid-hash
+    (assq-ref scan 'hash))
+  (define disfluid-translations-hash
+    (assq-ref scan 'translations-hash))
+  (computed-file
+   "disfluid.scm"
+   (with-imported-modules '((guix build utils))
+     #~(begin
+         (use-modules (guix build utils))
+         (use-modules (srfi srfi-26))
+         (use-modules (ice-9 pretty-print))
+         (define kwasikwot (string->symbol "quasiquote"))
+         (define unkwot (string->symbol "unquote"))
+         (define (fix-use-modules modules)
+           `(define-module (vkraus packages disfluid)
+              ,@(apply append
+                       (map (lambda (module)
+                              `(#:use-module ,module))
+                            `((gnu packages base)
+                              (gnu packages bash)
+                              (gnu packages emacs)
+                              (gnu packages gettext)
+                              (gnu packages glib)
+                              (gnu packages gnupg)
+                              (gnu packages gtk)
+                              (guix git-download)
+                              (guix monads)
+                              (guix store)
+                              (guix derivations)
+                              (guix profiles)
+                              (guix scripts pack)
+                              (guix gexp)
+                              ,@modules)))))
+         (define (fix-source _)
+           `(source
+             (directory-union
+              "source-with-translations"
+              (list
+               (origin
+                 (method git-fetch)
+                 (uri (git-reference
+                       (url "https://labo.planete-kraus.eu/disfluid.git")
+                       (commit #$disfluid-commit)))
+                 (sha256 (base32 #$disfluid-hash)))
+               (origin
+                 (method git-fetch)
+                 (uri (git-reference
+                       (url "https://labo.planete-kraus.eu/disfluid.git")
+                       (commit #$disfluid-translations-commit)))
+                 (sha256 (base32 #$disfluid-translations-hash)))))))
+         (define (fix-arguments args)
+           `(arguments
+             (,kwasikwot
+              (,@args
+               #:phases #$(new-phases scan)))))
+         (define (fix-inputs kind inputs new-ones)
+           `(,kind
+             (,kwasikwot
+              (,@(map cadr inputs)
+               ,@(map (lambda (new)
+                        `(,unkwot ,new))
+                      new-ones)))))
+         (define (fix-native-inputs inputs)
+           (fix-inputs
+            'native-inputs
+            inputs
+            '(guile-hall emacs gnu-gettext autoconf-archive
+                         findutils)))
+         (define (fix-runtime-inputs inputs)
+           (fix-inputs 'inputs inputs '(glib gtk bash-minimal)))
+         (define (fix-propagated-inputs inputs)
+           (fix-inputs 'propagated-inputs inputs '()))
+         (define fix-field
+           ((@ (ice-9 match) match-lambda)
+            (`(source . ,source)
+             (fix-source source))
+            (`(arguments (,the-quote ,arguments))
+             (begin
+               (unless (eq? the-quote kwasikwot)
+                 (error "Only quasiquote is supported."))
+               (fix-arguments arguments)))
+            (`(native-inputs (,the-quote ,inputs))
+             (begin
+               (unless (eq? the-quote kwasikwot)
+                 (error "Only quasiquote is supported."))
+               (fix-native-inputs inputs)))
+            (`(inputs (,the-quote ,inputs))
+             (begin
+               (unless (eq? the-quote kwasikwot)
+                 (error "Only quasiquote is supported."))
+               (fix-runtime-inputs inputs)))
+            (`(propagated-inputs (,the-quote ,inputs))
+             (begin
+               (unless (eq? the-quote kwasikwot)
+                 (error "Only quasiquote is supported."))
+               (fix-propagated-inputs inputs)))
+            (field field)))
+         (define (fix-package fields)
+           `(define-public disfluid
+              (package
+                ,@(map fix-field fields))))
+         (define fix-object
+           ((@ (ice-9 match) match-lambda)
+            (`(use-modules . ,modules)
+             (fix-use-modules modules))
+            (`(package . ,fields)
+             (fix-package fields))))
+         (call-with-input-file
+             #$(guix.scm scan)
+             (lambda (base)
+               (call-with-output-file #$output
+                 (lambda (inherited)
+                   (format inherited
+                           ";; This file has been automatically generated.\n")
+                   (let loop ()
+                     (let ((next (read base)))
+                       (unless (eof-object? next)
+                         (begin
+                           (pretty-print (fix-object next) inherited)
+                           (newline inherited)
+                           (loop)))))
+                   (write 'disfluid inherited)
+                   (newline inherited)))))))))
+
+(define (vkraus/packages scan)
+  (file-union
+   "packages"
+   `(("disfluid.scm" ,(vkraus/packages/disfluid.scm scan)))))
+
+(define (vkraus scan)
+  (file-union
+   "vkraus"
+   `(("packages" ,(vkraus/packages scan)))))
+
+(define (channel-code scan)
+  (file-union
+   "channel-code"
+   `(("vkraus" ,(vkraus scan)))))
diff --git a/disfluid/maintainer/local-package.scm b/disfluid/maintainer/local-package.scm
new file mode 100644
index 0000000..cdefb28
--- /dev/null
+++ b/disfluid/maintainer/local-package.scm
@@ -0,0 +1,51 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2022  Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (disfluid maintainer local-package)
+  #:use-module (disfluid maintainer package)
+  #:use-module (disfluid maintainer scan-source)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:use-module (guix packages)
+  #:use-module (guix git-download)
+  #:declarative? #t
+  #:export (local-package))
+
+;; local-package is a package built from the current checkout.
+
+(define (local-package)
+  (let ((scan (scan-source)))
+    (package
+      (inherit (full-package scan))
+      (source
+       (computed-file
+        "self-contained-source"
+        (with-imported-modules
+            (source-module-closure '((guix build utils)))
+          #~(begin
+              (use-modules (guix build utils))
+              (copy-recursively
+               #$(directory-union
+                  "full-local-source"
+                  (list
+                   (local-file (getcwd) "local-source"
+                               #:recursive? #t
+                               #:select?
+                               (lambda (filename _)
+                                 (not (string-contains filename "/.git/"))))
+                   (assq-ref scan 'po-files)))
+               #$output
+               #:follow-symlinks? #t))))))))
diff --git a/disfluid/maintainer/new-phases.scm b/disfluid/maintainer/new-phases.scm
new file mode 100644
index 0000000..330bb20
--- /dev/null
+++ b/disfluid/maintainer/new-phases.scm
@@ -0,0 +1,244 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2022  Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (disfluid maintainer new-phases)
+  #:use-module (guix gexp)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages guile-xyz)
+  #:declarative? #t
+  #:export (new-phases))
+
+;; new-phases should be the content of the #:phase argument of the
+;; disfluid package. It adds phases to set up the build system,
+;; generate the complete source code distribution and more.
+
+(define kwote (string->symbol "quote"))
+
+(define (new-phases scan)
+  (let ((version (assq-ref scan 'version)))
+    `(modify-phases %standard-phases
+       (add-after 'unpack 'fix-mtime
+         (lambda _
+           (let ((disfluid-mtimes (,kwote ,(assq-ref scan 'mtimes))))
+             (for-each
+              ((@ (ice-9 match) match-lambda)
+                ((file . mtime)
+                 (utime file mtime mtime)))
+              disfluid-mtimes))))
+       (add-before 'bootstrap 'fix-hall.scm
+         (lambda _
+           (let ((disfluid-version ,version))
+             (substitute* "hall.scm"
+               (("SNAPSHOT") disfluid-version)))))
+       (add-after 'fix-hall.scm 'hall-scan
+         (lambda _
+           (setenv "HOME" (getcwd))
+           ;; hall scan needs to know there will be a module (disfluid
+           ;; config), but disfluid/config.scm has not been generated
+           ;; yet.
+           (call-with-output-file "disfluid/config.scm"
+             (lambda (port)
+               (write
+                `(define-module (disfluid config))
+                port)))
+           (invoke "hall" "scan" "-x")
+           (delete-file "disfluid/config.scm")))
+       (add-after 'hall-scan 'hall-build-system
+         (lambda _
+           (invoke "hall" "build-system" "-x")
+           (substitute* "Makefile.am"
+             (("EXTRA_DIST =")
+              "EXTRA_DIST = guix.scm channels.scm"))))
+       (add-after 'hall-build-system 'support-config.scm
+         (lambda _
+           (let ((expanded-variables
+                  '(("prefix" . "PREFIX")
+                    ("bindir" . "BINDIR")
+                    ("exec_prefix" . "EXEC_PREFIX")
+                    ("guilemoduledir" . "GUILEMODULEDIR")
+                    ("guileobjectdir" . "GUILEOBJECTDIR")
+                    ("localedir" . "LOCALEDIR"))))
+             (let ((subst
+                    (string-join
+                     (map
+                      ((@ (ice-9 match) match-lambda)
+                        ((var . expanded)
+                         (format #f "\
+AX_RECURSIVE_EVAL([$~a], EXPANDED_~a)
+AC_SUBST([EXPANDED_~a])"
+                                 var expanded expanded)))
+                      expanded-variables)
+                     "\n")))
+               (substitute* "configure.ac"
+                 (("AC_OUTPUT")
+                  (string-append subst "
+AC_CONFIG_FILES([disfluid/config.scm])
+AC_OUTPUT")))))
+           (rename-file "Makefile.am" "hall.mk")
+           (call-with-output-file "Makefile.am"
+             (lambda (port)
+               (format port "\
+include %reldir%/hall.mk
+
+dist-hook:
+\trm -rf $(distdir)/disfluid/config.scm
+")))
+           (call-with-output-file "disfluid/config.scm.in"
+             (lambda (port)
+               (for-each
+                (lambda (code)
+                  ((@ (ice-9 pretty-print) pretty-print) code port)
+                  (newline port))
+                '((define-module (disfluid config)
+                    #:export
+                    (
+                     package
+                      package-bugreport
+                      version
+                      localedir
+                      guilemoduledir
+                      prefix
+                      exec-prefix
+                      pkg-config
+                      ))
+                  (define package "@PACKAGE@")
+                  (define package-bugreport "@PACKAGE_BUGREPORT@")
+                  (define version "@VERSION@")
+                  (define prefix "@EXPANDED_PREFIX@")
+                  (define exec-prefix "@EXPANDED_EXEC_PREFIX@")
+                  (define localedir "@EXPANDED_LOCALEDIR@")
+                  (define guilemoduledir "@EXPANDED_GUILEMODULEDIR@")
+                  (define pkg-config "@PKG_CONFIG@")))))))
+       (add-after 'support-config.scm 'gettextize
+         (lambda _
+           (substitute* "configure.ac"
+             (("AC_OUTPUT")
+              "
+AM_GNU_GETTEXT([external])
+AM_GNU_GETTEXT_VERSION([0.21])
+AC_OUTPUT
+")
+             (("AC_CONFIG_FILES\\(\\[Makefile")
+              "AC_CONFIG_FILES([Makefile po/Makefile.in"))
+           (substitute* "hall.mk"
+             (("EXTRA_DIST =")
+              "EXTRA_DIST = guix.scm channels.scm"))
+           (rename-file "Makefile.am" "withconfig.mk")
+           (call-with-output-file "Makefile.am"
+             (lambda (port)
+               (format port "SUBDIRS = po
+include withconfig.mk
+")))
+           (mkdir-p "po")
+           (call-with-output-file "po/Makevars"
+             (lambda (port)
+               (format port "\
+DOMAIN = $(PACKAGE)
+subdir = po
+top_builddir = ..
+XGETTEXT_OPTIONS = --keyword=_ --keyword=N_ --keyword=G_
+COPYRIGHT_HOLDER = Viven Kraus
+PACKAGE_GNU =
+MSGID_BUGS_ADDRESS = vivien@planete-kraus.eu
+EXTRA_LOCALE_CATEGORIES =
+USE_MSGCTXT = no
+MSGMERGE_OPTIONS =
+MSGINIT_OPTIONS =
+PO_DEPENDS_ON_POT = yes
+DIST_DEPENDS_ON_UPDATE_PO = yes
+")))
+         (call-with-output-file "collect-potfiles.sh"
+           (lambda (port)
+             (format port "
+(for pattern in '*.scm' ;
+ do find . -name \"$pattern\" ;
+ done) > po/POTFILES.in
+")
+             (chmod port #o755)))
+         (call-with-output-file "collect-linguas.sh"
+           (lambda (port)
+             (format port "
+(for pofile in po/*.po ;
+ do echo \"$pofile\" | cut -d '/' -f 2 | cut -d '.' -f 1 ;
+ done) > po/LINGUAS
+")
+             (chmod port #o755)))
+         (invoke "bash" "collect-potfiles.sh")
+         (invoke "bash" "collect-linguas.sh")))
+       (add-after 'hall-build-system 'define-package-bugreport
+         (lambda _
+           (substitute* "configure.ac"
+             (("AC_INIT")
+              (format #f "AC_INIT([disfluid], [~a], [vivien@planete-kraus.eu])
+dnl AC_INIT"
+                      ,version)))))
+       (add-after 'bootstrap 'fix-po-makefile-shell
+         (lambda _
+           (substitute* "po/Makefile.in.in"
+             (("SHELL = /bin/sh")
+              "SHELL = @SHELL@"))))
+       (add-after 'check 'distcheck
+         (lambda* (#:key make-flags inputs #:allow-other-keys)
+           (apply invoke "make"
+                  `(,@make-flags
+                    "distcheck"
+                    ,(format #f "DISTCHECK_CONFIGURE_FLAGS=SHELL=~a"
+                             (search-input-file inputs "/bin/bash"))))
+           (copy-file ,(format #f "disfluid-~a.tar.gz" version)
+                      ,(format #f "/tmp/disfluid-~a.tar.gz" version))
+           (with-directory-excursion "/tmp"
+             (invoke "tar" "xf"
+                     ,(format #f "disfluid-~a.tar.gz" version))
+             (delete-file ,(format #f "disfluid-~a.tar.gz" version))
+             (invoke "tar"
+                     ;; see https://reproducible-builds.org/docs/archives/
+                     "--sort=name"
+                     "--mtime=2022-01-01 00:00Z"
+                     "--owner=0"
+                     "--group=0"
+                     "--numeric-owner"
+                     "--pax-option=exthdr.name=%d/PaxHeaders/%f,delete=atime,delete=ctime"
+                     "-cf" ,(format #f "disfluid-~a.tar.gz" version)
+                     ,(format #f "disfluid-~a" version)))
+           (copy-file ,(format #f "/tmp/disfluid-~a.tar.gz" version)
+                      ,(format #f "disfluid-~a.tar.gz" version))))
+       (add-after 'build 'html
+         (lambda* (#:key make-flags #:allow-other-keys)
+           (apply invoke "make" "html" make-flags)))
+       (add-after 'install 'install-complete-corresponding-source
+         (lambda* (#:key outputs #:allow-other-keys)
+           (let ((out (assoc-ref outputs "out")))
+             (mkdir-p (string-append out "/share/disfluid"))
+             (copy-file
+              ,(format #f "disfluid-~a.tar.gz" version)
+              (string-append
+               out
+               "/share/disfluid/complete-corresponding-source.tar.gz")))))
+       (add-after 'install 'install-html
+         (lambda* (#:key make-flags #:allow-other-keys)
+           (apply invoke "make" "install-html" make-flags)))
+       (add-after 'install 'wrap-disfluid
+         (lambda* (#:key inputs outputs #:allow-other-keys)
+           (let ((out (assoc-ref outputs "out")))
+             (wrap-program (string-append out "/bin/disfluid")
+               `("GUILE_LOAD_PATH" prefix
+                 ,(search-path-as-list
+                   '("share/guile/site/3.0")
+                   (map cdr inputs)))
+               `("GUILE_COMPILED_LOAD_PATH" prefix
+                 ,(search-path-as-list
+                   '("lib/guile/3.0/site-ccache")
+                   (map cdr inputs))))))))))
diff --git a/disfluid/maintainer/package.scm b/disfluid/maintainer/package.scm
new file mode 100644
index 0000000..0ad8054
--- /dev/null
+++ b/disfluid/maintainer/package.scm
@@ -0,0 +1,42 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2022  Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (disfluid maintainer package)
+  #:use-module (disfluid maintainer channel-code)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:use-module (guix derivations)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages guile-xyz)
+  #:declarative? #f ;; because of load
+  #:export (full-package))
+
+;; full-package is a buildable package.
+
+(define (full-package scan)
+  (load
+   (run-with-store (open-connection)
+     (mlet %store-monad
+         ((guix.scm (gexp->derivation "guix.scm"
+                      #~(symlink
+                         (string-append
+                          #$(channel-code scan)
+                          "/vkraus/packages/disfluid.scm")
+                         #$output))))
+       (mbegin %store-monad
+         (built-derivations (list guix.scm))
+         (return (derivation->output-path guix.scm)))))))
diff --git a/disfluid/maintainer/scan-source.scm b/disfluid/maintainer/scan-source.scm
new file mode 100644
index 0000000..63b7a90
--- /dev/null
+++ b/disfluid/maintainer/scan-source.scm
@@ -0,0 +1,178 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2022  Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (disfluid maintainer scan-source)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:use-module (guix derivations)
+  #:use-module (guix modules)
+  #:use-module (gnu packages version-control)
+  #:use-module (gnu packages package-management)
+  #:use-module (gnu packages base)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 match)
+  #:declarative? #t
+  #:export (scan-source))
+
+;; The goal of scan-source is to run in the root of a git repository,
+;; and then extract the following information as an alist:
+
+;; - the version information of the checked out source (key: 'version);
+;; - the latest commit ID of the main branch (key: 'commit);
+;; - the latest commit ID in the translations branch (key: 'translations-commit);
+;; - the guix hash of the latest commit in the main branch (key: 'hash);
+;; - the guix hash of the translations branch (key: translations-hash);
+;; - an alist of file names (e.g. "doc/disfluid.texi") to timestamp of their last modification date (key: 'mtimes);
+;; - the translation files as a file-like object, from po file name (e.g. "en.po") to whole file content as a string (key: 'po-files).
+
+;; It uses a temporary directory in /tmp to do that, but the directory
+;; gets cleaned up. No other file is modified.
+
+(define scan-source-code
+  (with-imported-modules
+      (source-module-closure '((guix build utils)))
+    #~(begin
+        (use-modules (guix build utils)
+                     (ice-9 rdelim)
+                     (ice-9 popen)
+                     (ice-9 receive)
+                     (ice-9 match))
+        (define* (first-line . command)
+          (let ((port
+                 (apply
+                  open-pipe*
+                  OPEN_READ
+                  command)))
+            (let ((line (read-line port)))
+              (close-port port)
+              line)))
+        (define* (git . args)
+          (apply first-line #$(file-append git "/bin/git") args))
+        (define* (invoke-git . args)
+          (apply invoke #$(file-append git "/bin/git") args))
+        (define (git-archive ref output)
+          (invoke-git "archive" ref "-o" output))
+        (define (date . args)
+          (apply first-line #$(file-append coreutils "/bin/date") args))
+        (define (git-log-1-%ci-timestamp ref file)
+          (let ((readable (git "log" ref "-1" "--format=%ci" "--" file)))
+            (string->number (date "-d" readable "+%s"))))
+        (define* (invoke-tar . args)
+          (apply invoke #$(file-append tar "/bin/tar") args))
+        (define (tar-xf archive)
+          (invoke-tar "xf" archive))
+        (define* (guix . args)
+          (apply first-line #$(file-append guix "/bin/guix") args))
+        (define (guix-hash dir)
+          (guix "hash" "-x" "-S" "nar" dir))
+        (let ((version (git "describe" "--tags" "--dirty"))
+              (commit (git "rev-parse" "main"))
+              (translations-commit (git "rev-parse" "translations"))
+              (directory
+               (mkdtemp "/tmp/analyze-source-XXXXXX")))
+          (git-archive "main"
+                       (string-append directory "/source.tar.gz"))
+          (git-archive "translations"
+                       (string-append directory "/translations.tar.gz"))
+          (receive (hash translations-hash all-translations)
+              (with-directory-excursion directory
+                (mkdir-p "pure")
+                (mkdir-p "translations")
+                (let ((h
+                       (with-directory-excursion "pure"
+                         (tar-xf "../source.tar.gz")
+                         (guix-hash (getcwd))))
+                      (po-h
+                       (with-directory-excursion "translations"
+                         (tar-xf "../translations.tar.gz")
+                         (guix-hash (getcwd)))))
+                  (let ((all-translations
+                         (with-directory-excursion "translations/po"
+                           (let ((dir (opendir (getcwd))))
+                             (let scan ((all '()))
+                               (let ((next (readdir dir)))
+                                 (cond
+                                  ((eof-object? next)
+                                   (begin
+                                     (closedir dir)
+                                     (reverse all)))
+                                  ((or (string-suffix? ".po" next)
+                                       (string-suffix? ".pot" next))
+                                   (let ((lang (basename next))
+                                         (content
+                                          (call-with-input-file next
+                                            (lambda (port)
+                                              (read-delimited "" port)))))
+                                     (scan `((,lang ,content) ,@all))))
+                                  (else
+                                   (scan all)))))))))
+                    (delete-file-recursively "pure")
+                    (delete-file-recursively "translations")
+                    (values h po-h all-translations))))
+            (delete-file (string-append directory "/source.tar.gz"))
+            (delete-file (string-append directory "/translations.tar.gz"))
+            (delete-file-recursively directory)
+            (let ((mtimes
+                   (let ((important-files
+                          '(("main" . "doc/disfluid.texi")
+                            ("translations" . "po/disfluid.pot"))))
+                     (map
+                      (match-lambda
+                        ((ref . file)
+                         `(,file . ,(git-log-1-%ci-timestamp ref file))))
+                      important-files))))
+              (write
+               `((version . ,version)
+                 (commit . ,commit)
+                 (hash . ,hash)
+                 (translations-commit . ,translations-commit)
+                 (translations-hash . ,translations-hash)
+                 (mtimes . ,mtimes)
+                 (po-files . ,all-translations)))))))))
+
+(define (scan-source)
+  (let ((port
+         (open-pipe*
+          OPEN_READ
+          (run-with-store (open-connection)
+            (mlet %store-monad
+                ((scan-source
+                  (gexp->script "invoke-scan-source-script"
+                    scan-source-code)))
+              (mbegin %store-monad
+                (built-derivations (list scan-source))
+                (return (derivation->output-path scan-source))))))))
+    (let ((ret (read port)))
+      (close-port port)
+      `((version . ,(assq-ref ret 'version))
+        (commit . ,(assq-ref ret 'commit))
+        (hash . ,(assq-ref ret 'hash))
+        (translations-commit . ,(assq-ref ret 'translations-commit))
+        (translations-hash . ,(assq-ref ret 'translations-hash))
+        (mtimes . ,(assq-ref ret 'mtimes))
+        (po-files
+         . ,(file-union
+             "local-translations"
+             `(("po"
+                ,(file-union
+                  "po"
+                  (map
+                   (match-lambda
+                     ((file.po content)
+                      `(,file.po ,(plain-file file.po content))))
+                   (assq-ref ret 'po-files)))))))))))
diff --git a/disfluid/maintainer/update-channel.scm b/disfluid/maintainer/update-channel.scm
new file mode 100644
index 0000000..dd6f8c3
--- /dev/null
+++ b/disfluid/maintainer/update-channel.scm
@@ -0,0 +1,29 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2022  Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (disfluid maintainer update-channel)
+  #:use-module (disfluid maintainer update-repository)
+  #:use-module (disfluid maintainer scan-source)
+  #:use-module (disfluid maintainer channel-code)
+  #:use-module (guix gexp)
+  #:declarative? #t
+  #:export (update-channel))
+
+(define (update-channel)
+  (let ((scan (scan-source)))
+    (update-repository "guix"
+                       (channel-code scan)
+                       "Automatic channel synchronization")))
diff --git a/disfluid/maintainer/update-po.scm b/disfluid/maintainer/update-po.scm
new file mode 100644
index 0000000..37ef174
--- /dev/null
+++ b/disfluid/maintainer/update-po.scm
@@ -0,0 +1,58 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2022  Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (disfluid maintainer update-po)
+  #:use-module (disfluid maintainer update-repository)
+  #:use-module (disfluid maintainer local-package)
+  #:use-module (guix gexp)
+  #:use-module (guix packages)
+  #:use-module (gnu packages base)
+  #:declarative? #t
+  #:export (update-po))
+
+(define (update-po)
+  (let ((pkg (local-package)))
+    (let ((updated-po
+           (computed-file
+            "fixed-po-files"
+            (with-imported-modules '((guix build utils))
+              #~(begin
+                  (use-modules (guix build utils))
+                  (use-modules (ice-9 rdelim))
+                  (invoke
+                   #$(file-append tar "/bin/tar")
+                   "xf"
+                   #$(file-append
+                      pkg
+                      "/share/disfluid/complete-corresponding-source.tar.gz"))
+                  (with-directory-excursion
+                      (string-append "disfluid-" #$(package-version pkg))
+                    (let ((out (string-append #$output "/po")))
+                      (mkdir-p out)
+                      (copy-file "po/disfluid.pot"
+                                 (string-append out "/disfluid.pot"))
+                      (call-with-input-file "po/LINGUAS"
+                        (lambda (port)
+                          (let loop ()
+                            (let ((next (read-line port)))
+                              (unless (eof-object? next)
+                                (when (not (string-prefix? "#" next))
+                                  (copy-file
+                                   (format #f "po/~a.po" next)
+                                   (format #f "~a/~a.po" out next)))
+                                (loop)))))))))))))
+      (update-repository "translations" updated-po
+                         "Automatic translations synchronization"))))
diff --git a/disfluid/maintainer/update-repository.scm b/disfluid/maintainer/update-repository.scm
new file mode 100644
index 0000000..7c39d0e
--- /dev/null
+++ b/disfluid/maintainer/update-repository.scm
@@ -0,0 +1,83 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2022  Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (disfluid maintainer update-repository)
+  #:use-module (guix gexp)
+  #:use-module (guix monads)
+  #:use-module (guix store)
+  #:use-module (guix derivations)
+  #:use-module (guix modules)
+  #:use-module (guix build utils)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages version-control)
+  #:declarative? #t
+  #:export (update-repository))
+
+;; update-repository clones the repository at the current working
+;; directory, check out one of its branches (e.g. "guix" or
+;; "translations"), erases every directory that’s not ".git", adds the
+;; files, commits and pushes.
+
+(define (repository-updater branch files commit-message)
+  (with-imported-modules
+      (source-module-closure '((guix build utils)))
+    #~(begin
+        (use-modules (guix build utils)
+                     (ice-9 ftw))
+        (let ((clone
+               (mkdtemp "/tmp/clone-XXXXXX")))
+          (invoke #$(file-append git "/bin/git") "clone" (getcwd) clone)
+          (with-directory-excursion clone
+            (invoke #$(file-append git "/bin/git") "checkout" #$branch)
+            (invoke #$(file-append coreutils "/bin/chmod")
+                    "-R" "u+w" (getcwd))
+            (let ((dir (opendir (getcwd))))
+              (let cleanup ()
+                (let ((next (readdir dir)))
+                  (unless (eof-object? next)
+                    (unless (or (equal? next ".git")
+                                (equal? next ".")
+                                (equal? next ".."))
+                      (false-if-exception
+                       (delete-file-recursively next)))
+                    (cleanup))))
+              (closedir dir))
+            (let ((dir (opendir #$files)))
+              (let do-import ()
+                (let ((next (readdir dir)))
+                  (unless (eof-object? next)
+                    (unless (or (equal? next ".")
+                                (equal? next ".."))
+                      (copy-recursively (string-append #$files "/" next)
+                                        (string-append (getcwd) "/" next)
+                                        #:follow-symlinks? #t))
+                    (do-import)))))
+            (invoke #$(file-append git "/bin/git") "add" ".")
+            (false-if-exception
+             (invoke #$(file-append git "/bin/git") "commit" "-m" #$commit-message))
+            (false-if-exception
+             (invoke #$(file-append git "/bin/git") "push")))))))
+
+(define (update-repository branch files commit-message)
+  (invoke
+   (run-with-store (open-connection)
+     (mlet %store-monad
+         ((updater
+           (gexp->script "invoke-repository-updater"
+             (repository-updater branch files commit-message))))
+       (mbegin %store-monad
+         (built-derivations (list updater))
+         (return (derivation->output-path updater)))))))