(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)))