aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@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/>.

(define-module (gnu)
  #:use-module (guix i18n)
  #:use-module (guix diagnostics)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:use-module (ice-9 match)
  #:use-module (guix packages)
  #:use-module (gnu packages)
  #:use-module (gnu services)
  #:export (use-package-modules
            use-service-modules
            use-system-modules))

;;; Commentary:
;;;
;;; This composite module re-exports core parts the (gnu …) public modules.
;;;
;;; Code:

(eval-when (eval load compile)
  (begin
    (define %public-modules
      '((gnu system)
        (gnu system mapped-devices)
        (gnu system file-systems)
        (gnu bootloader)
        (gnu bootloader grub)
        (gnu system keyboard)
        (gnu system pam)
        (gnu system shadow)                       ; 'user-account'
        (gnu system linux-initrd)
        (gnu system nss)
        (gnu services)
        (gnu services base)
        (gnu packages)
        (gnu packages base)
        (guix gexp)))                             ; so gexps can be used

    (for-each (let ((i (module-public-interface (current-module))))
                (lambda (m)
                  (module-use! i (resolve-interface m))))
              %public-modules)))

(define (%try-use-modules modules location make-hint)
  "Attempt to load all of MODULES.  Report errors as coming from LOCATION, a
<location> record, and use MAKE-HINT to produce a fix hint."
  (define (location->string loc)
    (match loc
      (#f "")
      (($ <location> file line column)
       (format #f "~a:~a:~a: " file line column))))

  (for-each (lambda (module)
              (catch 'misc-error
                (lambda ()
                  (process-use-modules `((,module))))
                (lambda _
                  (raise
                   (apply
                    make-compound-condition
                    (formatted-message (G_ "module ~a not found")
                                       module)
                    (condition
                     (&error-location (location location)))
                    (or (and=> (make-hint module) list)
                        '()))))))
            modules))

(define (package-module-hint module)
  (define last-name
    (match module
      ((_ ... last)
       (symbol->string last))))

  (match (find-packages-by-name last-name)
    (()
     (condition
      (&fix-hint
       (hint (G_ "\
You may use @command{guix package --show=foo | grep location} to search
for the location of package @code{foo}.
If you get the line @code{location: gnu/packages/bar.scm:174:2},
add @code{bar} to the @code{use-package-modules} form.")))))
    ((package _ ...)
     (condition
      (&fix-hint
       (hint (format #f (G_ "\
Try adding @code{(use-package-modules ~a)}.")
                     (basename (location-file (package-location package))
                               ".scm"))))))))

(define (service-module-hint module)
  (define last-name
    (match module
      ((_ ... last)
       last)))

  (match (lookup-service-types last-name)
    (()
     (condition
      (&fix-hint
       (hint (format #f (G_ "\
You may use @command{guix system search ~a} to search for a service
matching @code{~a}.
If you get the line @code{location: gnu/services/foo.scm:188:2},
add @code{foo} to the @code{use-service-modules} form.")
                     last-name last-name)))))
    ((package _ ...)
     (condition
      (&fix-hint
       (hint (format #f (G_ "\
Try adding @code{(use-service-modules ~a)}.")
                     (basename (location-file (service-type-location package))
                               ".scm"))))))))

(define-syntax-rule (try-use-modules hint modules ...)
  (eval-when (expand load eval)
    (%try-use-modules '(modules ...)
                      (source-properties->location
                       (current-source-location))
                      hint)))

(define-syntax-rule (use-package-modules module ...)
  (try-use-modules package-module-hint
                   (gnu packages module) ...))

(define-syntax-rule (use-service-modules module ...)
  (try-use-modules service-module-hint
                   (gnu services module) ...))

(define-syntax-rule (use-system-modules module ...)
  (try-use-modules (const #f)                     ;no hint
                   (gnu system module) ...))

;;; gnu.scm ends here
(install-file file doc)) '("README.md" "RELEASENOTES.txt")))))))) (home-page "https://icl.utk.edu/papi/") (synopsis "Performance Application Programming Interface") (description "PAPI provides the tool designer and application engineer with a consistent interface and methodology for use of the performance counter hardware found in most major microprocessors. PAPI enables software engineers to see, in near real time, the relation between software performance and processor events. In addition, PAPI provides access to a collection of components that expose performance measurement opportunites across the hardware and software stack.") (properties '((release-monitoring-url . "http://icl.cs.utk.edu/papi/software/"))) ;; See Debian papi copyright file. (license (list license:bsd-3 license:lgpl2.1+ ;src/components/infiniband/pscanf.h ;; not used in output license:gpl2+ ;src/components/appio/tests/iozone/gengnuplot.sh )))) ;; NB. there's a potential name clash with libotf. (define-public otf2 (package (name "otf2") (version "2.1.1") (source (origin (method url-fetch) (uri (string-append "http://www.vi-hps.org/upload/packages/otf2/otf2-" version ".tar.gz")) (sha256 (base32 "1ls7rz6qwnqbkifpafc95bnfh3m9xbs74in8zxlnhfbgwx11nn81")))) (native-inputs (list python)) (outputs '("doc" ; 18MB "lib" "out")) (build-system gnu-build-system) (arguments `(#:configure-flags '("--enable-shared" "--disable-static") #:phases (modify-phases %standard-phases (add-after 'install 'licence (lambda* (#:key outputs #:allow-other-keys) (for-each (lambda (output) (let ((doc (string-append (assoc-ref outputs output) "/share/doc/otf2"))) (install-file "COPYING" doc))) '("lib" "doc")) #t))))) (home-page "https://www.vi-hps.org/projects/score-p/") (synopsis "Open Trace Format 2 library") (description "The Open Trace Format 2 (@dfn{OTF2}) is a scalable, memory-efficient event trace data format plus support library.") (license license:bsd-3))) (define-public opari2 (package (name "opari2") (version "2.0.5") (source (origin (method url-fetch) (uri (string-append "https://www.vi-hps.org/cms/upload/packages/opari2/" "opari2-" version ".tar.gz")) (sha256 (base32 "1xaf25lcxk4ky1kzfks40ja9mayh8pnmrzch2107c8dcjrsxsd4h")))) (build-system gnu-build-system) (inputs (list gfortran)) (native-inputs (list gawk ; for tests which)) (home-page "https://www.vi-hps.org/projects/score-p") (synopsis "OpenMP runtime performance measurement instrumenter") (description "OPARI2 is a source-to-source instrumentation tool for OpenMP and hybrid codes. It surrounds OpenMP directives and runtime library calls with calls to the POMP2 measurement interface.") (license license:bsd-3))) (define-public cube (package (name "cube") (version "4.3.5") (source (origin (method url-fetch) (uri (string-append "http://apps.fz-juelich.de/scalasca/releases/cube/4.3/dist/cube-" version ".tar.gz")) (sha256 (base32 "04irflia4rfw02093w9nx7rr98r640y4q8hisjywvd4b7r3nzhhx")) (patches (search-patches "cube-nocheck.patch")))) (inputs (list dbus zlib)) (native-inputs (list perl qtbase-5 ; native because of qmake which)) ;; FIXME: The doc is 14MB, but adding a doc output results in a cycle. (outputs '("out" ;"doc" "lib")) (build-system gnu-build-system) (arguments `(#:configure-flags `("--enable-shared" "--disable-static" "--disable-silent-rules" ,(string-append "LDFLAGS=-L" (assoc-ref %outputs "lib") "/lib")) #:parallel-tests? #f #:phases (modify-phases %standard-phases (add-after 'configure 'rpath ;; Account for moving GUI stuff (lambda* (#:key outputs #:allow-other-keys) (let ((wl (string-append "-Wl,-rpath=" (assoc-ref outputs "out") "/lib"))) (substitute* "build-backend/Makefile" (("^cube_LDFLAGS =") (string-append "cube_LDFLAGS = " wl)) (("^libheatmap_plugin_la_LDFLAGS =") (string-append "libheatmap_plugin_la_LDFLAGS = " wl)) (("^libbarplot_plugin_la_LDFLAGS =") (string-append "libbarplot_plugin_la_LDFLAGS = " wl))) #t))) (add-before 'install 'includes-cube ;; It tries to install here before include exists. (lambda* (#:key outputs #:allow-other-keys) (let ((inc (string-append (assoc-ref outputs "lib") "/include"))) (mkdir-p (string-append inc "/cube")) (mkdir-p (string-append inc "/cubew")) #t))) (add-after 'install 'licence (lambda* (#:key outputs #:allow-other-keys) (let ((doc (string-append (assoc-ref outputs "lib") "/share/doc/cube"))) (install-file "COPYING" doc) #t))) ;; XXX: Commented due to cycle (see comment above.) ;; (add-after 'install 'doc ;; (lambda _ ;; (let ((share (string-append (assoc-ref %outputs "doc") ;; "/share"))) ;; (mkdir-p share) ;; (rename-file (string-append %output "/share/doc") ;; (string-append share "/doc"))))) (add-after 'install 'gui-stuff ;; Get the Qt horror dependencies out of the lib closure (lambda _ (let ((outlib (string-append (assoc-ref %outputs "out") "/lib")) (lib (string-append (assoc-ref %outputs "lib") "/lib"))) (mkdir-p outlib) (rename-file (string-append lib "/cube-plugins") (string-append outlib "/cube-plugins")) (for-each (lambda (file) (rename-file file (string-append outlib "/" (basename file)))) (append (find-files lib "libgraphwidgetcommon-plugin\\..*") (find-files lib "libcube4gui\\.so.*"))) #t))) (add-after 'install 'move-include ;; Most of the headers end up under %output for some reason, ;; despite --includedir in configure. (lambda* (#:key outputs #:allow-other-keys) (let ((outinc (string-append (assoc-ref outputs "out") "/include")) (libinc (string-append (assoc-ref outputs "lib") "/include"))) (for-each (lambda (file) (let ((from (string-append outinc "/" file))) (copy-recursively from libinc) (delete-file-recursively from))) '("cube" "cubew")) #t))) ;; XXX: This doesn't work because cube-config, which is needed for ;; building stuff, sources cube-config-frontend. We don't want that ;; in the lib output because it pulls in >1GB via QT. ;; ;; (add-after 'install 'cube-config ;; (lambda _ ;; (let* ((lib (assoc-ref %outputs "lib")) ;; (libbin (string-append lib "/bin"))) ;; (mkdir-p libbin) ;; (system (string-append "mv " (assoc-ref %outputs "out") ;; "/bin/cube-config* " libbin)) ;; (substitute* (list (string-append libbin "/cube-config")) ;; (("^prefix=.*") (string-append "prefix=" lib)) ;; (("^exec_prefix=\"\\$\\{prefix\\}\"") ;; (string-append "exec_prefix=" lib)))))) (add-after 'install 'cube-config (lambda* (#:key outputs #:allow-other-keys) (let* ((lib (assoc-ref outputs "lib")) (libbin (string-append lib "/bin"))) (mkdir-p libbin) (install-file (string-append %output "/bin/cube-config") libbin) (install-file (string-append %output "/bin/cube-config-backend") libbin) (substitute* (list (string-append libbin "/cube-config")) (("^source .*frontend.*$") "") (((assoc-ref outputs "out")) lib)) #t)))))) (home-page "https://www.scalasca.org/software/cube-4.x/download.html") (synopsis "Performance report explorer for parallel programs") (description "CUBE (CUBE Uniform Behavioral Encoding) is a tool to display a variety of performance metrics for parallel programs including MPI and OpenMP applications. CUBE allows interactive exploration of a multidimensional performance space in a scalable fashion. Scalability is achieved in two ways: hierarchical decomposition of individual dimensions and aggregation across different dimensions. All performance metrics are uniformly accommodated in the same display and thus provide the ability to easily compare the effects of different kinds of performance behavior.") (license license:bsd-3))) (define (make-scorep mpi) (package (name (string-append "scorep-" (package-name mpi))) (version "3.1") (source (origin (method url-fetch) (uri (string-append "http://www.vi-hps.org/upload/packages/scorep/scorep-" version ".tar.gz")) (sha256 (base32 "0h45357djna4dn9jyxx0n36fhhms3jrf22988m9agz1aw2jfivs9")) (modules '((guix build utils))) (snippet ;; Remove bundled software. '(begin (for-each delete-file-recursively '("vendor/opari2" "vendor/cube")) #t)))) (build-system gnu-build-system) (inputs `(("mpi" ,mpi) ("papi" ,papi) ("opari2" ,opari2) ("libunwind" ,libunwind) ("otf2" ,otf2) ("cubelib" ,cube "lib") ;for lib, include ("openmpi" ,openmpi) ("zlib" ,zlib))) (native-inputs (list gfortran flex cube ;for cube-config bison python doxygen which)) (arguments `(#:configure-flags (list "--enable-shared" "--disable-static" (string-append "--with-opari2=" (assoc-ref %build-inputs "opari2")) (string-append "--with-cube=" (assoc-ref %build-inputs "cube"))) #:parallel-tests? #f #:make-flags '("V=1") #:phases (modify-phases %standard-phases (add-after 'install 'licence (lambda* (#:key outputs #:allow-other-keys) (let ((doc (string-append (assoc-ref outputs "out") "/share/doc/scorep"))) (install-file "COPYING" doc) #t)))))) (home-page "https://www.vi-hps.org/projects/score-p/") (synopsis "Performance measurement infrastructure for parallel code") (description "The Score-P (Scalable Performance Measurement Infrastructure for Parallel Codes) measurement infrastructure is a scalable and easy-to-use tool suite for profiling, event trace recording, and online analysis of high-performance computing (HPC) applications.") (license license:cpl1.0))) (define-public scorep-openmpi (make-scorep openmpi)) (define-public tracy-wayland (package (name "tracy-wayland") (version "0.10") (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/wolfpld/tracy") (commit (string-append "v" version)))) (sha256 (base32 "1w50bckvs1nn68amzrkyrh769dhmlhk7w00kr8ac5h9ryk349p8c")) (file-name (git-file-name "tracy" version)) (modules '((guix build utils))) (snippet '(begin ;; XXX: Sadly, the ImGui loaders appear to have been customized by ;; the project and the build fails when using the 'imgui' Guix ;; package due to a missing GL_TEXTURE_WRAP_S definition, so keep ;; the bundled copy. ;; Unbundle Zstd. (delete-file-recursively "zstd") ;; Adjust the include directives. (substitute* (find-files "server" "\\.(c|h)pp$") (("#include \".*zstd/(zstd|zdict).h\"" _ header) (format #f "#include \"~a.h\"" header))) ;; De-register source files from Visual Code project. (substitute* "profiler/build/win32/Tracy.vcxproj" ((".*Include=\"..\\\\..\\\\..\\\\zstd\\\\.*") "")))))) ;; Note: There is also CMake and Meson support, but only to build the ;; tracy library, not the profiler command. (build-system gnu-build-system) (arguments (list #:tests? #f ;no test for the profiler #:make-flags #~(list (string-append "CC=" #$(cc-for-target)) (string-append "CFLAGS=-lzstd")) #:phases #~(modify-phases %standard-phases (add-before 'build 'chdir (lambda _ (chdir "profiler/build/unix"))) (delete 'configure) ;the profiler has no configure script (replace 'install (lambda _ (let ((bin (string-append #$output "/bin")) (tracy (string-append #$output "/bin/tracy"))) (mkdir-p bin) (copy-file "Tracy-release" tracy))))))) (inputs (list capstone dbus freetype libxkbcommon mesa wayland `(,zstd "lib"))) (native-inputs (list pkg-config)) (home-page "https://github.com/wolfpld/tracy") (synopsis "Frame profiler") (description "A real time, nanosecond resolution, remote telemetry, hybrid frame and sampling profiler for games and other applications.") (license license:bsd-3))) (define-public tracy (package;xb (inherit tracy-wayland) (name "tracy") (arguments (substitute-keyword-arguments (package-arguments tracy-wayland) ((#:make-flags flags #~'()) #~(append #$flags ;; The LEGACY flag indicate we want to build tracy with glfw. (list "LEGACY=1"))))) (inputs (modify-inputs (package-inputs tracy-wayland) (delete "libxkbcommon" "wayland") (prepend glfw))) (synopsis "Frame profiler (X11 version)")))