diff --git a/zilti/build-system/chicken.scm b/zilti/build-system/chicken.scm new file mode 100644 index 0000000..30e705b --- /dev/null +++ b/zilti/build-system/chicken.scm @@ -0,0 +1,147 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 raingloom +;;; Copyright © 2021 Ludovic Courtès +;;; Copyright © 2021 Xinglu Chen +;;; +;;; 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 . + +(define-module (zilti build-system chicken) + #:use-module (guix utils) + #:use-module (guix gexp) + #:use-module (guix store) + #:use-module (guix monads) + #:use-module (guix download) + #:use-module (guix search-paths) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (guix packages) + #:export (%chicken-build-system-modules + chicken-build + chicken-build-system + egg-uri)) + +(define* (egg-uri name version #:optional (extension ".tar.gz")) + "Return a URI string for the CHICKEN egg corresponding to NAME and VERSION. +EXTENSION is the file name extension, such as '.tar.gz'." + (string-append "https://code.call-cc.org/egg-tarballs/5/" + name "/" name "-" version extension)) + +(define %chicken-build-system-modules + ;; Build-side modules imported and used by default. + `((zilti build chicken-build-system) + (guix build union) + ,@%gnu-build-system-modules)) + +(define (default-chicken) + "Return the default Chicken package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((chicken (resolve-interface '(zilti packages chicken)))) + (module-ref chicken 'chicken))) + +(define* (lower name + #:key source inputs native-inputs outputs system target + (chicken (default-chicken)) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME." + (define private-keywords + '(#:target #:chicken #:inputs #:native-inputs #:outputs)) + + ;; TODO: cross-compilation support + (and (not target) + (bag + (name name) + (system system) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs + + ;; Keep the standard inputs of 'gnu-build-system', since + ;; Chicken compiles Scheme by using C as an intermediate + ;; language. + ,@(standard-packages))) + (build-inputs `(("chicken" ,chicken) + ,@native-inputs)) + (outputs outputs) + (build chicken-build) + (arguments + (substitute-keyword-arguments + (strip-keyword-arguments private-keywords arguments) + ((#:extra-directories extra-directories) + `(list ,@(append-map + (lambda (name) + (match (assoc name inputs) + ((_ pkg) + (match (package-transitive-propagated-inputs pkg) + (((propagated-names . _) ...) + (cons name propagated-names)))))) + extra-directories)))))))) + +(define* (chicken-build name inputs + #:key source + (tests? #t) + (parallel-build? #f) + (build-flags ''()) + (configure-flags ''()) + (extra-directories ''()) + (phases '%standard-phases) + (outputs '("out" "static")) + (search-paths '()) + (egg-name "") + (unpack-path "") + (system (%current-system)) + (guile #f) + (imported-modules %chicken-build-system-modules) + (modules '((zilti build chicken-build-system) + (guix build union) + (guix build utils)))) + (define builder + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + #$(with-build-variables inputs outputs + #~(chicken-build #:name #$name + #:source #+source + #:system #$system + #:phases #$phases + #:configure-flags #$configure-flags + #:extra-directories #$extra-directories + #:parallel-build? #$parallel-build? + #:outputs #$(outputs->gexp outputs) + #:search-paths '#$(sexp->gexp + (map search-path-specification->sexp + search-paths)) + #:egg-name #$egg-name + #:unpack-path #$unpack-path + #:build-flags #$build-flags + #:tests? #$tests? + #:inputs #$(input-tuples->gexp inputs)))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system #:graft? #f))) + (gexp->derivation name builder + #:system system + #:guile-for-build guile))) + +(define chicken-build-system + (build-system + (name 'chicken) + (description + "Build system for Chicken Scheme programs") + (lower lower))) diff --git a/zilti/build/chicken-build-system.scm b/zilti/build/chicken-build-system.scm new file mode 100644 index 0000000..b2ec0cb --- /dev/null +++ b/zilti/build/chicken-build-system.scm @@ -0,0 +1,140 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 raingloom +;;; +;;; 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 . + +(define-module (zilti build chicken-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:use-module (ice-9 ftw) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (rnrs io ports) + #:use-module (rnrs bytevectors) + #:export (%standard-phases + chicken-build)) + +;; CHICKEN_EGG_CACHE is where sources are fetched and binaries are built +;; CHICKEN_INSTALL_REPOSITORY is where dependencies are looked up +;; its first component is also where new eggs are installed. + +;; TODO: the binary version should be defined in one of the relevant modules +;; instead of being hardcoded everywhere. Tried to do that but got undefined +;; variable errors. + +(define (chicken-package? name) + (string-prefix? "chicken-" name)) + +(define* (setup-chicken-environment #:key inputs outputs #:allow-other-keys) + (setenv "CHICKEN_INSTALL_REPOSITORY" + (string-append (assoc-ref outputs "out") "/var/lib/chicken/11/")) + (setenv "CHICKEN_INSTALL_PREFIX" + (string-append (assoc-ref outputs "out") "/bin/")) + (setenv "CHICKEN_REPOSITORY_PATH" + (string-append (getenv "CHICKEN_REPOSITORY_PATH") + ":" (getenv "CHICKEN_INSTALL_REPOSITORY"))) + (setenv "CHICKEN_EGG_CACHE" (getcwd)) + #t) + +;; This is copied from go-build-system.scm so it could probably be simplified. +;; I used it because the source of the egg needs to be unpacked into a directory +;; that is named after the egg and I knew that the go build system does that. +(define* (unpack #:key source egg-name unpack-path #:allow-other-keys) + "Relative to $CHICKEN_EGG_CACHE, unpack SOURCE in UNPACK-PATH, or EGG-NAME +when UNPACK-PATH is unset. If the SOURCE archive has a single top level +directory, it is stripped so that the sources appear directly under UNPACK-PATH. +When SOURCE is a directory, copy its content into UNPACK-PATH instead of +unpacking." + (define (unpack-maybe-strip source dest) + (let* ((scratch-dir (string-append (or (getenv "TMPDIR") "/tmp") + "/scratch-dir")) + (out (mkdir-p scratch-dir))) + (with-directory-excursion scratch-dir + (if (string-suffix? ".zip" source) + (invoke "unzip" source) + (invoke "tar" "-xvf" source)) + (let ((top-level-files (remove (lambda (x) + (member x '("." ".."))) + (scandir ".")))) + (match top-level-files + ((top-level-file) + (when (file-is-directory? top-level-file) + (copy-recursively top-level-file dest #:keep-mtime? #t))) + (_ + (copy-recursively "." dest #:keep-mtime? #t))))) + (delete-file-recursively scratch-dir))) + + (when (string-null? egg-name) + (display "WARNING: The egg name is unset.\n")) + (when (string-null? unpack-path) + (set! unpack-path egg-name)) + (let ((dest (string-append (getenv "CHICKEN_EGG_CACHE") "/" unpack-path))) + (mkdir-p dest) + (if (file-is-directory? source) + (copy-recursively source dest #:keep-mtime? #t) + (unpack-maybe-strip source dest))) + #t) + +(define* (build #:key egg-name #:allow-other-keys) + "Build the Chicken egg named by EGG-NAME" + (invoke "echo" (getenv "CHICKEN_REPOSITORY_PATH")) + (invoke "chicken-install" "-cached" "-no-install" egg-name)) + +(define* (install #:key egg-name #:allow-other-keys) + "Install the already built egg named by EGG-NAME" + (invoke "chicken-install" "-cached" egg-name)) + +(define* (check #:key egg-name tests? #:allow-other-keys) + "Build and run tests for the Chicken egg EGG-NAME" + ;; there is no "-test-only" option, but we've already run install + ;; so this just runs tests. + ;; i think it's a fair assumption that phases won't be reordered. + (when tests? + (invoke "echo" (getenv "CHICKEN_REPOSITORY_PATH")) + (invoke "chicken-install" "-cached" "-test" "-no-install" egg-name))) + +(define* (stamp-egg-version #:key egg-name name #:allow-other-keys) + "Check if EGG-NAME.egg contains version information and add some if not." + (let* ((filename (string-append egg-name "/" egg-name ".egg")) + (egg-info (call-with-input-file filename read)) + (ver? (find (lambda (i) (eqv? (car i) 'version)) egg-info)) + (ver (substring name (1+ (string-rindex name #\-))))) + (when (not ver?) + (make-file-writable filename) + (call-with-output-file filename + (lambda (f) (write (cons `(version ,ver) egg-info) f)))))) + +;; It doesn't look like Chicken generates any unnecessary references. +;; So we don't have to remove them either. Nice. + +(define %standard-phases + (modify-phases gnu:%standard-phases + (replace 'unpack unpack) + (delete 'bootstrap) + (delete 'configure) + (delete 'patch-generated-file-shebangs) + (add-before 'unpack 'setup-chicken-environment setup-chicken-environment) + (add-before 'build 'stamp-egg-version stamp-egg-version) + (replace 'build build) + (delete 'check) + (replace 'install install) + (add-after 'install 'check check))) + +(define* (chicken-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given Chicken package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) diff --git a/zilti/packages/chicken.scm b/zilti/packages/chicken.scm index 0e7483a..275ee48 100644 --- a/zilti/packages/chicken.scm +++ b/zilti/packages/chicken.scm @@ -21,7 +21,7 @@ (define-module (zilti packages chicken) #:use-module (gnu packages) #:use-module (guix packages) - #:use-module (guix build-system chicken) + #:use-module (zilti build-system chicken) #:use-module (guix build-system gnu) #:use-module (guix download) #:use-module (guix git-download) @@ -129,7 +129,7 @@ file indexing tool.") (define-public chicken-check-errors (package (name "chicken-check-errors") - (version "3.6.0") + (version "3.7.1") (source (origin (method url-fetch) @@ -214,7 +214,7 @@ and manipulating lists and pairs.") (define-public chicken-srfi-13 (package (name "chicken-srfi-13") - (version "0.3.2") + (version "0.3.4") (source (origin (method url-fetch) (uri (egg-uri "srfi-13" version)) @@ -261,7 +261,7 @@ a characters and be compared to other character sets") (define-public chicken-srfi-18 (package (name "chicken-srfi-18") - (version "0.1.6") + (version "0.1.7") (source (origin (method url-fetch) (uri (egg-uri "srfi-18" version)) @@ -285,7 +285,7 @@ multiple processor cores is not available.") (define-public chicken-srfi-69 (package (name "chicken-srfi-69") - (version "0.4.1") + (version "0.4.3") (source (origin (method svn-fetch) @@ -340,6 +340,31 @@ variant records, as described in the book @i{Essentials of Programming Languages} by Friedman, Wand, and Haynes.") (license license:bsd-3))) +(define-public chicken-fmt + (package + (name "chicken-fmt") + (version "0.8.11.2") + (source + (origin + (method url-fetch) + (uri (egg-uri "fmt" version)) + (sha256 + (base32 + "1x7al8nknj1xbs6hjfs6gs2h6cjy29gnhplvqisbqdpzxyq5zs20")))) + (propagated-inputs + (list chicken-srfi-1 + chicken-srfi-13 + chicken-srfi-69 + chicken-utf8)) + (native-inputs + (list chicken-test)) + (build-system chicken-build-system) + (arguments '(#:egg-name "fmt")) + (synopsis "A library of procedures for formatting Scheme objects to text in various ways") + (home-page "https://wiki.call-cc.org/eggref/5/fmt") + (description "A library of procedures for formatting Scheme objects to text in various ways") + (license license:bsd-2))) + (define-public chicken-iset (package (name "chicken-iset") @@ -369,6 +394,28 @@ Bit-vectors provide an abstract interface to bitwise operations typically done with integers.") (license license:bsd-3))) +(define-public chicken-matchable + (package + (name "chicken-matchable") + (version "1.1") + (source + (origin + (method url-fetch) + (uri (egg-uri "matchable" version)) + (sha256 + (base32 + "0bizkac4a926lbk0v2m05ysq359mzhfsqh973m72jc4gcj4azr5p")))) + (propagated-inputs + (list )) + (native-inputs + (list chicken-test)) + (build-system chicken-build-system) + (arguments '(#:egg-name "matchable")) + (synopsis "This extension implements Andrew Wright's pattern matching macros.") + (home-page "https://wiki.call-cc.org/eggref/5/matchable") + (description "This extension implements Andrew Wright's pattern matching macros.") + (license license:bsd-2))) + (define-public chicken-miscmacros (package (name "chicken-miscmacros") @@ -394,7 +441,7 @@ with integers.") (define-public chicken-string-utils (package (name "chicken-string-utils") - (version "2.7.1") + (version "2.7.3") (source (origin (method url-fetch) @@ -413,6 +460,28 @@ with integers.") (description "String utilities.") (license license:bsd-2))) +(define-public chicken-sxml-transforms + (package + (name "chicken-sxml-transforms") + (version "1.4.3") + (source + (origin + (method url-fetch) + (uri (egg-uri "sxml-transforms" version)) + (sha256 + (base32 + "0cvpqgjwz1p5vg8jwjr2p1l3hx9s02f083g84v16wv88y3d5rsbg")))) + (propagated-inputs + (list chicken-srfi-13)) + (native-inputs + (list )) + (build-system chicken-build-system) + (arguments '(#:egg-name "sxml-transforms")) + (synopsis "This is the sxml-transforms extension library for Chicken Scheme.") + (home-page "https://wiki.call-cc.org/eggref/5/sxml-transforms") + (description "This is the sxml-transforms extension library for Chicken Scheme.") + (license license:bsd-2))) + (define-public chicken-symbol-utils (package (name "chicken-symbol-utils") @@ -438,7 +507,7 @@ with integers.") (define-public chicken-test (package (name "chicken-test") - (version "1.1") + (version "1.2") (source (origin (method svn-fetch) @@ -506,7 +575,7 @@ with integers.") (define-public chicken-utf8 (package (name "chicken-utf8") - (version "3.5.0") + (version "3.6.3") (source (origin (method url-fetch) @@ -517,9 +586,9 @@ with integers.") ;; TODO do we really have to make these propagated? ;; I don't know Chicken's module system well enough to tell (propagated-inputs - (list chicken-iset)) + (list chicken-iset chicken-srfi-69 chicken-regex)) (native-inputs - (list chicken-srfi-69 chicken-regex)) + (list chicken-test)) (build-system chicken-build-system) (arguments '(#:egg-name "utf8")) (synopsis "Unicode support") @@ -553,3 +622,30 @@ with integers.") (description "An apropos facility for CHICKEN Scheme.") (license license:bsd-2))) + +(define-public chicken-chicken-doc + (package + (name "chicken-chicken-doc") + (version "0.7.0") + (source + (origin + (method url-fetch) + (uri (egg-uri "chicken-doc" version)) + (sha256 + (base32 + "1p7i5dsi9x8kfchh3xdw9ww9pz2p861v8vynqzwmbclpqjrspllh")))) + (propagated-inputs + (list chicken-matchable + chicken-fmt + chicken-sxml-transforms + chicken-srfi-1 + chicken-srfi-13 + chicken-srfi-69)) + (native-inputs + (list )) + (build-system chicken-build-system) + (arguments '(#:egg-name "chicken-doc")) + (synopsis "chicken-doc is a tool for exploring Chicken documentation.") + (home-page "https://wiki.call-cc.org/eggref/5/doc") + (description "chicken-doc is a tool for exploring Chicken documentation.") + (license license:bsd-2))) diff --git a/zilti/packages/hyprland.scm b/zilti/packages/hyprland.scm index 19e353a..0fa4cf1 100644 --- a/zilti/packages/hyprland.scm +++ b/zilti/packages/hyprland.scm @@ -79,40 +79,6 @@ Each database is contained in a specific package output, such as the (license (list license:gpl2+ license:expat)))) ;XFree86 1.0 -(define-public pixman - (package - (name "pixman") - (version "0.42.2") - (source - (origin - (method url-fetch) - (uri - (string-append - "https://www.cairographics.org/releases/pixman-" - version ".tar.gz")) - (sha256 - (base32 "0pk298iqxqr64vk3z6nhjwr6vjg1971zfrjkqy5r9zd2mppq057a")) - (patches - (search-patches - "pixman-CVE-2016-5296.patch")))) - (build-system gnu-build-system) - (arguments - `(#:configure-flags - (list - "--disable-static" - "--enable-timers" - "--enable-gnuplot"))) - (native-inputs - (list pkg-config)) - (inputs - (list libpng zlib)) - (synopsis "Low-level pixel manipulation library") - (description "Pixman is a low-level software library for pixel -manipulation, providing features such as image compositing and trapezoid -rasterisation.") - (home-page "http://www.pixman.org/") - (license license:expat))) - (define-public libinput-1.24 ;; Updating this will rebuild over 700 packages through libinput-minimal. (package @@ -207,82 +173,6 @@ including drivers for chipsets produced by 3DFX, AMD (formerly ATI), Intel and Matrox.") (license license:x11))) -(define-public wlroots-0.17 - (package - (name "wlroots") - (version "0.17.0") - (source - (origin - (method git-fetch) - (uri (git-reference - (url "https://gitlab.freedesktop.org/wlroots/wlroots") - (commit version))) - (file-name (git-file-name name version)) - (sha256 - (base32 "11vb6xjvsjz7j2jkx00ygjp5xi63ni8ydd8wf3s0200ldr4ffjjm")))) - (build-system meson-build-system) - (arguments - `(#:configure-flags - '("-Dauto_features=enabled") - #:phases - (modify-phases - %standard-phases - (add-before 'configure 'hardcode-paths - (lambda* (#:key inputs #:allow-other-keys) - (substitute* "xwayland/server.c" - (("Xwayland") (string-append (assoc-ref inputs - "xorg-server-xwayland") - "/bin/Xwayland"))) - #t)) - (add-before 'configure 'fix-meson-file - (lambda* (#:key native-inputs inputs #:allow-other-keys) - (substitute* "backend/drm/meson.build" - (("/usr/share/hwdata/pnp.ids") - (string-append (assoc-ref (or native-inputs inputs) "hwdata") - "/share/hwdata/pnp.ids")))))))) - (propagated-inputs - (list ;; As required by wlroots.pc. - eudev - ffmpeg-4 - glslang - libxkbcommon - mesa - pixman - libcap - libdisplay-info - libinput-1.24 - libpng - libseat - libxkbcommon - mesa - vulkan-loader - wayland - wayland-protocols - xcb-util-errors - xcb-util-renderutil - xcb-util-wm - xorg-server-xwayland)) - (inputs - (list libdrm-2.4.118)) - (native-inputs - (cons* - `(,hwdata "pnp") - cmake - hwdata - mesa-headers - vulkan-headers - pkg-config - wayland - (if (%current-target-system) - (list pkg-config-for-build) - '()))) - (home-page "https://gitlab.freedesktop.org/wlroots/wlroots/") - (synopsis "Pluggable, composable, unopinionated modules for building a -Wayland compositor") - (description "wlroots is a set of pluggable, composable, unopinionated -modules for building a Wayland compositor.") - (license license:expat))) - (define-public wlroots-master (package (name "wlroots")