~michal_atlas/guix-channel (master): atlas/utils/services.scm - sourcehut git


                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92

(define-module (atlas utils services)
  #:use-module (gnu services)
  #:use-module (ice-9 control)
  #:use-module (ice-9 ftw)
  #:use-module (srfi srfi-171)

  #:export (&s +s))

(define (name->typename ctx name)
  (datum->syntax ctx (symbol-append
                      (syntax->datum name)
                      '-service-type)))
(define (name->configname ctx name)
  (datum->syntax ctx (symbol-append
                      (syntax->datum name)
                      '-configuration)))

(define-syntax &s
  (lambda (x)
    "Takes a name and
configuration body and yields a valid
guix service expression:

@lisp
(&s hurd-vm
  (disk-size 20)
  (memory-size 2048))
@end lisp

transforms into

@lisp
(service hurd-vm-service-type
  (hurd-vm-configuration
    (disk-size 20)
    (memory-size 2048)))
@end lisp

if you with to pass the body as-is, then
pass #:config before it:

@lisp
(&s pam-limits #:config
  (list (pam-limits-entry \"*\" 'both 'nofile 524288)))
@end lisp

simple outputs

@lisp
(service pam-limits-service-type
  (list (pam-limits-entry \"*\" 'both 'nofile 524288)))
@end lisp"
    (syntax-case x ()
      [(_ name)
       (with-syntax ([service-type (name->typename x #'name)])
         #'(service service-type))]
      [(_ name #:config config)
       (with-syntax
           ([service-type (name->typename x #'name)])
         #'(service service-type
                    config))]
      [(_ name config ...)
       (with-syntax
           ([service-type (name->typename x #'name)]
            [configuration (name->configname x #'name)])
         #'(service service-type
                    (configuration
                     config ...)))])))

(define-syntax +s
  (lambda (x)
    "Similar to &s,
but doesn't wrap in a configuration struct,
and declares a simple-service:

@lisp
(+s hosts example-host
  (list (host \"127.10.1.0\" \"example.local\")))
@end lisp

expands to

@lisp
(simple-service 'example-host hosts-service-type
  (list (host \"127.10.1.0\" \"example.local\")))
@end lisp"
    (syntax-case x ()
      [(_ name extension-name config)
       (with-syntax ([service-type (name->typename x #'name)])
         #'(simple-service 'extension-name
                           service-type
                           config))])))