(define-module (ruther packages python-next)
#:use-module (gnu)
#:use-module (guix packages)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-71)
#:use-module (guix gexp)
#:use-module (guix build-system)
#:use-module (guix download)
#:use-module (guix utils)
#:use-module ((guix build-system copy) #:prefix copy:)
#:use-module ((guix build-system python) #:prefix python:)
#:use-module ((guix build-system pyproject) #:prefix pyproject:)
#:use-module (gnu packages sphinx)
#:use-module (gnu packages python)
#:use-module (gnu packages check)
#:use-module (gnu packages python-check)
#:use-module (gnu packages python-build)
#:use-module (gnu packages python-xyz)
#:export (replace-python-deps
replace-python-deps/recursively))
(define with-python-3.12-raw
(package-input-rewriting `((,python . ,python-3.12))))
(define-public python-3.12-wrapped
((@@ (gnu packages python) wrap-python3) python-3.12))
(define python-3.12-wheel
(package/inherit python-wheel
(properties `(('python-3.12- . #t)
,@(package-properties python-3.12)))
(inputs
(modify-inputs (package-inputs python-wheel)
(append (with-python-3.12-raw python-setuptools))))
(arguments
`(#:tests? #f
#:python ,python-3.12-wrapped))))
(define-public python-3.12-toolchain
((@@ (gnu packages python) wrap-python3)
(package/inherit python-3.12
(name "python-next-toolchain")
(propagated-inputs
(modify-inputs (package-propagated-inputs python-3.12)
(append python-3.12-wheel)
(append (with-python-3.12-raw python-setuptools))))
(properties `(('python-3.12- . #t)
,@(package-properties python-3.12)))
(arguments
(substitute-keyword-arguments (package-arguments python-3.12)
((#:tests? _ #f) #f)))))) ;; Disabled tests, because this was running forever...
(define with-python-3.12-no-cython
(package-input-rewriting `((,python . ,python-3.12-toolchain))))
;; Cython is dependency of a lot of packages, let's update it here
(define-public python-3.12-cython-0.29.37
(with-python-3.12-no-cython
(package/inherit python-cython
(name "python-3.12-cython")
(version "0.29.37")
(source
(origin
(method url-fetch)
(uri (python:pypi-uri "Cython" version))
(sha256
(base32 "1ysca2r23h12ai9wrym4ci0nvgwm3lfijrpj9xfyxbclvnkd84zq"))))
(properties `(('python-3.12- . #t)
,@(package-properties python-cython)))
(arguments
(substitute-keyword-arguments (package-arguments python-cython)
((#:tests? _ #f) #f)))))) ;; Failing... I don't know why...
;; This is changed a bit compared to the original function from Guix.
;; This one also works for pyproject
(define* (package-with-explicit-python python old-prefix new-prefix
#:key variant-property)
"Return a procedure of one argument, P. The procedure creates a package with
the same fields as P, which is assumed to use PYTHON-BUILD-SYSTEM, such that
it is compiled with PYTHON instead. The inputs are changed recursively
accordingly. If the name of P starts with OLD-PREFIX, this is replaced by
NEW-PREFIX; otherwise, NEW-PREFIX is prepended to the name.
When VARIANT-PROPERTY is present, it is used as a key to search for
pre-defined variants of this transformation recorded in the 'properties' field
of packages. The property value must be the promise of a package. This is a
convenient way for package writers to force the transformation to use
pre-defined variants."
(define package-variant
(if variant-property
(lambda (package)
(assq-ref (package-properties package)
variant-property))
(const #f)))
(define replacement-property (string->symbol new-prefix))
(define (transform p)
(cond
;; If VARIANT-PROPERTY is present, use that.
((package-variant p)
=> force)
((assq-ref (package-properties p) replacement-property)
p)
;; Otherwise build the new package object graph.
((and
(or (eq? (build-system-name (package-build-system p)) (build-system-name python:python-build-system))
(eq? (build-system-name (package-build-system p)) (build-system-name pyproject:pyproject-build-system))))
(package/inherit p
(location (package-location p))
(name (let ((name (package-name p)))
(string-append new-prefix
(if (string-prefix? old-prefix name)
(substring name
(string-length old-prefix))
name))))
(properties `((,replacement-property . #t)
,@(package-properties p)))
(arguments
(let ((python (if (promise? python)
(force python)
python)))
(ensure-keyword-arguments (package-arguments p)
`(#:python ,python))))))
(else p)))
(define (cut? p)
(or (not (or (eq? (build-system-name (package-build-system p)) (build-system-name python:python-build-system))
(eq? (build-system-name (package-build-system p)) (build-system-name pyproject:pyproject-build-system))))
(assq-ref (package-properties p) replacement-property)
(package-variant p)))
(package-mapping transform cut?))
(define* (replace-python-deps replacements #:key (deep? #t))
(define table
(fold (lambda (replacement table)
(match replacement
((spec . proc)
(let ((name version (package-name->name+version spec)))
(vhash-cons name (list version proc) table)))))
vlist-null
replacements))
(define (find-replacement package)
(vhash-fold* (lambda (item proc)
(or proc
(match item
((#f proc)
proc)
((version proc)
(and (version-prefix? version
(package-version package))
proc)))))
#f
(package-name package)
table))
(define replacement-property
(gensym " package-replacement"))
(define (rewrite p)
(if (or (assq-ref (package-properties p) replacement-property)
(hidden-package? p))
p
(match (find-replacement p)
(#f p)
(proc
(let ((new (proc p)))
;; Mark NEW as already processed.
(package/inherit new
(properties `((,replacement-property . #t)
,@(package-properties new)))))))))
(define (cut? p)
(or
(not (or (eq? (build-system-name (package-build-system p)) (build-system-name python:python-build-system))
(eq? (build-system-name (package-build-system p)) (build-system-name pyproject:pyproject-build-system))))
;; (assq-ref (package-properties p) replacement-property)
;; (find-replacement p)
))
(package-mapping rewrite cut?
#:deep? deep?))
(define* (replace-python-deps/recursively deps #:key (deep? #t))
(if (nil? deps)
identity
(lambda (pkgs)
((replace-python-deps (list (car deps)))
((replace-python-deps/recursively (cdr deps)) pkgs)))))
(define with-explicit-python-3.12-single
(package-with-explicit-python python-3.12-toolchain "python-" "python-3.12-"))
(define python-3.12-cython-inner
(with-explicit-python-3.12-single python-cython))
(define with-python-3.12-single
(lambda (pkg)
(let ((rewritten (with-explicit-python-3.12-single pkg)))
((package-input-rewriting `((,python-3.12-cython-inner . ,python-3.12-cython-0.29.37)))
rewritten))))
(define-public (with-python-3.12 el)
(if
(list? el)
(map with-python-3.12 el)
(with-python-3.12-single el)))