code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014, 2016, 2018 David Thompson <davet@gnu.org>
;;; Copyright © 2014, 2017, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015, 2017 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017, 2018 Amirouche <amirouche@hypermove.net>
;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2019 Taylan Kammer <taylan.kammer@gmail.com>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; 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 packages guile)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (gnu packages)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages base)
  #:use-module (gnu packages bash)
  #:use-module (gnu packages bdw-gc)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages dbm)
  #:use-module (gnu packages flex)
  #:use-module (gnu packages gawk)
  #:use-module (gnu packages gettext)
  #:use-module (gnu packages hurd)
  #:use-module (gnu packages libffi)
  #:use-module (gnu packages libunistring)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages m4)
  #:use-module (gnu packages multiprecision)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages readline)
  #:use-module (gnu packages sqlite)
  #:use-module (gnu packages texinfo)
  #:use-module (gnu packages version-control)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system guile)
  #:use-module (guix deprecation)
  #:use-module (guix utils)
  #:use-module (ice-9 match)
  #:use-module ((srfi srfi-1) #:prefix srfi-1:))

;;; Commentary:
;;;
;;; GNU Guile, and modules and extensions.
;;;
;;; Code:

(define-public guile-1.8
  (package
   (name "guile")
   (version "1.8.8")
   (source (origin
            (method url-fetch)
            (uri (string-append "mirror://gnu/guile/guile-" version
                                ".tar.gz"))
            (sha256
             (base32
              "0l200a0v7h8bh0cwz6v7hc13ds39cgqsmfrks55b1rbj5vniyiy3"))
            (patches (search-patches "guile-1.8-cpp-4.5.patch"))))
   (build-system gnu-build-system)
   (arguments '(#:configure-flags '("--disable-error-on-warning")

                ;; Insert a phase before `configure' to patch things up.
                #:phases
                (modify-phases %standard-phases
                  (add-before 'configure 'patch-stuff
                    (lambda* (#:key outputs #:allow-other-keys)
                      ;; Add a call to `lt_dladdsearchdir' so that
                      ;; `libguile-readline.so' & co. are in the
                      ;; loader's search path.
                      (substitute* "libguile/dynl.c"
                        (("lt_dlinit.*$" match)
                         (format #f
                                 "  ~a~%  lt_dladdsearchdir(\"~a/lib\");~%"
                                 match
                                 (assoc-ref outputs "out"))))

                      ;; The usual /bin/sh...
                      (substitute* "ice-9/popen.scm"
                        (("/bin/sh") (which "sh")))
                      #t)))))

   ;; When cross-compiling, a native version of Guile itself is needed.
   (native-inputs (if (%current-target-system)
                      `(("self" ,this-package))
                      '()))

   (inputs `(("gawk" ,gawk)
             ("readline" ,readline)))

   ;; Since `guile-1.8.pc' has "Libs: ... -lgmp -lltdl", these must be
   ;; propagated.
   (propagated-inputs `(("gmp" ,gmp)
                        ("libltdl" ,libltdl)))

   (native-search-paths
    (list (search-path-specification
           (variable "GUILE_LOAD_PATH")
           (files '("share/guile/site")))))

   (synopsis "Scheme implementation intended especially for extensions")
   (description
    "Guile is the GNU Ubiquitous Intelligent Language for Extensions, the
official extension language of the GNU system.  It is an implementation of
the Scheme language which can be easily embedded in other applications to
provide a convenient means of extending the functionality of the application
without requiring the source code to be rewritten.")
   (home-page "https://www.gnu.org/software/guile/")
   (license license:lgpl2.0+)))

(define-public guile-2.0
  (package
   (name "guile")
   (version "2.0.14")
   (source (origin
            (method url-fetch)
            (uri (string-append "mirror://gnu/guile/guile-" version
                                ".tar.xz"))
            (sha256
             (base32
              "10lxc6l5alf3lzbs3ihnbfy6dfcrsyf8667wa57f26vf4mk2ai78"))))
   (build-system gnu-build-system)

   ;; When cross-compiling, a native version of Guile itself is needed.
   (native-inputs `(,@(if (%current-target-system)
                          `(("self" ,this-package))
                          '())
                    ("pkgconfig" ,pkg-config)))
   (inputs `(("libffi" ,libffi)
             ,@(libiconv-if-needed)

             ;; We need Bash when cross-compiling because some of the scripts
             ;; in bin/ refer to it.  Use 'bash-minimal' because we don't need
             ;; an interactive Bash with Readline and all.
             ,@(if (target-mingw?) '() `(("bash" ,bash-minimal)))))
   (propagated-inputs
    `( ;; These ones aren't normally needed here, but since `libguile-2.0.la'
       ;; reads `-lltdl -lunistring', adding them here will add the needed
       ;; `-L' flags.  As for why the `.la' file lacks the `-L' flags, see
       ;; <http://thread.gmane.org/gmane.comp.lib.gnulib.bugs/18903>.
      ("libunistring" ,libunistring)

      ;; Depend on LIBLTDL, not LIBTOOL.  That way, we avoid some the extra
      ;; dependencies that LIBTOOL has, which is helpful during bootstrap.
      ("libltdl" ,libltdl)

      ;; The headers and/or `guile-2.0.pc' refer to these packages, so they
      ;; must be propagated.
      ("bdw-gc" ,libgc)
      ("gmp" ,gmp)))

   (outputs '("out" "debug"))

   (arguments
    `(#:configure-flags '("--disable-static") ; saves 3 MiB
      #:phases
      (modify-phases %standard-phases
        ,@(if (hurd-system?)
              '((add-after 'unpack 'disable-tests
                  (lambda _
                    ;; Hangs at: "Running 00-repl-server.test"
                    (rename-file "test-suite/tests/00-repl-server.test" "00-repl-server.test")
                    ;; Sometimes Hangs at: "Running 00-socket.test"
                    (rename-file "test-suite/tests/00-socket.test" "00-socket.test")
                    ;; FAIL: srfi-18.test: thread-sleep!: thread sleeps fractions of a second
                    (rename-file "test-suite/tests/srfi-18.test" "srfi-18.test")
                    ;; failed to remove 't-guild-compile-7215.go.tdL7yC
                    (substitute* "test-suite/standalone/Makefile.in"
                      (("test-guild-compile ") ""))
                    #t)))
              '())
        (add-before 'configure 'pre-configure
          (lambda* (#:key inputs #:allow-other-keys)
            ;; Tell (ice-9 popen) the file name of Bash.
            (let ((bash (assoc-ref inputs "bash")))
              (substitute* "module/ice-9/popen.scm"
                ;; If bash is #f allow fallback for user to provide
                ;; "bash" in PATH.  This happens when cross-building to
                ;; MinGW for which we do not have Bash yet.
                (("/bin/sh")
                 ,@(if (target-mingw?)
                       '((if bash
                             (string-append bash "/bin/bash")
                             "bash"))
                       '((string-append bash "/bin/bash")))))
              #t))))))

   (native-search-paths
    (list (search-path-specification
           (variable "GUILE_LOAD_PATH")
           (files '("share/guile/site/2.0")))
          (search-path-specification
           (variable "GUILE_LOAD_COMPILED_PATH")
           (files '("lib/guile/2.0/site-ccache")))))

   (synopsis "Scheme implementation intended especially for extensions")
   (description
    "Guile is the GNU Ubiquitous Intelligent Language for Extensions, the
official extension language of the GNU system.  It is an implementation of
the Scheme language which can be easily embedded in other applications to
provide a convenient means of extending the functionality of the application
without requiring the source code to be rewritten.")
   (home-page "https://www.gnu.org/software/guile/")
   (license license:lgpl3+)))

(define-public guile-2.2
  (package (inherit guile-2.0)
    (name "guile")
    (version "2.2.7")
    (source (origin
              (method url-fetch)

              ;; Note: we are limited to one of the compression formats
              ;; supported by the bootstrap binaries, so no lzip here.
              (uri (string-append "mirror://gnu/guile/guile-" version
                                  ".tar.xz"))
              (sha256
               (base32
                "013mydzhfswqci6xmyc1ajzd59pfbdak15i0b090nhr9bzm7dxyd"))
              (modules '((guix build utils)))
              (patches (search-patches
                        "guile-2.2-skip-oom-test.patch"))

              ;; Remove the pre-built object files.  Instead, build everything
              ;; from source, at the expense of significantly longer build
              ;; times (almost 3 hours on a 4-core Intel i5).
              (snippet '(begin
                          (for-each delete-file
                                    (find-files "prebuilt" "\\.go$"))
                          #t))))
    (properties '((timeout . 72000)               ;20 hours
                  (max-silent-time . 36000)))     ;10 hours (needed on ARM
                                                  ;  when heavily loaded)
    (native-search-paths
     (list (search-path-specification
            (variable "GUILE_LOAD_PATH")
            (files '("share/guile/site/2.2")))
           (search-path-specification
            (variable "GUILE_LOAD_COMPILED_PATH")
            (files '("lib/guile/2.2/site-ccache")))))))

(define-deprecated guile-2.2/bug-fix guile-2.2)

(define-public guile-2.2.4
  (package/inherit
   guile-2.2
   (version "2.2.4")
   (source (origin
             (inherit (package-source guile-2.2))
             (uri (string-append "mirror://gnu/guile/guile-" version
                                 ".tar.xz"))
             (sha256
              (base32
               "07p3g0v2ba2vlfbfidqzlgbhnzdx46wh2rgc5gszq1mjyx5bks6r"))))))

(define-public guile-3.0
  ;; This is the latest Guile stable version.
  (package
    (inherit guile-2.2)
    (name "guile")
    (version "3.0.4")
    (source (origin
              (inherit (package-source guile-2.2))
              (uri (string-append "mirror://gnu/guile/guile-"
                                  version ".tar.xz"))
              (sha256
               (base32
                "0c8dkyvs6xbxp7rgnhkyakajzhakay7qn9kahj1mj49x5vf4fybb"))))
    (arguments
     ;; XXX: JIT-enabled Guile crashes in obscure ways on GNU/Hurd.
     (if (hurd-target?)
         (substitute-keyword-arguments (package-arguments guile-2.2)
           ((#:configure-flags flags ''())
            `(cons "--disable-jit" ,flags)))
         (package-arguments guile-2.2)))
    (native-search-paths
     (list (search-path-specification
            (variable "GUILE_LOAD_PATH")
            (files '("share/guile/site/3.0")))
           (search-path-specification
            (variable "GUILE_LOAD_COMPILED_PATH")
            (files '("lib/guile/3.0/site-ccache"
                     "share/guile/site/3.0")))))))

(define-public guile-3.0-latest
  ;; The latest 3.0.x version.
  guile-3.0)

(define-public guile-next
  (deprecated-package "guile-next" guile-3.0))

(define-public guile-3.0/libgc-7
  ;; Using libgc-7 avoid crashes that can occur, particularly when loading
  ;; data in to the Guix Data Service:
  ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=40525
  (hidden-package
   (package
     (inherit guile-3.0-latest)
     (propagated-inputs
      `(("bdw-gc" ,libgc-7)
        ,@(srfi-1:alist-delete "bdw-gc" (package-propagated-inputs guile-3.0)))))))

(define-public guile-3.0/fixed
  ;; A package of Guile that's rarely changed.  It is the one used in the
  ;; `base' module, and thus changing it entails a full rebuild.
  (package
    (inherit guile-3.0)
    (properties '((hidden? . #t)            ;people should install 'guile-2.2'
                  (timeout . 72000)             ;20 hours
                  (max-silent-time . 36000))))) ;10 hours (needed on ARM
                                                ;  when heavily loaded)

(define* (make-guile-readline guile #:optional (name "guile-readline"))
  (package
    (name name)
    (version (package-version guile))
    (source (package-source guile))
    (build-system gnu-build-system)
    (arguments
     '(#:configure-flags '("--disable-silent-rules")
       #:phases (modify-phases %standard-phases
                  (add-before 'build 'chdir
                    (lambda* (#:key outputs #:allow-other-keys)
                      (invoke "make" "-C" "libguile" "scmconfig.h")
                      (invoke "make" "-C" "lib")
                      (chdir "guile-readline")

                      (substitute* "Makefile"
                        (("../libguile/libguile-[[:graph:]]+\\.la")
                         ;; Remove dependency on libguile-X.Y.la.
                         "")
                        (("^READLINE_LIBS = (.*)$" _ libs)
                         ;; Link against the provided libguile.
                         (string-append "READLINE_LIBS = "
                                        "-lguile-$(GUILE_EFFECTIVE_VERSION) "
                                        libs "\n"))
                        (("\\$\\(top_builddir\\)/meta/build-env")
                         ;; Use the provided Guile, not the one from
                         ;; $(builddir).
                         "")

                        ;; Install modules to the 'site' directories.
                        (("^moddir = .*$")
                         "moddir = $(pkgdatadir)/site/$(GUILE_EFFECTIVE_VERSION)\n")
                        (("^ccachedir = .*$")
                         "ccachedir = $(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/site-ccache\n"))

                      ;; Load 'guile-readline.so' from the right place.
                      (substitute* "ice-9/readline.scm"
                        (("load-extension \"guile-readline\"")
                         (format #f "load-extension \
 (string-append ~s \"/lib/guile/\" (effective-version) \"/extensions/guile-readline\")"
                                 (assoc-ref outputs "out"))))
                      #t)))))
    (home-page (package-home-page guile))
    (native-inputs (package-native-inputs guile))
    (inputs
     `(,@(package-inputs guile)                   ;to placate 'configure'
       ,@(package-propagated-inputs guile)
       ("guile" ,guile)
       ("readline" ,readline)))
    (synopsis "Line editing support for GNU Guile")
    (description
     "This module provides line editing support via the Readline library for
GNU@tie{}Guile.  Use the @code{(ice-9 readline)} module and call its
@code{activate-readline} procedure to enable it.")
    (license license:gpl3+)))

(define-public guile-readline
  (make-guile-readline guile-3.0))

(define-public guile2.2-readline
  (make-guile-readline guile-2.2 "guile2.2-readline"))

(define (guile-variant-package-name prefix)
  (lambda (name)
    "Return NAME with PREFIX instead of \"guile-\", when applicable."
    (if (string-prefix? "guile-" name)
        (string-append prefix "-"
                       (string-drop name
                                    (string-length "guile-")))
        name)))

(define package-for-guile-2.0
  ;; A procedure that rewrites the dependency tree of the given package to use
  ;; GUILE-2.0 instead of GUILE-3.0.
  (package-input-rewriting `((,guile-3.0 . ,guile-2.0))
                           (guile-variant-package-name "guile2.0")))

(define package-for-guile-2.2
  (package-input-rewriting `((,guile-3.0 . ,guile-2.2))
                           (guile-variant-package-name "guile2.2")))

(define-syntax define-deprecated-guile3.0-package
  (lambda (s)
    "Define a deprecated package alias for \"guile3.0-something\"."
    (syntax-case s ()
      ((_ name)
       (and (identifier? #'name)
            (string-prefix? "guile3.0-" (symbol->string (syntax->datum
                                                         #'name))))
       (let ((->guile (lambda (str)
                        (let ((base (string-drop str
                                                 (string-length "guile3.0-"))))
                          (string-append "guile-" base)))))
         (with-syntax ((package-name (symbol->string (syntax->datum #'name)))
                       (package
                         (datum->syntax
                          #'name
                          (string->symbol
                           (->guile (symbol->string (syntax->datum
                                                     #'name))))))
                       (old-name
                        ;; XXX: This is the name generated by
                        ;; 'define-deprecated'.
                        (datum->syntax
                         #'name
                         (symbol-append '% (syntax->datum #'name)
                                        '/deprecated))))
           #'(begin
               (define-deprecated name package
                 (deprecated-package package-name package))
               (export old-name))))))))

(define-deprecated-guile3.0-package guile3.0-readline)

(define-public guile-for-guile-emacs
  (let ((commit "15ca78482ac0dd2e3eb36dcb31765d8652d7106d")
        (revision "1"))
    (package (inherit guile-2.2)
      (name "guile-for-guile-emacs")
      (version (git-version "2.1.2" revision commit))
      (source (origin
                (method git-fetch)
                (uri (git-reference
                      (url "git://git.savannah.gnu.org/guile.git")
                      (commit commit)))
                (file-name (git-file-name name version))
                (sha256
                 (base32
                  "1l7ik4q4zk7vq4m3gnwizc0b64b1mdr31hxqlzxs94xaf2lvi7s2"))))
      (arguments
       (substitute-keyword-arguments (package-arguments guile-2.2)
         ((#:phases phases '%standard-phases)
          `(modify-phases ,phases
             (replace 'bootstrap
               (lambda _
                 ;; Disable broken tests.
                 ;; TODO: Fix them!
                 (substitute* "test-suite/tests/gc.test"
                   (("\\(pass-if \"after-gc-hook gets called\"" m)
                    (string-append "#;" m)))
                 (substitute* "test-suite/tests/version.test"
                   (("\\(pass-if \"version reporting works\"" m)
                    (string-append "#;" m)))
                 ;; Warning: Unwind-only `out-of-memory' exception; skipping pre-unwind handler.
                 ;; FAIL: test-out-of-memory
                 (substitute* "test-suite/standalone/Makefile.am"
                   (("(check_SCRIPTS|TESTS) \\+= test-out-of-memory") ""))

                 (patch-shebang "build-aux/git-version-gen")
                 (invoke "sh" "autogen.sh")
                 #t))))))
      (native-inputs
       `(("autoconf" ,autoconf)
         ("automake" ,automake)
         ("libtool" ,libtool)
         ("flex" ,flex)
         ("texinfo" ,texinfo)
         ("gettext" ,gettext-minimal)
         ,@(package-native-inputs guile-2.2))))))

;;;
;;; Extensions.
;;;

(define-public guile-json-1
  (package
    (name "guile-json")
    (version "1.3.2")
    (home-page "https://github.com/aconchillo/guile-json")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://savannah/guile-json/guile-json-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "0m6yzb169r6iz56k3nkncjaiijwi4p0x9ijn1p5ax3s77jklxy9k"))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags '("GUILE_AUTO_COMPILE=0")))   ;to prevent guild warnings
    (native-inputs `(("pkg-config" ,pkg-config)
                     ("guile" ,guile-2.2)))
    (inputs `(("guile" ,guile-2.2)))
    (synopsis "JSON module for Guile")
    (description
     "Guile-JSON supports parsing and building JSON documents according to the
specification.  These are the main features:

@itemize
@item Strictly complies to @uref{http://json.org, specification}.
@item Build JSON documents programmatically via macros.
@item Unicode support for strings.
@item Allows JSON pretty printing.
@end itemize\n")

    ;; Version 1.2.0 switched to GPLv3+ (from LGPLv3+).
    (license license:gpl3+)))

;; Deprecate the 'guile-json' alias to force the use 'guile-json-1' or
;; 'guile-json-3'.  In the future, we may reuse 'guile-json' as an alias for
;; 'guile-json-3'.
(define-deprecated guile-json guile-json-1)
(export guile-json)

(define-public guile2.0-json
  (package-for-guile-2.0 guile-json-1))

(define-public guile-json-3
  ;; This version is incompatible with 1.x; see the 'NEWS' file.
  (package
    (inherit guile-json-1)
    (name "guile-json")
    (version "3.5.0")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://savannah/guile-json/guile-json-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "0nj0684qgh6ppkbdyxqfyjwsv2qbyairxpi8fzrhsi3xnc7jn4im"))))
    (native-inputs `(("pkg-config" ,pkg-config)
                     ("guile" ,guile-3.0)))
    (inputs `(("guile" ,guile-3.0)))))

(define-public guile3.0-json
  (deprecated-package "guile3.0-json" guile-json-3))

(define-public guile-json-4
  (package
    (inherit guile-json-3)
    (name "guile-json")
    (version "4.3.2")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://savannah/guile-json/guile-json-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "0255c7f053z4p9mqzhpxwbfx3y47j9nfvlgnm8xasdclyzmjl9y2"))))))

(define-public guile2.2-json
  (package-for-guile-2.2 guile-json-4))

;; There are two guile-gdbm packages, one using the FFI and one with
;; direct C bindings, hence the verbose name.

(define-public guile-gdbm-ffi
  (package
    (name "guile-gdbm-ffi")
    (version "20120209.fa1d5b6")
    (source (origin
              (method git-fetch)
              (uri (git-reference
                    (url "https://github.com/ijp/guile-gdbm")
                    (commit "fa1d5b6231d0e4d096687b378c025f2148c5f246")))
              (file-name (string-append name "-" version "-checkout"))
              (patches (search-patches
                        "guile-gdbm-ffi-support-gdbm-1.14.patch"))
              (sha256
               (base32
                "1j8wrsw7v9w6qkl47xz0rdikg50v16nn6kbs3lgzcymjzpa7babj"))))
    (build-system guile-build-system)
    (arguments
     '(#:phases (modify-phases %standard-phases
                  (add-after 'unpack 'move-examples
                    (lambda* (#:key outputs #:allow-other-keys)
                      ;; Move examples where they belong.
                      (let* ((out (assoc-ref outputs "out"))
                             (doc (string-append out "/share/doc/"
                                                 (strip-store-file-name out)
                                                 "/examples")))
                        (copy-recursively "examples" doc)
                        (delete-file-recursively "examples")
                        #t)))
                  (add-after 'unpack 'set-libgdbm-file-name
                    (lambda* (#:key inputs #:allow-other-keys)
                      (substitute* "gdbm.scm"
                        (("\\(dynamic-link \"libgdbm\"\\)")
                         (format #f "(dynamic-link \"~a/lib/libgdbm.so\")"
                                 (assoc-ref inputs "gdbm"))))
                      #t)))))
    (native-inputs
     `(("guile" ,guile-3.0)))
    (inputs
     `(("gdbm" ,gdbm)))
    (home-page "https://github.com/ijp/guile-gdbm")
    (synopsis "Guile bindings to the GDBM library via Guile's FFI")
    (description
     "Guile bindings to the GDBM key-value storage system, using
Guile's foreign function interface.")
    (license license:gpl3+)))

(define-public guile2.0-gdbm-ffi
  (package-for-guile-2.0 guile-gdbm-ffi))

(define-public guile2.2-gdbm-ffi
  (package-for-guile-2.2 guile-gdbm-ffi))

(define-deprecated-guile3.0-package guile3.0-gdbm-ffi)

(define-public guile-sqlite3
  (package
    (name "guile-sqlite3")
    (version "0.1.2")
    (home-page "https://notabug.org/guile-sqlite3/guile-sqlite3.git")
    (source (origin
              (method git-fetch)
              (uri (git-reference
                    (url home-page)
                    (commit (string-append "v" version))))
              (sha256
               (base32
                "1nryy9j3bk34i0alkmc9bmqsm0ayz92k1cdf752mvhyjjn8nr928"))
              (file-name (string-append name "-" version "-checkout"))))
    (build-system gnu-build-system)
    (native-inputs
     `(("autoconf" ,autoconf)
       ("automake" ,automake)
       ("guile" ,guile-3.0)
       ("pkg-config" ,pkg-config)))
    (inputs
     `(("guile" ,guile-3.0)
       ("sqlite" ,sqlite)))
    (synopsis "Access SQLite databases from Guile")
    (description
     "This package provides Guile bindings to the SQLite database system.")
    (license license:gpl3+)))

(define-public guile2.0-sqlite3
  (package-for-guile-2.0 guile-sqlite3))

(define-public guile2.2-sqlite3
  (package-for-guile-2.2 guile-sqlite3))

(define-deprecated-guile3.0-package guile3.0-sqlite3)

(define-public guile-bytestructures
  (package
    (name "guile-bytestructures")
    (version "1.0.7")
    (home-page "https://github.com/TaylanUB/scheme-bytestructures")
    (source (origin
              (method git-fetch)
              (uri (git-reference
                    (url home-page)
                    (commit (string-append "v" version))))
              (file-name (git-file-name name version))
              (sha256
               (base32
                "0q0habjiy3h9cigb7q1br9kz6z212dn2ab31f6dgd3rrmsfn5rvb"))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags '("GUILE_AUTO_COMPILE=0")     ;to prevent guild warnings

       #:phases (modify-phases %standard-phases
                  (add-after 'install 'install-doc
                    (lambda* (#:key outputs #:allow-other-keys)
                      (let* ((out (assoc-ref outputs "out"))
                             (package ,(package-full-name this-package "-"))
                             (doc (string-append out "/share/doc/" package)))
                        (install-file "README.md" doc)
                        #t))))))
    (native-inputs
     `(("autoconf" ,autoconf)
       ("automake" ,automake)
       ("pkg-config" ,pkg-config)
       ("guile" ,guile-3.0)))
    (inputs
     `(("guile" ,guile-3.0)))
    (synopsis "Structured access to bytevector contents for Guile")
    (description
     "Guile bytestructures offers a system imitating the type system
of the C programming language, to be used on bytevectors.  C's type
system works on raw memory, and Guile works on bytevectors which are
an abstraction over raw memory.  It's also more powerful than the C
type system, elevating types to first-class status.")
    (license license:gpl3+)
    (properties '((upstream-name . "bytestructures")))))

(define-public guile2.0-bytestructures
  (package-for-guile-2.0 guile-bytestructures))

(define-public guile2.2-bytestructures
  (package-for-guile-2.2 guile-bytestructures))

(define-deprecated-guile3.0-package guile3.0-bytestructures)

(define-public guile-git
  (package
    (name "guile-git")
    (version "0.3.0")
    (home-page "https://gitlab.com/guile-git/guile-git.git")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://gitlab.com/guile-git/guile-git/uploads/"
                                  "4c563d8e7e1ff84396abe8ca7011bcaf/guile-git-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "0c5i3d16hp7gp9rd78vk9zc45js8bphf92m4lbb5gyi4l1yl7kkm"))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags '("GUILE_AUTO_COMPILE=0")))     ; to prevent guild warnings
    (native-inputs
     `(("pkg-config" ,pkg-config)
       ("guile" ,guile-3.0)
       ("guile-bytestructures" ,guile-bytestructures)))
    (inputs
     `(("guile" ,guile-3.0)
       ("libgit2" ,libgit2)))
    (propagated-inputs
     `(("guile-bytestructures" ,guile-bytestructures)))
    (synopsis "Guile bindings for libgit2")
    (description
     "This package provides Guile bindings to libgit2, a library to
manipulate repositories of the Git version control system.")
    (license license:gpl3+)))

(define-public guile2.2-git
  (package-for-guile-2.2 guile-git))

(define-public guile2.0-git
  (let ((base (package-for-guile-2.0 guile-git)))
    (package
      (inherit base)
      ;; Libgit2's Guile test driver requires (ice-9 textual-ports), which is
      ;; not in Guile 2.0.  Thus, keep LIBGIT2 as-is here (i.e., built against
      ;; Guile 2.2).
      (inputs `(("libgit2" ,libgit2)
                ,@(srfi-1:alist-delete "libgit2"
                                       (package-inputs base)))))))

(define-deprecated-guile3.0-package guile3.0-git)

(define-public guile-zlib
  (package
    (name "guile-zlib")
    (version "0.0.1")
    (source
     (origin
       ;; XXX: Do not use "git-fetch" method here that would create and
       ;; endless inclusion loop, because this package is used as an extension
       ;; in the same method.
       (method url-fetch)
       (uri
        (string-append "https://notabug.org/guile-zlib/guile-zlib/archive/"
                       version ".tar.gz"))
       (file-name (string-append name "-" version ".tar.gz"))
       (sha256
        (base32
         "1caz6cbl6sg5567nk68z88rshp0m26zmb0a9ry1jkc1ivpk0n47i"))))
    (build-system gnu-build-system)
    (arguments
     '(#:make-flags
       '("GUILE_AUTO_COMPILE=0"))) ;to prevent guild warnings
    (native-inputs
     `(("autoconf" ,autoconf)
       ("automake" ,automake)
       ("pkg-config" ,pkg-config)
       ,@(if (%current-target-system)
             `(("guile" ,guile-3.0))   ;for 'guild compile' and 'guile-3.0.pc'
             '())))
    (inputs
     `(("guile" ,guile-3.0)
       ("zlib" ,zlib)))
    (synopsis "Guile bindings to zlib")
    (description
     "This package provides Guile bindings for zlib, a lossless
data-compression library.  The bindings are written in pure Scheme by using
Guile's foreign function interface.")
    (home-page "https://notabug.org/guile-zlib/guile-zlib")
    (license license:gpl3+)))

(define-public guile-lzlib
  (package
    (name "guile-lzlib")
    (version "0.0.1")
    (source
     (origin
       (method url-fetch)
       (uri
        (string-append "https://notabug.org/guile-lzlib/guile-lzlib/archive/"
                       version ".tar.gz"))
       (file-name (string-append name "-" version ".tar.gz"))
       (sha256
        (base32
         "0rdmszn1qix085ci2mddwq5cypipc004fk7arrrkgn9bv39hazza"))))
    (build-system gnu-build-system)
    (arguments
     '(#:make-flags
       '("GUILE_AUTO_COMPILE=0"))) ;to prevent guild warnings
    (native-inputs
     `(("autoconf" ,autoconf)
       ("automake" ,automake)
       ("pkg-config" ,pkg-config)
       ,@(if (%current-target-system)
             `(("guile" ,guile-3.0))   ;for 'guild compile' and 'guile-3.0.pc'
             '())))
    (inputs
     `(("guile" ,guile-3.0)
       ("lzlib" ,lzlib)))
    (synopsis "Guile bindings to lzlib")
    (description
     "This package provides Guile bindings for lzlib, a C library for
in-memory LZMA compression and decompression.  The bindings are written in
pure Scheme by using Guile's foreign function interface.")
    (home-page "https://notabug.org/guile-lzlib/guile-lzlib")
    (license license:gpl3+)))

;;; guile.scm ends here

license: mit


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; 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 packages gv)
  #:use-module (gnu packages)
  #:use-module (gnu packages ghostscript)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages xorg)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu))

(define-public gv
  (package
   (name "gv")
   (version "3.7.4")
   (source (origin
            (method url-fetch)
            (uri (string-append "mirror://gnu/gv/gv-"
                                version ".tar.gz"))
            (sha256 (base32
                     "0q8s43z14vxm41pfa8s5h9kyyzk1fkwjhkiwbf2x70alm6rv6qi1"))))
   (build-system gnu-build-system)
   (arguments
    '(#:phases (modify-phases %standard-phases
                 (add-before 'configure 'set-gs-file-name
                   (lambda* (#:key inputs #:allow-other-keys)
                     ;; Set the value of 'GV.gsInterpreter' in the generated
                     ;; 'gv_system.ad' file.
                     (let ((gs (assoc-ref inputs "ghostscript")))
                       (with-fluids ((%default-port-encoding "ISO-8859-1"))
                        (substitute* "src/Makefile.in"
                          (("GV\\.gsInterpreter:([[:blank:]]+)gs" _ blank)
                           (string-append "GV.gsInterpreter:" blank
                                          gs "/bin/gs"))
                          (("GV\\.gsCmd([[:alpha:]]+):([[:blank:]]+)gs" _
                            command blank)
                           (string-append "GV.gsCmd" command ":"
                                          blank gs "/bin/gs"))))
                       #t))))))
   (inputs `(("ghostscript" ,ghostscript/x)
             ("libx11" ,libx11)
             ("libxaw3d" ,libxaw3d)
             ("libxinerama" ,libxinerama)
             ("libxpm" ,libxpm)
             ("zlib" ,zlib)))
   (native-inputs
     `(("pkg-config" ,pkg-config)))
   (synopsis "PostScript and PDF viewer using Ghostscript as a back-end")
   (description
    "GNU GV is a graphical user interface to the Ghostscript interpreter.
With it, one can view and navigate through PostScript and PDF documents in X
Windows.")
   (license license:gpl3+)
   (home-page "https://www.gnu.org/software/gv/")))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 John Darrington <jmd@gnu.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; 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 packages gxmessage)
  #:use-module (guix licenses)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (gnu packages glib)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages gtk)
  #:use-module (gnu packages))

(define-public gxmessage
  (package
    (name "gxmessage")
    (version "3.4.3")
    (source (origin
             (method url-fetch)
             (uri (string-append "mirror://gnu/gxmessage/gxmessage-"
                                 version ".tar.gz"))
             (sha256
              (base32 "01ggvvp0nyn8xczh93icifnji468wsjgqzd1f1bixwsqziaicknv"))))
    (build-system gnu-build-system)
    (arguments
     '(#:phases
       (modify-phases %standard-phases
         (add-before 'install 'skip-gtk-update-icon-cache
           ;; Don't create 'icon-theme.cache'.
           (lambda _
             (substitute* "Makefile"
               (("gtk-update-icon-cache") "true"))
             #t)))))
    (inputs
     `(("gtk+" ,gtk+)))
    (native-inputs
     `(("intltool" ,intltool)
       ("pkg-config" ,pkg-config)))
    (home-page "https://www.gnu.org/software/gxmessage/")
    (synopsis "Open popup message window with buttons for return")
    (description "GNU gxmessage is a program that pops up dialog windows, which display
a message to the user and waits for their action.  The program then exits
with an exit code corresponding to the response.")
    (license gpl3+)))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
;;;
;;; 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 packages hardware)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages bash)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages check)
  #:use-module (gnu packages cpp)
  #:use-module (gnu packages crypto)
  #:use-module (gnu packages documentation)
  #:use-module (gnu packages gcc)
  #:use-module (gnu packages glib)
  #:use-module (gnu packages libusb)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages openldap)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages polkit)
  #:use-module (gnu packages protobuf)
  #:use-module (gnu packages xdisorg)
  #:use-module (gnu packages xml)
  #:use-module (gnu packages xorg)
  #:use-module (guix build-system gnu)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix packages)
  #:use-module (guix utils))

;; This is a module for packages related to physical hardware that don't (yet)
;; have a more specific home like gps.scm, security-token.scm, &c.

(define-public ddcutil
  (package
    (name "ddcutil")
    (version "0.9.8")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "https://www.ddcutil.com/tarballs/"
                           "ddcutil-" version ".tar.gz"))
       (sha256
        (base32 "13ccxbqgyz4ah9jwbcylnfkgl8j3ida8xd00xkcq4xnfyyv5mg6v"))))
    (build-system gnu-build-system)
    (native-inputs
     `(("pkg-config" ,pkg-config)))
    (inputs
     `(("eudev" ,eudev)
       ("glib" ,glib)
       ("libdrm" ,libdrm)               ; enhanced diagnostics
       ("libusb" ,libusb)               ; support USB monitors
       ("libx11" ,libx11)               ; enhanced diagnostics
       ("libxrandr" ,libxrandr)
       ("zlib" ,zlib)))
    (home-page "https://www.ddcutil.com/")
    (synopsis "Control external monitor settings")
    (description
     "ddcutil can query and modify most external monitors' settings, such as
brightness, colour levels, and input sources.  Generally speaking, any setting
that can be changed by pressing buttons on the monitor can be modified by
ddcutil.

ddcutil communicates directly with monitors implementing the Monitor Control
Command Set (@dfn{MCCS}).  It usually does so through the the Display Data
Channel Command Interface (@dfn{DDC/CI}) protocol on the I2C bus, but can also
communicate over USB as per the USB Monitor Control Class Specification.

One particular use case is in colour profile management.  Monitor calibration
is relative to the monitor colour settings currently in effect, e.g. red gain.
ddcutil allows colour-related settings to be saved at the time a monitor is
calibrated, and restored when the calibration is applied.")
    (license (list license:bsd-3        ; FindDDCUtil.cmake
                   license:gpl2+))))    ; everything else

(define-public edid-decode
  (let ((commit "74b64180d67bb009d8d9ea1b6f18ad41aaa16396") ; 2020-04-22
        (revision "1"))
    (package
      (name "edid-decode")
      (version (git-version "0.0.0" revision commit))
      (source
       (origin
         (method git-fetch)
         (file-name (git-file-name name version))
         (uri (git-reference
               (url "git://linuxtv.org/edid-decode.git")
               (commit commit)))
         (sha256
          (base32 "0nirp5bza08zj5d8bjgcm0p869hdg3qg3mwa7999pjdrzmn7s2ah"))))
      (build-system gnu-build-system)
      (arguments
       `(#:tests? #f                     ; No test suite
         #:make-flags
         (list (string-append "DESTDIR=" (assoc-ref %outputs "out"))
               "bindir=/bin" "mandir=/share/man")
         #:phases
         (modify-phases %standard-phases
           (add-after 'unpack 'fix-cross-compilation
             (lambda* (#:key native-inputs target #:allow-other-keys)
               (when target
                 (substitute* "Makefile"
                   (("\\$\\(CXX\\)")
                    (string-append target "-g++"))))
               #t))
           (delete 'configure))))
      (home-page "https://git.linuxtv.org/edid-decode.git/")
      (synopsis "Decode @dfn{EDID} data in human-readable format")
      (description "edid-decode decodes @dfn{EDID} monitor description data in
human-readable format and checks if it conforms to the standards.")
      (license license:expat))))

;; Distinct from memtest86, which is obsolete.
(define-public memtest86+
  (package
    (name "memtest86+")
    ;; Update the description when/if UEFI support is released.
    (version "5.01")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "https://www.memtest.org/download/5.01/memtest86+-"
                           version ".tar.gz"))
       (sha256
        (base32 "0fch1l55753y6jkk0hj8f6vw4h1kinkn9ysp22dq5g9zjnvjf88l"))))
    (build-system gnu-build-system)
    (arguments
     `(#:system "i686-linux"            ; the result runs outside of any OS
       #:tests? #f                      ; no way to test this
       #:phases
       (modify-phases %standard-phases
         (delete 'configure)            ; no configure script
         (replace 'build
           ;; The default 'make all' does wonderful things, like scp(1) a file to
           ;; 192.168.0.12. Build the bootable images and nothing more.
           (lambda _
             (invoke "make"
                     "memtest"          ; ELF executable
                     "memtest.bin")))   ; DOS/MBR boot sector
         (replace 'install
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (lib (string-append out "/lib/memtest86+"))
                    (doc (string-append out "/share/doc/memtest86+-" ,version)))
               (for-each
                (lambda (file)
                  (install-file file lib))
                (list "memtest"
                      "memtest.bin"))
               (for-each
                (lambda (file)
                  (install-file file doc))
                (list "FAQ"
                      "README"))
               #t))))))
    (native-inputs
     ;; Newer GCCs fail with a deluge of "multiple definition of `__foo'" errors.
     `(("gcc" ,gcc-4.9)))
    (supported-systems (list "i686-linux" "x86_64-linux"))
    (home-page "https://www.memtest.org/")
    (synopsis "Thorough real-mode memory tester")
    (description
     "Memtest86+ is a thorough, stand-alone memory test for x86 systems.  It
repeatedly writes different patterns to all memory locations, reads them back
again, and verifies whether the result is the same as what was written.  This
can help debug even intermittent and non-deterministic errors.

It runs independently of any operating system, at computer boot-up, so that it
can scan as much of your RAM as possible for hardware defects.

Memtest86+ cannot currently be used on computers booted with UEFI.")
    (license license:gpl2)))

(define-public memtester
  (package
    (name "memtester")
    (version "4.3.0")
    (source
     (origin
       (method url-fetch)
       ;; Even the latest release is available under 'old-versions/'.
       (uri (string-append "http://pyropus.ca/software/memtester/old-versions/"
                           "memtester-" version ".tar.gz"))
       (sha256
        (base32 "127xymmyzb9r6dxqrwd69v7gf8csv8kv7fjvagbglf3wfgyy5pzr"))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags
       (list ,(string-append "CC=" (cc-for-target)))
       #:phases
       (modify-phases %standard-phases
         (replace 'configure
           ;; This is a home-brewed configuration system where the cc/ld command
           ;; lines are stored in one-line files.
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out")))
               (substitute* (list "conf-cc" "conf-ld")
                 (("^cc") "gcc"))
               (substitute* "Makefile"
                 (("(INSTALLPATH.*=).*" _ assignment)
                  (string-append assignment out)))
               #t)))
         (replace 'check
           ;; There is no test suite. Test some RAM for a single iteration.
           (lambda _
             (invoke "./memtester" "64K" "1"))))))
    (home-page "http://pyropus.ca/software/memtester/")
    (synopsis "User-space memory subsystem tester")
    (description
     "Memtester stress-tests the memory subsystem of your operating system and
computer.  It repeatedly writes different patterns to all memory locations,
reads them back again, and verifies whether the result is the same as what was
written.  This can help debug even intermittent and non-deterministic errors.

Memtester runs entirely in user space.  This means that you don't need to reboot
to test your memory, but also that it's not possible to test all of the RAM
installed in the system.

It can also be told to test memory starting at a particular physical address.")
    (license license:gpl2)))

(define-public msr-tools
  (package
    (name "msr-tools")
    (version "1.3")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "https://01.org/sites/default/files/downloads/"
                           name "/" name "-" version ".zip"))
       (sha256
        (base32 "07hxmddg0l31kjfmaq84ni142lbbvgq6391r8bd79wpm819pnigr"))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags
       (list (string-append "sbindir=" (assoc-ref %outputs "out") "/sbin"))
       #:phases
       (modify-phases %standard-phases
         (delete 'configure)            ; no configure script
         (add-before 'install 'create-output-directory
           (lambda* (#:key outputs #:allow-other-keys)
             ;; 'make install' assumes that sbindir exists.
             (let* ((out  (assoc-ref outputs "out"))
                    (sbin (string-append out "/sbin")))
               (mkdir-p sbin)
               #t))))
       #:tests? #f))                    ; no test suite
    (native-inputs
     `(("unzip" ,unzip)))
    ;; These registers and the CPUID instruction only exist on (most) x86 chips.
    (supported-systems (list "i686-linux" "x86_64-linux"))
    (home-page "https://01.org/msr-tools/")
    (synopsis "Read and write Model-Specific Registers (@dfn{MSR})")
    (description
     "The MSR Tools project provides console utilities to directly access the
Model-Specific Registers (@dfn{MSR}s) and CPU ID of Intel-compatible processors:

@itemize
@item @command{cpuid}: show identification and feature information of any CPU
@item @command{rdmsr}: read MSRs from any CPU or all CPUs
@item @command{wrmsr}: write to MSRs on any CPU or all CPUs
@end itemize

These tools can be used to query and modify certain low-level CPU parameters,
such as the Turbo Boost ratio and Thermal Design Power (@dfn{TDP}) limits.

MSR addresses differ (greatly) between processors, and any such modification can
be dangerous and may void your CPU or system board's warranty.")
    (license license:gpl2)))     ; cpuid.c is gpl2, {rd,wr}msr.c are gpl2+

(define-public wavemon
  (package
    (name "wavemon")
    (version "0.9.1")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://github.com/uoaerg/wavemon")
             (commit (string-append "v" version))))
       (file-name (git-file-name name version))
       (sha256
        (base32 "109ycwnjjqc2vpnd8b86njfifczlxglnyv4rh2qmbn2i5nw2wryg"))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags
       (list "CC=gcc"
             ;; Makefile.in (ab)uses $(datadir) as $(docdir). Set it to Guix's
             ;; standard --docdir since it's only used as such.
             (string-append "datadir=" (assoc-ref %outputs "out")
                            "/share/doc/" ,name "-" ,version))
       #:tests? #f))                    ; no tests
    (native-inputs
     `(("pkg-config" ,pkg-config)))
    (inputs
     `(("libcap" ,libcap)
       ("libnl" ,libnl)
       ("ncurses" ,ncurses)))
    (home-page "https://github.com/uoaerg/wavemon")
    (synopsis "Wireless network device monitor")
    (description
     "Wavemon is a wireless device monitor with an interactive ncurses terminal
interface.  It can display and plot signal and noise levels in real time.  It
also reports packet statistics, device configuration, network parameters, and
access points and other wireless clients of your wireless network hardware.

Wavemon should work (with varying levels of detail and features) with any device
supported by the Linux kernel.")
    ;; Source file headers still say GPL2+, but the authorial intent
    ;; (from COPYING and the F9 'about' screen) is clearly GPL3+.
    (license license:gpl3+)))

(define-public rkdeveloptool
  (let ((commit "6e92ebcf8b1812da02663494a68972f956e490d3")
        (revision "0"))
    (package
      (name "rkdeveloptool")
      (version (git-version "1.3" revision commit))
      (source
       (origin
         (method git-fetch)
         (uri (git-reference
               (url "https://github.com/rockchip-linux/rkdeveloptool")
               (commit commit)))
         (file-name (git-file-name name version))
         (sha256
          (base32 "0zwrkqfxd671iy69v3q0844gfdpm1yk51i9qh2rqc969bd8glxga"))))
      (build-system gnu-build-system)
      (native-inputs
       `(("autoconf" ,autoconf)
         ("automake" ,automake)
         ("pkg-config" ,pkg-config)))
      (inputs
       `(("libusb" ,libusb)))
      (home-page "https://github.com/rockchip-linux/rkdeveloptool")
      (synopsis "Read from and write to RockChicp devices over USB")
      (description
       "Rkdeveloptool can read from and write to RockChip devices over USB, such
as the Pinebook Pro.")
      (license license:gpl2+))))

(define-public libqb
  (package
    (name "libqb")
    ;; NOTE: We are using a Release Candidate version (for 2.0) here because
    ;; of the linker issues with the previous release.
    (version "1.9.1")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "https://github.com/ClusterLabs/libqb/releases/download/v"
                    version "/libqb-" version ".tar.xz"))
              (sha256
               (base32
                "008vvw504kh40br5v2xkqavnp9vpmjvf768faqzv1d00fd53ingn"))))
    (build-system gnu-build-system)
    (native-inputs
     `(("pkg-config" ,pkg-config)
       ("xmllint" ,libxml2)))
    (home-page "https://clusterlabs.github.io/libqb/")
    (synopsis "Library providing high performance logging, tracing, ipc, and poll")
    (description "Libqb is a library with the primary purpose of providing
high-performance, reusable features for client-server architecture, such as
logging, tracing, inter-process communication (IPC), and polling.  Libqb is
not intended to be an all-encompassing library, but instead provide focused
APIs that are highly tuned for maximum performance for client-server
applications.")
    (license license:lgpl2.1)))

(define-public usbguard
  (package
    (name "usbguard")
    (version "0.7.8")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "https://github.com/USBGuard/usbguard/releases/download/usbguard-"
                    version "/usbguard-" version ".tar.gz"))
              (file-name (git-file-name name version))
              (sha256
               (base32 "1il5immqfxh2cj8wn1bfk7l42inflzgjf07yqprpz7r3lalbxc25"))))
    (build-system gnu-build-system)
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'patch-build-scripts
           (lambda* (#:key inputs #:allow-other-keys)
             (substitute* "configure"
               (("/usr/include/catch")
                (string-append (assoc-ref inputs "catch") "/include")))
             ;; Do not create log directory.
             (substitute* "Makefile.in" ((".*/log/usbguard.*") ""))
             ;; Disable LDAP tests: they use 'sudo'.
             (substitute* "src/Tests/Makefile.in"
               (("\\$\\(am__append_2\\)") ""))
             #t))
         (add-after 'install 'delete-static-library
           (lambda* (#:key outputs #:allow-other-keys)
             ;; It can't be direclty disabled since it's needed for the tests.
             (delete-file (string-append (assoc-ref outputs "out")
                                         "/lib/libusbguard.a"))
             #t))
         (add-after 'install 'install-zsh-completion
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (site-functions
                     (string-append out "/share/zsh/site-functions")))
               (mkdir-p site-functions)
               (copy-file "scripts/usbguard-zsh-completion"
                          (string-append site-functions "/_usbguard"))
               #t))))
       #:make-flags
       (list (string-append "BASH_COMPLETION_DIR="
                            (assoc-ref %outputs "out")
                            "/etc/bash_completion.d"))
       #:configure-flags
       (list
        "--localstatedir=/var"
        "--enable-systemd=no"
        "--with-ldap"
        "--with-dbus"
        "--with-polkit")))
    (inputs
     `(("audit" ,audit)
       ("catch" ,catch-framework)
       ("dbus-glib" ,dbus-glib)
       ("ldap" ,openldap)
       ("libcap-ng" ,libcap-ng)
       ("libseccomp" ,libseccomp)
       ("libsodium" ,libsodium)
       ("pegtl" ,pegtl)
       ("polkit" ,polkit)
       ("protobuf" ,protobuf)
       ("libqb" ,libqb)))
    (native-inputs
     `(("asciidoc" ,asciidoc)
       ("bash-completion" ,bash-completion)
       ("gdbus-codegen" ,glib "bin")
       ("umockdev" ,umockdev)
       ("xmllint" ,libxml2)
       ("xsltproc" ,libxslt)
       ("pkg-config" ,pkg-config)))
    (home-page "https://usbguard.github.io")
    (synopsis "Helps to protect your computer against rogue USB devices (a.k.a. BadUSB)")
    (description "USBGuard is a software framework for implementing USB device
authorization policies (what kind of USB devices are authorized) as well as
method of use policies (how a USB device may interact with the system).
Simply put, it is a USB device whitelisting tool.")
    (license license:gpl2)))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Siniša Biđin <sinisa@bidin.eu>
;;; Copyright © 2015, 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016, 2017, 2018 Nikita <nikita@n0.is>
;;; Copyright © 2017 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2017, 2018 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2017, 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Timothy Sample <samplet@ngyro.com>
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;; Copyright © 2019, 2020 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2015 John Soo <jsoo1@asu.edu>
;;; Copyright © 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2019, 2020 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2020 Alexandru-Sergiu Marton <brown121407@member.fsf.org>
;;; Copyright © 2020 Brian Leung <bkleung89@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 packages haskell-apps)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module (guix packages)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix build-system haskell)
  #:use-module (gnu packages base)
  #:use-module (gnu packages curl)
  #:use-module (gnu packages gl)
  #:use-module (gnu packages haskell)
  #:use-module (gnu packages haskell-check)
  #:use-module (gnu packages haskell-crypto)
  #:use-module (gnu packages haskell-web)
  #:use-module (gnu packages haskell-xyz)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages rsync)
  #:use-module (gnu packages version-control))

(define-public apply-refact
  (package
    (name "apply-refact")
    (version "0.6.0.0")
    (source
     (origin
       (method url-fetch)
       (uri (string-append
             "https://hackage.haskell.org/package/apply-refact/apply-refact-"
             version ".tar.gz"))
       (sha256
        (base32
         "0p2mqgjcqr1zcmk8zgr0yq7g8z1agsa6l493lkj6g3ya9lyhxgig"))))
    (build-system haskell-build-system)
    (inputs
     `(("ghc-refact" ,ghc-refact)
       ("ghc-exactprint" ,ghc-exactprint)
       ("ghc-syb" ,ghc-syb)
       ("ghc-temporary" ,ghc-temporary)
       ("ghc-filemanip" ,ghc-filemanip)
       ("ghc-unix-compat" ,ghc-unix-compat)
       ("ghc-optparse-applicative"
        ,ghc-optparse-applicative)))
    (native-inputs
     `(("ghc-tasty" ,ghc-tasty)
       ("ghc-tasty-golden" ,ghc-tasty-golden)
       ("ghc-tasty-expected-failure"
        ,ghc-tasty-expected-failure)
       ("ghc-silently" ,ghc-silently)))
    (home-page "https://hackage.haskell.org/package/apply-refact")
    (synopsis "Perform refactorings specified by the refact library")
    (description
     "This package lets you perform refactorings specified by the refact
library.  It is primarily used with HLint's @code{--refactor} flag.")
    (license license:bsd-3)))

;; In Stackage LTS 14, this package is at 2.4.1.0.  However, that
;; version requires version 2.4.1.0 of the 'Cabal' package, which is
;; provided by GHC 8.6.5 at version 2.4.0.1.  Hence, we use an older
;; version to match the compiler's library.
(define-public cabal-install
 (package
  (name "cabal-install")
   (version "2.4.0.0")
   (source
    (origin
     (method url-fetch)
      (uri (string-append
            "https://hackage.haskell.org/package/cabal-install/cabal-install-"
            version
            ".tar.gz"))
      (sha256
       (base32 "1xmyl0x8wqfrnray6ky5wy0g0samv4264fbdlzxhqsvk9dbfja8k"))))
   (build-system haskell-build-system)
   (arguments
    `(#:cabal-revision
      ("2" "1xil5pim6j1ckqj61zz6l7xpfxxr3rkw2hvpws2f7pr9shk645dl")
      #:phases
       (modify-phases %standard-phases
         (add-before 'configure 'update-constraints
           (lambda _
             (substitute* "cabal-install.cabal"
               (("zip-archive >= 0\\.3\\.2\\.5 && < 0\\.4,")
                "zip-archive >= 0.3.2.5 && <= 0.4.1,"))
             #t)))))
   (inputs
    `(("ghc-async" ,ghc-async)
      ("ghc-base16-bytestring" ,ghc-base16-bytestring)
      ("ghc-cryptohash-sha256" ,ghc-cryptohash-sha256)
      ("ghc-echo" ,ghc-echo)
      ("ghc-edit-distance" ,ghc-edit-distance)
      ("ghc-hackage-security" ,ghc-hackage-security)
      ("ghc-hashable" ,ghc-hashable)
      ("ghc-http" ,ghc-http)
      ("ghc-network-uri" ,ghc-network-uri)
      ("ghc-network" ,ghc-network)
      ("ghc-random" ,ghc-random)
      ("ghc-resolv" ,ghc-resolv)
      ("ghc-tar" ,ghc-tar)
      ("ghc-zip-archive" ,ghc-zip-archive)
      ("ghc-zlib" ,ghc-zlib)))
   (home-page "https://www.haskell.org/cabal/")
   (synopsis "Command-line interface for Cabal and Hackage")
   (description
    "The cabal command-line program simplifies the process of managing
Haskell software by automating the fetching, configuration, compilation and
installation of Haskell libraries and programs.")
   (license license:bsd-3)))

(define-public corrode
  (let ((commit "b6699fb2fa552a07c6091276285a44133e5c9789"))
    (package
      (name "corrode")
      (version (string-append "0.0.1-" (string-take commit 7)))
      (source
       (origin
         (method git-fetch)
         (uri (git-reference
               (url "https://github.com/jameysharp/corrode")
               (commit "b6699fb2fa552a07c6091276285a44133e5c9789")))
         (file-name (git-file-name name version))
         (sha256
          (base32 "02v0yyj6sk4gpg2222wzsdqjxn8w66scbnf6b20x0kbmc69qcz4r"))))
      (build-system haskell-build-system)
      (inputs
       `(("ghc-language-c" ,ghc-language-c)
         ("ghc-markdown-unlit" ,ghc-markdown-unlit)))
      (home-page "https://github.com/jameysharp/corrode")
      (synopsis "Automatic semantics-preserving translation from C to Rust")
      (description
       "This program reads a C source file and prints an equivalent module in
Rust syntax.  It is intended to be useful for two different purposes:

@enumerate
@item Partial automation for migrating legacy code that was implemented in C.
@item A new, complementary approach to static analysis for C programs.
@end enumerate\n")
      (license license:gpl2+))))

(define-public cpphs
  (package
    (name "cpphs")
    (version "1.20.8")
    (source
     (origin
       (method url-fetch)
       (uri (string-append
             "https://hackage.haskell.org/package/" name "/"
             name "-" version ".tar.gz"))
       (sha256
        (base32
         "1bh524asqhk9v1s0wvipl0hgn7l63iy3js867yv0z3h5v2kn8vg5"))))
    (build-system haskell-build-system)
    (inputs
     `(("ghc-polyparse" ,ghc-polyparse)
       ("ghc-old-locale" ,ghc-old-locale)
       ("ghc-old-time" ,ghc-old-time)))
    (home-page "http://projects.haskell.org/cpphs/")
    (synopsis "Liberalised re-implementation of cpp, the C pre-processor")
    (description "Cpphs is a re-implementation of the C pre-processor that is
both more compatible with Haskell, and itself written in Haskell so that it
can be distributed with compilers.  This version of the C pre-processor is
pretty-much feature-complete and compatible with traditional (K&R)
pre-processors.  Additional features include: a plain-text mode; an option to
unlit literate code files; and an option to turn off macro-expansion.")
    (license (list license:lgpl2.1+ license:gpl3+))))

;; Darcs has no https support:
;; http://darcs.net/manual/Configuring_darcs.html#SECTION00440070000000000000
;; and results of search engines will show that if the protocol is http, https
;; is never mentioned.
(define-public darcs
  (package
    (name "darcs")
    (version "2.14.2")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "https://hackage.haskell.org/package/darcs/"
                           "darcs-" version ".tar.gz"))
       (sha256
        (base32
         "0zm2486gyhiga1amclbg92cd09bvki6vgh0ll75hv5kl72j61lb5"))
       (modules '((guix build utils)))
       ;; Remove time-dependent code for reproducibility.
       (snippet
        '(begin
           (substitute* "darcs/darcs.hs"
             (("__DATE__") "\"1970-01-01\"")
             (("__TIME__") "\"00:00:00\""))
           #t))))
    (build-system haskell-build-system)
    (arguments
     `(#:cabal-revision
       ("1" "0xl7j5cm704pbl2ms0dkydh7jvrz0ym76d725ifpg4h902m1zkhg")
       #:configure-flags '("-fpkgconfig" "-fcurl" "-flibiconv" "-fthreaded"
                           "-fnetwork-uri" "-fhttp" "--flag=executable"
                           "--flag=library")
       #:phases
       (modify-phases %standard-phases
         (add-after 'patch-source-shebangs 'patch-sh
           (lambda _
             (substitute* "tests/issue538.sh"
               (("/bin/sh") (which "sh")))
             #t))
         (add-before 'configure 'update-constraints
           (lambda _
             (substitute* "darcs.cabal"
               (("QuickCheck   >= 2\\.8\\.2 && < 2\\.13,")
                "QuickCheck   >= 2.8.2 && < 2.14,"))
             #t)))))
    (inputs
     `(("ghc-cmdargs" ,ghc-cmdargs)
       ("ghc-split" ,ghc-split)
       ("ghc-test-framework-quickcheck2" ,ghc-test-framework-quickcheck2)
       ("ghc-test-framework-hunit" ,ghc-test-framework-hunit)
       ("ghc-test-framework" ,ghc-test-framework)
       ("ghc-quickcheck" ,ghc-quickcheck)
       ("ghc-findbin" ,ghc-findbin)
       ("ghc-hunit" ,ghc-hunit)
       ("ghc-async" ,ghc-async)
       ("ghc-attoparsec" ,ghc-attoparsec)
       ("ghc-base16-bytestring" ,ghc-base16-bytestring)
       ("ghc-bytestring-builder" ,ghc-bytestring-builder)
       ("ghc-cryptohash" ,ghc-cryptohash)
       ("ghc-data-ordlist" ,ghc-data-ordlist)
       ("ghc-fgl" ,ghc-fgl)
       ("ghc-system-filepath" ,ghc-system-filepath)
       ("ghc-graphviz" ,ghc-graphviz)
       ("ghc-hashable" ,ghc-hashable)
       ("ghc-html" ,ghc-html)
       ("ghc-mmap" ,ghc-mmap)
       ("ghc-old-time" ,ghc-old-time)
       ("ghc-random" ,ghc-random)
       ("ghc-regex-applicative" ,ghc-regex-applicative)
       ("ghc-regex-compat-tdfa" ,ghc-regex-compat-tdfa)
       ("ghc-sandi" ,ghc-sandi)
       ("ghc-shelly" ,ghc-shelly)
       ("ghc-tar" ,ghc-tar)
       ("ghc-transformers-compat" ,ghc-transformers-compat)
       ("ghc-unix-compat" ,ghc-unix-compat)
       ("ghc-utf8-string" ,ghc-utf8-string)
       ("ghc-vector" ,ghc-vector)
       ("ghc-zip-archive" ,ghc-zip-archive)
       ("ghc-zlib" ,ghc-zlib)
       ("ghc-http" ,ghc-http)
       ("curl" ,curl)
       ("ghc" ,ghc)
       ("ncurses" ,ncurses)
       ("perl" ,perl)
       ("libiconv" ,libiconv)
       ("ghc-network" ,ghc-network)
       ("ghc-network-uri" ,ghc-network-uri)))
    (native-inputs
     `(("pkg-config" ,pkg-config)))
    (home-page "http://darcs.net")
    (synopsis "Distributed Revision Control System")
    (description
     "Darcs is a revision control system.  It is:

@enumerate
@item Distributed: Every user has access to the full command set, removing boundaries
between server and client or committer and non-committers.
@item Interactive: Darcs is easy to learn and efficient to use because it asks you
questions in response to simple commands, giving you choices in your work flow.
You can choose to record one change in a file, while ignoring another.  As you update
from upstream, you can review each patch name, even the full diff for interesting
patches.
@item Smart: Originally developed by physicist David Roundy, darcs is based on a
unique algebra of patches called @url{http://darcs.net/Theory,Patchtheory}.
@end enumerate")
    (license license:gpl2)))

(define-public ghcid
  (package
    (name "ghcid")
    (version "0.8.7")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "https://hackage.haskell.org/package/ghcid/"
                           "ghcid-" version ".tar.gz"))
       (sha256
        (base32 "0yqc1pkfajnr56gnh43sbj50r7c3r41b2jfz07ivgl6phi4frjbq"))))
    (build-system haskell-build-system)
    (inputs
     `(("ghc-extra" ,ghc-extra)
       ("ghc-ansi-terminal" ,ghc-ansi-terminal)
       ("ghc-cmdargs" ,ghc-cmdargs)
       ("ghc-fsnotify" ,ghc-fsnotify)
       ("ghc-terminal-size" ,ghc-terminal-size)))
    (native-inputs
     `(("ghc-tasty" ,ghc-tasty)
       ("ghc-tasty-hunit" ,ghc-tasty-hunit)))
    (home-page "https://github.com/ndmitchell/ghcid#readme")
    (synopsis "GHCi based bare bones IDE")
    (description
     "Either \"GHCi as a daemon\" or \"GHC + a bit of an IDE\".  A very simple Haskell
development tool which shows you the errors in your project and updates them whenever
you save.  Run @code{ghcid --topmost --command=ghci}, where @code{--topmost} makes the
window on top of all others (Windows only) and @code{--command} is the command to start
GHCi on your project (defaults to @code{ghci} if you have a @file{.ghci} file, or else
to @code{cabal repl}).")
    (license license:bsd-3)))

(define-public git-annex
  (package
    (name "git-annex")
    (version "8.20200908")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "https://hackage.haskell.org/package/"
                           "git-annex/git-annex-" version ".tar.gz"))
       (sha256
        (base32 "1113inl10f4m0699ba2zglaqlfqvwhqjkqg6r6m1d5rqv5brswb1"))))
    (build-system haskell-build-system)
    (arguments
     `(#:configure-flags
       '("--flags=-Android -Assistant -Pairing -Webapp")
       #:phases
       (modify-phases %standard-phases
         (add-before 'configure 'patch-shell-for-tests
           (lambda _
             ;; Shell.hs defines "/bin/sh" that is used in Git hooks.  We
             ;; shouldn't patch hooks with Guix's current bash because the
             ;; hooks can exist after that bash is garbage collected, but
             ;; let's temporarily patch it so that we can run the tests.
             (copy-file "Utility/Shell.hs" "/tmp/Shell.hs")
             (substitute* "Utility/Shell.hs"
               (("/bin/sh") (which "sh")))
             #t))
         (add-before 'configure 'factor-setup
           (lambda _
             ;; Factor out necessary build logic from the provided
             ;; `Setup.hs' script.  The script as-is does not work because
             ;; it cannot find its dependencies, and there is no obvious way
             ;; to tell it where to look.
             (call-with-output-file "PreConf.hs"
               (lambda (out)
                 (format out "import qualified Build.Configure as Configure~%")
                 (format out "main = Configure.run Configure.tests~%")))
             (call-with-output-file "Setup.hs"
               (lambda (out)
                 (format out "import Distribution.Simple~%")
                 (format out "main = defaultMain~%")))
             #t))
         (add-before 'configure 'pre-configure
           (lambda _
             (invoke "runhaskell" "PreConf.hs")
             #t))
         (add-after 'build 'build-manpages
           (lambda _
             ;; The Setup.hs rewrite above removed custom code for building
             ;; the man pages.  In addition to that code, git-annex's source
             ;; tree has a file that's not included in the tarball but is used
             ;; by the Makefile to build man pages.  Copy the core bits here.
             (call-with-output-file "Build/MakeMans.hs"
               (lambda (out)
                 (format out "module Main where~%")
                 (format out "import Build.Mans~%")
                 (format out "main = buildMansOrWarn~%")))
             (invoke "runhaskell" "Build/MakeMans.hs")))
         (replace 'check
           (lambda _
             ;; We need to set the path so that Git recognizes
             ;; `git annex' as a custom command.
             (setenv "PATH" (string-append (getenv "PATH") ":"
                                           (getcwd) "/dist/build/git-annex"))
             (with-directory-excursion "dist/build/git-annex"
               (symlink "git-annex" "git-annex-shell"))
             (invoke "git-annex" "test")
             #t))
         (add-after 'check 'unpatch-shell-and-rebuild
           (lambda args
             ;; Undo `patch-shell-for-tests'.
             (copy-file "/tmp/Shell.hs" "Utility/Shell.hs")
             (apply (assoc-ref %standard-phases 'build) args)))
         (add-after 'install 'install-manpages
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((man (string-append (assoc-ref outputs "out")
                                       "/man/man1/")))
               (mkdir-p man)
               (for-each (lambda (file) (install-file file man))
                         (find-files "man")))
             #t))
         (add-after 'install 'install-symlinks
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (bin (string-append out "/bin")))
               (symlink (string-append bin "/git-annex")
                        (string-append bin "/git-annex-shell"))
               (symlink (string-append bin "/git-annex")
                        (string-append bin "/git-remote-tor-annex"))
               #t)))
         (add-after 'install 'touch-static-output
           (lambda* (#:key outputs #:allow-other-keys)
             ;; The Haskell build system adds a "static" output by
             ;; default, and there is no way to override this until
             ;; <https://issues.guix.gnu.org/41569> is fixed.  Without
             ;; this phase, the daemon complains because we do not
             ;; create the "static" output.
             (with-output-to-file (assoc-ref outputs "static")
               (lambda ()
                 (display "static output not used\n"))))))))
    (inputs
     `(("curl" ,curl)
       ("ghc-aeson" ,ghc-aeson)
       ("ghc-async" ,ghc-async)
       ("ghc-aws" ,ghc-aws)
       ("ghc-bloomfilter" ,ghc-bloomfilter)
       ("ghc-byteable" ,ghc-byteable)
       ("ghc-case-insensitive" ,ghc-case-insensitive)
       ("ghc-concurrent-output" ,ghc-concurrent-output)
       ("ghc-crypto-api" ,ghc-crypto-api)
       ("ghc-cryptonite" ,ghc-cryptonite)
       ("ghc-data-default" ,ghc-data-default)
       ("ghc-dav" ,ghc-dav)
       ("ghc-disk-free-space" ,ghc-disk-free-space)
       ("ghc-dlist" ,ghc-dlist)
       ("ghc-edit-distance" ,ghc-edit-distance)
       ("ghc-esqueleto" ,ghc-esqueleto)
       ("ghc-exceptions" ,ghc-exceptions)
       ("ghc-feed" ,ghc-feed)
       ("ghc-filepath-bytestring" ,ghc-filepath-bytestring)
       ("ghc-free" ,ghc-free)
       ("ghc-hslogger" ,ghc-hslogger)
       ("ghc-http-client" ,ghc-http-client)
       ("ghc-http-conduit" ,ghc-http-conduit)
       ("ghc-http-types" ,ghc-http-types)
       ("ghc-ifelse" ,ghc-ifelse)
       ("ghc-magic" ,ghc-magic)
       ("ghc-memory" ,ghc-memory)
       ("ghc-monad-control" ,ghc-monad-control)
       ("ghc-monad-logger" ,ghc-monad-logger)
       ("ghc-network" ,ghc-network)
       ("ghc-old-locale" ,ghc-old-locale)
       ("ghc-optparse-applicative" ,ghc-optparse-applicative)
       ("ghc-persistent" ,ghc-persistent)
       ("ghc-persistent-sqlite" ,ghc-persistent-sqlite)
       ("ghc-persistent-template" ,ghc-persistent-template)
       ("ghc-quickcheck" ,ghc-quickcheck)
       ("ghc-random" ,ghc-random)
       ("ghc-regex-tdfa" ,ghc-regex-tdfa)
       ("ghc-resourcet" ,ghc-resourcet)
       ("ghc-safesemaphore" ,ghc-safesemaphore)
       ("ghc-sandi" ,ghc-sandi)
       ("ghc-securemem" ,ghc-securemem)
       ("ghc-socks" ,ghc-socks)
       ("ghc-split" ,ghc-split)
       ("ghc-stm-chans" ,ghc-stm-chans)
       ("ghc-tagsoup" ,ghc-tagsoup)
       ("ghc-unix-compat" ,ghc-unix-compat)
       ("ghc-unordered-containers" ,ghc-unordered-containers)
       ("ghc-utf8-string" ,ghc-utf8-string)
       ("ghc-uuid" ,ghc-uuid)
       ("git" ,git)
       ("rsync" ,rsync)))
    (native-inputs
     `(("ghc-tasty" ,ghc-tasty)
       ("ghc-tasty-hunit" ,ghc-tasty-hunit)
       ("ghc-tasty-quickcheck" ,ghc-tasty-quickcheck)
       ("ghc-tasty-rerun" ,ghc-tasty-rerun)
       ("perl" ,perl)))
    (home-page "https://git-annex.branchable.com/")
    (synopsis "Manage files with Git, without checking in their contents")
    (description "This package allows managing files with Git, without
checking the file contents into Git.  It can store files in many places,
such as local hard drives and cloud storage services.  It can also be
used to keep a folder in sync between computers.")
    ;; The main author has released all his changes under AGPLv3+ as of March
    ;; 2019 (7.20190219-187-g40ecf58d4).  These are also licensed under the
    ;; original GPLv3+ license, but going forward new changes will be under
    ;; only AGPLv3+.  The other licenses below cover code written by others.
    ;; See git-annex's COPYRIGHT file for details on each file.
    (license (list license:agpl3+
                   license:gpl3+
                   license:bsd-2
                   license:expat
                   license:gpl2))))

(define-public hlint
  (package
    (name "hlint")
    (version "2.1.26")
    (source
     (origin
       (method url-fetch)
       (uri (string-append
             "https://hackage.haskell.org/package/" name
             "/" name "-" version ".tar.gz"))
       (sha256
        (base32
         "16zkkpbfrd69853cdqf597fva969lirfc86b039i9zd7ghlrcayc"))))
    (build-system haskell-build-system)
    (inputs
     `(("cpphs" ,cpphs)
       ("ghc-unordered-containers" ,ghc-unordered-containers)
       ("ghc-yaml" ,ghc-yaml)
       ("ghc-vector" ,ghc-vector)
       ("ghc-data-default" ,ghc-data-default)
       ("ghc-cmdargs" ,ghc-cmdargs)
       ("ghc-haskell-src-exts" ,ghc-haskell-src-exts)
       ("ghc-haskell-src-exts-util" ,ghc-haskell-src-exts-util)
       ("ghc-uniplate" ,ghc-uniplate)
       ("ghc-ansi-terminal" ,ghc-ansi-terminal)
       ("ghc-extra" ,ghc-extra)
       ("ghc-refact" ,ghc-refact)
       ("ghc-aeson" ,ghc-aeson)
       ("ghc-lib-parser" ,ghc-lib-parser)
       ("hscolour" ,hscolour)))
    (home-page "https://github.com/ndmitchell/hlint")
    (synopsis "Suggest improvements for Haskell source code")
    (description "HLint reads Haskell programs and suggests changes that
hopefully make them easier to read.  HLint also makes it easy to disable
unwanted suggestions, and to add your own custom suggestions.")
    (license license:bsd-3)))

(define-public hoogle
  (package
    (name "hoogle")
    (version "5.0.17.11")
    (source
     (origin
       (method url-fetch)
       (uri
        (string-append
         "https://hackage.haskell.org/package/hoogle/hoogle-"
         version ".tar.gz"))
       (sha256
        (base32
         "1svp8z9pad8z2j386pr0dda0ds8ddxab0salnz4gm51q877w93p1"))))
    (build-system haskell-build-system)
    (inputs
     `(("ghc-quickcheck" ,ghc-quickcheck)
       ("ghc-aeson" ,ghc-aeson)
       ("ghc-blaze-html" ,ghc-blaze-html)
       ("ghc-blaze-markup" ,ghc-blaze-markup)
       ("ghc-cmdargs" ,ghc-cmdargs)
       ("ghc-conduit" ,ghc-conduit)
       ("ghc-conduit-extra" ,ghc-conduit-extra)
       ("ghc-connection" ,ghc-connection)
       ("ghc-extra" ,ghc-extra)
       ("ghc-foundation" ,ghc-foundation)
       ("ghc-old-locale" ,ghc-old-locale)
       ("ghc-haskell-src-exts" ,ghc-haskell-src-exts)
       ("ghc-http-conduit" ,ghc-http-conduit)
       ("ghc-http-types" ,ghc-http-types)
       ("ghc-js-flot" ,ghc-js-flot)
       ("ghc-js-jquery" ,ghc-js-jquery)
       ("ghc-mmap" ,ghc-mmap)
       ("ghc-process-extras" ,ghc-process-extras)
       ("ghc-resourcet" ,ghc-resourcet)
       ("ghc-storable-tuple" ,ghc-storable-tuple)
       ("ghc-tar" ,ghc-tar)
       ("ghc-uniplate" ,ghc-uniplate)
       ("ghc-utf8-string" ,ghc-utf8-string)
       ("ghc-vector" ,ghc-vector)
       ("ghc-wai" ,ghc-wai)
       ("ghc-wai-logger" ,ghc-wai-logger)
       ("ghc-warp" ,ghc-warp)
       ("ghc-warp-tls" ,ghc-warp-tls)
       ("ghc-zlib" ,ghc-zlib)))
    (home-page "https://hoogle.haskell.org/")
    (synopsis "Haskell API Search")
    (description "Hoogle is a Haskell API search engine, which allows
you to search many standard Haskell libraries by either function name,
or by approximate type signature.")
    (license license:bsd-3)))

(define-public hscolour
  (package
    (name "hscolour")
    (version "1.24.4")
    (source
     (origin
       (method url-fetch)
       (uri (string-append
             "https://hackage.haskell.org/package/hscolour/hscolour-"
             version
             ".tar.gz"))
       (sha256
        (base32
         "079jwph4bwllfp03yfr26s5zc6m6kw3nhb1cggrifh99haq34cr4"))))
    (build-system haskell-build-system)
    (home-page "https://hackage.haskell.org/package/hscolour")
    (synopsis "Script to colourise Haskell code")
    (description "HSColour is a small Haskell script to colourise Haskell
code.  It currently has six output formats: ANSI terminal codes (optionally
XTerm-256colour codes), HTML 3.2 with font tags, HTML 4.01 with CSS, HTML 4.01
with CSS and mouseover annotations, XHTML 1.0 with inline CSS styling, LaTeX,
and mIRC chat codes.")
    (license license:bsd-3)))

(define-public kmonad
  (package
    (name "kmonad")
    (version "0.4.0")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://github.com/david-janssen/kmonad")
             (commit version)))
       (file-name (git-file-name name version))
       (sha256
        (base32 "064gnzzcm6fnxfiildbjmgbdxkhqvp61zrl6qhkl1pgbn27j1mll"))))
    (build-system haskell-build-system)
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (delete 'haddock)             ; Haddock fails to generate docs
         (add-after 'install 'install-udev-rules
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (rules (string-append out "/lib/udev/rules.d")))
               (mkdir-p rules)
               (call-with-output-file (string-append rules "/70-kmonad.rules")
                 (lambda (port)
                   (display
                    (string-append
                     "KERNEL==\"uinput\", MODE=\"0660\", "
                     "GROUP=\"input\", OPTIONS+=\"static_node=uinput\"\n")
                    port)))
               #t)))
         (add-after 'install-udev-rules 'install-documentation
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (doc (string-append out "/share/doc/kmonad-" ,version)))
               (install-file "README.md" doc)
               (copy-recursively "doc" doc)
               (copy-recursively "keymap" (string-append doc "/keymap"))
               #t))))))
    (inputs
     `(("ghc-cereal" ,ghc-cereal)
       ("ghc-exceptions" ,ghc-exceptions)
       ("ghc-hashable" ,ghc-hashable)
       ("ghc-lens" ,ghc-lens)
       ("ghc-megaparsec" ,ghc-megaparsec)
       ("ghc-optparse-applicative" ,ghc-optparse-applicative)
       ("ghc-resourcet" ,ghc-resourcet)
       ("ghc-rio" ,ghc-rio)
       ("ghc-unagi-chan" ,ghc-unagi-chan)
       ("ghc-unliftio" ,ghc-unliftio)
       ("ghc-unordered-containers" ,ghc-unordered-containers)))
    (home-page "https://github.com/david-janssen/kmonad")
    (synopsis "Advanced keyboard manager")
    (description "KMonad is a keyboard remapping utility that supports
advanced functionality, such as custom keymap layers and modifiers, macros,
and conditional mappings that send a different keycode when tapped or held.
By operating at a lower level than most similar tools, it supports X11,
Wayland, and Linux console environments alike.")
    (license license:expat)))

(define-public raincat
  (package
    (name "raincat")
    (version "1.2.1")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "mirror://hackage/package/Raincat/"
                           "Raincat-" version ".tar.gz"))
       (sha256
        (base32
         "10y9zi22m6hf13c9h8zd9vg7mljpwbw0r3djb6r80bna701fdf6c"))))
    (build-system haskell-build-system)
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (add-after 'install 'wrap-executable
           (lambda* (#:key inputs outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (wrap-program (string-append out "/bin/raincat")
                 `("LD_LIBRARY_PATH" ":" =
                   (,(string-append (assoc-ref inputs "freeglut")
                                    "/lib"))))
               #t))))))
    (inputs
     `(("ghc-extensible-exceptions" ,ghc-extensible-exceptions)
       ("ghc-random" ,ghc-random)
       ("ghc-glut" ,ghc-glut)
       ("freeglut" ,freeglut)
       ("ghc-opengl" ,ghc-opengl)
       ("ghc-sdl2" ,ghc-sdl2)
       ("ghc-sdl2-image" ,ghc-sdl2-image)
       ("ghc-sdl2-mixer" ,ghc-sdl2-mixer)))
    (home-page "https://www.gamecreation.org/games/raincat")
    (synopsis "Puzzle game with a cat in lead role")
    (description "Project Raincat is a game developed by Carnegie Mellon
students through GCS during the Fall 2008 semester.  Raincat features game
play inspired from classics Lemmings and The Incredible Machine.  The project
proved to be an excellent learning experience for the programmers.  Everything
is programmed in Haskell.")
    (license license:bsd-3)))

(define-public scroll
  (package
    (name "scroll")
    (version "1.20180421")
    (source
      (origin
        (method url-fetch)
        (uri (string-append
               "https://hackage.haskell.org/package/scroll/scroll-"
               version ".tar.gz"))
        (sha256
         (base32
          "0apzrvf99rskj4dbmn57jjxrsf19j436s8a09m950df5aws3a0wj"))))
    (build-system haskell-build-system)
    (arguments
     '(#:phases
       (modify-phases %standard-phases
         (add-after 'install 'touch-static-output
           (lambda* (#:key outputs #:allow-other-keys)
             ;; The Haskell build system adds a "static" output by
             ;; default, and there is no way to override this until
             ;; <https://issues.guix.gnu.org/41569> is fixed.  Without
             ;; this phase, the daemon complains because we do not
             ;; create the "static" output.
             (with-output-to-file (assoc-ref outputs "static")
               (lambda ()
                 (display "static output not used\n")))
             #t)))))
    (inputs
     `(("ghc-case-insensitive" ,ghc-case-insensitive)
       ("ghc-data-default" ,ghc-data-default)
       ("ghc-ifelse" ,ghc-ifelse)
       ("ghc-monad-loops" ,ghc-monad-loops)
       ("ghc-ncurses" ,ghc-ncurses)
       ("ghc-optparse-applicative" ,ghc-optparse-applicative)
       ("ghc-random" ,ghc-random)
       ("ghc-vector" ,ghc-vector)))
    (home-page "https://joeyh.name/code/scroll/")
    (synopsis "scroll(6), a roguelike game")
    (description
     "You're a bookworm that's stuck on a scroll.  You have to dodge between
words and use spells to make your way down the page as the scroll is read.  Go
too slow and you'll get wound up in the scroll and crushed.")
    (license license:gpl2)))

(define-public shellcheck
  (package
    (name "shellcheck")
    (version "0.7.1")
    (source
     (origin
       (method url-fetch)
       (uri (string-append
             "https://hackage.haskell.org/package/ShellCheck/ShellCheck-"
             version ".tar.gz"))
       (sha256
        (base32 "06m4wh891nah3y0br4wh3adpsb16zawkb2ijgf1vcz61fznj6ps1"))
       (file-name (string-append name "-" version ".tar.gz"))))
    (build-system haskell-build-system)
    (inputs
     `(("ghc-aeson" ,ghc-aeson)
       ("ghc-diff" ,ghc-diff)
       ("ghc-quickcheck" ,ghc-quickcheck)
       ("ghc-regex-tdfa" ,ghc-regex-tdfa)))
    (home-page "https://www.shellcheck.net/")
    (synopsis "Static analysis for shell scripts")
    (description "@code{shellcheck} provides static analysis for
@command{bash} and @command{sh} shell scripts.
It gives warnings and suggestions in order to:

@enumerate
@item Point out and clarify typical beginner's syntax issues that cause
a shell to give cryptic error messages.
@item Point out and clarify typical intermediate level semantic problems
that cause a shell to behave strangely and counter-intuitively.
@item Point out subtle caveats, corner cases and pitfalls that may cause an
advanced user's otherwise working script to fail under future circumstances.
@end enumerate")
    (license license:gpl3+)))

(define-public shelltestrunner
  (package
    (name "shelltestrunner")
    (version "1.9")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://hackage/package/shelltestrunner-"
                                  version "/shelltestrunner-" version ".tar.gz"))
              (sha256
               (base32
                "1a5kzqbwg6990249ypw0cx6cqj6663as1kbj8nzblcky8j6kbi6b"))))
    (build-system haskell-build-system)
    (arguments
     '(#:phases
       (modify-phases %standard-phases
         (delete 'check)
         (add-after 'install 'check
           (lambda* (#:key outputs tests? parallel-tests? #:allow-other-keys)
             ;; This test is inspired by the Makefile in the upstream
             ;; repository, which is missing in the Hackage release tarball
             ;; along with some of the tests.  The Makefile would not work
             ;; anyway as it ties into the 'stack' build tool.
             (let* ((out (assoc-ref outputs "out"))
                    (shelltest (string-append out "/bin/shelltest"))
                    (numjobs (if parallel-tests?
                                 (number->string (parallel-job-count))
                                 "1")))
               (if tests?
                   (invoke shelltest (string-append "-j" numjobs)
                           "tests/examples")
                   (format #t "test suite not run~%"))
               #t))))))
    (inputs
     `(("ghc-diff" ,ghc-diff)
       ("ghc-cmdargs" ,ghc-cmdargs)
       ("ghc-filemanip" ,ghc-filemanip)
       ("ghc-hunit" ,ghc-hunit)
       ("ghc-pretty-show" ,ghc-pretty-show)
       ("ghc-regex-tdfa" ,ghc-regex-tdfa)
       ("ghc-safe" ,ghc-safe)
       ("ghc-utf8-string" ,ghc-utf8-string)
       ("ghc-test-framework" ,ghc-test-framework)
       ("ghc-test-framework-hunit" ,ghc-test-framework-hunit)))
    (home-page "https://github.com/simonmichael/shelltestrunner")
    (synopsis "Test CLI programs")
    (description
     "shelltestrunner (executable: @command{shelltest}) is a command-line tool
for testing command-line programs, or general shell commands.  It reads simple
test specifications defining a command to run, some input, and the expected
output, stderr, and exit status.")
    (license license:gpl3+)))

(define-public stylish-haskell
  (package
    (name "stylish-haskell")
    (version "0.9.2.2")
    (source
     (origin
       (method url-fetch)
       (uri
        (string-append
         "mirror://hackage/package/stylish-haskell/"
         "stylish-haskell-" version ".tar.gz"))
       (sha256
        (base32
         "1zs624xqp6j8vrl6pfv18dm8vz8hvz25grri65ximxhcizgwhnax"))))
    (build-system haskell-build-system)
    (inputs
     `(("ghc-aeson" ,ghc-aeson)
       ("ghc-file-embed" ,ghc-file-embed)
       ("ghc-haskell-src-exts" ,ghc-haskell-src-exts)
       ("ghc-semigroups" ,ghc-semigroups)
       ("ghc-syb" ,ghc-syb)
       ("ghc-yaml" ,ghc-yaml)
       ("ghc-strict" ,ghc-strict)
       ("ghc-optparse-applicative" ,ghc-optparse-applicative)
       ("ghc-hunit" ,ghc-hunit)
       ("ghc-test-framework" ,ghc-test-framework)
       ("ghc-test-framework-hunit" ,ghc-test-framework-hunit)))
    (home-page "https://github.com/jaspervdj/stylish-haskell")
    (synopsis "Haskell code prettifier")
    (description "Stylish-haskell is a Haskell code prettifier.  The goal is
not to format all of the code in a file, to avoid \"getting in the way\".
However, this tool can e.g. clean up import statements and help doing various
tasks that get tedious very quickly.  It can
@itemize
@item
Align and sort @code{import} statements
@item
Group and wrap @code{{-# LANGUAGE #-}} pragmas, remove (some) redundant
pragmas
@item
Remove trailing whitespaces
@item
Align branches in @code{case} and fields in records
@item
Convert line endings (customisable)
@item
Replace tabs by four spaces (turned off by default)
@item
Replace some ASCII sequences by their Unicode equivalent (turned off by
default)
@end itemize")
    (license license:bsd-3)))

(define-public ghc-stylish-haskell
  (deprecated-package "ghc-stylish-haskell" stylish-haskell))