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