blob: 42371403bdf15bdf512277b49e4a8c4e661c452d (
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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
;; zabbix.scm --- Monitor Guix in Zabbix.
;; Copyright © 2019 Oleg Pykhalov <go.wigust@gmail.com>
;; Released under the GNU GPLv3 or any later version.
(define-module (zabbix)
#:use-module (guix channels)
#:use-module (guix describe)
#:use-module (guix profiles)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim)
#:use-module (json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-37))
(define (git . args)
"Execute 'git ARGS ...' command and return its output without trailing
newspace."
(let* ((port (apply open-pipe* OPEN_READ "git" args))
(output (read-string port)))
(close-port port)
(string-trim-right output #\newline)))
(define (remote-channels channels)
(map (lambda (c)
(match (string-split (git "ls-remote" (channel-url c)
(string-append "*/" (channel-branch c)))
#\tab)
((commit ref)
(channel (name (channel-name c))
(url (channel-url c))
(commit commit)
(branch (channel-branch c))
(location #f)))))
(eval (begin (use-modules (guix channels))
(with-input-from-file channels read))
(current-module))))
(define (channels profile)
(define number
(generation-number profile))
(map (lambda (entry)
(match (assq 'source (manifest-entry-properties entry))
(('source ('repository ('version 0)
('url url)
('branch branch)
('commit commit)
_ ...))
(channel (name (string->symbol (manifest-entry-name entry)))
(url url)
(commit commit)
(location #f)))
;; Pre-0.15.0 Guix does not provide that information,
;; so there's not much we can do in that case.
(_ (channel (name 'guix)
(url "?")
(commit "?")))))
;; Show most recently installed packages last.
(reverse
(manifest-entries
(profile-manifest
(if (zero? number)
profile
(generation-file-name profile number)))))))
(define %options
(let ((display-and-exit-proc (lambda (msg)
(lambda (opt name arg loads)
(display msg) (quit)))))
(list (option '(#\v "version") #f #f
(display-and-exit-proc "Guiz version 0.0.1\n"))
(option '(#\h "help") #f #f
(display-and-exit-proc
"Usage: foo scheme-file ..."))
(option '(#\A "available") #f #t
(lambda (opt name arg loads)
(cons `(query list-available ,(or arg ""))
loads)))
(option '(#\d "diff") #t #f
(lambda (opt name arg loads)
(cons `(query diff ,(or arg ""))
loads)))
(option '(#\p "profile") #t #f
(lambda (opt name arg loads)
(alist-cons 'profile (canonicalize-profile arg)
loads)))
(option '(#\r "remote") #t #f
(lambda (opt name arg loads)
(alist-cons 'remote arg loads))))))
(define %default-options
'())
(define (main args)
(define opts
(args-fold (cdr (program-arguments))
%options
(lambda (opt name arg loads)
(error "Unrecognized option `~A'" name))
(lambda (op loads)
(cons op loads))
%default-options))
(define (find-channel-name name channels)
(fold (lambda (x xs)
(if (string=? (symbol->string (channel-name x)) name)
(cons x xs)
xs))
'()
channels))
(define remote (or (assq-ref opts 'remote)
(string-append (getenv "HOME") "/.config/guix/channels.scm")))
(define profile (or (assq-ref opts 'profile) (current-profile)))
(match (assoc-ref opts 'query)
(('list-available name)
(scm->json
`((data ,@(map (lambda (local remote)
`(("{#REMOTE_NAME}" . ,(channel-name remote))
("{#REMOTE_URL}" . ,(channel-url remote))
("{#REMOTE_COMMIT}" . ,(channel-commit remote))
("{#LOCAL_NAME}" . ,(channel-name local))
("{#LOCAL_URL}" . ,(channel-url local))
("{#LOCAL_COMMIT}" . ,(channel-commit local))))
(channels profile)
(remote-channels remote))))))
(('diff name)
(map (lambda (local remote)
(if (string=? name (symbol->string (channel-name local)))
(begin (display 0) (exit 1))
(begin (display 1) (exit 0))))
(channels profile)
(remote-channels remote)))))
|
