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
  #:export (simple-file-home
23
            symlink-file-home
24
            make-ini-file))
25
26
(define (simple-file-home file-gexp location)
27
  "Add @var{file-gexp}, a file-like object, to the user home at @var{location}."
28
  (computed-file "simple-file-home"
29
    #~(begin
30
        (use-modules (guix build utils))
31
        (mkdir-p (string-append #$output "/" #$(dirname location)))
32
        (copy-file #$file-gexp (string-append #$output "/" #$location)))
33
    #:options
34
    '(#:local-build? #t
35
      #:modules ((guix build utils)))))
36
37
(define (symlink-file-home from to)
38
  "Create a symlink from the user home at @var{from} that points to @var{to}."
39
  (computed-file "symlink-file-home"
40
    #~(begin
41
        (use-modules (guix build utils))
42
        (mkdir-p (string-append #$output "/" #$(dirname to)))
43
        (symlink #$from (string-append #$output "/" #$to)))
44
    #:options
45
    '(#:local-build? #t
46
      #:modules ((guix build utils)))))
47
48
(define (make-ini-file name config)
49
  (define (make-ini-section name config)
50
    (string-append "[" name "]\n"
51
                   (string-join
52
                     (map (lambda (conf)
53
                            (match conf
54
                              ((key value)
55
                               (string-append key "="
56
                                              (match value
57
                                                ((? string? val) val)
58
                                                ((? number? val) (number->string val))
59
                                                (#t "true")
60
                                                (#f "false"))))))
61
                          config)
62
                     "\n")))
63
  (plain-file name
64
    (string-join (map (lambda (section)
65
                        (match section
66
                          ((name content)
67
                           (make-ini-section name content))))
68
                        config) "\n\n")))
69