unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Andrew Tropin <andrew@trop.in>
To: 49419@debbugs.gnu.org
Subject: [bug#49419] [PATCH v3 2/4] home-services: Add home-run-on-change-service-type
Date: Mon, 5 Jul 2021 18:39:44 +0300	[thread overview]
Message-ID: <87sg0ag19m.fsf@trop.in> (raw)
In-Reply-To: <87v956g1g5.fsf@trop.in>

[-- Attachment #1: Type: text/plain, Size: 4951 bytes --]


Service allows to trigger actions during activation if file or directory
specified by pattern is changed.
---
 gnu/home-services.scm | 100 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 99 insertions(+), 1 deletion(-)

diff --git a/gnu/home-services.scm b/gnu/home-services.scm
index a89a061a81..bcb6dd80df 100644
--- a/gnu/home-services.scm
+++ b/gnu/home-services.scm
@@ -37,7 +37,8 @@
 	    home-environment-variables-service-type
 	    home-files-service-type
 	    home-run-on-first-login-service-type
-            home-activation-service-type)
+            home-activation-service-type
+            home-run-on-change-service-type)
 
   #:re-export (service
 	       service-type
@@ -326,3 +327,100 @@ directory.  @command{activate} script automatically called during
 reconfiguration or generation switching.  This service can be extended
 with one gexp, but many times, and all gexps must be idempotent.")))
 
