(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
with-explicit-python-3.12
with-explicit-python-3.12-single))
(define-public python-3.12-sans-pip
(hidden-package
(package/inherit python-3.12
(name "python-next")
(version "3.12")
(arguments
(substitute-keyword-arguments (package-arguments python)
((#:tests? _ #f) #f)
((#:phases original-phases '())
#~(modify-phases (or #$original-phases %standard-phases)
(replace 'install-sitecustomize.py
#$(customize-site version))))
((#:configure-flags flags #~())
#~(append '("--with-ensurepip=no")
(delete "--with-ensurepip=install" #$flags))))))))
(define (with-property pkg)
(package
(inherit pkg)
(properties `(('python-3.12- . #t)
,@(package-properties pkg)))))
(define-public python-3.12-setuptools
((package-input-rewriting `((,python . ,python-3.12-sans-pip)))
(with-property python-setuptools)))
;; python-3.12 stopped bundling setuptools, but we need it for guix packages to work.
;; Most guix packages need setuptools, but it's nowhere to be found with python 3.12
(define-public python-3.12-sans-pip-with-setuptools
(with-property
(package
(inherit python-3.12-sans-pip)
(propagated-inputs
(modify-inputs (package-propagated-inputs python-3.12-sans-pip)
(append python-3.12-setuptools))))))
;; 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 python-wrapped
((@@ (gnu packages python) wrap-python3) python))
(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))))
(inputs
(modify-inputs (package-inputs p)
(replace "python" python)))
(propagated-inputs
(modify-inputs (package-propagated-inputs p)
(replace "python" python)))
(native-inputs
(modify-inputs (package-native-inputs p)
(replace "python" python)))
(properties `((,replacement-property . #t)
,@(package-properties p)))
(arguments
(let ((python (if (promise? python)
(force python-wrapped)
python-wrapped)))
(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-sans-pip-with-setuptools "python-" "python-3.12-"))
(define python-3.12-cython-inner
(with-explicit-python-3.12-single python-cython))
;; (define python-3.12-cython-0.29.35
;; (with-explicit-python-3.12-single python-cython-0.29.35))
;; (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.35)))
;; rewritten))))
;; (define-public (with-explicit-python-3.12 el)
;; (if
;; (list? el)
;; (map with-python-3.12-single el)
;; (with-python-3.12-single el)))