aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2020, 2021 Mathieu Othacehe <othacehe@gnu.org>
;;;
;;; 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 ci)
  #:use-module (guix build-system channel)
  #:use-module (guix config)
  #:autoload   (guix describe) (package-channels)
  #:use-module (guix memoization)
  #:use-module (guix store)
  #:use-module (guix profiles)
  #:use-module (guix packages)
  #:autoload   (guix transformations) (tunable-package? tuned-package)
  #:use-module (guix channels)
  #:use-module (guix config)
  #:use-module (guix derivations)
  #:use-module (guix monads)
  #:use-module (guix gexp)
  #:use-module (guix ui)
  #:use-module ((guix licenses)
                #:select (gpl3+ license? license-name))
  #:use-module ((guix utils) #:select (%current-system))
  #:use-module ((guix scripts system) #:select (read-operating-system))
  #:use-module ((guix scripts pack)
                #:select (self-contained-tarball))
  #:use-module (gnu bootloader)
  #:use-module (gnu bootloader u-boot)
  #:use-module (gnu compression)
  #:use-module (gnu image)
  #:use-module (gnu packages)
  #:use-module (gnu packages gcc)
  #:use-module (gnu packages gdb)
  #:use-module (gnu packages base)
  #:use-module (gnu packages gawk)
  #:use-module (gnu packages guile)
  #:use-module (gnu packages gettext)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages multiprecision)
  #:use-module (gnu packages make-bootstrap)
  #:use-module (gnu packages package-management)
  #:use-module (guix platform)
  #:use-module (gnu system)
  #:use-module (gnu system image)
  #:use-module (gnu system vm)
  #:use-module (gnu system install)
  #:use-module (gnu system images hurd)
  #:use-module (gnu system images novena)
  #:use-module (gnu system images pine64)
  #:use-module (gnu system images pinebook-pro)
  #:use-module (gnu system images visionfive2)
  #:use-module (gnu tests)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)
  #:export (derivation->job
            image->job

            %core-packages

            arguments->systems
            cuirass-jobs))

;;; Commentary:
;;;
;;; This file defines build jobs for Cuirass.
;;;
;;; Code:

