guix-home-manager/home/utils.scm

utils.scm

1
;;; Guix Home Manager.
2
;;;
3
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
4
;;;
5
;;; This program is free software: you can redistribute it and/or modify
6
;;; it under the terms of the GNU General Public License as published by
7
;;; the Free Software Foundation, either version 3 of the License, or
8
;;; (at your option) any later version.
9
;;;
10
;;; This program is distributed in the hope that it will be useful,
11
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13
;;; GNU General Public License for more details.
14
;;;
15
;;; You should have received a copy of the GNU General Public License
16
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
17
18
(define-module (home utils)
19
  #:use-module (guix build utils)
20
  #:use-module (guix gexp)
21
  #:use-module (ice-9 match)
22
  #:use-module (home)
23
  #:export (simple-file-home
24
            symlink-file-home
25
            make-ini-file))
26
27
(define (simple-file-home file-gexp location)
28
  (user-home
29
    (home-type
30
      (name 'simple-file)
31
      (extensions
32
        (list
33
          (home-extension
34
            (target root-home-type)
35
            (compute
36
              (const `((,location ,file-gexp))))))))
37
    #t))
38
39
(define (symlink-file-home to from)
40
  "Create a symlink from the user home at @var{from} that points to @var{to}."
41
  (user-home
42
    (home-type
43
      (name 'symlink-file)
44
      (extensions
45
        (list
46
          (home-extension
47
            (target root-home-type)
48
            (compute
49
              (const `((,from ,to))))))))
50
    #t))
51
52
(define (make-ini-file name config)
53
  (define (make-ini-section name config)
54
    (string-append "[" name "]\n"
55
                   (string-join
56
                     (map (lambda (conf)
57
                            (match conf
58
                              ((key value)
59
                               (string-append key "="
60
                                              (match value
61
                                                ((? string? val) val)
62
                                                ((? number? val) (number->string val))
63
                                                (#t "true")
64
                                                (#f "false"))))))
65
                          config)
66
                     "\n")))
67
  (plain-file name
68
    (string-join (map (lambda (section)
69
                        (match section
70
                          ((name content)
71
                           (make-ini-section name content))))
72
                        config) "\n\n")))
73