all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 65119@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#65119] [PATCH 6/8] home: services: mcron: Define as a mapping of the system service.
Date: Sun,  6 Aug 2023 23:07:33 +0200	[thread overview]
Message-ID: <319a7664fdf2b910f4183ce3c748234a8763e107.1691355218.git.ludo@gnu.org> (raw)
In-Reply-To: <cover.1691355218.git.ludo@gnu.org>

* gnu/services/mcron.scm (list-of-gexps?): Remove.
(<mcron-configuration>): Rewrite using 'define-record-type*'.
[home-service?]: New field.
[log-file]: Make thunked and changed default value.
(mcron-shepherd-services): Honor 'home-service?' and remove use of
'maybe-value-set?'.
(mcron-service-type): Inherit 'home-service?' from CONFIG.
(generate-doc): Remove.
* gnu/home/services/mcron.scm (list-of-gexp?)
(<home-mcron-configuration>, job-files, shepherd-schedule-action)
(home-mcron-shepherd-services, home-mcron-profile)
(home-mcron-extend, generate-doc): Remove.
(home-mcron-configuration): Turn into a macro.
(home-mcron-service-type): Define in terms of
'system->home-service-type'.
<top level>: Add service type mapping.
---
 gnu/home/services/mcron.scm | 96 ++++---------------------------------
 gnu/services/mcron.scm      | 80 ++++++++++++++-----------------
 2 files changed, 45 insertions(+), 131 deletions(-)

diff --git a/gnu/home/services/mcron.scm b/gnu/home/services/mcron.scm
index f51edd6634..23be44ba07 100644
--- a/gnu/home/services/mcron.scm
+++ b/gnu/home/services/mcron.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2021, 2023 Andrew Tropin <andrew@trop.in>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,16 +20,9 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu home services mcron)
-  #:use-module (gnu packages guile-xyz)
   #:use-module (gnu home services)
-  #:use-module (gnu services configuration)
-  #:use-module (gnu services shepherd)
   #:use-module (gnu home services shepherd)
-  #:use-module (guix records)
-  #:use-module (guix gexp)
-  #:use-module (srfi srfi-1)
-  #:use-module (ice-9 match)
-
+  #:use-module (gnu services mcron)               ;for the service mapping
   #:export (home-mcron-configuration
             home-mcron-service-type))
 
