ebuild-autogen/ebuild/fetchers/pypi.scm

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; pypi.scm
;; Copyright (C) 2025 Cor Legemaat <cor@cor.za.net>
;;
;; This file is part of ebuild-autogen: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published by the
;; Free Software Foundation, version 3 of the License.
;;
;; ebuild-autogen 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
;; ebuild-autogen. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (ebuild fetchers pypi)
  #:use-module (ebuild defs)
  #:use-module (ebuild fetchers raw)
  #:use-module (ebuild utils)
  #:use-module (curl)
  #:use-module (json)
  #:use-module (ice-9 pretty-print)
  #:use-module (oop goops)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-43)
  #:use-module (rx irregex)
  #:use-module (dql dql))

(define fetch-pypi-pkg
  (lambda (pkg display-data)
    ""
    (let ((curl-handle (curl-easy-init)))
      (curl-easy-setopt curl-handle
                        'url
                        (string-append "https://pypi.org/simple/"
                                       pkg
                                       "/"))
      (curl-easy-setopt curl-handle 'useragent curl-useragent)
      (curl-easy-setopt curl-handle
                            'httpheader
                            (list (string-append "Accept: "
                                                 "application/vnd.pypi.simple.v1+json")))
      (let* ((responce (curl-easy-perform curl-handle)))
        ;;(display "json = ") (display responce) (newline)
        (if responce
            (let ((scm-responce (json-string->scm responce)))
              (begin (if display-data
                         (pretty-print scm-responce))
                     scm-responce))
            (error (string-append "PyPI fetch failed with error "
                                  (curl-error-string)
                                  "\n")))))))

(define-public fetch-pypi
  (lambda* (parms #:key
									(pypi-name (assoc-ref parms 'name))
									(file-types (list ".tar.gz"))
									(display-data #f))
    ""
    (let* ((data (fetch-pypi-pkg pypi-name display-data))
           (versions (vector->list (assoc-ref data "versions")))
           (files (assoc-ref data "files")))
      (map (lambda (version)
             (let ((upload-date (car ((dql (select (filter (where (lambda (file-name)
																																		(if (string? file-name)
																																				(string-contains file-name
																																												 (string-append "-"
																																																				version
																																																				(car file-types)))
																																				#f)) 
																																	"filename"))
																									 (parm-as "date" "upload-time")))
																			files))))
							 (if (nil? upload-date)
									 (if (>= (assoc-ref parms 'verbosity)
													 verbosity-error)
											 (begin (display "Upload file \"")
															(display (string-append "-"
																											version
																											(car file-types)))
															(display "\" not found, skipping release!")
															(newline)))
									 (list (cons "version" version)
												 (car upload-date)
												 (cons "assets"
															 (map (lambda (type)
																			(append (car ((dql (select (filter (where (lambda (file-name)
																																									(if (string? file-name)
																																											(string-contains file-name
																																																			 (string-append "-"
																																																											version
																																																											type))
																																											#f))
																																								"filename"))
																																 (parm-as "uri" "url")
																																 (parm-as "name" "filename")
																																 (parm "hashes" "sha256")))
																										files))
																							(list (cons "type" type))))
																		file-types))))))
           versions))))