+\f
+;;;
+;;; On-change.
+;;;
+
+(define (compute-on-change-gexp eval-gexps? pattern-gexp-tuples)
+  #~(begin
+      (define (equal-regulars? file1 file2)
+        "Check if FILE1 and FILE2 are bit for bit identical."
+        (let* ((cmp-binary #$(file-append
+                              (@ (gnu packages base) diffutils) "/bin/cmp"))
+               (stats1     (lstat file1))
+               (stats2     (lstat file2)))
+          (cond
+           ((= (stat:ino stats1) (stat:ino stats2))         #t)
+           ((not (= (stat:size stats1) (stat:size stats2))) #f)
+
+           (else (= (system* cmp-binary file1 file2) 0)))))
+
+      (define (equal-symlinks? symlink1 symlink2)
+        "Check if SYMLINK1 and SYMLINK2 are pointing to the same target."
+        (string=? (readlink symlink1) (readlink symlink2)))
+
+      (define (equal-directories? dir1 dir2)
+        "Check if DIR1 and DIR2 have the same content."
+        (define (ordinary-file file)
+          (not (or (string=? file ".")
+                   (string=? file ".."))))
+        (let* ((files1 (scandir dir1 ordinary-file))
+               (files2 (scandir dir2 ordinary-file)))
+          (if (equal? files1 files2)
+              (map (lambda (file)
+                     (equal-files?
+                      (string-append dir1 "/" file)
+                      (string-append dir2 "/" file)))
+                   files1)
+              #f)))
+
+      (define (equal-files? file1 file2)
+        "Compares files, symlinks or directories of the same type."
+        (case (file-type file1)
+          ((directory) (equal-directories? file1 file2))
+          ((symlink) (equal-symlinks? file1 file2))
+          ((regular) (equal-regulars? file1 file2))
+          (else
+           (display "The file type is unsupported by on-change service.\n")
+           #f)))
+
+      (define (file-type file)
+        (stat:type (lstat file)))
+
+      (define (something-changed? file1 file2)
+        (cond
+         ((and (not (file-exists? file1))
+               (not (file-exists? file2))) #f)
+         ((or  (not (file-exists? file1))
+               (not (file-exists? file2))) #t)
+
+         ((not (eq? (file-type file1) (file-type file2))) #t)
+
+         (else
+          (not (equal-files? file1 file2)))))
+
+      (define expressions-to-eval
+        (map
+         (lambda (x)
+           (let* ((file1 (string-append (getenv "GUIX_OLD_HOME") "/" (car x)))
+                  (file2 (string-append (getenv "GUIX_NEW_HOME") "/" (car x)))
+                  (_ (format #t "Comparing ~a and\n~10t~a..." file1 file2))
+                  (any-changes? (something-changed? file1 file2))
+                  (_ (format #t " done (~a)\n"
+                             (if any-changes? "changed" "same"))))
+             (if any-changes? (cadr x) "")))
+         '#$pattern-gexp-tuples))
+
+      (if #$eval-gexps?
+          (begin
+            (display "Evaling on-change gexps.\n\n")
+            (for-each primitive-eval expressions-to-eval)
+            (display "On-change gexps evaluation finished.\n\n"))
+          (display "\
+On-change gexps won't evaluated, disabled by service configuration.\n"))))
+
+(define home-run-on-change-service-type
+  (service-type (name 'home-run-on-change)
+                (extensions
+                 (list (service-extension
+                        home-activation-service-type
+                        identity)))
+                (compose concatenate)
+                (extend compute-on-change-gexp)
+                (default-value #t)
+                (description "\
+G-expressions to run if the specified files have changed since the
+last generation.  The extension should be a list of lists where the
+first element is the pattern for file or directory that expected to be
+changed, and the second element is the G-expression to be evaluated.")))
-- 
2.32.0


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 853 bytes --]

  parent reply	other threads:[~2021-07-19 17:17 UTC|newest]

Thread overview: 38+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-07-05 15:35 [bug#49419] [PATCH 0/4] Essential home services Andrew Tropin
2021-07-05 15:37 ` [bug#49419] [PATCH 1/4] home-services: Add most essential " Andrew Tropin
2021-07-05 15:47   ` Maxime Devos
2021-07-05 16:19     ` Andrew Tropin
2021-07-05 19:19       ` Maxime Devos
2021-07-06  7:09         ` Andrew Tropin
2021-07-06  8:26           ` Maxime Devos
2021-07-06  7:23     ` Andrew Tropin
2021-07-05 15:39 ` [bug#49419] [PATCH 2/4] home-services: Add home-run-on-change-service-type Andrew Tropin
2021-07-05 15:41 ` [bug#49419] [PATCH 3/4] home-services: Add home-provenance-service-type Andrew Tropin
2021-07-05 15:41 ` [bug#49419] [PATCH 4/4] home-services: Add fold-home-service-types function Andrew Tropin
2021-07-13 16:17 ` [bug#49419] [PATCH v2 0/4] Essential home services Andrew Tropin
2021-07-05 15:37   ` [bug#49546] [PATCH v2 1/4] home-services: Add most essential " Andrew Tropin
     [not found]     ` <handler.49546.B.16262002971832.ack@debbugs.gnu.org>
2021-07-13 18:24       ` [bug#49546] Acknowledgement ([PATCH v2 1/4] home-services: Add most essential home services) Andrew Tropin
2021-07-05 15:39   ` [bug#49547] [PATCH v2 2/4] home-services: Add home-run-on-change-service-type Andrew Tropin
2021-07-14 10:41     ` Maxime Devos
2021-07-15  8:46       ` Andrew Tropin
2021-07-18 16:17         ` Maxime Devos
2021-07-05 15:41   ` [bug#49548] [PATCH v2 3/4] home-services: Add home-provenance-service-type Andrew Tropin
2021-07-05 15:41   ` [bug#49549] [PATCH v2 4/4] home-services: Add fold-home-service-types function Andrew Tropin
2021-07-15  9:59   ` [bug#49568] Testing reply without debbugs address Andrew Tropin
2021-07-19  8:04 ` [bug#49419] [PATCH v3 0/4] Essential home services Andrew Tropin
2021-07-05 15:37   ` [bug#49419] [PATCH v3 1/4] home-services: Add most essential " Andrew Tropin
2021-07-05 15:39   ` Andrew Tropin [this message]
2021-07-05 15:41   ` [bug#49419] [PATCH v3 3/4] home-services: Add home-provenance-service-type Andrew Tropin
2021-07-05 15:41   ` [bug#49419] [PATCH v3 4/4] home-services: Add fold-home-service-types function Andrew Tropin
2021-07-21 15:08   ` [bug#49419] [PATCH 0/4] Essential home services Ludovic Courtès
2021-07-28  5:35     ` Andrew Tropin
     [not found] ` <handler.49419.B.162549932625345.ack@debbugs.gnu.org>
2021-08-05  5:41   ` [bug#49419] [PATCH v4 " Andrew Tropin
2021-08-05  5:45     ` [bug#49419] [PATCH v4 1/4] home-services: Add most essential " Andrew Tropin
2021-08-05  5:46     ` [bug#49419] [PATCH v4 2/4] home-services: Add home-run-on-change-service-type Andrew Tropin
2021-08-05  5:46     ` [bug#49419] [PATCH v4 3/4] home-services: Add home-provenance-service-type Andrew Tropin
2021-08-05  5:47     ` [bug#49419] [PATCH v4 4/4] home-services: Add fold-home-service-types function Andrew Tropin
2021-08-23  9:57     ` [bug#49419] [PATCH v4 0/4] Essential home services Andrew Tropin
2021-08-23 16:24       ` [bug#49419] [PATCH " Oleg Pykhalov
2021-08-24  8:53         ` Andrew Tropin
2021-08-24 12:14           ` bug#49419: " Oleg Pykhalov
2021-08-26  7:01             ` [bug#49419] " Andrew Tropin

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87sg0ag19m.fsf@trop.in \
    --to=andrew@trop.in \
    --cc=49419@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).