summaryrefslogtreecommitdiff
path: root/suweren/update.scm
blob: 84baee50bbce2a61fabfe218852a8d80d14d1fbf (about) (plain)
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 (suweren update)
  ;; home-bash-extension
  ;; home-bash-service-type
  #:use-module (gnu home services shells)

  ;; simple-service
  #:use-module (gnu services))

;; string
(define delete-garbage
  "sudo guix gc -d 7d")

;; string
(define delete-home-generations
  "guix home delete-generations -d 7d")

;; string
(define delete-system-generations
  "sudo guix system delete-generations -d 7d")

;; string
(define guile-load-path
  "GUILE_LOAD_PATH='$HOME/Szablony/distribution:$HOME/Szablony/deployment'")

;; string
(define pull-guix
  "guix pull")

;; string
(define collect-garbage
  (string-append delete-home-generations
		 " ; "
		 delete-system-generations
		 " ; "
		 delete-garbage))

;; string ->
;; string
(define (system-definition host-name*)
  (string-append "'(@ (systems "
		 host-name*
		 ") operating-system*)'"))

;; string ->
;; string
(define (reconfigure-system system-definition*)
  (string-append "sudo guix system reconfigure -e "
		 system-definition*))

;; string ->
;; string
(define (test-update reconfigure-system*)
  (string-append guile-load-path
		 " "
		 reconfigure-system*))

;; string ->
;; string
(define (update-system reconfigure-system*)
  (string-append pull-guix
		 " ; "
		 reconfigure-system*
		 " ; "
		 collect-garbage))

;; string ->
;; string ->
;; string ->
;; alist
(define (aliases reconfigure-system*
		 test-update*
		 update-system*)
  `(("collect-garbage" . ,collect-garbage)
    ("pull-guix" . ,pull-guix)
    ("reconfigure-system" . ,reconfigure-system*)
    ("test-system" . ,test-update*)
    ("update-system" . ,update-system*)))

;; string ->
;; record service
(define-public (update-commands host-name*)
  (let* ((system-definition* (system-definition host-name*))
	 (reconfigure-system* (reconfigure-system system-definition*))
	 (test-update* (test-update reconfigure-system*))
	 (update-system* (update-system reconfigure-system*))
	 (aliases* (aliases reconfigure-system*
			    test-update*
			    update-system*))
	 (service-extension* (home-bash-extension (aliases aliases*))))
    (simple-service 'update-commands
		    home-bash-service-type
		    service-extension*)))