[bug#65119] [PATCH 6/8] home: services: mcron: Define as a mapping of the system service.

[Andrew Tropin <andrew@trop.in>]

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

On 2023-08-06 23:07, Ludovic Courtès wrote:

> * 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")

It seems that (modules `((shepherd support))) is missing for this line
to work.

> +                     "/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

-- 
Best regards,
Andrew Tropin

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