(define* (derivation->job name drv
                          #:key
                          (max-silent-time 3600)
                          (timeout (* 5 3600)))
  "Return a Cuirass job called NAME and describing DRV.

MAX-SILENT-TIME and TIMEOUT are build options passed to the daemon when
building the derivation."
  `((#:job-name . ,name)
    (#:derivation . ,(derivation-file-name drv))
    (#:inputs . ,(map (compose derivation-file-name
                               derivation-input-derivation)
                      (derivation-inputs drv)))
    (#:outputs . ,(filter-map
                   (lambda (res)
                     (match res
                       ((name . path)
                        `(,name . ,path))))
                   (derivation->output-paths drv)))
    (#:nix-name . ,(derivation-name drv))
    (#:system . ,(derivation-system drv))
    (#:max-silent-time . ,max-silent-time)
    (#:timeout . ,timeout)))

(define* (package-job store job-name package system
                      #:key cross? target (suffix ""))
  "Return a job called JOB-NAME that builds PACKAGE on SYSTEM."
  (let ((job-name (string-append job-name "." system suffix)))
    (parameterize ((%graft? #f))
      (let* ((drv (if cross?
                      (package-cross-derivation store package target system
                                                #:graft? #f)
                      (package-derivation store package system
                                          #:graft? #f)))
             (max-silent-time (or (assoc-ref (package-properties package)
                                             'max-silent-time)
                                  3600))
             (timeout (or (assoc-ref (package-properties package)
                                     'timeout)
                          72000)))
        (derivation->job job-name drv
                         #:max-silent-time max-silent-time
                         #:timeout timeout)))))

(define (package-cross-job store job-name package target system)
  "Return a job called TARGET.JOB-NAME that cross-builds PACKAGE for TARGET on
SYSTEM."
  (let ((name (string-append target "." job-name)))
    (package-job store name package system
                 #:cross? #t
                 #:target target)))

(define %core-packages
  ;; Note: Don't put the '-final' package variants because (1) that's
  ;; implicit, and (2) they cannot be cross-built (due to the explicit input
  ;; chain.)
  (list gcc-10 gcc-11 gcc-12 glibc binutils gdb-minimal
        gmp mpfr mpc coreutils findutils diffutils patch sed grep
        gawk gnu-gettext hello guile-2.2 guile-3.0 zlib gzip xz guix
        %bootstrap-binaries-tarball
        %binutils-bootstrap-tarball
        (%glibc-bootstrap-tarball)
        %gcc-bootstrap-tarball
        %guile-bootstrap-tarball
        %bootstrap-tarballs))

(define (commencement-packages system)
  "Return the list of bootstrap packages from the commencement module for
SYSTEM."
  ;; Only include packages supported on SYSTEM.  For example, the Mes
  ;; bootstrap graph is currently not supported on ARM so it should be
  ;; excluded.
  (filter (lambda (obj)
            (and (package? obj)
                 (supported-package? obj system)))
          (module-map (lambda (sym var)
                        (variable-ref var))
                      (resolve-module '(gnu packages commencement)))))

(define (packages-to-cross-build target)
  "Return the list of packages to cross-build for TARGET."
  ;; Don't cross-build the bootstrap tarballs for MinGW.
  (if (string-contains target "mingw")
      (drop-right %core-packages 6)
      %core-packages))

(define %bare-platform-triplets
  ;; Cross-compilation triplets of platforms that lack a proper user-space and
  ;; for which there's no point in trying to build regular packages.
  '("avr"
    "or1k-elf"
    "xtensa-ath9k-elf"))

(define %unsupported-platform-triplets
  ;; These systems are kept around for nostalgia or for tinkering, but regular
  ;; CI is disabled for them to reduce the load on CI infrastructure.
  '("mips64el-linux-gnu"
    "powerpc-linux-gnu"
    "powerpc64-linux-gnu"))

(define (cross-jobs store system)
  "Return a list of cross-compilation jobs for SYSTEM."
  (define (from-32-to-64? target)
    ;; Return true if SYSTEM is 32-bit and TARGET is 64-bit.  This hack
    ;; prevents known-to-fail cross-builds from i686-linux or armhf-linux to
    ;; mips64el-linux-gnuabi64.
    (and (or (string-prefix? "i686-" system)
             (string-prefix? "i586-" system)
             (string-prefix? "armhf-" system))
         (string-contains target "64")))    ;x86_64, mips64el, aarch64, etc.

  (define (same? target)
    ;; Return true if SYSTEM and TARGET are the same thing.  This is so we
    ;; don't try to cross-compile to 'mips64el-linux-gnu' from
    ;; 'mips64el-linux'.
    (or (and (string-contains target system)
             (not (string=? "x86_64-linux-gnux32" target)))
        (and (string-prefix? "armhf" system)    ;armhf-linux
             (string-prefix? "arm" target))))   ;arm-linux-gnueabihf

  (define (pointless? target)
    ;; Return #t if it makes no sense to cross-build to TARGET from SYSTEM.
    (or (member target %bare-platform-triplets)
        (member target %unsupported-platform-triplets)
        (match system
          ((or "x86_64-linux" "i686-linux")
           (if (string-contains target "mingw")
               (not (string=? "x86_64-linux" system))
               #f))
          (_
           ;; Don't try to cross-compile from non-Intel platforms: this isn't
           ;; very useful and these are often brittle configurations.
           #t))))

  (define (either proc1 proc2 proc3)
    (lambda (x)
      (or (proc1 x) (proc2 x) (proc3 x))))

  (append-map (lambda (target)
                (map (lambda (package)
                       (package-cross-job store (job-name package)
                                          package target system))
                     (packages-to-cross-build target)))
              (remove (either from-32-to-64? same? pointless?)
                      (targets))))

(define* (guix-jobs store systems #:key source commit)
  "Return a list of jobs for Guix itself."
  (define build
    (primitive-load (string-append source "/build-aux/build-self.scm")))

  (map
   (lambda (system)
     (let ((name (string->symbol
                  (string-append "guix." system)))
           (drv (run-with-store store
                  (build source #:version commit #:system system
                         #:pull-version 1
                         #:guile-version "2.2"))))
       (derivation->job name drv)))
   systems))

;; Architectures that are able to build or cross-build Guix System images.
;; This does not mean that other architectures are not supported, only that
;; they are often not fast enough to support Guix System images building.
(define %guix-system-supported-systems
  '("x86_64-linux" "i686-linux"))

(define %guix-system-images
  (list hurd-barebones-qcow2-image
        pine64-barebones-raw-image
        pinebook-pro-barebones-raw-image
        novena-barebones-raw-image
        visionfive2-barebones-raw-image))

(define (hours hours)
  (* 3600 hours))

(define* (image->job store image
                     #:key name system)
  "Return the job for IMAGE on SYSTEM.  If NAME is passed, use it as job name,
otherwise use the IMAGE name."
  (let* ((image-name (or name
                         (symbol->string (image-name image))))
         (name (string-append image-name "." system))
         (drv (run-with-store store
                (mbegin %store-monad
                  (set-guile-for-build (default-guile))
                  (lower-object (system-image image) system)))))
    (parameterize ((%graft? #f))
      (derivation->job name drv))))

(define* (image-jobs store system
                     #:key source commit)
  "Return a list of jobs that build images for SYSTEM."
  (define MiB
    (expt 2 20))

  (parameterize ((current-guix-package
                  (channel-source->package source #:commit commit)))
    (if (member system %guix-system-supported-systems)
        `(,(image->job store
                       (image
                        (inherit mbr-hybrid-disk-image)
                        (operating-system installation-os))
                       #:name "usb-image"
                       #:system system)
          ,(image->job
            store
            (image
             (inherit (image-with-label
                       iso9660-image
                       (string-append "GUIX_" system "_"
                                      (if (> (string-length %guix-version) 7)
                                          (substring %guix-version 0 7)
                                          %guix-version))))
             (operating-system installation-os))
            #:name "iso9660-image"
            #:system system)
          ;; Only cross-compile Guix System images from x86_64-linux for now.
          ,@(if (string=? system "x86_64-linux")
                (map (cut image->job store <>
                          #:system system)
                     %guix-system-images)
                '()))
        '())))

(define* (system-test-jobs store system
                           #:key source commit)
  "Return a list of jobs for the system tests."
  (define (->job test)
    (let ((name (string-append "test." (system-test-name test)
                               "." system))
          (drv (run-with-store store
                 (mbegin %store-monad
                   (set-current-system system)
                   (set-grafting #f)
                   (set-guile-for-build (default-guile))
                   (system-test-value test)))))

      (derivation->job name drv)))

  (if (member system %guix-system-supported-systems)
      ;; Override the value of 'current-guix' used by system tests.  Using a
      ;; channel instance makes tests that rely on 'current-guix' less
      ;; expensive.  It also makes sure we get a valid Guix package when this
      ;; code is not running from a checkout.
      (parameterize ((current-guix-package
                      (channel-source->package source #:commit commit)))
        (map ->job (all-system-tests)))
      '()))

(define (tarball-jobs store system)
  "Return jobs to build the self-contained Guix binary tarball."
  (define (->job name drv)
    (let ((name (string-append name "." system)))
      (parameterize ((%graft? #f))
        (derivation->job name drv))))

  ;; XXX: Add a job for the stable Guix?
  (list
   (->job "binary-tarball"
          (run-with-store store
            (mbegin %store-monad
              (set-guile-for-build (default-guile))
              (>>= (profile-derivation (packages->manifest (list guix)))
                   (lambda (profile)
                     (self-contained-tarball "guix-binary" profile
                                             #:profile-name "current-guix"
                                             #:localstatedir? #t
                                             #:compressor
                                             (lookup-compressor "xz")))))
            #:system system))))

(define job-name
  ;; Return the name of a package's job.
  package-name)

(define base-packages
  (mlambda (system)
    "Return the set of packages considered to be part of the base for SYSTEM."
    (delete-duplicates
     (append-map (match-lambda
                   ((_ package _ ...)
                    (match (package-transitive-inputs package)
                      (((_ inputs _ ...) ...)
                       inputs))))
                 (%final-inputs system)))))

(define package->job
  (lambda* (store package system #:key (suffix ""))
    "Return a job for PACKAGE on SYSTEM, or #f if this combination is not
valid.  Append SUFFIX to the job name."
    (cond ((member package (base-packages system))
           (package-job store (string-append "base." (job-name package))
                        package system #:suffix suffix))
          ((supported-package? package system)
           (let ((drv (package-derivation store package system
                                          #:graft? #f)))
             (and (substitutable-derivation? drv)
                  (package-job store (job-name package)
                               package system #:suffix suffix))))
          (else
           #f))))

(define %x86-64-micro-architectures
  ;; Micro-architectures for which we build tuned variants.
  '("haswell" "skylake" "x86-64-v2" "x86-64-v3" "x86-64-v4"))

(define (tuned-package-jobs store package system)
  "Return a list of jobs for PACKAGE tuned for SYSTEM's micro-architectures."
  (filter-map (lambda (micro-architecture)
                (define suffix
                  (string-append "." micro-architecture))

                (package->job store
                              (tuned-package package micro-architecture)
                              system
                              #:suffix suffix))
              (match system
                ("x86_64-linux" %x86-64-micro-architectures)
                (_ '()))))

(define (all-packages)
  "Return the list of packages to build."
  (define (adjust package result)
    (cond ((package-replacement package)
           ;; XXX: If PACKAGE and its replacement have the same name/version,
           ;; then both Cuirass jobs will have the same name, which
           ;; effectively means that the second one will be ignored.  Thus,
           ;; return the replacement first.
           (cons* (package-replacement package)   ;build both
                  package
                  result))
          ((package-superseded package)
           result)                                ;don't build it
          (else
           (cons package result))))

  (fold-packages adjust
                 (fold adjust '()                 ;include base packages
                       (match (%final-inputs)
                         (((labels packages _ ...) ...)
                          packages)))
                 #:select? (const #t)))           ;include hidden packages

(define (arguments->manifests arguments channels)
  "Return the list of manifests extracted from ARGUMENTS."
  (map (lambda (manifest)
         (any (lambda (checkout)
                (let ((path (in-vicinity checkout manifest)))
                  (and (file-exists? path)
                       path)))
              (map channel-url channels)))
       arguments))

(define (manifests->jobs store manifests systems)
  "Return the list of jobs for the entries in MANIFESTS, a list of file
names, for each one of SYSTEMS."
  (define (load-manifest manifest)
    (save-module-excursion
     (lambda ()
       (set-current-module (make-user-module '((guix profiles) (gnu))))
       (primitive-load manifest))))

  (define (manifest-entry-job-name entry)
    (string-append (manifest-entry-name entry) "-"
                   (manifest-entry-version entry)))

  (define (manifest-entry->job entry system)
    (let* ((obj (manifest-entry-item entry))
           (drv (parameterize ((%graft? #f))
                  (run-with-store store
                    (lower-object obj system)
                    #:system system)))
           (max-silent-time (or (and (package? obj)
                                     (assoc-ref (package-properties obj)
                                                'max-silent-time))
                                3600))
           (timeout (or (and (package? obj)
                             (assoc-ref (package-properties obj) 'timeout))
                        (* 5 3600))))
      (derivation->job (manifest-entry-job-name entry) drv
                       #:max-silent-time max-silent-time
                       #:timeout timeout)))

  (let ((entries (delete-duplicates
                  (append-map (compose manifest-entries load-manifest)
                              manifests)
                  manifest-entry=?)))
    (append-map (lambda (system)
                  (map (cut manifest-entry->job <> system) entries))
                systems)))

(define (arguments->systems arguments)
  "Return the systems list from ARGUMENTS."
  (match (assoc-ref arguments 'systems)
    (#f              %cuirass-supported-systems)
    ((lst ...)       lst)
    ((? string? str) (call-with-input-string str read))))


;;;
;;; Cuirass entry point.
;;;

(define (cuirass-jobs store arguments)
  "Register Cuirass jobs."
  (define subset
    (assoc-ref arguments 'subset))

  (define systems
    (arguments->systems arguments))

  (define channels
    (let ((channels (assq-ref arguments 'channels)))
      (map sexp->channel channels)))

  (define guix
    (find guix-channel? channels))

  (define commit
    (channel-commit guix))

  (define source
    (channel-url guix))

  ;; Turn off grafts.  Grafting is meant to happen on the user's machines.
  (parameterize ((%graft? #f))
    ;; Return one job for each package, except bootstrap packages.
    (append-map
     (lambda (system)
       (format (current-error-port)
               "evaluating for '~a' (heap size: ~a MiB)...~%"
               system
               (round
                (/ (assoc-ref (gc-stats) 'heap-size)
                   (expt 2. 20))))
       (invalidate-derivation-caches!)
       (match subset
         ('all
          ;; Build everything, including replacements.
          (let ((all (all-packages))
                (jobs (lambda (package)
                        (match (package->job store package system)
                          (#f '())
                          (main-job
                           (cons main-job
                                 (if (tunable-package? package)
                                     (tuned-package-jobs store package system)
                                     '())))))))
            (append
             (append-map jobs all)
             (cross-jobs store system))))
         ('core
          ;; Build core packages only.
          (append
           (map (lambda (package)
                  (package-job store (job-name package)
                               package system))
                (append (commencement-packages system) %core-packages))
           (cross-jobs store system)))
         ('guix
          ;; Build Guix modules only.
          (guix-jobs store systems
                     #:source source
                     #:commit commit))
         ('hello
          ;; Build hello package only.
          (let ((hello (specification->package "hello")))
            (list (package-job store (job-name hello)
                               hello system))))
         ('images
          ;; Build Guix System images only.
          (image-jobs store system
                      #:source source
                      #:commit commit))
         ('system-tests
          ;; Build Guix System tests only.
          (system-test-jobs store system
                            #:source source
                            #:commit commit))
         ('tarball
          ;; Build Guix tarball only.
          (tarball-jobs store system))
         (('custom . modules)
          ;; Build custom modules jobs only.
          (append-map
           (lambda (module)
             (let ((proc (module-ref
                          (resolve-interface module)
                          'cuirass-jobs)))
               (proc store arguments)))
           modules))
         (('channels . channels)
          ;; Build only the packages from CHANNELS.
          (let ((all (all-packages)))
            (filter-map
             (lambda (package)
               (any (lambda (channel)
                      (and (member (channel-name channel) channels)
                           (package->job store package system)))
                    (package-channels package)))
             all)))
         (('packages . rest)
          ;; Build selected list of packages only.
          (let ((packages (map specification->package rest)))
            (map (lambda (package)
                   (package-job store (job-name package)
                                package system))
                 packages)))
         (('manifests . rest)
          ;; Build packages in the list of manifests.
          (let ((manifests (arguments->manifests rest channels)))
            (manifests->jobs store manifests systems)))
         (else
          (error "unknown subset" subset))))
     systems)))
generated by cgit
ion "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 (hackage-uri "hscolour" version)) (sha256 (base32 "079jwph4bwllfp03yfr26s5zc6m6kw3nhb1cggrifh99haq34cr4")))) (build-system haskell-build-system) (properties '((upstream-name . "hscolour"))) (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 ;; Project is active, but no new releases exist. Pick current master ;; HEAD as of 2024-08-18. (let ((commit "07cd1cb4fddb46a8d9de3bb9d06196d08b7a8ed2") (revision "1")) (package (name "kmonad") (version (git-version "0.4.2" revision commit)) (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/david-janssen/kmonad") (commit commit))) (file-name (git-file-name name version)) (sha256 (base32 "08ybif2lw0jy9h2hrlvx3469a3hkvih9gsg60kp9qnklzvqjdy5i")))) (build-system haskell-build-system) (arguments `(#:haddock? #f ; Haddock fails to generate docs #:phases (modify-phases %standard-phases (add-after 'unpack 'patch-git-path (lambda* (#:key inputs #:allow-other-keys) (substitute* "src/KMonad/Args/TH.hs" (("\"git\"") (string-append "\"" (search-input-file inputs "/bin/git") "\""))))) (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 (list ghc-cereal ghc-exceptions ghc-lens ghc-megaparsec ghc-optparse-applicative ghc-resourcet ghc-rio ghc-unliftio ghc-unordered-containers ghc-template-haskell)) (native-inputs (list ghc-hspec hspec-discover git)) (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 matterhorn (package (name "matterhorn") (version "90000.0.0") (source (origin ;; use git repo instead of hackage URL because the hackage tarball ;; doesn't contain the sample config file (method git-fetch) (uri (git-reference (url "https://github.com/matterhorn-chat/matterhorn") (commit version))) (sha256 (base32 "08ng5axranilvfl9j3v0mjgpg76kzacrqj4c8x6pblpc3yxx02i5")))) (build-system haskell-build-system) (properties '((upstream-name . "matterhorn"))) (inputs (list ghc-aeson ghc-aspell-pipe ghc-async ghc-base-compat ghc-bimap ghc-brick ghc-brick-skylighting ghc-commonmark ghc-commonmark-extensions ghc-config-ini ghc-crypton-connection ghc-data-clist ghc-gitrev ghc-hashable ghc-hclip ghc-mattermost-api ghc-microlens-platform ghc-network-uri ghc-random ghc-semigroups ghc-skylighting-core ghc-split ghc-stm-delay ghc-strict ghc-temporary ghc-text-zipper ghc-timezone-olson ghc-timezone-series ghc-unix-compat-7 ghc-unordered-containers ghc-utf8-string ghc-uuid ghc-vector ghc-vty-6 ghc-vty-crossplatform ghc-word-wrap ghc-xdg-basedir)) (native-inputs (list ghc-checkers ghc-mattermost-api-qc ghc-tasty ghc-tasty-hunit ghc-tasty-quickcheck ghc-unique)) (arguments (list #:phases #~(modify-phases %standard-phases (add-after 'unpack 'fix-requirements (lambda _ (for-each (lambda (dep) (substitute* "matterhorn.cabal" (((string-append "(,\\s" dep "\\s*>=\\s[0-9].[0-9]).*") all pat) pat))) (list "random" "data-clist" "semigroups" "word-wrap" "unix-compat" "skylighting-core" "checkers" "vty" "vty-crossplatform" "brick")))) (add-after 'install 'install-config-file (lambda _ (install-file "./docs/sample-config.ini" (string-append #$output "/share/doc/" #$name "-" #$version "/etc/"))))))) (home-page "https://hackage.haskell.org/package/matterhorn") (synopsis "Terminal client for the Mattermost chat system") (description "This is a terminal client for the Mattermost chat system.") (license license:bsd-3))) (define-public nixfmt (package (name "nixfmt") (version "0.5.0") (source (origin (method url-fetch) (uri (hackage-uri "nixfmt" version)) (sha256 (base32 "0rxi8zrd2xr72w673nvgnhb0g3r7rssc1ahlhz8rmdpc6c1a82wl")))) (build-system haskell-build-system) (properties '((upstream-name . "nixfmt"))) (inputs (list ghc-megaparsec ghc-parser-combinators ghc-cmdargs ghc-safe-exceptions)) (home-page "https://github.com/serokell/nixfmt") (synopsis "Opinionated formatter for Nix") (description "Nixfmt is a formatter for Nix that ensures consistent and clear formatting by forgetting all existing formatting during parsing.") (license license:mpl2.0))) (define-public greenclip (package (name "greenclip") (version "4.2") (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/erebe/greenclip") (commit (string-append "v" version)))) (file-name (git-file-name name version)) (sha256 (base32 "10r485q055ci29fmpsjy55n1yqfil53cvdxldlzw2n6mpynmckyv")))) (build-system haskell-build-system) (native-inputs (list pkg-config)) (inputs (list libx11 libxext libxscrnsaver ghc-x11 ghc-exceptions ghc-hashable ghc-microlens ghc-microlens-mtl ghc-protolude ghc-tomland ghc-vector ghc-wordexp)) (home-page "https://github.com/erebe/greenclip") (synopsis "Simple Clipboard manager") (description "@code{greenclip} is a clipboard manager written in Haskell.") (license license:bsd-3))) (define-public raincat (package (name "raincat") (version "1.2.1") (source (origin (method url-fetch) (uri (hackage-uri "Raincat" version)) (sha256 (base32 "10y9zi22m6hf13c9h8zd9vg7mljpwbw0r3djb6r80bna701fdf6c")))) (build-system haskell-build-system) (properties '((upstream-name . "Raincat"))) (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 (list bash-minimal ghc-extensible-exceptions ghc-random ghc-glut freeglut ghc-opengl ghc-sdl2 ghc-sdl2-image 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 (hackage-uri "scroll" version)) (sha256 (base32 "0apzrvf99rskj4dbmn57jjxrsf19j436s8a09m950df5aws3a0wj")))) (build-system haskell-build-system) (properties '((upstream-name . "scroll"))) (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 (list ghc-case-insensitive ghc-data-default ghc-ifelse ghc-monad-loops ghc-ncurses ghc-optparse-applicative ghc-random 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.10.0") (source (origin (method url-fetch) (uri (hackage-uri "ShellCheck" version)) (sha256 (base32 "08bdjcdl457xz2vh8y2w29bcwh1k7sfzyvszln3498vm5m1xn22d")) (file-name (string-append name "-" version ".tar.gz")))) (build-system haskell-build-system) (arguments (list #:haddock? #f ; TODO: Fails to build. #:phases #~(modify-phases %standard-phases (add-after 'build 'build-man-page (lambda _ (chmod "manpage" #o555) (invoke "./manpage"))) (add-after 'install 'install-man-page (lambda* (#:key outputs #:allow-other-keys) (install-file "shellcheck.1" (string-append #$output "/share/man/man1/")))) (add-after 'register 'remove-libraries (lambda* (#:key outputs #:allow-other-keys) (delete-file-recursively (string-append #$output "/lib"))))))) (native-inputs (list pandoc)) (inputs (list ghc-aeson ghc-diff ghc-fgl ghc-quickcheck 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") ;; CVE-2021-28794 is for a completely different, unofficial add-on. (properties `((lint-hidden-cve . ("CVE-2021-28794")) (upstream-name . "ShellCheck"))) (license license:gpl3+))) (define-public shelltestrunner (package (name "shelltestrunner") (version "1.9") (source (origin (method url-fetch) (uri (hackage-uri "shelltestrunner" version)) (sha256 (base32 "1a5kzqbwg6990249ypw0cx6cqj6663as1kbj8nzblcky8j6kbi6b")))) (build-system haskell-build-system) (properties '((upstream-name . "shelltestrunner"))) (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 (list ghc-diff ghc-cmdargs ghc-filemanip ghc-hunit ghc-pretty-show ghc-regex-tdfa ghc-safe ghc-utf8-string ghc-test-framework 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.14.3.0") (source (origin (method url-fetch) (uri (hackage-uri "stylish-haskell" version)) (sha256 (base32 "17w92v0qnwj7m6yqdq5cxbr04xiz0yfnnyx5q54218wdl7n5lf6d")))) (build-system haskell-build-system) (properties '((upstream-name . "stylish-haskell"))) (inputs (list ghc-aeson ghc-file-embed ghc-regex-tdfa ghc-syb ghc-hsyaml-aeson ghc-hsyaml ghc-semigroups ghc-lib-parser-ex ghc-strict ghc-optparse-applicative)) (native-inputs (list ghc-hunit ghc-random ghc-test-framework ghc-test-framework-hunit)) (home-page "https://github.com/haskell/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)))
generated by cgit