@@ -55,86 +49,16 @@ (define-module (gnu home services mcron)
 ;;
 ;;; Code:
 
-(define list-of-gexps?
-  (list-of gexp?))
-
-(define-configuration/no-serialization home-mcron-configuration
-  (mcron (file-like mcron) "The mcron package to use.")
-  (jobs
-   (list-of-gexps '())
-   "This is a list of gexps (@pxref{G-Expressions}), where each gexp
-corresponds to an mcron job specification (@pxref{Syntax, mcron job
-specifications,, mcron, GNU@tie{}mcron}).")
-  (log? (boolean #t) "Log messages to standard output.")
-  (log-format
-   (string "~1@*~a ~a: ~a~%")
-   "@code{(ice-9 format)} format string for log messages.  The default value
-produces messages like \"@samp{@var{pid} @var{name}:
-@var{message}\"} (@pxref{Invoking mcron, Invoking,, mcron, GNU@tie{}mcron}).
-Each message is also prefixed by a timestamp by GNU Shepherd."))
-
-(define job-files (@@ (gnu services mcron) job-files))
-(define shepherd-schedule-action
-  (@@ (gnu services mcron) shepherd-schedule-action))
-
-(define (home-mcron-shepherd-services config)
-  (match-record config <home-mcron-configuration>
-    (mcron jobs log? log-format)
-    (if (null? jobs)
-        '()                                       ;no jobs to run
-        (let ((files (job-files mcron jobs)))
-          (list (shepherd-service
-                 (documentation "User cron jobs.")
-                 (provision '(mcron))
-                 (modules `((srfi srfi-1)
-                            (srfi srfi-26)
-                            (ice-9 popen)         ;for the 'schedule' action
-                            (ice-9 rdelim)
-                            (ice-9 match)
-                            ,@%default-modules))
-                 (start #~(make-forkexec-constructor
-                           (list (string-append #$mcron "/bin/mcron")
-                                 #$@(if log?
-                                        #~("--log" "--log-format" #$log-format)
-                                        #~())
-                                 #$@files)
-                           #:log-file (string-append
-                                       (or (getenv "XDG_STATE_HOME")
-                                           (format #f "~a/.local/state"
-                                                   (getenv "HOME")))
-                                       "/log/mcron.log")))
-                 (stop #~(make-kill-destructor))
-                 (actions
-                  (list (shepherd-schedule-action mcron files)))))))))
-
-(define home-mcron-profile (compose list home-mcron-configuration-mcron))
-
-(define (home-mcron-extend config jobs)
-  (home-mcron-configuration
-   (inherit config)
-   (jobs (append (home-mcron-configuration-jobs config)
-                 jobs))))
+(define-syntax-rule (home-mcron-configuration fields ...)
+  ;; Macro provided for backward compatibility.
+  (for-home (mcron-configuration fields ...)))
 
 (define home-mcron-service-type
-  (service-type (name 'home-mcron)
-                (extensions
-                 (list (service-extension
-                        home-shepherd-service-type
-                        home-mcron-shepherd-services)
-                       (service-extension
-                        home-profile-service-type
-                        home-mcron-profile)))
-                (compose concatenate)
-                (extend home-mcron-extend)
-                (default-value (home-mcron-configuration))
-                (description
-                 "Install and configure the GNU mcron cron job manager.")))
+  (service-type
+   (inherit (system->home-service-type mcron-service-type))
+   (default-value (for-home (mcron-configuration)))))
 
-\f
-;;;
-;;; Generate documentation.
-;;;
-(define (generate-doc)
-  (configuration->documentation 'home-mcron-configuration))
+(define-service-type-mapping
+  mcron-service-type => home-mcron-service-type)
 
 ;;; mcron.scm ends here
diff --git a/gnu/services/mcron.scm b/gnu/services/mcron.scm
index 2ef5980e09..db8b539ff5 100644
--- a/gnu/services/mcron.scm
+++ b/gnu/services/mcron.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2020, 2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
 ;;;
@@ -20,10 +20,8 @@
 
 (define-module (gnu services mcron)
   #:use-module (gnu services)
-  #:use-module (gnu services configuration)
   #:use-module (gnu services shepherd)
   #:use-module (gnu packages guile-xyz)
-  #:use-module (guix deprecation)
   #:use-module (guix records)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
@@ -37,6 +35,7 @@ (define-module (gnu services mcron)
             mcron-configuration-log-file
             mcron-configuration-log-format
             mcron-configuration-date-format
+            mcron-configuration-home-service?
 
             mcron-service-type))
 
@@ -55,40 +54,34 @@ (define-module (gnu services mcron)
 ;;;
 ;;; Code:
 
-(define list-of-gexps?
-  (list-of gexp?))
+;; Configuration of mcron.
+;; XXX: 'define-configuration' cannot be used here due to the need for
+;; 'thunked' and 'innate' fields as well as 'this-mcron-configuration'.
+(define-record-type* <mcron-configuration> mcron-configuration
+  make-mcron-configuration
+  mcron-configuration?
+  this-mcron-configuration
 
-(define-maybe/no-serialization string)
+  (mcron       mcron-configuration-mcron          ;file-like
+               (default mcron))
+  (jobs        mcron-configuration-jobs           ;list of gexps
+               (default '()))
+  (log?        mcron-configuration-log?           ;Boolean
+               (default #t))
+  (log-file    mcron-configuration-log-file       ;string | gexp
+               (thunked)
+               (default
+                 (if (mcron-configuration-home-service?
+                      this-mcron-configuration)
+                     #~(string-append %user-log-dir "/mcron.log")
+                     "/var/log/mcron.log")))
+  (log-format  mcron-configuration-log-format     ;string
+               (default "~1@*~a ~a: ~a~%"))
+  (date-format mcron-configuration-date-format    ;string | #f
+               (default #f))
 
-(define-configuration/no-serialization mcron-configuration
-  (mcron
-   (file-like mcron)
-   "The mcron package to use.")
-
-  (jobs
-   (list-of-gexps '())
-   "This is a list of gexps (@pxref{G-Expressions}), where each gexp
-corresponds to an mcron job specification (@pxref{Syntax, mcron job
-specifications,, mcron, GNU@tie{}mcron}).")
-
-  (log?
-   (boolean #t)
-   "Log messages to standard output.")
-
-  (log-file
-   (string "/var/log/mcron.log")
-   "Log file location.")
-
-  (log-format
-   (string "~1@*~a ~a: ~a~%")
-   "@code{(ice-9 format)} format string for log messages.  The default value
-produces messages like @samp{@var{pid} @var{name}: @var{message}}
-(@pxref{Invoking mcron, Invoking,, mcron, GNU@tie{}mcron}).
-Each message is also prefixed by a timestamp by GNU Shepherd.")
-
-  (date-format
-   maybe-string
-   "@code{(srfi srfi-19)} format string for date."))
+  (home-service? mcron-configuration-home-service?
+                 (default for-home?) (innate)))
 
 (define (job-files mcron jobs)
   "Return a list of file-like object for JOBS, a list of gexps."
@@ -158,13 +151,15 @@ (define (shepherd-schedule-action mcron files)
 
 (define (mcron-shepherd-services config)
   (match-record config <mcron-configuration>
-    (mcron jobs log? log-file log-format date-format)
+    (mcron jobs log? log-file log-format date-format home-service?)
     (if (eq? jobs '())
         '()                             ;nothing to do
         (let ((files (job-files mcron jobs)))
           (list (shepherd-service
                  (provision '(mcron))
-                 (requirement '(user-processes))
+                 (requirement (if home-service?
+                                  '()
+                                  '(user-processes)))
                  (modules `((srfi srfi-1)
                             (srfi srfi-26)
                             (ice-9 popen) ;for the 'schedule' action
@@ -175,7 +170,7 @@ (define (mcron-shepherd-services config)
                            (list #$(file-append mcron "/bin/mcron")
                                  #$@(if log?
                                         `("--log" "--log-format" ,log-format
-                                          ,@(if (maybe-value-set? date-format)
+                                          ,@(if date-format
                                                 (list "--date-format"
                                                       date-format)
                                                 '()))
@@ -209,15 +204,10 @@ (define mcron-service-type
                 (extend (lambda (config jobs)
                           (mcron-configuration
                            (inherit config)
+                           (home-service?
+                            (mcron-configuration-home-service? config))
                            (jobs (append (mcron-configuration-jobs config)
                                          jobs)))))
                 (default-value (mcron-configuration)))) ;empty job list
 
-\f
-;;;
-;;; Generate documentation.
-;;;
-(define (generate-doc)
-  (configuration->documentation 'mcron-configuration))
-
 ;;; mcron.scm ends here
-- 
2.41.0





  parent reply	other threads:[~2023-08-06 21:09 UTC|newest]

Thread overview: 25+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-08-06 21:04 [bug#65119] [PATCH 0/8] Sharing service code between Home and System Ludovic Courtès
2023-08-06 21:07 ` [bug#65119] [PATCH 1/8] services: dicod: Remove Shepherd < 0.9.0 compatibility layer Ludovic Courtès
2023-08-06 21:07 ` [bug#65119] [PATCH 2/8] services: dicod: Pre-build the GCIDE index Ludovic Courtès
2023-08-06 21:07 ` [bug#65119] [PATCH 3/8] services: syncthing: Use 'match-record' Ludovic Courtès
2023-08-06 21:07 ` [bug#65119] [PATCH 4/8] services: Define 'for-home' Ludovic Courtès
2023-08-06 21:07 ` [bug#65119] [PATCH 5/8] home: services: Support mapping of System services to Home services Ludovic Courtès
2023-08-06 21:07 ` Ludovic Courtès [this message]
2023-08-21 15:50   ` [bug#65119] [PATCH 6/8] home: services: mcron: Define as a mapping of the system service Andrew Tropin
2023-08-06 21:07 ` [bug#65119] [PATCH 7/8] home: services: Add dicod Ludovic Courtès
2023-08-06 21:07 ` [bug#65119] [PATCH 8/8] home: services: Add Syncthing Ludovic Courtès
2023-08-13  5:28 ` [bug#65119] [PATCH 0/8] Sharing service code between Home and System 宋文武 via Guix-patches via
2023-08-20 21:23   ` bug#65119: " Ludovic Courtès
2023-08-21 13:43   ` [bug#65119] " Andrew Tropin
2023-08-22 16:25     ` Ludovic Courtès
2023-08-25  6:28       ` Andrew Tropin
2023-09-08 12:42         ` Andrew Tropin
2023-09-08 22:18         ` Ludovic Courtès
2023-09-09 10:42           ` Andrew Tropin
2023-09-13 18:06             ` Ludovic Courtès
2023-09-17  5:28               ` Andrew Tropin
2023-09-17 10:27                 ` Ludovic Courtès
2023-09-13 19:55             ` Ludovic Courtès
2023-09-17  7:01               ` Andrew Tropin
2023-10-13 16:05                 ` Ludovic Courtès
2023-10-14  6:03                   ` 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

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

  git send-email \
    --in-reply-to=319a7664fdf2b910f4183ce3c748234a8763e107.1691355218.git.ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=65119@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 external index

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

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.