guix.scm: Update.HEADmaster

* guix.scm: Update.

1 files changed, 95 insertions, 100 deletions

diff --git a/guix.scm b/guix.scm
index 058dde4..26dd74c 100644
--- a/guix.scm
+++ b/guix.scm
@@ -1,20 +1,5 @@
-;;; GNU Guix --- Functional package management for GNU
+;;; GNU Guix --- Check load average on a remote computer via SSH.
 ;;; Copyright © Oleg Pykhalov <go.wigust@gmail.com>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (use-modules ((guix licenses) #:prefix license:)
              (gnu packages autotools)
@@ -34,90 +19,100 @@
              (ice-9 popen)
              (ice-9 rdelim))
 
-(define-public guile-loadavg
-  (let ((source-dir (string-append (getenv "HOME")
-                                   "/src/guile-loadavg")))
-    (package
-      (home-page "https://gitlab.com/wigust/guile-loadavg/")
-      (name "guile-loadavg")
-      (version (string-append "0.0.1"))
-      (source (local-file source-dir
-                          #:recursive? #t
-                          #:select? (git-predicate source-dir)))
-      (build-system gnu-build-system)
-      (arguments
-       `(#:tests? #f
-         #:modules ((guix build gnu-build-system)
-                    (guix build utils)
-                    (srfi srfi-26)
-                    (ice-9 popen)
-                    (ice-9 rdelim))
-          #:phases
-         (modify-phases %standard-phases
-           (add-after 'install 'wrap-program
-             (lambda* (#:key inputs outputs #:allow-other-keys)
-               (let* ((out    (assoc-ref outputs "out"))
-                      (guile  (assoc-ref inputs "guile"))
-                      (gcrypt (assoc-ref inputs "guile-gcrypt"))
-                      (gnutls (assoc-ref inputs "gnutls"))
-                      (guix   (assoc-ref inputs "guix"))
-                      (ssh    (assoc-ref inputs "guile-ssh"))
-                      (deps   (list gcrypt gnutls guix ssh out))
-                      (effective
-                       (read-line
-                        (open-pipe* OPEN_READ
-                                    (string-append guile "/bin/guile")
-                                    "-c" "(display (effective-version))")))
-                      (path   (string-join
-                               (map (cut string-append <>
-                                         "/share/guile/site/"
-                                         effective)
-                                    deps)
-                               ":"))
-                      (gopath (string-join
-                               (map (cut string-append <>
-                                         "/lib/guile/" effective
-                                         "/site-ccache")
-                                    deps)
-                               ":")))
+(define %source-dir (dirname (current-filename)))
 
-                 (wrap-program (string-append out "/bin/loadavg")
-                   `("GUILE_LOAD_PATH" ":" prefix (,path))
-                   `("GUILE_LOAD_COMPILED_PATH" ":" prefix (,gopath)))
+(define (git-output . args)
+  "Execute 'git ARGS ...' command and return its output without trailing
+newspace."
+  (with-directory-excursion %source-dir
+    (let* ((port   (apply open-pipe* OPEN_READ "git" args))
+           (output (read-string port)))
+      (close-port port)
+      (string-trim-right output #\newline))))
 
-                 #t)
-               (let* ((guile  (assoc-ref inputs "guile"))
-                      (effective
-                       (read-line
-                        (open-pipe* OPEN_READ
-                                    (string-append guile "/bin/guile")
-                                    "-c" "(display (effective-version))")))
-                      (path (cut string-append <>
-                                 "/share/guile/site/"
-                                 effective
-                                 "/loadavg")))
-                 (with-directory-excursion "loadavg"
-                   (copy-file "config.scm.in" "config.scm")
-                   (substitute* "config.scm"
-                     (("@PACKAGE_NAME@") ,name)
-                     (("@PACKAGE_VERSION@") ,version)
-                     (("@PACKAGE_URL@") ,home-page))
-                   (install-file "config.scm"
-                                 (path (assoc-ref outputs "out"))))
-                 #t))))))
-      (native-inputs
-       `(("autoconf" ,autoconf)
-         ("automake" ,automake)
-         ("pkg-config" ,pkg-config)))
-      (inputs
-       `(("gnutls" ,gnutls)
-         ("guile" ,guile-2.2)
-         ("guile-gcrypt" ,guile-gcrypt)
-         ("guile-ssh" ,guile-ssh)
-         ("guix" ,guix)))
-      (synopsis "Guile interface to Linux loadavg")
-      (description
-       "This package provides a Guile interface to Linux loadavg")
-      (license license:gpl3+))))
+(define (current-commit)
+  (git-output "log" "-n" "1" "--pretty=format:%H"))
 
-guile-loadavg
+(let ((commit (current-commit)))
+  (package
+    (home-page "https://gitlab.com/wigust/guile-loadavg/")
+    (name "guile-loadavg")
+    (version (string-append "0.0.1" "-" (string-take commit 7)))
+    (source (local-file %source-dir
+                        #:recursive? #t
+                        #:select? (git-predicate %source-dir)))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f
+                #:modules ((guix build gnu-build-system)
+                           (guix build utils)
+                           (srfi srfi-26)
+                           (ice-9 popen)
+                           (ice-9 rdelim))
+                #:phases
+                (modify-phases %standard-phases
+                  (add-after 'install 'wrap-program
+                    (lambda* (#:key inputs outputs #:allow-other-keys)
+                      (let* ((out    (assoc-ref outputs "out"))
+                             (guile  (assoc-ref inputs "guile"))
+                             (gcrypt (assoc-ref inputs "guile-gcrypt"))
+                             (gnutls (assoc-ref inputs "gnutls"))
+                             (guix   (assoc-ref inputs "guix"))
+                             (ssh    (assoc-ref inputs "guile-ssh"))
+                             (deps   (list gcrypt gnutls guix ssh out))
+                             (effective
+                              (read-line
+                               (open-pipe* OPEN_READ
+                                           (string-append guile "/bin/guile")
+                                           "-c" "(display (effective-version))")))
+                             (path   (string-join
+                                      (map (cut string-append <>
+                                                "/share/guile/site/"
+                                                effective)
+                                           deps)
+                                      ":"))
+                             (gopath (string-join
+                                      (map (cut string-append <>
+                                                "/lib/guile/" effective
+                                                "/site-ccache")
+                                           deps)
+                                      ":")))
+
+                        (wrap-program (string-append out "/bin/loadavg")
+                          `("GUILE_LOAD_PATH" ":" prefix (,path))
+                          `("GUILE_LOAD_COMPILED_PATH" ":" prefix (,gopath)))
+
+                        #t)
+                      (let* ((guile  (assoc-ref inputs "guile"))
+                             (effective
+                              (read-line
+                               (open-pipe* OPEN_READ
+                                           (string-append guile "/bin/guile")
+                                           "-c" "(display (effective-version))")))
+                             (path (cut string-append <>
+                                        "/share/guile/site/"
+                                        effective
+                                        "/loadavg")))
+                        (with-directory-excursion "loadavg"
+                          (copy-file "config.scm.in" "config.scm")
+                          (substitute* "config.scm"
+                            (("@PACKAGE_NAME@") ,name)
+                            (("@PACKAGE_VERSION@") ,version)
+                            (("@PACKAGE_URL@") ,home-page))
+                          (install-file "config.scm"
+                                        (path (assoc-ref outputs "out"))))
+                        #t))))))
+    (native-inputs
+     `(("autoconf" ,autoconf)
+       ("automake" ,automake)
+       ("pkg-config" ,pkg-config)))
+    (inputs
+     `(("gnutls" ,gnutls)
+       ("guile" ,guile-2.2)
+       ("guile-gcrypt" ,guile-gcrypt)
+       ("guile-ssh" ,guile-ssh)
+       ("guix" ,guix)))
+    (synopsis "Guile interface to Linux loadavg")
+    (description
+     "This package provides a Guile interface to Linux loadavg")
+    (license license:gpl3+)))