From fda58508de96bea22ed1a015eda27eaea04c1a02 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Wed, 31 May 2023 21:46:43 +0100
Subject: Trigger xapian index rebuild conditionally.

* genenetwork-development.scm: Import mariadb from (gnu packages
databases). Import guile-dsv and guile-xapian from (gnu packages
guile-xyz).
(build-xapian-index-cron-gexp): New variable.
(operating-system)[services]: Use build-xapian-index-cron-gexp.
---
 genenetwork-development.scm | 64 +++++++++++++++++++++++++++++++++++++++------
 1 file changed, 56 insertions(+), 8 deletions(-)

diff --git a/genenetwork-development.scm b/genenetwork-development.scm
index 62394f3..7415885 100644
--- a/genenetwork-development.scm
+++ b/genenetwork-development.scm
@@ -31,11 +31,12 @@
              ((gnu packages check) #:select (python-pylint))
              ((gnu packages ci) #:select (laminar))
              ((gnu packages compression) #:select (gzip))
-             ((gnu packages databases) #:select (virtuoso-ose))
+             ((gnu packages databases) #:select (mariadb virtuoso-ose))
              ((gnu packages gnupg) #:select (guile-gcrypt))
              ((gnu packages graphviz) #:select (graphviz))
              ((gnu packages guile) #:select (guile-3.0 guile-git guile-zlib))
-             ((gnu packages guile-xyz) #:select (guile-dbd-mysql guile-dbi guile-hashing guile-ini guile-lib guile-libyaml guile-smc))
+             ((gnu packages guile-xyz) #:select (guile-dbd-mysql guile-dbi guile-dsv guile-hashing
+                                                 guile-ini guile-lib guile-libyaml guile-smc guile-xapian))
              ((gnu packages guile-xyz) #:select (guile-sparql) #:prefix guix:)
              ((gnu packages haskell-apps) #:select (shellcheck))
              ((gnu packages python-check) #:select (python-mypy))
@@ -293,6 +294,58 @@ genenetwork3 source from the latest commit of @var{project}."
                   (cut invoke #$sudo #$(file-append shepherd "/bin/herd") "start" "genenetwork3")))
               (cut delete-file-recursively xapian-build-directory)))))))
 
+;; G-expression that is configured in cron to trigger a rebuild of the
+;; xapian index
+(define build-xapian-index-cron-gexp
+  (with-extensions (list guile-dsv guile-lib guile-xapian)
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils)
+                       (dsv)
+                       (xapian wrap)
+                       (xapian xapian)
+                       (ice-9 match)
+                       (ice-9 popen)
+                       (srfi srfi-26)
+                       (srfi srfi-71)
+                       (rnrs io ports))
+
+          ;; guile-dbi does not support guile 3. So, we shell out to
+          ;; mysql instead.
+          (define (mysql-table-checksums user password database tables)
+            "Return list of checksums for @var{tables} in MySQL
+@var{database}. Authenticate with @var{user} and @var{password}."
+            (let ((from to pids (pipeline `((#$(file-append mariadb "/bin/mysql")
+                                               "--batch"
+                                               ,(string-append "--user=" user)
+                                               ,(string-append "--password=" password)
+                                               ,database)))))
+              (put-string to (string-append "CHECKSUM TABLES "
+                                            (string-join tables ",")
+                                            ";"))
+              (close to)
+              (match (dsv->scm from #\tab)
+                ((header (tables checksums) ...)
+                 (close from)
+                 checksums))))
+
+          (call-with-database #$%xapian-directory
+            (lambda (db)
+              (let ((tables (string-split (Database-get-metadata db "tables")
+                                          #\space))
+                    (checksums (map string->number
+                                    (string-split (Database-get-metadata db "checksums")
+                                                  #\space))))
+                ;; Trigger xapian index rebuild when table checksums
+                ;; in the index do not match with the SQL database and
+                ;; there is no running build job.
+                (unless (or (equal? (mysql-table-checksums "webqtlout" "webqtlout" "db_webqtl" tables)
+                                    checksums)
+                            (file-exists? (string-append #$%xapian-directory "/build")))
+                  (setenv "LAMINAR_REASON" "Nightly xapian index rebuild")
+                  (invoke #$(file-append laminar "/bin/laminarc")
+                          "queue" "genenetwork3-build-xapian-index")))))))))
+
 (define (genenetwork-projects config)
   "Return forge projects for genenetwork described by CONFIG, a
 <genenetwork-configuration> object."
@@ -1125,12 +1178,7 @@ gn-auth."
                             (mcron-configuration
                              (jobs (list #~(job '(next-day)
                                                 #$(program-file "build-xapian-index-cron"
-                                                                (with-imported-modules '((guix build utils))
-                                                                  #~(begin
-                                                                      (use-modules (guix build utils))
-                                                                      (setenv "LAMINAR_REASON" "Nightly xapian index rebuild")
-                                                                      (invoke #$(file-append laminar "/bin/laminarc")
-                                                                              "queue" "genenetwork3-build-xapian-index"))))
+                                                                build-xapian-index-cron-gexp)
                                                 #:user "laminar")))))
                    (simple-service 'install-laminar-template
                                    activation-service-type
-- 
cgit v1.2.3