me/guix
Archived
1
0
Fork 0
Code Activity

gnu: ganeti: Adjust code style.

Browse source 
* gnu/packages/virtualization.scm (ganeti)[arguments]: Remove trailing #t's.
Add syntactic sugar using primitives from SRFI-1, SRFI-26, and (ice-9 match).
This commit is contained in:
Marius Bakke 2021-10-12 00:20:57 +02:00
parent 6214743aa8
commit 89ea3ab220
No known key found for this signature in database
GPG key ID: A2A06DF2A33A54FA
1 changed files with 22 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
gnu/packages/virtualization.scm
View file

@ -511,8 +511,6 @@ firmware blobs. You can
(define-public ganeti (define-public ganeti
(package (package
(name "ganeti") (name "ganeti")
;; Note: we use a pre-release for Python 3 compatibility as well as many
;; other fixes.
(version "3.0.1") (version "3.0.1")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
@ -536,6 +534,9 @@ firmware blobs. You can
#:modules (,@%gnu-build-system-modules #:modules (,@%gnu-build-system-modules
((guix build haskell-build-system) #:prefix haskell:) ((guix build haskell-build-system) #:prefix haskell:)
((guix build python-build-system) #:select (python-version)) ((guix build python-build-system) #:select (python-version))
(srfi srfi-1)
(srfi srfi-26)
(ice-9 match)
(ice-9 rdelim)) (ice-9 rdelim))
;; The default test target includes a lot of checks that are only really ;; The default test target includes a lot of checks that are only really
@ -590,8 +591,7 @@ firmware blobs. You can
(unless (file-exists? "vcs-version") (unless (file-exists? "vcs-version")
(call-with-output-file "vcs-version" (call-with-output-file "vcs-version"
(lambda (port) (lambda (port)
(format port "v~a~%" ,version)))) (format port "v~a~%" ,version))))))
#t))
(add-after 'unpack 'patch-absolute-file-names (add-after 'unpack 'patch-absolute-file-names
(lambda _ (lambda _
(substitute* '("lib/utils/process.py" (substitute* '("lib/utils/process.py"
@ -617,8 +617,7 @@ firmware blobs. You can
(("ndisc6") (which "ndisc6")) (("ndisc6") (which "ndisc6"))
(("fping") (which "fping")) (("fping") (which "fping"))
(("grep") (which "grep")) (("grep") (which "grep"))
(("ip addr") (string-append (which "ip") " addr"))) (("ip addr") (string-append (which "ip") " addr")))))
#t))
(add-after 'unpack 'override-builtin-PATH (add-after 'unpack 'override-builtin-PATH
(lambda _ (lambda _
;; Ganeti runs OS install scripts and similar with a built-in ;; Ganeti runs OS install scripts and similar with a built-in
@ -626,8 +625,7 @@ firmware blobs. You can
(substitute* "src/Ganeti/Constants.hs" (substitute* "src/Ganeti/Constants.hs"
(("/sbin:/bin:/usr/sbin:/usr/bin") (("/sbin:/bin:/usr/sbin:/usr/bin")
"/run/setuid-programs:/run/current-system/profile/sbin:\ "/run/setuid-programs:/run/current-system/profile/sbin:\
/run/current-system/profile/bin")) /run/current-system/profile/bin"))))
#t))
(add-after 'bootstrap 'patch-sphinx-version-detection (add-after 'bootstrap 'patch-sphinx-version-detection
(lambda _ (lambda _
;; The build system runs 'sphinx-build --version' to verify that ;; The build system runs 'sphinx-build --version' to verify that
@ -635,8 +633,7 @@ firmware blobs. You can
;; .sphinx-build-real executable name created by the Sphinx wrapper. ;; .sphinx-build-real executable name created by the Sphinx wrapper.
(substitute* "configure" (substitute* "configure"
(("\\$SPHINX --version 2>&1") (("\\$SPHINX --version 2>&1")
"$SPHINX --version 2>&1 | sed 's/.sphinx-build-real/sphinx-build/g'")) "$SPHINX --version 2>&1 | sed 's/.sphinx-build-real/sphinx-build/g'"))))
#t))
;; The build system invokes Cabal and GHC, which do not work with ;; The build system invokes Cabal and GHC, which do not work with
;; GHC_PACKAGE_PATH: <https://github.com/haskell/cabal/issues/3728>. ;; GHC_PACKAGE_PATH: <https://github.com/haskell/cabal/issues/3728>.
@ -650,13 +647,11 @@ firmware blobs. You can
(("\\$\\(CABAL\\)") (("\\$\\(CABAL\\)")
"$(CABAL) --package-db=../package.conf.d") "$(CABAL) --package-db=../package.conf.d")
(("\\$\\(GHC\\)") (("\\$\\(GHC\\)")
"$(GHC) -package-db=../package.conf.d")) "$(GHC) -package-db=../package.conf.d"))))
#t))
(add-after 'configure 'make-ghc-use-shared-libraries (add-after 'configure 'make-ghc-use-shared-libraries
(lambda _ (lambda _
(substitute* "Makefile" (substitute* "Makefile"
(("HFLAGS =") "HFLAGS = -dynamic -fPIC")) (("HFLAGS =") "HFLAGS = -dynamic -fPIC"))))
#t))
(add-after 'configure 'fix-installation-directories (add-after 'configure 'fix-installation-directories
(lambda _ (lambda _
(substitute* "Makefile" (substitute* "Makefile"
@ -666,8 +661,7 @@ firmware blobs. You can
;; Similarly, do not attempt to install the sample ifup scripts ;; Similarly, do not attempt to install the sample ifup scripts
;; to /etc/ganeti. ;; to /etc/ganeti.
(("\\$\\(DESTDIR\\)\\$\\(ifupdir\\)") (("\\$\\(DESTDIR\\)\\$\\(ifupdir\\)")
"$(DESTDIR)${prefix}$(ifupdir)")) "$(DESTDIR)${prefix}$(ifupdir)"))))
#t))
(add-before 'build 'adjust-tests (add-before 'build 'adjust-tests
(lambda _ (lambda _
;; Disable tests that can not run. Do it early to prevent ;; Disable tests that can not run. Do it early to prevent
@ -692,15 +686,13 @@ firmware blobs. You can
;; the Python interpreter, which does not work very well for us. ;; the Python interpreter, which does not work very well for us.
(substitute* "Makefile" (substitute* "Makefile"
(("PYTHONPATH=") (("PYTHONPATH=")
(string-append "PYTHONPATH=" (getenv "PYTHONPATH") ":"))) (string-append "PYTHONPATH=" (getenv "PYTHONPATH") ":")))))
#t))
(add-after 'build 'build-bash-completions (add-after 'build 'build-bash-completions
(lambda _ (lambda _
(let ((orig-pythonpath (getenv "PYTHONPATH"))) (let ((orig-pythonpath (getenv "PYTHONPATH")))
(setenv "PYTHONPATH" (string-append ".:" orig-pythonpath)) (setenv "PYTHONPATH" (string-append ".:" orig-pythonpath))
(invoke "./autotools/build-bash-completion") (invoke "./autotools/build-bash-completion")
(setenv "PYTHONPATH" orig-pythonpath) (setenv "PYTHONPATH" orig-pythonpath))))
#t)))
(add-before 'check 'pre-check (add-before 'check 'pre-check
(lambda* (#:key inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)
;; Set TZDIR so that time zones are found. ;; Set TZDIR so that time zones are found.
@ -738,15 +730,14 @@ firmware blobs. You can
(for-each (lambda (file) (for-each (lambda (file)
(symlink "../../src/htools" file)) (symlink "../../src/htools" file))
'("hspace" "hscan" "hinfo" "hbal" "hroller" '("hspace" "hscan" "hinfo" "hbal" "hroller"
"hcheck" "hail" "hsqueeze"))) "hcheck" "hail" "hsqueeze")))))
#t))
(add-after 'install 'install-bash-completions (add-after 'install 'install-bash-completions
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(compdir (string-append out "/etc/bash_completion.d"))) (compdir (string-append out "/etc/bash_completion.d")))
(mkdir-p compdir) (mkdir-p compdir)
(copy-file "doc/examples/bash_completion" (copy-file "doc/examples/bash_completion"
(string-append compdir "/ganeti")) (string-append compdir "/ganeti"))
;; The one file contains completions for many different ;; The one file contains completions for many different
;; executables. Create symlinks for found completions. ;; executables. Create symlinks for found completions.
(with-directory-excursion compdir (with-directory-excursion compdir
@ -765,11 +756,10 @@ firmware blobs. You can
;; Note that 'burnin' is listed with the ;; Note that 'burnin' is listed with the
;; absolute file name, which is why we ;; absolute file name, which is why we
;; run everything through 'basename'. ;; run everything through 'basename'.
(cons (basename (car (reverse (string-split (match (string-split line #\ )
line #\ )))) ((commands ... prog)
progs)) (cons (basename prog) progs))))
(loop (read-line port) progs)))))))) (loop (read-line port) progs)))))))))))
#t)))
;; Wrap all executables with PYTHONPATH. We can't borrow the phase ;; Wrap all executables with PYTHONPATH. We can't borrow the phase
;; from python-build-system because we also need to wrap the scripts ;; from python-build-system because we also need to wrap the scripts
;; in $out/lib/ganeti such as "node-daemon-setup". ;; in $out/lib/ganeti such as "node-daemon-setup".
@ -792,7 +782,7 @@ firmware blobs. You can
(or (string-contains shebang "/bin/bash") (or (string-contains shebang "/bin/bash")
(string-contains shebang "/bin/sh"))))))) (string-contains shebang "/bin/sh")))))))
(define (wrap? file) (define* (wrap? file #:rest _)
;; Do not wrap shell scripts because some are meant to be ;; Do not wrap shell scripts because some are meant to be
;; sourced, which breaks if they are wrapped. We do wrap ;; sourced, which breaks if they are wrapped. We do wrap
;; the Haskell executables because some call out to Python ;; the Haskell executables because some call out to Python
@ -804,10 +794,9 @@ firmware blobs. You can
(for-each (lambda (file) (for-each (lambda (file)
(wrap-program file (wrap-program file
`("PYTHONPATH" ":" prefix (,PYTHONPATH)))) `("PYTHONPATH" ":" prefix (,PYTHONPATH))))
(filter wrap? (append-map (cut find-files <> wrap?)
(append (find-files (string-append lib "/ganeti")) (list (string-append lib "/ganeti")
(find-files sbin)))) sbin)))))))))
#t))))))
(native-inputs (native-inputs
`(("haskell" ,ghc) `(("haskell" ,ghc)
("cabal" ,cabal-install) ("cabal" ,cabal-install)