aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--README108
-rw-r--r--guix-env.scm217
-rwxr-xr-xpre-inst-env12
-rwxr-xr-xpure-pre-inst-env3
-rw-r--r--pypi/api.scm62
-rw-r--r--pypi/build-configuration-graph.scm331
-rw-r--r--pypi/dependency-solver.scm475
-rw-r--r--pypi/logging.scm24
-rw-r--r--pypi/package.scm524
-rw-r--r--pypi/requirement.scm210
-rw-r--r--pypi/sdist-store.scm190
-rw-r--r--pypi/sdist-store/dependency-sets.scm66
-rw-r--r--pypi/sdist-store/import-master.scm401
-rw-r--r--pypi/sdist-store/import.scm720
-rw-r--r--pypi/sdist-store/utils.scm233
-rw-r--r--pypi/sdist.scm192
-rw-r--r--pypi/utils.scm24
-rw-r--r--pypi/version.scm18
-rw-r--r--solver/__init__.py184
19 files changed, 3994 insertions, 0 deletions
diff --git a/README b/README
new file mode 100644
index 0000000..73c46e9
--- /dev/null
+++ b/README
@@ -0,0 +1,108 @@
+Guix Python Package Utilities
+=============================
+
+This library provides utilities for working with Python package indexes, or
+PyPIs for short.
+
+It provides a generic framework, with which the contents of a PyPI can be
+used from the Guix package manager.
+
+For example, the [Guix Python Integration Project][1] uses this library to
+provide Guix packages for the contents of [pypi.org][2].
+
+[1]: http://git.cbaines.net/guix-python-integration-project
+[2]: https://pypi.org/
+
+Implementation Details
+----------------------
+
+### sdist records
+
+The sdist record acts as a higher level representation of a set of Guix package
+records. It is from this set of sdist records that a Guix package can be
+generated for a specific version with a specific set of extras of the desired
+software project.
+
+### Guix package generation
+
+A Guix package is a function of the following:
+
+ - A sdist store
+ - The name and version of the sdist in the store, from which to create the
+ package
+ - A set of extras which can apply to this sdist
+ - A function, which takes a sdist and package, and can return a modified
+ version of the package (fix-function)
+ - A python package (e.g. python-3.4) (python)
+
+The fix-function should be used to adjust packages in ways which cannot be
+represented by the sdist. For example, it can be used to unconditionally
+disable the tests for a given sdist, or add a input from outside of the sdist
+store.
+
+None of the inputs to the package returned by sdist->package should be used
+directly. This is because they may have disabled test suites, or missing
+propagated inputs as a result of breaking dependency loops when constructing
+the package. sdist->package should just be called for each desired package.
+
+### Importer service
+
+*TODO:* Currently there is no importer service, but this describes how it could
+work.
+
+The importer service keeps the repository up to date with the pypi.org Python
+package index. It attempts to create sdist records for a given version of a
+software project, and any packages in its dependency tree which do not have a
+corresponding sdist record.
+
+This is quite complex, as the information for setup_requires, and tests_require
+is inside the setup.py. They may differ depending on the environment in which
+the setup.py is run, making it difficult to extract the metadata in a reliable
+way.
+
+Due to current limitations described above with extracting information from
+sdist archives, the importer service uses a number of strategies to create
+sdist records, this is optimised for compatibility, while compromising speed.
+
+The steps are listed below:
+
+ - pypi.org is queried to get the url for the sdist
+ - The sdist is downloaded and unpacked in a temporary directory
+ - The egg info metadata is read, which gives the version and install_requires
+ (including extras)
+ - An initial sdist record can now be constructed
+ - From this initial sdist record, a Guix package record is created if there
+ are inputs that are not present in the sdist store, these will be fetched
+ first (with this process)
+ - The package record is first built, first without running the tests
+ if the build fails, the log is read (through the use of regular expressions)
+ in an attempt to determine if the build failed due to a missing dependency,
+ if no match is found, the process stops, but if a missing dependency is
+ identified, this is added as a build requirement to the sdist, and the step
+ is attempted again.
+ - The package record is now built, but with the tests enabled. Like the
+ previous step, the logs are checked if the build fails, and any missing
+ requirements identified are added as test requirements to the sdist record.
+ - To confirm that it is possible to build the packages for all of the
+ combinations of extras, every possible combination is built. Again, the logs
+ for any build failure are analysed to determine missing sdist records
+ (*TODO:* This is disabled, as some projects, e.g. kombu have a large number
+ of extras).
+
+### Updater service
+
+*TODO:* There is currently no updater service. Its unclear how this could
+relate to the import service should it exist.
+
+To reduce the possibility of packages failing to build, the versions of each
+package in the dependency tree for an sdist are limited at the point at which
+it is imported (as described int he previous section). The updater service is
+used to bump when possible the version limits associated with an individual
+sdist record.
+
+This involves raising all the limits to the latest versions for which there are
+sdists available, while not violating the limits or requirements for any
+propagated package in the dependency tree of the set of propagated packages.
+
+Inputs that are not propagated (inputs and native-inputs) are still subject to
+the version limits, but only those of the corresponding sdist.
diff --git a/guix-env.scm b/guix-env.scm
new file mode 100644
index 0000000..eb188e3
--- /dev/null
+++ b/guix-env.scm
@@ -0,0 +1,217 @@
+(use-modules ((guix licenses) #:select (bsd-3 gpl3+ psfl))
+ (guix packages)
+ (guix download)
+ (guix git-download)
+ (guix gexp)
+ (guix build-system gnu)
+ (guix build-system cmake)
+ (guix build-system python)
+ (guix build-system trivial)
+ (gnu packages python)
+ (gnu packages xml)
+ (gnu packages tls)
+ (gnu packages emacs)
+ (gnu packages package-management)
+ (gnu packages zip)
+ (gnu packages swig)
+ (gnu packages compression)
+ (gnu packages guile))
+
+(define libsolv
+ (package
+ (name "libsolv")
+ (version "0.6.22")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "https://github.com/openSUSE/libsolv/archive/"
+ version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
+ (modules '((guix build utils)))
+ (sha256
+ (base32
+ "0zl7dlqmib05y5f2wkbz66n68bmqk2fxhvph1dfr071v7jnzc6gf"))
+ (snippet
+ '(substitute* '("bindings/python/CMakeLists.txt")
+ (("EXECUTE_PROCESS.*") "")
+ (("libsolv ") "libsolv python2.7 ")
+ ))))
+ (build-system cmake-build-system)
+ (inputs
+ `(("expat" ,expat)
+ ("zlib" ,zlib)
+ ("python" ,python-2.7)
+ ("swig" ,swig)))
+ (arguments
+ '(#:configure-flags
+ (list (string-append "-DPYTHON_INSTALL_DIR="
+ (assoc-ref %outputs "out") "/lib/python2.7/site-packages")
+ "-DENABLE_PYTHON=1"
+ (string-append ; uses lib64 by default
+ "-DLIB=lib")
+ (string-append "-DCMAKE_INSTALL_RPATH="
+ (assoc-ref %outputs "out") "/lib"))))
+ ;(assoc-ref %outputs "out") "/lib:"
+ ;(assoc-ref %outputs "out") "/lib64"))))
+ (home-page "https://github.com/openSUSE/libsolv")
+ (synopsis "libsolv")
+ (description "")
+ (license bsd-3)))
+
+(define pyguile
+ (package
+ (name "pyguile")
+ (version "0.3.1")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "http://git.cbaines.net/pyguile")
+ (commit "HEAD")))
+ (sha256
+ (base32
+ "037w1bf58yn4kfy5jydd1jzfi7dpg0m2w8p1sd2wnr6py03hybwq"))))
+ ;(source (origin
+ ; (method url-fetch)
+ ; (uri (string-append "https://github.com/cbaines/pyguile/archive/v"
+ ; version ".tar.gz"))
+ ; (file-name (string-append name "-" version ".tar.gz"))
+ ; (modules '((guix build utils)))
+ ; (sha256
+ ; (base32
+ ; "0ds5pnm4dc0vyfa5wlyw9dvzl6dyiizh4q8s153byyn8jkiimb5c"))))
+ (build-system cmake-build-system)
+ (inputs
+ `(("python" ,python-2.7)
+ ("guile" ,guile-2.0)))
+ (arguments
+ '(;#:tests? #f ; no tests
+ ;#:make-flags (list "CC=gcc"
+ ; (string-append "PREFIX=" %output))
+ #:phases
+ (modify-phases %standard-phases
+ (delete 'configure)
+ (delete 'check)
+ (replace 'build
+ (lambda* (#:key outputs #:allow-other-keys)
+ ;(chdir "..")
+ (display "CWD ")(display (getcwd))(display "\n")
+ (let ((out (assoc-ref outputs "out")))
+ (zero?
+ (system* "make" "CC=gcc")))))
+ (replace
+ 'install
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (guild (string-append (assoc-ref %build-inputs "guile")
+ "/bin/guild"))
+ (scm-dir
+ (string-append out "/share/guile/site/2.0/"))
+ (scm-path
+ (string-append scm-dir "pyguile.scm"))
+ (lib-dir
+ (string-append out "/lib/"))
+ (lib-path
+ (string-append lib-dir "libpyguile.so")))
+ (mkdir-p scm-dir)
+ (mkdir-p lib-dir)
+ (copy-file "pyguile.scm" scm-path)
+ (copy-file "libpyguile.so" lib-path)
+ (substitute* scm-path
+ (("libpyguile")
+ (string-append lib-dir "libpyguile")))
+ (setenv "GUILE_AUTO_COMPILE" "0")
+ (unless (zero?
+ (system* guild "compile" scm-path
+ "-o" (string-append scm-dir "pyguile.go")))
+ (error "failed to compile"))
+ #t))))))
+ (home-page "https://github.com/tddpirate/pyguile")
+ (synopsis "pyguile")
+ (description "")
+ (license bsd-3)))
+
+(define python-packaging
+ (package
+ (name "python-packaging")
+ (version "16.7")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append
+ "https://pypi.python.org/packages/28/ad/4e6601d14b11bb300719a8bb6247f6ef5861467a692523c978a4e9e3981a/packaging-"
+ version
+ ".tar.gz"))
+ (sha256
+ (base32
+ "07h18mrpqs0lv2x4fl43pqi0xj6hdrmrnm6v9q634yliagg6q91f"))))
+ (build-system python-build-system)
+ (inputs
+ `(("python-setuptools" ,python-setuptools)))
+ (propagated-inputs
+ `(("python-pyparsing" ,python-pyparsing)
+ ("python-six" ,python-six)))
+ (home-page "https://github.com/pypa/packaging")
+ (synopsis "Core utilities for Python packages")
+ (description
+ "Core utilities for Python packages")
+ (license #f)))
+
+(define python2-packaging
+ (package-with-python2 python-packaging))
+
+(define python-setuptools
+ (package
+ (name "python-setuptools")
+ (version "20.10.1")
+ (source
+ (origin
+ (method url-fetch)
+ (uri "https://pypi.python.org/packages/d3/16/21cf5dc6974280197e42d57bf7d372380562ec69aef9bb796b5e2dbbed6e/setuptools-20.10.1.tar.gz")
+ (sha256
+ (base32
+ "1pdm34rjixkdyp5j2yp774ri1da7ncqy8s34h4qxdl4yy22whn9y"))))
+ (build-system python-build-system)
+ ;; FIXME: Tests require pytest, which itself relies on setuptools.
+ ;; One could bootstrap with an internal untested setuptools.
+ (arguments
+ `(#:tests? #f))
+ (home-page "https://pypi.python.org/pypi/setuptools")
+ (synopsis
+ "Library designed to facilitate packaging Python projects")
+ (description
+ "Setuptools is a fully-featured, stable library designed to facilitate
+packaging Python projects, where packaging includes:
+Python package and module definitions,
+distribution package metadata,
+test hooks,
+project installation,
+platform-specific details,
+Python 3 support.")
+ (license psfl)))
+
+(define python2-setuptools
+ (package-with-python2 python-setuptools))
+
+(define guix-pypi-utils
+ (package
+ (name "guix-pypi-utils")
+ (version "0.1")
+ (source (local-file "." #:recursive? #t))
+ (build-system trivial-build-system)
+ (inputs
+ `(("unzip" ,unzip)
+ ("libsolv" ,libsolv)
+ ("guile" ,guile-2.0)))
+ (propagated-inputs
+ `(("guix" ,guix-0.11.0)
+ ("guile-lib" ,guile-lib)
+ ("guile-json" ,guile-json)
+ ("pyguile" ,pyguile)
+ ("python" ,python-2.7)
+ ("python2-setuptools" ,python2-setuptools)
+ ("python2-packaging" ,python2-packaging)))
+ (home-page "https://example.com")
+ (synopsis "guix-pypi-utils")
+ (description "")
+ (license gpl3+)))
+
+guix-pypi-utils
diff --git a/pre-inst-env b/pre-inst-env
new file mode 100755
index 0000000..cae58b0
--- /dev/null
+++ b/pre-inst-env
@@ -0,0 +1,12 @@
+#!/bin/sh
+
+GUILE_LOAD_PATH=".:../guix-python-intergration-project:$GUILE_LOAD_PATH"
+export GUILE_LOAD_PATH
+
+GUIX_PACKAGE_PATH="$GUILE_LOAD_PATH"
+export GUIX_PACKAGE_PATH
+
+GUILE_WARN_DEPRECATED="detailed"
+export GUILE_WARN_DEPRECATED
+
+exec "$@"
diff --git a/pure-pre-inst-env b/pure-pre-inst-env
new file mode 100755
index 0000000..9ab3e82
--- /dev/null
+++ b/pure-pre-inst-env
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+guix environment --pure -l guix-env.scm -- ./pre-inst-env "$@"
diff --git a/pypi/api.scm b/pypi/api.scm
new file mode 100644
index 0000000..9d884fb
--- /dev/null
+++ b/pypi/api.scm
@@ -0,0 +1,62 @@
+(define-module (pypi api)
+ #:use-module (json)
+ #:use-module (logging logger)
+ #:use-module (web uri)
+ #:use-module (guix ui)
+ #:use-module (guix utils)
+ #:use-module (guix import utils)
+ #:use-module ((guix download) #:prefix download:)
+ #:use-module (guix import json)
+ #:use-module (guix packages)
+ #:use-module (guix upstream)
+ #:use-module (guix licenses)
+ #:use-module (guix build-system python)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 pretty-print)
+ #:use-module (gnu packages python)
+ #:use-module (pypi version)
+ #:export (pypi-fetch
+ get-sdist-releases
+ available-versions))
+
+(define pypi-fetch
+ (memoize
+ (lambda (name api-root)
+ (begin
+ (log-msg 'INFO (string-append "Fetching... " name))
+ (let
+ ((data
+ (call-with-output-file "/dev/null"
+ (lambda (null)
+ (with-error-to-port (current-error-port)
+ (lambda ()
+ (json-fetch (string-append api-root name "/json"))))))))
+ (if (eq? data #f)
+ (begin
+ (error (string-append "data from " api-root " is false"))
+ (sleep 2)
+ (pypi-fetch name api-root))
+ data))))))
+
+(define (available-versions name api-root)
+ (sort-versions
+ (map
+ car
+ (get-sdist-releases (pypi-fetch name api-root)))))
+
+(define (get-sdist-releases data)
+ (filter
+ (match-lambda
+ ((version . releases)
+ (> (length (car releases)) 0)))
+ (map
+ (match-lambda
+ ((version . releases)
+ (list
+ version
+ (filter
+ (lambda (r) (string=? "sdist" (assoc-ref r "packagetype")))
+ releases))))
+ (filter
+ (lambda (r) (> (length r) 1))
+ (assoc-ref* data "releases")))))
diff --git a/pypi/build-configuration-graph.scm b/pypi/build-configuration-graph.scm
new file mode 100644
index 0000000..02fc5cf
--- /dev/null
+++ b/pypi/build-configuration-graph.scm
@@ -0,0 +1,331 @@
+(define-module (pypi build-configuration-graph)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (logging logger)
+ #:use-module (pyguile)
+ #:use-module (pypi requirement)
+ #:use-module (pypi sdist)
+ #:use-module (pypi sdist-store)
+ #:use-module (pypi package)
+ #:export (build-configuration-graph
+ build-configuration-graph?
+ build-configuration-graph-roots
+ build-configuration-graph-edges
+
+ build-configuration
+ build-configuration?
+ build-configuration-sdist
+ build-configuration-extras
+ build-configuration-tests?
+ build-configuration-omitted-dependencies
+
+ requirement-options
+ requirement-options?
+ requirement-options-type
+ requirement-options-requirement
+ requirement-options-options
+
+ log-build-configuration-graph
+
+ requirements->build-configuration-graph
+
+ dependency-loop-can-be-broken-by-not-running-tests?))
+
+(define-record-type <build-configuration-graph>
+ (build-configuration-graph
+ roots
+ edges)
+ build-configuration-graph?
+ (roots build-configuration-graph-roots)
+ (edges build-configuration-graph-edges))
+
+(define-record-type <requirement-options>
+ (requirement-options
+ type
+ requirement
+ options)
+ requirement-options?
+ (type requirement-options-type)
+ (requirement requirement-options-requirement)
+ (options requirement-options-options))
+
+(define-record-type <build-configuration>
+ (build-configuration
+ sdist
+ extras
+ tests?
+ omitted-dependencies)
+ build-configuration?
+ (sdist build-configuration-sdist)
+ (extras build-configuration-extras)
+ (tests? build-configuration-tests?)
+ (omitted-dependencies build-configuration-omitted-dependencies))
+
+(define (requirements->build-configuration-graph
+ sdist-store
+ requirements)
+ (let
+ ((edges (make-hash-table))
+ (roots
+ (map
+ (lambda (requirement)
+ (requirement-options
+ '() ; No type
+ requirement
+ (get-build-configurations-for-requirement
+ sdist-store
+ '() ; No dependant build configurations
+ requirement
+ #t
+ '())))
+ requirements)))
+ (for-each
+ (lambda (requirement-options)
+ (for-each
+ (lambda (build-configuration)
+ (add-build-configuration-closure-to-graph!
+ sdist-store
+ build-configuration
+ '()
+ edges))
+ (requirement-options-options requirement-options)))
+ roots)
+ (build-configuration-graph roots edges)))
+
+(define (requirement-options-for-sdist-requirements
+ sdist
+ sdist-store
+ run-tests
+ omitted-dependencies
+ dependant-build-configurations)
+ (concatenate
+ (map
+ (lambda (type requirements)
+ (map
+ (lambda (requirement)
+ (requirement-options
+ type
+ requirement
+ (get-build-configurations-for-requirement
+ sdist-store
+ dependant-build-configurations
+ requirement
+ run-tests
+ '())))
+ (filter
+ (lambda (requirement)
+ (log-msg 'DEBUG "filtering requirements")
+ (log-msg 'DEBUG requirement)
+ (log-msg 'DEBUG omitted-dependencies)
+ (not (member (requirement-name requirement)
+ omitted-dependencies)))
+ requirements)))
+ '(build test install)
+ (list
+ (sdist-build-requires sdist)
+ (if run-tests
+ (sdist-tests-require sdist)
+ '())
+ (sdist-install-requires sdist)))))
+
+(define (log-build-configuration-graph level graph)
+ (letrec
+ ((log-msg'
+ (lambda (msg . parts)
+ (if (null? level)
+ (begin
+ (for-each display (cons msg parts))
+ (display "\n"))
+ (apply log-msg (cons level (cons msg parts))))))
+ (log-requirement-options
+ (lambda (indent requirement-options)
+ (if (> indent 50)
+ (error "graph too deep"))
+ (log-msg'
+ (make-string (* 4 indent) #\space)
+ (requirement-name
+ (requirement-options-requirement
+ requirement-options)))
+ (for-each
+ (lambda (build-configuration)
+ (log-msg'
+ (make-string (+ 2 (* 4 indent)) #\space)
+ (sdist-short-description
+ (build-configuration-sdist build-configuration))
+ " (tests? " (build-configuration-tests? build-configuration) ")")
+ (for-each
+ (lambda (requirement-options)
+ (log-requirement-options
+ (+ 1 indent)
+ requirement-options))
+ (hash-ref
+ (build-configuration-graph-edges graph)
+ build-configuration)))
+ (requirement-options-options requirement-options)))))
+ (for-each
+ (lambda (requirement-options)
+ (log-requirement-options 0 requirement-options))
+ (build-configuration-graph-roots graph))
+ graph))
+
+(define (sdist->build-configuration
+ sdist
+ dependant-build-configurations
+ extras
+ run-tests
+ omitted-dependencies)
+ (let
+ ((initial-build-configuration
+ (build-configuration
+ sdist
+ extras
+ run-tests
+ omitted-dependencies)))
+ (if (not (member
+ initial-build-configuration
+ dependant-build-configurations))
+ initial-build-configuration
+ (if
+ (and
+ run-tests
+ (dependency-loop-can-be-broken-by-not-running-tests?
+ (reverse
+ (cons
+ initial-build-configuration
+ dependant-build-configurations))))
+ (sdist->build-configuration
+ sdist
+ dependant-build-configurations
+ extras
+ #f
+ omitted-dependencies)
+ (let*
+ ((build-configuration-to-omit
+ (first dependant-build-configurations))
+ (sdist-name
+ (pkg-info-name
+ (sdist-info
+ (build-configuration-sdist build-configuration-to-omit)))))
+ (if (not (member
+ sdist-name
+ omitted-dependencies))
+ (sdist->build-configuration
+ sdist
+ dependant-build-configurations
+ extras
+ #f
+ (cons
+ sdist-name
+ omitted-dependencies))
+ (begin
+ (log-dependency-loop dependant-build-configurations)
+ (error "Cannot solve build dependency issue"))))))))
+
+(define (log-dependency-loop
+ dependant-build-configurations)
+ (log-msg 'ERROR "Dependency loop:\n")
+ (for-each
+ (lambda (build-configuration)
+ (log-msg 'ERROR build-configuration "\n"))
+ (reverse dependant-build-configurations)))
+
+(define (add-build-configuration-closure-to-graph!
+ sdist-store
+ build-configuration
+ dependant-build-configurations
+ graph)
+ (if (not (hash-ref
+ graph
+ build-configuration))
+ (let*
+ ((new-dependant-build-configurations
+ (cons build-configuration
+ dependant-build-configurations))
+ (requirement-options-for-sdist
+ (requirement-options-for-sdist-requirements
+ (build-configuration-sdist build-configuration)
+ sdist-store
+ (build-configuration-tests? build-configuration)
+ (build-configuration-omitted-dependencies build-configuration)
+ new-dependant-build-configurations)))
+ (hash-set!
+ graph
+ build-configuration
+ requirement-options-for-sdist)
+ (for-each
+ (lambda (requirement-options)
+ (for-each
+ (lambda (build-configuration)
+ (add-build-configuration-closure-to-graph!
+ sdist-store
+ build-configuration
+ new-dependant-build-configurations
+ graph))
+ (requirement-options-options
+ requirement-options)))
+ requirement-options-for-sdist))))
+
+(define (dependency-loop-can-be-broken-by-not-running-tests?
+ dependant-build-configurations)
+ (let*
+ ((a (first dependant-build-configurations)))
+ (if (null? a)
+ #f
+ (let
+ ((b (if (null? (cdr dependant-build-configurations))
+ '()
+ (second dependant-build-configurations))))
+ (if (null? b)
+ #f
+ (or
+ (sdist-has-test-requirement-matching-normalised-requirement-name
+ a
+ (normalise-requirement-name
+ (pkg-info-name
+ (sdist-info
+ (build-configuration-sdist
+ b)))))
+ (dependency-loop-can-be-broken-by-not-running-tests?
+ (cdr dependant-build-configurations))))))))
+
+(define (sdist-has-test-requirement-matching-normalised-requirement-name
+ sdist
+ normalised-requirement-name)
+ (any
+ (lambda (test-requirement)
+ (equal? normalised-requirement-name
+ (normalise-requirement-name
+ (requirement-name
+ test-requirement))))
+ (sdist-tests-require
+ (build-configuration-sdist
+ sdist))))
+
+(define (get-build-configurations-for-requirement
+ sdist-store
+ dependant-build-configurations
+ requirement
+ run-tests
+ omitted-dependencies)
+ (let
+ ((sdists
+ (get-sdists-by-version-meeting-requirement
+ sdist-store
+ requirement)))
+ (if (null? sdists)
+ (throw
+ unsatisfied-requirements-error
+ (list requirement))
+ (map
+ (match-lambda
+ ((version . sdist)
+ (sdist->build-configuration
+ sdist
+ dependant-build-configurations
+ (requirement-extras requirement)
+ (and
+ run-tests
+ (requirement-run-tests requirement))
+ omitted-dependencies)))
+ sdists))))
diff --git a/pypi/dependency-solver.scm b/pypi/dependency-solver.scm
new file mode 100644
index 0000000..b4aa1f2
--- /dev/null
+++ b/pypi/dependency-solver.scm
@@ -0,0 +1,475 @@
+(define-module (pypi dependency-solver)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
+ #:use-module (ice-9 hash-table)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (logging logger)
+ #:use-module (pyguile)
+ #:use-module (pypi requirement)
+ #:use-module (pypi sdist)
+ #:use-module (pypi sdist-store)
+ #:use-module (pypi build-configuration-graph)
+ #:use-module (pypi package)
+ #:export (generate-solver-hash-tables
+ solve-build-configuration-graph
+ get-scoped-releases-to-versions
+
+ release
+ release?
+ release-name
+ release-version
+
+ root-scope
+
+ scope
+ scope?
+ scope-release
+ scope-parent
+
+ scoped-release
+ scoped-release?
+ scoped-release-release
+ scoped-release-scope
+
+ scoped-requirement
+ scoped-requirement?
+ scopred-requirement-requirement
+ scopred-requirement-scope))
+
+(define root-scope '())
+
+(define-record-type <release>
+ (release name version)
+ release?
+ (name release-name)
+ (version release-version))
+
+(define (release->string r)
+ (string-join
+ (list
+ (normalise-requirement-name (release-name r))
+ "@"
+ (release-version r))
+ ""))
+
+(define-record-type <scope>
+ (scope release parent)
+ scope?
+ (release scope-release)
+ (parent scope-parent))
+
+(define (scope->string s)
+ (if (null? s)
+ ""
+ (string-join
+ (list
+ "("
+ (release->string (scope-release s))
+ (if (null? (scope-parent s))
+ ""
+ (string-join
+ (list
+ " -> "
+ (scope->string
+ (scope-parent s)))
+ ""))
+ ")")
+ "")))
+
+(define (scope-tree-contains-release? r s)
+ (if (null? s)
+ #f
+ (or
+ (equal?
+ (scope-release s)
+ r)
+ (scope-tree-contains-release?
+ r
+ (scope-parent s)))))
+
+(define-record-type <scoped-release>
+ (scoped-release release scope)
+ scoped-release?
+ (release scoped-release-release)
+ (scope scoped-release-scope))
+
+(define-record-type <scoped-build-configuration>
+ (scoped-release release scope)
+ scoped-release?
+ (release scoped-release-release)
+ (scope scoped-release-scope))
+
+(define (scoped-release->string sr)
+ (string-join
+ (list
+ (release->string
+ (scoped-release-release sr))
+ (if (null? (scoped-release-scope sr))
+ ""
+ (string-join
+ (list
+ " "
+ (scope->string
+ (scoped-release-scope sr)))
+ "")))
+ ""))
+
+(define-record-type <scoped-requirement>
+ (scoped-requirement requirement scope)
+ scoped-requirement?
+ (requirement scoped-requirement-requirement)
+ (scope scoped-requirement-scope))
+
+(define (scoped-requirement->solver-package-name sr)
+ (string-append
+ (normalise-requirement-name
+ (requirement-name
+ (scoped-requirement-requirement sr)))
+ (if (null? (scoped-requirement-scope sr))
+ ""
+ (string-append
+ " "
+ (scope->string
+ (scoped-requirement-scope sr))))))
+
+(define (scoped-release->solver-package-name sr)
+ (string-append
+ (normalise-requirement-name
+ (release-name (scoped-release-release sr)))
+ (if (null? (scoped-release-scope sr))
+ ""
+ (string-append
+ " "
+ (scope->string
+ (scoped-release-scope sr))))))
+
+(define (scoped-build-configuration->solver-name sr)
+ (string-append
+ (normalise-requirement-name
+ (release-name (scoped-release-release sr)))
+ (if (null? (scoped-release-scope sr))
+ ""
+ (string-append
+ " "
+ (scope->string
+ (scoped-release-scope sr))))))
+
+(define (scoped-requirement->solver-output-string sr)
+ (string-append
+ (normalise-requirement-name
+ (requirement-name
+ (scoped-requirement-requirement sr)))
+ (if (null? (scoped-requirement-scope sr))
+ ""
+ (string-append
+ " "
+ (scope->string
+ (scoped-requirement-scope sr))))))
+
+(define (scoped-requirement->string sr)
+ (string-append
+ (requirement->string
+ (scoped-requirement-requirement sr))
+ (if (null? (scoped-requirement-scope sr))
+ ""
+ (string-append
+ " "
+ (scope->string
+ (scoped-requirement-scope sr))))))
+
+(define (build-configuration->release build-configuration)
+ (let*
+ ((sdist
+ (build-configuration-sdist build-configuration))
+ (info (sdist-info sdist)))
+ (release
+ (pkg-info-name info)
+ (pkg-info-version info))))
+
+(define (process-build-configuration!
+ build-configuration-graph
+ scoped-releases-to-scoped-requirements
+ result-string-to-requirement-options
+ current-scope build-configuration)
+ (let*
+ ((requirement-options-list
+ (hash-ref
+ (build-configuration-graph-edges build-configuration-graph)
+ build-configuration))
+ (build-configuration-release
+ (build-configuration->release build-configuration))
+ (build-configuration-scoped-release
+ (scoped-release
+ build-configuration-release
+ current-scope))
+ (inner-scope
+ (scope
+ build-configuration-release
+ current-scope))
+ (requirement-options-and-scopes
+ (map
+ (lambda (requirement-options)
+ (let*
+ ((type
+ (requirement-options-type requirement-options))
+ (scope-for-requirement-options
+ (cond
+ ((member type '(() install))
+ current-scope)
+ ((member type '(test build))
+ inner-scope)
+ (else
+ (error "Unrecognised requirement type " type)))))
+ (cons requirement-options scope-for-requirement-options)))
+ requirement-options-list))
+ (scoped-requirements
+ (map
+ (match-lambda
+ ((requirement-options . scope)
+ (let
+ ((sr
+ (scoped-requirement
+ (requirement-options-requirement
+ requirement-options)
+ scope)))
+ (hash-set!
+ result-string-to-requirement-options
+ (scoped-requirement->solver-output-string sr)
+ (cons
+ requirement-options
+ (or
+ (hash-ref
+ result-string-to-requirement-options
+ (scoped-requirement->solver-output-string sr))
+ '())))
+ sr)))
+ requirement-options-and-scopes)))
+ (if (hash-ref
+ scoped-releases-to-scoped-requirements
+ build-configuration-scoped-release)
+ (begin
+ (log-msg 'DEBUG "Duplicate scoped-release " build-configuration-scoped-release)
+ (log-msg 'DEBUG "existing: " (hash-ref scoped-releases-to-scoped-requirements build-configuration-scoped-release))
+ (log-msg 'DEBUG "new: " scoped-requirements)
+ ;(error "Duplicate scoped-release") TODO: Check this
+ ))
+ (if (not (hash-ref scoped-releases-to-scoped-requirements
+ build-configuration-scoped-release))
+ (hash-set!
+ scoped-releases-to-scoped-requirements
+ build-configuration-scoped-release
+ scoped-requirements))
+ (for-each
+ (match-lambda
+ ((requirement-options . scope)
+ (for-each
+ (lambda (build-configuration)
+ (process-build-configuration!
+ build-configuration-graph
+ scoped-releases-to-scoped-requirements
+ result-string-to-requirement-options
+ scope
+ build-configuration))
+ (requirement-options-options requirement-options))))
+ requirement-options-and-scopes)))
+
+(define (generate-solver-hash-tables
+ build-configuration-graph)
+ (let
+ ((scoped-releases-to-scoped-requirements (make-hash-table))
+ (result-string-to-requirement-options (make-hash-table)))
+ (for-each
+ (lambda (requirement-options)
+ (let
+ ((solver-name
+ (normalise-requirement-name
+ (requirement-name (requirement-options-requirement requirement-options)))))
+ (hash-set!
+ result-string-to-requirement-options
+ solver-name
+ (cons
+ requirement-options
+ (or
+ (hash-ref
+ result-string-to-requirement-options
+ solver-name)
+ '())))
+ (for-each
+ (lambda (build-configuration)
+ (process-build-configuration!
+ build-configuration-graph
+ scoped-releases-to-scoped-requirements
+ result-string-to-requirement-options
+ root-scope
+ build-configuration))
+ (requirement-options-options requirement-options))))
+ (build-configuration-graph-roots build-configuration-graph))
+ (log-msg 'DEBUG
+ "generate-solver-hash-tables result \n"
+ (string-join
+ (hash-map->list
+ (lambda (k v)
+ (string-join
+ (cons
+ (scoped-release->string k)
+ (map
+ (lambda (sr)
+ (string-append
+ " "
+ (scoped-requirement->string sr)
+ "\n"))
+ v))
+ "\n"))
+ scoped-releases-to-scoped-requirements))
+ "\n")
+ (values
+ scoped-releases-to-scoped-requirements
+ result-string-to-requirement-options)))
+
+(define (scoped-releases-to-scoped-requirements->string-to-scoped-releases
+ ht)
+ (hash-map->list
+ (lambda (scoped-release scoped-requirements)
+ (cons
+ (scoped-release->solver-package-name scoped-release)
+ scoped-release))
+ ht))
+
+(define (solve-build-configuration-graph
+ build-configuration-graph)
+ (receive (scoped-releases-to-scoped-requirements
+ result-string-to-requirement-options)
+ (generate-solver-hash-tables
+ build-configuration-graph)
+ (let*
+ ((requirements
+ (map
+ (lambda (requirement-options)
+ (requirement-options-requirement requirement-options))
+ (build-configuration-graph-roots build-configuration-graph)))
+ (result
+ (get-versions-or-error
+ (hash-map->list
+ (lambda (scoped-release scoped-requirements)
+ (list
+ (scoped-release->solver-package-name scoped-release)
+ (release-version
+ (scoped-release-release scoped-release))
+ (map
+ (lambda (sr)
+ (list
+ (scoped-requirement->solver-package-name sr)
+ (filter
+ (lambda (s)
+ (not (equal? s "")))
+ (string-split
+ (requirement-specifiers
+ (scoped-requirement-requirement sr))
+ #\,))))
+ scoped-requirements)))
+ scoped-releases-to-scoped-requirements)
+ (concatenate
+ (map
+ (lambda (r)
+ (map
+ (lambda (s)
+ (string-append
+ (normalise-requirement-name (requirement-name r))
+ s))
+ (string-split
+ (requirement-specifiers r)
+ #\,)))
+ requirements)))))
+ (if (string? result)
+ (begin
+ (log-msg 'ERROR "Error during dependency resolution")
+ (hash-for-each
+ (lambda (s-release s-requirements)
+ (log-msg 'ERROR
+ (scoped-release->string s-release) ":")
+ (for-each
+ (lambda (s-requirement)
+ (log-msg 'ERROR " " (scoped-requirement->string s-requirement)))
+ s-requirements))
+ scoped-releases-to-scoped-requirements)
+ (log-msg 'ERROR "Requirements:")
+ (for-each
+ (lambda (r)
+ (log-msg 'ERROR " " (requirement->string r)))
+ requirements)
+ (error result))
+ (alist->hash-table
+ (concatenate
+ (map
+ (match-lambda
+ ((result-string version)
+ (log-msg 'DEBUG result-string " - " version)
+ (map
+ (lambda (requirement-options)
+ (cons requirement-options version))
+ (or
+ (hash-ref
+ result-string-to-requirement-options
+ result-string)
+ (begin
+ (log-msg 'ERROR "|" result-string "| not found")
+ #f)))))
+ result)))))))
+
+(define (select-build-configuration-from-requirement-options
+ requirement-options
+ version)
+ (find
+ (lambda (build-configuration)
+ (equal?
+ version
+ (pkg-info-version
+ (sdist-info
+ (build-configuration-sdist build-configuration)))))
+ (requirement-options-options requirement-options)))
+
+(define (filter-build-configuration-graph
+ graph
+ requirement-options-to-version)
+ (build-configuration-graph
+ (map
+ (lambda (requirement-options)
+ (select-build-configuration-from-requirement-options
+ requirement-options
+ (hash-ref
+ requirement-options-to-version
+ requirement-options)))
+ (build-configuration-graph-roots graph))
+ (alist->hash-table
+ (hash-map->list
+ (lambda (build-configuration requirement-options-list)
+ (cons
+ build-configuration
+ (map
+ (lambda (requirement-options)
+ (select-build-configuration-from-requirement-options
+ requirement-options
+ (hash-ref
+ requirement-options-to-version
+ requirement-options)))
+ requirement-options-list)))
+ (build-configuration-graph-edges graph)))))
+
+(define %solver-location "")
+
+(define (get-versions-or-error name-version-requirements overall-requirements)
+ (log-msg 'DEBUG "get-versions-or-error\n")
+ (if (not (string-null? %solver-location))
+ (python-eval (string-append "import sys; sys.path.append(\"" %solver-location "\");")))
+ (python-eval "from solver import get_versions_or_error")
+ (log-msg 'DEBUG "name-version-requirements\n")
+ (log-msg 'DEBUG name-version-requirements)
+ (log-msg 'DEBUG "\n")
+ (log-msg 'DEBUG "overall-requirements\n")
+ (log-msg 'DEBUG overall-requirements)
+ (log-msg 'DEBUG "\n")
+ (python-apply
+ '(solver get_versions_or_error)
+ (list name-version-requirements overall-requirements)
+ '()))
diff --git a/pypi/logging.scm b/pypi/logging.scm
new file mode 100644
index 0000000..bd02eb9
--- /dev/null
+++ b/pypi/logging.scm
@@ -0,0 +1,24 @@
+(define-module (pypi logging)
+ #:use-module (logging logger)
+ #:use-module (logging port-log)
+ #:use-module (oop goops)
+ #:export (setup-logging
+ shutdown-logging))
+
+(define (setup-logging)
+ (let ((lgr (make <logger>))
+ (err (make <port-log> #:port (current-error-port))))
+
+ (disable-log-level! err 'DEBUG)
+ ;(disable-log-level! err 'WARN)
+ ;(disable-log-level! err 'INFO)
+
+ (add-handler! lgr err)
+
+ (set-default-logger! lgr)
+ (open-log! lgr)))
+
+(define (shutdown-logging)
+ (flush-log) ;; since no args, it uses the default
+ (close-log!) ;; since no args, it uses the default
+ (set-default-logger! #f))
diff --git a/pypi/package.scm b/pypi/package.scm
new file mode 100644
index 0000000..8cae990
--- /dev/null
+++ b/pypi/package.scm
@@ -0,0 +1,524 @@
+(define-module (pypi package)
+ #:use-module (logging logger)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-13)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
+ #:use-module (ice-9 hash-table)
+ #:use-module (ice-9 pretty-print)
+ #:use-module (guix ui)
+ #:use-module (guix records)
+ #:use-module (guix combinators)
+ #:use-module (guix packages)
+ #:use-module (gnu packages zip)
+ #:use-module (guix build-system python)
+ #:use-module (guix download)
+ #:use-module (pypi sdist)
+ #:use-module (pypi sdist-store)
+ #:use-module (pypi requirement)
+ #:use-module (pypi dependency-solver)
+ #:use-module (pypi build-configuration-graph)
+ #:use-module (guix utils)
+ #:export (<package-configuration>
+ package-configuration
+ package-configuration?
+ package-configuration-fix-function
+ package-configuration-python
+
+ requirement->package
+ requirements->package
+
+ build-configuration-graph->packages
+
+ unsatisfiable-requirements
+ unsatisfiable-requirements?
+ get-unsatisfiable-requirements))
+
+(define-record-type <package-configuration>
+ (package-configuration python fix-function)
+ package-configuration?
+ (python package-configuration-python)
+ (fix-function package-configuration-fix-function))
+
+(define-record-type <unsatisfiable-requirements>
+ (unsatisfiable-requirements requirements)
+ unsatisfiable-requirements?
+ (requirements get-unsatisfiable-requirements))
+
+(define (requirement-options->package
+ graph
+ package-configuration
+ requirement-options-to-versions
+ requirement-options)
+ (let
+ ((build-configuration
+ (select-build-configuration-from-requirement-options
+ requirement-options
+ (or
+ (hash-ref
+ requirement-options-to-versions
+ requirement-options)
+ (begin
+ (log-build-configuration-graph 'ERROR graph)
+ (error "Missing version error for " requirement-options))))))
+ (receive (native-inputs inputs propagated-inputs)
+ (get-inputs
+ graph
+ package-configuration
+ requirement-options-to-versions
+ (hash-ref
+ (build-configuration-graph-edges graph)
+ build-configuration))
+ (build-configuration->package
+ package-configuration
+ (if (string-contains
+ (origin-uri
+ (sdist-source
+ (build-configuration-sdist build-configuration)))
+ ".zip")
+ (cons
+ `("unzip" ,unzip)
+ native-inputs)
+ native-inputs)
+ inputs
+ propagated-inputs
+ build-configuration))))
+
+(define (debug-package package)
+ (log-msg 'DEBUG (package-name package) "@" (package-version package))
+ (log-msg 'DEBUG (package-native-inputs package))
+ (log-msg 'DEBUG (package-inputs package))
+ (log-msg 'DEBUG (package-propagated-inputs package))
+ (if (null? (origin-patch-guile (package-source package)))
+ (error "null patch-guile in own package"))
+ package)
+
+(define build-configuration->package
+ (memoize
+ (lambda (package-configuration
+ native-inputs
+ inputs
+ propagated-inputs
+ build-configuration)
+ (let*
+ ((sdist (build-configuration-sdist build-configuration))
+ (info (sdist-info sdist)))
+ ((package-configuration-fix-function package-configuration)
+ sdist
+ (package
+ (name (generate-package-name build-configuration))
+ (version (pkg-info-version info))
+ (source (sdist-source sdist))
+ (build-system python-build-system)
+ (native-inputs native-inputs)
+ (inputs inputs)
+ (propagated-inputs propagated-inputs)
+ (arguments
+ (append
+ `(#:python ,(package-configuration-python
+ package-configuration))
+ (if (build-configuration-tests? build-configuration)
+ '()
+ `(#:tests? #f))))
+ (home-page "")
+ (synopsis "")
+ (description (pkg-info-name info))
+ (license "")
+ (properties
+ `((sdist . ,sdist)
+ (build-configuration . ,build-configuration)))))))))
+
+(define (select-build-configuration-from-requirement-options
+ requirement-options
+ version)
+ (or
+ (find
+ (lambda (build-configuration)
+ (equal?
+ version
+ (pkg-info-version
+ (sdist-info
+ (build-configuration-sdist build-configuration)))))
+ (requirement-options-options requirement-options))
+ (begin
+ (log-msg 'ERROR "select-build-configuration-from-requirement-options")
+ (log-msg 'ERROR "version: " version)
+ (for-each
+ (lambda (build-configuration)
+ (let
+ ((info (sdist-info (build-configuration-sdist build-configuration))))
+ (log-msg 'ERROR " " (pkg-info-name info) "@" (pkg-info-version info))))
+ (requirement-options-options requirement-options))
+ (error "Could not find build-configuration matching version"))))
+
+(define (get-inputs
+ graph
+ package-configuration
+ requirement-options-to-versions
+ input-requirement-options)
+ (apply
+ values
+ (map
+ (lambda (type)
+ (packages->input-list
+ (map
+ (lambda (requirement-options)
+ (requirement-options->package
+ graph
+ package-configuration
+ requirement-options-to-versions
+ requirement-options))
+ (filter
+ (lambda (requirement-options)
+ (eq? type (requirement-options-type requirement-options)))
+ input-requirement-options))))
+ '(build test install))))
+
+(define (build-configuration-graph->packages
+ graph
+ package-configuration
+ requirement-options-to-versions)
+ (map
+ (lambda (requirement-options)
+ (requirement-options->package
+ graph
+ package-configuration
+ requirement-options-to-versions
+ requirement-options))
+ (build-configuration-graph-roots graph)))
+
+(define (requirements->packages
+ package-configuration
+ sdist-store
+ requirements)
+ (let
+ ((build-configuration-graph
+ (requirements->build-configuration-graph
+ sdist-store
+ requirements)))
+ (log-build-configuration-graph 'DEBUG build-configuration-graph)
+ (let
+ ((requirement-options-to-versions
+ (solve-build-configuration-graph
+ build-configuration-graph)))
+ (build-configuration-graph->packages
+ build-configuration-graph
+ package-configuration
+ requirement-options-to-versions))))
+
+(define (requirement->package
+ package-configuration
+ sdist-store
+ requirement)
+ (first
+ (requirements->packages
+ package-configuration
+ sdist-store
+ (list requirement))))
+
+(define (memorise-input->package f)
+ (lambda args
+ (let*
+ ((key (list-head args 4))
+ (store (second key))
+ (store-list (get-sdist-list store)))
+
+ (list-set! key 1 store-list)
+ (let
+ ((results (hash-ref input->package-cache key)))
+ (if results
+ (apply values results)
+ (let ((results (call-with-values (lambda ()
+ (apply f args))
+ list)))
+ (hash-set! input->package-cache key results)
+ (apply values results)))))))
+
+(define (get-inputs-for-input-requirements ipt dependants dependant-requirements store)
+ (receive (native-input-requirements
+ input-requirements
+ propagated-input-requirements)
+ (partition-requirements ipt)
+ (let*
+ ((new-dependant-requirements
+ (apply
+ lset-adjoin
+ (append
+ (list equal? propagated-input-requirements)
+ dependant-requirements)))
+ (native-input-sdists-and-extras
+ (get-inputs-for-requirements
+ store
+ native-input-requirements
+ new-dependant-requirements))
+ (input-sdists-and-extras
+ (get-inputs-for-requirements
+ store
+ input-requirements
+ new-dependant-requirements))
+ (propagated-input-sdists-and-extras
+ (get-inputs-for-requirements
+ store
+ propagated-input-requirements
+ new-dependant-requirements))
+ (unsatisfied-requirements
+ (filter
+ requirement?
+ (append native-input-sdists-and-extras
+ input-sdists-and-extras
+ propagated-input-sdists-and-extras))))
+ (values
+ native-input-sdists-and-extras
+ input-sdists-and-extras
+ propagated-input-sdists-and-extras
+ unsatisfied-requirements
+ new-dependant-requirements))))
+
+(define (get-input-inputs ipt fix-function python dependants dependant-requirements store)
+ (receive (native-input-inputs
+ input-inputs
+ propagated-input-inputs
+ unsatisfied-requirements
+ new-dependant-requirements)
+ (get-inputs-for-input-requirements ipt dependants dependant-requirements store)
+ (if (not (null? unsatisfied-requirements))
+ (throw
+ unsatisfied-requirements-error
+ unsatisfied-requirements)
+ (values
+ ; native-inputs
+ (append
+ (packages->input-list
+ (input-requirements->packages
+ ipt
+ fix-function
+ python
+ dependants
+ new-dependant-requirements
+ native-input-inputs
+ store
+ #f))
+ (if (string-contains
+ (origin-uri (sdist-source (input-sdist ipt)))
+ ".zip")
+ `(("unzip" ,unzip))
+ '()))
+ ; inputs
+ (packages->input-list
+ (input-requirements->packages
+ ipt
+ fix-function
+ python
+ dependants
+ new-dependant-requirements
+ input-inputs
+ store
+ #t))
+ ; propagated-inputs
+ (packages->input-list
+ (input-requirements->packages
+ ipt
+ fix-function
+ python
+ dependants
+ new-dependant-requirements
+ propagated-input-inputs
+ store
+ #t))))))
+
+(define (generate-package-name build-configuration)
+ (let* ((sd (build-configuration-sdist build-configuration))
+ (info (sdist-info sd)))
+ (string-append
+ (pkg-info-name info)
+ (if (null? (build-configuration-extras build-configuration))
+ ""
+ (string-append
+ "+"
+ (string-join
+ (stable-sort
+ (build-configuration-extras build-configuration)
+ string<?)
+ "+")))
+ (if (build-configuration-tests? build-configuration)
+ ""
+ "-no-tests"))))
+
+(define input->package
+ (memorise-input->package
+ ; A package is a function of an sdist, and a list of extras
+ ; dependants is used to detect dependency loops
+ (lambda (ipt store fix-function python dependants dependant-requirements)
+ (let* ((sd (input-sdist ipt))
+ (info (sdist-info sd)))
+ (receive (native-inputs
+ inputs
+ propagated-inputs)
+ (get-input-inputs ipt fix-function python dependants dependant-requirements store)
+ (fix-function
+ sd
+ (package
+ (name (generate-package-name ipt))
+ (version (pkg-info-version info))
+ (source (sdist-source sd))
+ (build-system python-build-system)
+ (native-inputs native-inputs)
+ (inputs inputs)
+ (propagated-inputs propagated-inputs)
+ (arguments
+ (append
+ `(#:python ,python)
+ (if (input-run-tests ipt)
+ '()
+ `(#:tests? #f))))
+ (home-page "")
+ (synopsis "")
+ (description (pkg-info-name info))
+ (license "")
+ (properties
+ `((sdist . ,sd))))))))))
+
+(define (input-requirement->package ipt req-input fix-function python dependants dependant-requirements store)
+ (if (not (dependency-loop? req-input dependants))
+ ; no dependency loop detected, so just continue
+ (input->package
+ req-input
+ store
+ fix-function
+ python
+ (cons
+ ipt
+ dependants)
+ dependant-requirements)
+ ; this package is a dependency on req-input already, so try
+ ; building it without tests
+ (let
+ ((req-input-no-tests
+ (input
+ (inherit req-input)
+ (run-tests #f))))
+ (if (not (dependency-loop? req-input-no-tests dependants))
+ (input->package
+ req-input-no-tests
+ store
+ fix-function
+ python
+ (cons
+ ipt
+ dependants)
+ dependant-requirements)
+ ; Building without tests has been tried already, and the loop is
+ ; still present, so try omitting the dependency entirely
+ (let
+ ((req-input-no-tests-no-prop
+ (input
+ (inherit req-input)
+ (run-tests #f)
+ (allow-missing-dependencies
+ ; Add the current input, but without the allow-missing-dependencies
+ ; as this is not relevant when deciding what to ignore
+ (cons (input
+ (inherit ipt)
+ (allow-missing-dependencies '()))
+ (input-allow-missing-dependencies ipt))))))
+ (if (and
+ (not (dependency-loop?
+ req-input-no-tests-no-prop dependants))
+ (not (> (length (input-allow-missing-dependencies ipt)) 4)))
+ (input->package
+ req-input-no-tests-no-prop
+ store
+ fix-function
+ python
+ (cons
+ ipt
+ dependants)
+ dependant-requirements)
+ (begin
+ (explain-dependency-loop ipt dependants req-input)
+ (error "dependency loop detected\n"))))))))
+
+(define (inputs-equivalent? ipt1 ipt2)
+ (let*
+ ((sd1 (input-sdist ipt1))
+ (sd2 (input-sdist ipt2))
+ (info1 (sdist-info sd1))
+ (info2 (sdist-info sd2)))
+ (and
+ (equal? (pkg-info-name info1)
+ (pkg-info-name info2))
+ (equal? (pkg-info-version info1)
+ (pkg-info-version info2)))))
+
+(define (input-requirements->packages ipt fix-function python dependants dependant-requirements inputs store do-filter)
+ (log-msg 'DEBUG "input-requirements->packages " (input-short-description ipt))
+ (map
+ (lambda (requirement-ipt)
+ (input-requirement->package ipt
+ requirement-ipt
+ fix-function
+ python
+ dependants
+ dependant-requirements
+ store))
+ ; Filter out any dependencies that are being ignored for this input.
+ ; If this happens, this is a partial package, being used to break a dependency
+ ; loop.
+ (if do-filter
+ (filter
+ (lambda (requirement-ipt)
+ (let*
+ ((allow-missing (input-allow-missing-dependencies ipt))
+ (result
+ (not
+ (find
+ (lambda (ipt2)
+ (inputs-equivalent? requirement-ipt ipt2))
+ allow-missing))))
+ (log-msg 'DEBUG
+ "considering "
+ (input-short-description requirement-ipt)
+ " in " (map input-short-description allow-missing) " " result)
+ result))
+ inputs)
+ inputs)))
+
+(define input->package-cache (make-hash-table))
+
+(define (packages->input-list packages)
+ (map (lambda (package)
+ (list (package-name package) package))
+ packages))
+
+(define (dependency-loop? ipt dependants)
+ (member ipt dependants))
+
+(define (partition-requirements ipt)
+ ; propagated-inputs-requirements is the install_requirements
+ ; native-inputs is the
+ ; (differece
+ ; (union
+ ; build requirements
+ ; test requirements)
+ ; install_requirements)
+ (let*
+ ((sd (input-sdist ipt))
+ (propagated-input-requirements
+ (filter-requirements-by-extras
+ (sdist-install-requires sd)
+ (input-extras ipt)))
+ (native-input-requirements
+ (lset-difference
+ equal?
+ (lset-union
+ equal?
+ (sdist-build-requires sd)
+ (if (input-run-tests ipt)
+ (sdist-tests-require sd)
+ '()))
+ propagated-input-requirements)))
+ (values
+ native-input-requirements
+ '()
+ propagated-input-requirements)))
diff --git a/pypi/requirement.scm b/pypi/requirement.scm
new file mode 100644
index 0000000..fc1bb87
--- /dev/null
+++ b/pypi/requirement.scm
@@ -0,0 +1,210 @@
+(define-module (pypi requirement)
+ #:use-module (pyguile)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
+ #:use-module (srfi srfi-13)
+ #:use-module (ice-9 pretty-print)
+ #:use-module (guix records)
+ #:use-module (guix combinators)
+ #:use-module (pypi version)
+ #:export (requirement
+ requirement?
+ requirement-name
+ requirement-specifiers
+ requirement-extras
+ requirement-markers
+ requirement-run-tests
+
+ unsatisfied-requirements-error
+ normalise-requirement-name
+ requirement-satisfied-by?
+
+ requirement->string
+
+ get-quoted-requirement
+ version-meets-requirement
+ get-version-best-matching-requirement
+
+ requirement-string->requirement
+ requirement-tuple->quoted-requirement
+ requirement-tuple->requirement
+ requirement-string->quoted-requirement
+ filter-requirements-by-extras))
+
+(define unsatisfied-requirements-error 'unsatisfied-requirements-error)
+
+(define-record-type* <requirement>
+ requirement make-requirement
+ requirement?
+ (name requirement-name)
+ (specifiers requirement-specifiers (default ""))
+ (extras requirement-extras (default '()))
+ (markers requirement-markers (default '()))
+ (run-tests requirement-run-tests (default #t)))
+
+(set-record-type-printer! <requirement>
+ (lambda (record port)
+ (display (requirement->string record) port)))
+
+(define (get-quoted-requirement r)
+ (fold
+ (lambda (f d) (f d))
+ `(requirement
+ (name ,(requirement-name r)))
+ `(,(lambda
+ (d)
+ (if (string-null? (requirement-specifiers r))
+ d
+ (append d `((specifiers ,(requirement-specifiers r))))))
+ ,(lambda
+ (d)
+ (if (null? (requirement-extras r))
+ d
+ (append d `((extras (quote ,(requirement-extras r)))))))
+ ,(lambda
+ (d)
+ (if (null? (requirement-markers r))
+ d
+ (append d `((markers (quote ,(requirement-markers r))))))))))
+
+(define (requirement-satisfied-by? r name version)
+ (and
+ (equal?
+ (normalise-requirement-name name)
+ (normalise-requirement-name (requirement-name r)))
+ (version-meets-requirement r version)))
+
+(define (version-meets-requirement r version)
+ (begin
+ (python-import "packaging.requirements")
+ (python-import "packaging.version")
+ (let* ((contains (python-eval "lambda r, v: r.specifier.contains(v)" #t))
+ (pyr (python-apply '(packaging requirements Requirement)
+ (list
+ (string-append
+ (requirement-name r)
+ (requirement-specifiers r)))
+ '()))
+ (pyv (python-apply '(packaging version parse)
+ (list version)
+ '()))
+ (result
+ (python-apply (list contains) (list pyr pyv) '())))
+ result)))
+
+(define (get-version-best-matching-requirement r versions)
+ (find
+ (lambda (v) (version-meets-requirement r v))
+ (sort-versions versions)))
+
+(define (filter-versions-by-requirement r versions)
+ (filter
+ (lambda (v) (version-meets-requirement r v))
+ versions))
+
+(define (filter-requirements-by-extras reqs extras)
+ (filter (lambda (r)
+ (if (> (length (requirement-extras r)) 0)
+ ; If an extra is specified in the requirement, only
+ ; include the dependency if a matching extra is given
+ (> (length (lset-intersection equal?
+ extras
+ (requirement-extras r)))
+ 0)
+ #t)) ; If the requirement does not specify extras, it is valid regardless
+ reqs))
+
+(define (requirement-tuple->quoted-requirement t)
+ (requirement->quoted-requirement
+ (requirement-tuple->requirement t)))
+
+(define (validate-requirement r)
+ (or
+ (string? (requirement-name r))
+ (error "requirement name is not a string " (requirement-name r)))
+ (or
+ (list? (requirement-markers r))
+ (error "requirement markers are not a list " (requirement-markers r)))
+ (or
+ (list? (requirement-extras r))
+ (error "requirement extras are not a list " (requirement-extras r)))
+ r)
+
+(define (requirement-tuple->requirement t)
+ (validate-requirement
+ (requirement
+ (name (first t))
+ (specifiers (second t))
+ (extras (third t))
+ (markers (fourth t)))))
+
+(define (requirement->string r)
+ (string-append
+ (requirement-name r)
+ (if (null? (requirement-extras r))
+ ""
+ (apply
+ string-append
+ (list
+ "["
+ (string-join
+ (requirement-extras r)
+ ",")
+ "]")))
+ (requirement-specifiers r)))
+
+(define (requirement-string->quoted-requirement requirement-string)
+ (requirement->quoted-requirement
+ (requirement-string->requirement
+ requirement-string)))
+
+(define (requirement->quoted-requirement r)
+ `(requirement
+ (name ,(requirement-name r))
+ (specifiers ,(requirement-specifiers r))
+ (extras ,(requirement-extras r))
+ (markers ,(requirement-markers r))))
+
+(define (requirement-string->requirement requirement-string)
+ (begin
+ (python-import "packaging.requirements")
+ (python-import "packaging.version")
+ (let* ((pyr (python-apply '(packaging requirements Requirement)
+ (list requirement-string)
+ '()))
+ (name (python-apply '("__builtin__" "getattr")
+ (list pyr "name")
+ '()))
+ (specifier (python-apply '("__builtin__" "getattr")
+ (list pyr "specifier")
+ '()))
+ (specifiers (python-apply '("__builtin__" "str")
+ (list specifier)
+ '()))
+ (extras (let
+ ((f (python-eval "lambda pyr: list(pyr.extras)" #t)))
+ (python-apply
+ f
+ (list pyr)
+ '())))
+ (markers (python-apply '("__builtin__" "getattr")
+ (list pyr "marker")
+ '())))
+ (validate-requirement
+ (requirement
+ (name name)
+ (specifiers specifiers)
+ (extras extras)
+ (markers markers))))))
+
+(define normalise-requirement-name
+ (memoize
+ (lambda (name)
+ (python-eval "from pkg_resources import to_filename, safe_name")
+ (let*
+ ((f (python-eval
+ "lambda n: to_filename(safe_name(n))"
+ #t)))
+ (string-downcase
+ (python-apply f (list name) '()))))))
diff --git a/pypi/sdist-store.scm b/pypi/sdist-store.scm
new file mode 100644
index 0000000..f1e0277
--- /dev/null
+++ b/pypi/sdist-store.scm
@@ -0,0 +1,190 @@
+(define-module (pypi sdist-store)
+ #:use-module (logging logger)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-13)
+ #:use-module (ice-9 vlist)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 hash-table)
+ #:use-module (ice-9 pretty-print)
+ #:use-module (guix ui)
+ #:use-module (guix packages)
+ #:use-module (guix build utils)
+ #:use-module (guix download)
+ #:use-module (pypi sdist)
+ #:use-module (pypi version)
+ #:use-module (pypi requirement)
+ #:export (make-sdist-store
+ add-sdist
+ add-sdists
+ get-sdist
+ get-sdists
+ get-sdist-list
+ get-sdists-by-version-meeting-requirement
+ get-sdist-best-matching-requirement
+ get-sdist-best-matching-requirements
+ store-can-satisfy-requirement?
+ log-sdist-store
+ create-sdists-module))
+
+(define (vhash-set key value vhash)
+ (vhash-cons
+ key
+ value
+ (vhash-delete
+ key
+ vhash)))
+
+(define (make-sdist-store)
+ vlist-null)
+
+(define (add-sdist store sd)
+ (let*
+ ((info (sdist-info sd))
+ (name (normalise-requirement-name (pkg-info-name info)))
+ (version (pkg-info-version info))
+ (versions
+ (vhash-assoc
+ (normalise-requirement-name name)
+ store)))
+ (vhash-set
+ name
+ (vhash-set
+ version
+ sd
+ (if versions
+ (cdr versions)
+ vlist-null))
+ store)))
+
+(define (log-sdist-store level sdist-store)
+ (for-each
+ (match-lambda
+ ((name . versions)
+ (log-msg level name ":")
+ (for-each
+ (match-lambda
+ ((version . sdist)
+ (log-msg level " " version)))
+ (vlist->list versions))))
+ (vlist->list sdist-store)))
+
+(define (add-sdists store sds)
+ (fold
+ (lambda (sd store)
+ (add-sdist store sd))
+ store
+ sds))
+
+(define (get-sdists store name) ; TODO: Change this, as it does not get sdists (instead it gets an alist)
+ (let
+ ((p
+ (vhash-assoc (normalise-requirement-name name) store)))
+ (if p
+ (vlist->list (cdr p))
+ '())))
+
+(define (get-sdists-by-version-meeting-requirement sdist-store requirement)
+ (filter
+ (match-lambda
+ ((version . sd)
+ (sdist-meets-requirement sd requirement)))
+ (get-sdists sdist-store (requirement-name requirement))))
+
+(define (get-sdist store name version)
+ (assoc-ref
+ (get-sdists store name)
+ version))
+
+(define (sort-version-alist al)
+ (let*
+ ((versions (map car al))
+ (sorted-versions (sort-versions versions)))
+ (map
+ (lambda (version)
+ (cons version (assoc-ref al version)))
+ sorted-versions)))
+
+
+(define (get-sdist-list store)
+ (apply
+ append
+ (map
+ cdr
+ (stable-sort
+ (vlist->list
+ (vlist-map
+ (match-lambda
+ ((name . versions)
+ (cons
+ name
+ (map cdr
+ (sort-version-alist
+ (vlist->list versions))))))
+ store))
+ (lambda (x y)
+ (string<? (car x) (car y)))))))
+
+
+(define (create-sdists-module store module path)
+ (call-with-output-file
+ path
+ (lambda (port)
+ (pretty-print
+ `(define-module ,module
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-13)
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (guix build utils)
+ #:use-module (pypi sdist)
+ #:use-module (pypi requirement))
+ port)
+ (pretty-print
+ `(define-public
+ sdists
+ ,(append
+ '(list)
+ (map get-quoted-sdist (get-sdist-list store))))
+ port))))
+
+(define (store-can-satisfy-requirement? store r)
+ (get-sdist-best-matching-requirement store r))
+
+(define (get-sdist-best-matching-requirement store r)
+ (get-sdist-best-matching-requirements store (list r)))
+
+(define (get-sdist-best-matching-requirements store requirements)
+ (let*
+ ((unique-names
+ (apply
+ lset-adjoin
+ (append
+ (list equal? '())
+ (map (lambda (r) (normalise-requirement-name
+ (requirement-name r)))
+ requirements))))
+ (normalised-name (first unique-names)))
+ (if (not (eq? 1 (length unique-names)))
+ (error "Not all requirements are for the name package"
+ requirements))
+ (let ((sorted-suitable-versions
+ (let*
+ ((sdists (filter
+ (lambda (sd)
+ (every
+ (lambda (r)
+ (sdist-meets-requirement sd r))
+ requirements))
+ (map cdr (get-sdists store normalised-name))))
+ (sdists-and-versions
+ (map
+ (lambda (sd) (cons (pkg-info-version (sdist-info sd)) sd))
+ sdists))
+ (sorted-versions
+ (sort-versions (map car sdists-and-versions))))
+ (map
+ (lambda (v) (assoc-ref sdists-and-versions v))
+ sorted-versions))))
+ (if (> (length sorted-suitable-versions) 0)
+ (first sorted-suitable-versions)
+ #f))))
diff --git a/pypi/sdist-store/dependency-sets.scm b/pypi/sdist-store/dependency-sets.scm
new file mode 100644
index 0000000..d8fb920
--- /dev/null
+++ b/pypi/sdist-store/dependency-sets.scm
@@ -0,0 +1,66 @@
+(define-module (pypi sdist-store dependency-sets)
+ #:use-module (srfi srfi-9)
+ #:use-module (ice-9 vlist)
+ #:export (make-dependency-sets-record
+ add-dependency-set
+ remove-dependency-set
+ dependency-sets->list
+ get-dependency-set-keys-matching
+ get-dependency-set-keys
+ get-dependency-set))
+
+(define-record-type <dependency-sets>
+ (new-dependency-sets-record vhash next-key)
+ dependency-sets-record?
+ (vhash dependency-sets-vhash)
+ (next-key dependency-sets-next-key))
+
+(define (make-dependency-sets-record)
+ (new-dependency-sets-record
+ vlist-null
+ 0))
+
+(define (add-dependency-set dependency-sets entry)
+ (let ((key (dependency-sets-next-key dependency-sets)))
+ (new-dependency-sets-record
+ (vhash-consq
+ key
+ entry
+ (dependency-sets-vhash dependency-sets))
+ (+ key 1))))
+
+(define (remove-dependency-set dependency-sets key)
+ (new-dependency-sets-record
+ (vhash-delq
+ key
+ (dependency-sets-vhash dependency-sets))
+ (dependency-sets-next-key dependency-sets)))
+
+(define (dependency-sets->list proc dependency-sets)
+ (vhash-fold
+ (lambda (key value result)
+ (cons
+ (proc key value)
+ result))
+ '()
+ (dependency-sets-vhash dependency-sets)))
+
+(define (get-dependency-set-keys-matching dependency-sets proc)
+ (vhash-fold
+ (lambda (key value result)
+ (if (proc value)
+ (cons key result)
+ result))
+ '()
+ (dependency-sets-vhash dependency-sets)))
+
+(define (get-dependency-set-keys dependency-sets)
+ (vhash-fold
+ (lambda (key value result)
+ (cons key result))
+ '()
+ (dependency-sets-vhash dependency-sets)))
+
+(define (get-dependency-set dependency-sets key)
+ (cdr
+ (vhash-assq key (dependency-sets-vhash dependency-sets))))
diff --git a/pypi/sdist-store/import-master.scm b/pypi/sdist-store/import-master.scm
new file mode 100644
index 0000000..b55e415
--- /dev/null
+++ b/pypi/sdist-store/import-master.scm
@@ -0,0 +1,401 @@
+(define-module (pypi sdist-store import-master)
+ #:use-module (pyguile)
+ #:use-module (ice-9 binary-ports)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
+ #:use-module (ice-9 pretty-print)
+ #:use-module (ice-9 ftw)
+ #:use-module (ice-9 vlist)
+ #:use-module (ice-9 hash-table)
+ #:use-module (ice-9 regex)
+ #:use-module ((ice-9 rdelim) #:select (read-line))
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-13)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:use-module (rnrs bytevectors)
+ #:use-module (logging logger)
+ #:use-module (json)
+ #:use-module (web uri)
+ #:use-module (guix ui)
+ #:use-module (guix utils)
+ #:use-module (guix import utils)
+ #:use-module ((guix download) #:prefix download:)
+ #:use-module (guix import json)
+ #:use-module (guix packages)
+ #:use-module (guix upstream)
+ #:use-module (guix licenses)
+ #:use-module (guix build-system python)
+ #:use-module (pypi api)
+ #:use-module (pypi sdist)
+ #:use-module (pypi package)
+ #:use-module (pypi sdist-store)
+ #:use-module (pypi requirement)
+ #:use-module (pypi sdist-store dependency-sets)
+ #:use-module (pypi sdist-store utils)
+ #:use-module (pypi sdist-store import)
+ #:export (create-sdist-and-missing-dependencies))
+
+(define (vhash-set key value vhash)
+ (vhash-cons
+ key
+ value
+ (vhash-delete
+ key
+ vhash)))
+
+(define (create-sdist-and-missing-dependencies
+ api-root
+ sdist-store
+ fix-function
+ python-pkg
+ name
+ version
+ intermediate-result-callback)
+ (process-dependency-sets
+ (import-context
+ (python python-pkg)
+ (fix-function fix-function)
+ (pypi-api-root api-root))
+ sdist-store
+ (add-dependency-set
+ (make-dependency-sets-record)
+ (list (cons name version)))
+ vlist-null
+ intermediate-result-callback))
+
+(define (dependency-set-ready-for-processing? key sdist-store import-states)
+ (log-msg 'DEBUG "dependency-set-ready-for-processing?")
+ (log-msg 'DEBUG sdist-store)
+ (let ((import-state (vhash-assq key import-states)))
+ (if (eq? import-state #f)
+ #t ; accept if this has not been tried before
+ (let
+ ((status (get-import-state-status (cdr import-state))))
+ (if (bad-status? status)
+ (let
+ ((reason (get-bad-status-reason status)))
+ (cond
+ ((unsatisfiable-requirements? reason)
+ (every
+ (lambda (r)
+ (store-can-satisfy-requirement? sdist-store r))
+ (get-unsatisfiable-requirements reason)))
+ (else (error "unknown failure reason"))))
+ ; only continue if there are remaining steps
+ (not (null? (get-import-state-remaining-steps (cdr import-state)))))))))
+
+(define (get-dependency-sets-for-processing
+ sdist-store dependency-sets import-states)
+ (filter
+ (lambda (key)
+ (dependency-set-ready-for-processing? key sdist-store import-states))
+ (get-dependency-set-keys dependency-sets)))
+
+(define (add-result-to-log key results-log result)
+ (let ((existing-results (hash-ref results-log key)))
+ (hash-set!
+ results-log
+ key
+ (if existing-results
+ (cons result existing-results)
+ (list result)))))
+
+(define (get-latest-results-for-dependency-sets dependency-sets results-log)
+ (map
+ (lambda (key)
+ (let
+ ((entries (hash-ref results-log key)))
+ (if entries
+ (car entries)
+ #f)))
+ (get-dependency-set-keys dependency-sets)))
+
+(define (update-sdist-store master dest)
+ ; Not quite sure what this is doing, as it only acts at the package (and not
+ ; version) level
+ (vhash-fold
+ (lambda (k v result)
+ (vhash-set k v result))
+ dest
+ master))
+
+(define (get-graph-handle-for-dependency-set
+ key dependency-sets import-states-unsatisfiable-requirements)
+ (let
+ ((unsatisfiable-requirements
+ (hash-ref import-states-unsatisfiable-requirements key)))
+ (if (eq? #f unsatisfiable-requirements)
+ (cons key '())
+ (begin
+ (cons
+ key
+ (map
+ (lambda (r)
+ (get-dependency-set-key-for-requirement dependency-sets r))
+ unsatisfiable-requirements))))))
+
+(define (get-dependency-set-dependency-graph
+ dependency-sets import-states-unsatisfiable-requirements)
+ (alist->hash-table
+ (dependency-sets->list
+ (lambda (key dependency-set)
+ (get-graph-handle-for-dependency-set
+ key dependency-sets import-states-unsatisfiable-requirements))
+ dependency-sets)))
+
+(define (merge-cycles-in-dependency-sets
+ dependency-sets import-states-unsatisfiable-requirements)
+ (log-msg 'DEBUG "merge-cycles-in-dependency-sets")
+ (log-msg 'DEBUG (hash-map->list cons import-states-unsatisfiable-requirements))
+ (let*
+ ((dependency-graph
+ (get-dependency-set-dependency-graph
+ dependency-sets import-states-unsatisfiable-requirements))
+ (cycle (find-cycle-in-graph dependency-graph)))
+ (if cycle
+ (merge-cycles-in-dependency-sets
+ (fold
+ (lambda (key dependency-sets)
+ (remove-dependency-set dependency-sets key))
+ (add-dependency-set
+ dependency-sets
+ (concatenate
+ (map
+ (lambda (key)
+ (get-dependency-set dependency-sets key))
+ cycle)))
+ cycle)
+ import-states-unsatisfiable-requirements)
+ dependency-sets)))
+
+(define (process-dependency-set
+ import-context
+ sdist-store
+ dependency-sets
+ import-states
+ intermediate-result-callback
+ key)
+ (let
+ ((state
+ (process-import
+ import-context
+ (let
+ ((existing (vhash-assoc key import-states)))
+ (if existing
+ (import-state
+ (inherit (cdr existing))
+ (sdist-store
+ (update-sdist-store
+ sdist-store
+ (get-import-state-sdist-store (cdr existing))))
+ (status good-status))
+ (import-state
+ (packages
+ (get-dependency-set dependency-sets key))
+ (sdist-store
+ sdist-store)
+ (remaining-steps
+ steps)
+ (status good-status))))
+ intermediate-result-callback)))
+ (let
+ ((status (get-import-state-status state))
+ (updated-import-states
+ (vhash-set
+ key
+ state
+ import-states)))
+ (log-msg 'DEBUG "in process-dependency-set")
+ (log-msg 'DEBUG import-states)
+ (log-msg 'DEBUG status (good-status? status))
+ (values
+ ; sdist-store
+ (if (good-status? status)
+ (add-sdists
+ sdist-store
+ (map
+ (match-lambda
+ ((name . version)
+ (log-msg 'INFO "Adding " name "@" version " to the store")
+ (get-sdist
+ (get-import-state-sdist-store
+ state)
+ name
+ version)))
+ (get-import-state-packages state)))
+ sdist-store)
+ ; dependency-sets
+ (cond
+ ((good-status? status)
+ (remove-dependency-set dependency-sets key))
+ ((bad-status? status)
+ (log-msg 'DEBUG "bad status")
+ (let
+ ((reason (get-bad-status-reason status)))
+ (cond
+ ((unsatisfiable-requirements? reason)
+ (log-msg 'DEBUG "FOO")
+ (log-msg 'DEBUG updated-import-states)
+ (log-msg 'DEBUG (vlist->list updated-import-states))
+ (merge-cycles-in-dependency-sets
+ (add-missing-dependency-sets
+ dependency-sets
+ (get-unsatisfiable-requirements reason)
+ import-context)
+ (get-import-states-unsatisfiable-requirements
+ sdist-store
+ updated-import-states)))
+ (else
+ (error "Unknown bad status reason" reason)))))
+ (else
+ (error "Unknown worker result" state)))
+
+ ; import-states
+ updated-import-states))))
+
+(define (get-import-states-unsatisfiable-requirements sdist-store import-states)
+ (log-msg 'DEBUG "get-import-states-unsatisfiable-requirements")
+ (log-msg 'DEBUG import-states)
+ (log-msg 'DEBUG (vlist->list import-states))
+ (alist->hash-table
+ (map
+ (match-lambda
+ ((key . state)
+ (log-msg 'DEBUG state)
+ (cons
+ key
+ (if (bad-status? (get-import-state-status state))
+ (filter
+ (lambda (r)
+ (not (store-can-satisfy-requirement? sdist-store r)))
+ (get-unsatisfiable-requirements
+ (get-bad-status-reason
+ (get-import-state-status state))))
+ '()))))
+ (vlist->list import-states))))
+
+(define (process-dependency-set-keys
+ import-context
+ sdist-store
+ dependency-sets
+ import-states
+ intermediate-result-callback
+ keys)
+ (if (null? keys)
+ (values
+ sdist-store
+ dependency-sets
+ import-states)
+ (let-values
+ (((sdist-store dependency-sets import-states)
+ (process-dependency-set
+ import-context
+ sdist-store
+ dependency-sets
+ import-states
+ intermediate-result-callback
+ (car keys))))
+ (process-dependency-set-keys
+ import-context
+ sdist-store
+ dependency-sets
+ import-states
+ intermediate-result-callback
+ (cdr keys)))))
+
+(define (process-dependency-sets
+ import-context
+ sdist-store
+ dependency-sets
+ import-states
+ intermediate-result-callback)
+ (let
+ ((dependency-sets-for-processing
+ (get-dependency-sets-for-processing
+ sdist-store
+ dependency-sets
+ import-states)))
+ (log-msg 'DEBUG "dependency-sets-for-processing")
+ (log-msg 'DEBUG dependency-sets-for-processing)
+ (log-msg 'DEBUG "dependency-sets")
+ (log-msg 'DEBUG (dependency-sets->list cons dependency-sets))
+ (if (null? dependency-sets-for-processing)
+ sdist-store
+ (let-values
+ (((sdist-store dependency-sets import-states)
+ (process-dependency-set-keys
+ import-context
+ sdist-store
+ dependency-sets
+ import-states
+ intermediate-result-callback
+ dependency-sets-for-processing)))
+ (process-dependency-sets
+ import-context
+ sdist-store
+ dependency-sets
+ import-states
+ intermediate-result-callback)))))
+
+(define (get-dependency-set-key-for-requirement dependency-sets r)
+ (or
+ (any
+ (match-lambda
+ ((key . name-version-pairs)
+ (any
+ (match-lambda
+ ((name . version)
+ (if (requirement-satisfied-by? r name version)
+ key
+ #f)))
+ name-version-pairs)))
+ (dependency-sets->list cons dependency-sets))
+ (error "Could not find dependency set meeting requirement" r)))
+
+(define (add-missing-dependency-sets
+ dependency-sets
+ requirements
+ import-context)
+ (log-msg 'DEBUG "add-missing-dependency-sets")
+ (log-msg 'DEBUG requirements)
+ (fold
+ (lambda (r dependency-sets)
+ (log-msg 'DEBUG "Adding dependnecy set for " r)
+ (add-dependency-set
+ dependency-sets
+ (list
+ (cons
+ (requirement-name r)
+ (get-version-best-matching-requirement
+ r
+ (available-versions
+ (requirement-name r)
+ (get-import-context-pypi-api-root import-context)))))))
+ dependency-sets
+ (filter
+ (lambda (r)
+ (log-msg 'DEBUG r)
+ (not
+ (any
+ (lambda (name-version-pairs)
+ (any
+ (match-lambda
+ ((name . version)
+ (requirement-satisfied-by? r name version)))
+ name-version-pairs))
+ (dependency-sets->list
+ (lambda (k v) v)
+ dependency-sets))))
+ requirements)))
+
+(define (package-meets-requirement package requirement)
+ (let* ((package-name (car package))
+ (package-version (cdr package)))
+ (if (equal? (requirement-name requirement)
+ package-name)
+ (begin
+ (version-meets-requirement requirement package-version))
+ #f)))
diff --git a/pypi/sdist-store/import.scm b/pypi/sdist-store/import.scm
new file mode 100644
index 0000000..b00afd0
--- /dev/null
+++ b/pypi/sdist-store/import.scm
@@ -0,0 +1,720 @@
+(define-module (pypi sdist-store import)
+ #:use-module (pyguile)
+ #:use-module (logging logger)
+ #:use-module (rnrs io ports)
+ #:use-module (ice-9 binary-ports)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 pretty-print)
+ #:use-module (ice-9 vlist)
+ #:use-module (ice-9 ftw)
+ #:use-module (ice-9 regex)
+ #:use-module ((ice-9 rdelim) #:select (read-line))
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:use-module (rnrs bytevectors)
+ #:use-module (json)
+ #:use-module (web uri)
+ #:use-module (guix ui)
+ #:use-module (guix utils)
+ #:use-module (guix records)
+ #:use-module (guix store)
+ #:use-module (guix monads)
+ #:use-module (guix import utils)
+ #:use-module ((guix download) #:prefix download:)
+ #:use-module (guix import json)
+ #:use-module (guix packages)
+ #:use-module (guix upstream)
+ #:use-module (guix licenses)
+ #:use-module (guix build-system python)
+ #:use-module ((guix derivations) #:select (derivation-file-name
+ built-derivations
+ derivation->output-path))
+ #:use-module (pypi package)
+ #:use-module (pypi requirement)
+ #:use-module (pypi api)
+ #:use-module (pypi sdist)
+ #:use-module (pypi sdist-store)
+ #:use-module (pypi requirement)
+ #:use-module (pypi dependency-solver)
+ #:use-module (pypi build-configuration-graph)
+ #:use-module (pypi sdist-store utils)
+ #:use-module (gnu packages python)
+ #:export (process-import
+
+ recursive-package-inputs
+
+ import-state
+ get-import-state-status
+ get-import-state-sdist-store
+ get-import-state-packages
+
+ import-context
+ make-import-context
+ get-import-context-python
+ get-import-context-fix-function
+ get-import-context-pypi-api-root
+
+ steps
+
+ good-status
+ good-status?
+ bad-status
+ bad-status?
+ get-bad-status-reason))
+
+(define-record-type* <import-state>
+ import-state make-import-state
+ import-state?
+ (packages get-import-state-packages)
+ (sdist-store get-import-state-sdist-store)
+ (remaining-steps get-import-state-remaining-steps)
+ (status get-import-state-status))
+
+(define-record-type* <import-context>
+ import-context make-import-context
+ import-context?
+ (python get-import-context-python)
+ (pypi-api-root get-import-context-pypi-api-root)
+ (fix-function get-import-context-fix-function))
+
+(define good-status 'good-status)
+
+(define (good-status? s) (eq? good-status s))
+
+(define-record-type <bad-status>
+ (bad-status reason)
+ bad-status?
+ (reason get-bad-status-reason))
+
+(define (check-packages-for-duplicates packages)
+ (if (not (=
+ (length packages)
+ (length (delete-duplicates packages equal?))))
+ (error "packages contains duplicate entries" packages)))
+
+(define (process-import import-context import-state intermediate-result-callback)
+ (check-packages-for-duplicates
+ (get-import-state-packages import-state))
+ (let
+ ((remaining-steps (get-import-state-remaining-steps import-state)))
+ (if (null? remaining-steps)
+ import-state
+ (let
+ ((next-step (car remaining-steps)))
+ (let*
+ ((new-state (next-step import-context import-state))
+ (new-status (get-import-state-status new-state)))
+ (intermediate-result-callback (get-import-state-sdist-store new-state))
+ (cond
+ ((good-status? new-status)
+ (process-import import-context new-state intermediate-result-callback))
+ ((bad-status? new-status)
+ new-state)
+ (else
+ (error "Unknown import status" new-status))))))))
+
+(define (create-initial-sdist-record-from-sdist name version import-context)
+ (ensure-unpacked-sdist-exists
+ name version (get-import-context-pypi-api-root import-context))
+ (let
+ ((requires (parse-requires name version)))
+ (sdist
+ (info (get-pkg-info name version))
+ (build-requires (get-sdist-build-requires name version))
+ (tests-require (get-sdist-tests-require name version))
+ (install-requires (get-sdist-install-requires requires))
+ (extras-require (get-sdist-extras-require requires))
+ (source (get-sdist-origin name version import-context)))))
+
+(define (create-initial-sdists import-context state)
+ "create-initial-sdists"
+ (log-msg 'DEBUG "create-initial-sdists")
+ (log-msg 'DEBUG (vlist->list (get-import-state-sdist-store state)))
+ (import-state
+ (inherit state)
+ (remaining-steps (cdr (get-import-state-remaining-steps state)))
+ (sdist-store
+ (let ((previous-store
+ (get-import-state-sdist-store state)))
+ (add-sdists
+ previous-store
+ (map
+ (match-lambda
+ ((name . version)
+ (create-initial-sdist-record-from-sdist name version import-context)))
+ (filter
+ (match-lambda
+ ((name . version)
+ (log-msg 'DEBUG "Checking that " name "@" version " is not already in the store")
+ (log-msg 'DEBUG (not (get-sdist previous-store name version)))
+ (not (get-sdist previous-store name version))))
+ (get-import-state-packages state))))))))
+
+(define (get-package-processor f)
+ (letrec
+ ((fn
+ (lambda (import-context state)
+ (check-steps state fn)
+ (letrec
+ ((processor
+ (lambda (import-context state packages)
+ (if (null? packages)
+ (import-state
+ (inherit state)
+ (remaining-steps (cdr (get-import-state-remaining-steps state))))
+ (let*
+ ((pkg (car packages))
+ (name (car pkg))
+ (version (cdr pkg))
+ (new-import-state
+ (f import-context state name version))
+ (new-status (get-import-state-status new-import-state)))
+ (cond
+ ((good-status? new-status)
+ (processor import-context new-import-state (cdr packages)))
+ ((bad-status? new-status)
+ new-import-state)
+ (else
+ (error "Unknown import status" new-status))))))))
+ (processor
+ import-context
+ state
+ (get-import-state-packages state))))))
+ fn))
+
+(define build-package-to-determine-build-requirements
+ (get-package-processor
+ (lambda (import-context import-state name version)
+ (log-msg 'INFO "Building " name "@" version " without tests")
+ (build-package-to-determine-requirements
+ import-context
+ import-state
+ name
+ version
+ #f
+ '()))))
+
+(define build-package-to-determine-test-requirements
+ (get-package-processor
+ (lambda (import-context import-state name version)
+ (log-msg 'INFO "Building " name "@" version " with tests")
+ (build-package-to-determine-requirements
+ import-context
+ import-state
+ name
+ version
+ #t
+ '()))))
+
+(define steps (list
+ create-initial-sdists
+ build-package-to-determine-build-requirements
+ build-package-to-determine-test-requirements))
+
+(define (get-sdist-coresponding-to-package store pkg)
+ (let*
+ ((sd (assoc-ref (package-properties pkg) 'sdist))
+ (pkginfo (sdist-info sd))
+ (name (pkg-info-name pkginfo))
+ (version (pkg-info-version pkginfo)))
+ (get-sdist
+ store
+ name
+ version)))
+
+(define (get-build-configuration-from-package pkg)
+ (let
+ ((bc
+ (assoc-ref (package-properties pkg) 'build-configuration)))
+ (if (not (build-configuration? bc))
+ (begin
+ (log-msg 'ERROR "get-build-configuration-from-package is not a build configuration"
+ bc)
+ (error)))
+ bc))
+
+(define (build-and-report-log-on-failures pkg)
+ (letrec*
+ ((inputs-plus-pkg
+ (reverse (cons pkg (reverse (recursive-package-inputs pkg)))))
+ (build-all
+ (lambda (remaining-packages)
+ (if (null? remaining-packages)
+ #t
+ (let
+ ((pkg (car remaining-packages)))
+ (let
+ ((result (build-and-return-log-on-failure pkg)))
+ (if (eq? result #t)
+ (build-all (cdr remaining-packages))
+ result)))))))
+ (build-all inputs-plus-pkg)))
+
+(define (check-steps state current-step)
+ (if
+ (not (eq? (car (get-import-state-remaining-steps state)) current-step))
+ (error "Actual step " current-step " does not equal " (car (get-import-state-remaining-steps state)))))
+
+(define (build-package-to-determine-requirements
+ import-context state name version run-tests extras)
+ (let*
+ ((sdist-store
+ (get-import-state-sdist-store state))
+ (sd
+ (get-sdist
+ sdist-store
+ name
+ version))
+ (build-configuration-graph-or-error
+ (catch
+ unsatisfied-requirements-error
+ (lambda ()
+ (requirements->build-configuration-graph
+ sdist-store
+ (list
+ (requirement
+ (name name)
+ (specifiers
+ (string-append "==" version))
+ (extras extras)
+ (run-tests run-tests)))))
+ (lambda (err unsatisfied-requirements)
+ (unsatisfiable-requirements unsatisfied-requirements)))))
+ (if (not (build-configuration-graph? build-configuration-graph-or-error))
+ (import-state
+ (inherit state)
+ (status (bad-status
+ build-configuration-graph-or-error)))
+ (let*
+ ((build-configuration-graph
+ build-configuration-graph-or-error)
+ (requirement-options-to-versions
+ (solve-build-configuration-graph
+ build-configuration-graph))
+ (pkg-or-error
+ (catch
+ unsatisfied-requirements-error
+ (lambda ()
+ (first
+ (build-configuration-graph->packages
+ build-configuration-graph
+ (package-configuration
+ (get-import-context-python import-context)
+ (get-import-context-fix-function import-context))
+ requirement-options-to-versions)))
+ (lambda (err unsatisfied-requirements)
+ (unsatisfiable-requirements unsatisfied-requirements)))))
+ (if (not (package? pkg-or-error))
+ (import-state
+ (inherit state)
+ (status (bad-status
+ pkg-or-error)))
+ (begin
+ (log-msg 'DEBUG "sdist information " (sdist-short-description sd))
+ (log-msg 'DEBUG "build-requires " (sdist-build-requires sd))
+ (log-msg 'DEBUG "test-requires " (sdist-tests-require sd))
+ (log-msg 'DEBUG "install-requires " (sdist-install-requires sd))
+ (log-msg 'DEBUG "dependencies for " (package-name pkg-or-error))
+ (log-msg 'DEBUG "native-inputs " (map car (package-native-inputs pkg-or-error)))
+ (log-msg 'DEBUG "inputs " (map car (package-inputs pkg-or-error)))
+ (log-msg 'DEBUG "propagated-inputs " (map car (package-propagated-inputs pkg-or-error)))
+ (let*
+ ((build-result (build-and-report-log-on-failures pkg-or-error)))
+ (if (eq? build-result #t)
+ state
+ (let*
+ ((pkg (car build-result))
+ (log-contents (cdr build-result))
+ (parsed-result (parse-build-log log-contents))
+ (sdist (get-sdist-coresponding-to-package
+ sdist-store
+ pkg)))
+ (if (eq? parsed-result #f)
+ (begin
+ (display "\n")
+ (display log-contents)
+ (display "\n")
+ (log-msg 'ERROR "Unable to determine build problem")
+ (error)))
+ (log-msg 'INFO "Finished building " (package-name pkg) " " (package-version pkg))
+ (log-msg 'INFO "Missing requirements: " parsed-result)
+ (if
+ (not
+ (member
+ (normalise-requirement-name
+ (pkg-info-name (sdist-info sdist)))
+ (map (match-lambda
+ ((name . version)
+ (normalise-requirement-name name)))
+ (get-import-state-packages state))))
+ (begin
+ (display "\n")
+ (display log-contents)
+ (display "\n")
+ (log-msg 'ERROR
+ "Build problem in package outside of packages that this worker is trying to build:\n"
+ " packages: " (get-import-state-packages state) "\n"
+ " build failed for: " (normalise-requirement-name (pkg-info-name (sdist-info sdist))) "\n")
+ (error)))
+ (let*
+ ((missing-requirement parsed-result))
+ (log-msg 'DEBUG "missing requirement " missing-requirement)
+ (if (member
+ (requirement-name missing-requirement)
+ (build-configuration-omitted-dependencies
+ (get-build-configuration-from-package pkg)))
+ (begin
+ (display "\n")
+ (display log-contents)
+ (display "\n")
+ (log-build-configuration-graph
+ '() build-configuration-graph)
+ (log-msg 'ERROR "Build configuration: "
+ (get-build-configuration-from-package pkg))
+ (error "Package has failed to build due to omitted dependency")))
+ (if (store-can-satisfy-requirement? sdist-store missing-requirement)
+ (begin
+ (log-msg 'DEBUG "missing requirement is in the store")
+ (if (member
+ missing-requirement
+ (if (package-has-tests-enabled pkg)
+ (sdist-tests-require sdist)
+ (sdist-build-requires sdist)))
+ (begin
+ (display "\n")
+ (display log-contents)
+ (display "\n")
+ (log-msg 'ERROR "Problem building package")
+ (log-build-configuration-graph
+ '() build-configuration-graph)
+ (log-msg 'ERROR "Build configuration: "
+ (get-build-configuration-from-package pkg))
+ (error "Cannot add duplicate requirement " missing-requirement)))
+ (let
+ ((new-state
+ (import-state
+ (inherit state)
+ (sdist-store
+ (add-sdist
+ sdist-store
+ ((if (package-has-tests-enabled pkg)
+ add-test-requirements-to-sdist
+ add-build-requirements-to-sdist)
+ sdist
+ (list missing-requirement)))))))
+ (log-msg 'DEBUG "about to call build-package-to-determine-requirements")
+ (log-msg 'DEBUG state)
+ (log-msg 'DEBUG new-state)
+ (build-package-to-determine-requirements
+ import-context
+ new-state
+ name
+ version
+ run-tests
+ extras)))
+ ; Store can't satisfy requirements, so report failure
+ (begin
+ (log-msg 'DEBUG "missing requirement is not in the store")
+ (import-state
+ (inherit state)
+ (status
+ (bad-status
+ (unsatisfiable-requirements
+ (list missing-requirement)))))))))))))))))
+
+(define (readable-package p)
+ (string-append (package-name p) "@" (package-version p)))
+
+(define (check-and-fix-dependency-ordering package-and-dependencies)
+ (if (null? package-and-dependencies)
+ '()
+ (let*
+ ((first-pair (car package-and-dependencies))
+ (pkg (car first-pair))
+ (dependencies (cdr first-pair))
+ (remaining-packages (map car (cdr package-and-dependencies))))
+ (if
+ (every
+ (lambda (dependency)
+ (not (member dependency remaining-packages)))
+ dependencies)
+ (cons
+ first-pair
+ (check-and-fix-dependency-ordering (cdr package-and-dependencies)))
+ (check-and-fix-dependency-ordering
+ (append
+ (check-and-fix-dependency-ordering (cdr package-and-dependencies))
+ (list first-pair)))))))
+
+(define (recursive-package-inputs pkg)
+ (apply
+ lset-adjoin
+ (append
+ (list eq? '())
+ (apply
+ append
+ (reverse
+ (check-and-fix-dependency-ordering
+ (map
+ (lambda (p)
+ (cons p (reverse (recursive-package-inputs p))))
+ (filter
+ (lambda (p)
+ (assoc-ref
+ (package-properties p)
+ 'sdist))
+ (map cadr (package-direct-inputs pkg))))))))))
+
+(define (get-pkg-info name version)
+ (let* ((possible-egg-info-paths
+ (search-for-egg-info (get-sdist-directory name version) 2))
+ (pkg-info-path
+ (if (> (length possible-egg-info-paths) 0)
+ (string-append (first possible-egg-info-paths)
+ "/PKG-INFO")
+ (let ((p (string-append (get-sdist-directory name version)
+ "/PKG-INFO")))
+ (if (file-exists? p)
+ p
+ #f)))))
+ (if pkg-info-path
+ (let ((data ((call-with-input-file
+ pkg-info-path
+ read-rfc822) 'headers)))
+ (pkg-info
+ (name (string-trim-both (assq-ref data 'Name)))
+ (version (string-trim-both (assq-ref data 'Version)))
+ (home-page (assq-ref data 'Home-page))
+ (synopsis (assq-ref data 'Synopsis))
+ (description "") ; TODO: Possibly use (assq-ref data 'Description))
+ (license (assq-ref data 'License))))
+ (pkg-info
+ (name name)
+ (version version)
+ (home-page "")
+ (synopsis "")
+ (description "")
+ (license "")))))
+
+(define (get-sdist-build-requires name version)
+ (if (equal? name "setuptools")
+ '()
+ `(,(requirement
+ (name "setuptools")))))
+
+(define (get-sdist-tests-require name version)
+ '())
+
+(define (get-sdist-install-requires requires)
+ (let ((install-requires
+ (assoc-ref requires '())))
+ (if install-requires
+ install-requires
+ '())))
+
+(define (get-sdist-extras-require requires)
+ (map
+ (match-lambda
+ ((name . deps)
+ (extra name deps)))
+ (filter
+ (match-lambda
+ ((name . deps)
+ (not (null? name))))
+ requires)))
+
+(define (parse-requires name version)
+ (log-msg 'DEBUG "parse-requires " name "@" version)
+ (python-import "pkg_resources")
+ (let*
+ ((possible-egg-info-directories
+ (search-for-egg-info (get-sdist-directory name version) 2)))
+ (if (= (length possible-egg-info-directories) 0)
+ '()
+ (let*
+ ((sdist-directory (get-sdist-directory name version))
+ (egg-info (first possible-egg-info-directories))
+ (path-metadata (python-apply
+ '(pkg_resources PathMetadata)
+ (list
+ sdist-directory
+ egg-info)
+ '()))
+ (distribution (python-apply
+ '(pkg_resources Distribution)
+ (list
+ sdist-directory
+ path-metadata)
+ '()))
+ (output-dep-map
+ (python-eval "lambda d: [(extra, [(d.name, str(d.specifier), list(d.extras), d.marker) for d in deps]) for extra, deps in d._dep_map.items()]" #t))
+ (dep-map (python-apply output-dep-map
+ (list
+ distribution)
+ '())))
+ (map
+ (match-lambda
+ ((extra deps)
+ (log-msg 'DEBUG extra)
+ (log-msg 'DEBUG deps)
+ (cons
+ extra
+ (let
+ ((r (map
+ requirement-tuple->requirement
+ deps)))
+ (log-msg 'DEBUG r)
+ r))))
+ dep-map)))))
+
+(define (get-sdist-origin name version import-context)
+ (let* ((data
+ (source-release
+ (pypi-fetch
+ name
+ (get-import-context-pypi-api-root import-context))
+ version))
+ (filename (assoc-ref* data "filename"))
+ (full-path (string-append (get-tmpdir) "/" filename))
+ (source-url (assoc-ref* data "url")))
+ (origin
+ (method download:url-fetch)
+ (uri source-url)
+ (sha256
+ (base32 (guix-hash-url full-path))))))
+
+(define-condition-type &missing-source-error &error
+ missing-source-error?
+ (package missing-source-error-package))
+
+(define (source-release pypi-package version)
+ (let ((releases (assoc-ref* pypi-package "releases" version)))
+ (or (find (lambda (release)
+ (string=? "sdist" (assoc-ref release "packagetype")))
+ releases)
+ (raise (condition (&missing-source-error
+ (package pypi-package)))))))
+
+; error: Could not find suitable distribution for Requirement.parse('cryptography_vectors==1.4')
+(define requirement-regex
+ (make-regexp
+ ".*Could not find suitable distribution for Requirement\\.parse\\('(.*)'\\)"))
+
+(define import-error-regex-1
+ (make-regexp
+ "ImportError: No module named '?([^'.]+)"))
+
+(define import-error-regex-2
+ (make-regexp
+ "ImportError: cannot import name '?([^'.]+)"))
+
+(define no-matching-distribution
+ (make-regexp
+ "No matching distribution found for (.*)"))
+
+; 'No module named 'hypothesis''
+(define no-module-named
+ (make-regexp
+ "'No module named '(.*)''"))
+
+(define (list->pairs lst)
+ (if (null? lst)
+ '()
+ (cons
+ (cons (car lst) (cadr lst))
+ (list->pairs (cddr lst)))))
+
+(define (package-has-tests-enabled pkg)
+ (let
+ ((argument (find
+ (match-lambda
+ ((key . value)
+ (equal? #:tests? key)))
+ (list->pairs (package-arguments pkg)))))
+ (if argument
+ (cdr argument)
+ #t))) ; tests are on by default
+
+(define (parse-build-log l)
+ (let*
+ ((lines (string-split l #\newline))
+ (matches
+ (any
+ (lambda (rgx)
+ (let
+ ((matches
+ (filter
+ regexp-match?
+ (map
+ (lambda (line)
+ (regexp-exec rgx line))
+ lines))))
+ (if (null? matches)
+ #f
+ matches)))
+ (list
+ requirement-regex
+ import-error-regex-1
+ no-matching-distribution
+ no-module-named)))
+ (requirements
+ (if (eq? matches #f)
+ '()
+ (map
+ (lambda (m) (match:substring m 1))
+ matches))))
+ (if (null? requirements)
+ #f
+ (catch
+ #t
+ (lambda ()
+ (requirement-string->requirement (car requirements)))
+ (lambda args
+ (display "\n")
+ (display l)
+ (display "\n")
+ (log-msg 'ERROR args)
+ (log-msg 'ERROR "Error parsing requirement from build log"))))))
+
+(define (build-and-return-log-on-failure pkg)
+ (let*
+ ((derivation
+ (with-store store
+ (package-derivation store pkg #:graft? #f)))
+ (built-already
+ (with-store store
+ (valid-path?
+ store (derivation->output-path derivation)))))
+ (if built-already
+ #t
+ (begin
+ (log-msg 'DEBUG derivation)
+ (catch
+ #t
+ (lambda ()
+ (parameterize ((current-build-output-port (if #f
+ (%make-void-port "w")
+ (current-error-port))))
+ (with-store store
+ (run-with-store store
+ (mbegin %store-monad
+ (built-derivations (list derivation))))))
+ #t)
+ (lambda args
+ (log-msg 'DEBUG args)
+ (log-msg 'DEBUG (derivation-file-name derivation))
+ (let* ((logf
+ (with-store store
+ (log-file store (derivation-file-name derivation))))
+ (contents
+ (begin
+ (log-msg 'DEBUG "logf " logf)
+ (call-with-input-file logf
+ (lambda (port)
+ (call-with-decompressed-port 'bzip2 port
+ (lambda (port)
+ (get-string-all port))))))))
+ (cons pkg contents))))))))
diff --git a/pypi/sdist-store/utils.scm b/pypi/sdist-store/utils.scm
new file mode 100644
index 0000000..483e730
--- /dev/null
+++ b/pypi/sdist-store/utils.scm
@@ -0,0 +1,233 @@
+(define-module (pypi sdist-store utils)
+ #:use-module (pyguile)
+ #:use-module (logging logger)
+ #:use-module (ice-9 binary-ports)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 pretty-print)
+ #:use-module (ice-9 ftw)
+ #:use-module (ice-9 regex)
+ #:use-module ((ice-9 rdelim) #:select (read-line))
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:use-module (rnrs bytevectors)
+ #:use-module (json)
+ #:use-module (web uri)
+ #:use-module (guix ui)
+ #:use-module (guix utils)
+ #:use-module (guix import utils)
+ #:use-module ((guix download) #:prefix download:)
+ #:use-module (guix import json)
+ #:use-module (guix packages)
+ #:use-module (guix upstream)
+ #:use-module (guix licenses)
+ #:use-module (guix build-system python)
+ #:use-module (pypi api)
+ #:use-module (pypi sdist)
+ #:use-module (pypi sdist-store)
+ #:use-module (pypi requirement)
+ #:use-module (gnu packages python)
+ #:export (ensure-unpacked-sdist-exists
+ search-for-egg-info
+ find-cycle-in-graph
+ get-sdist-directory
+ read-rfc822
+ get-tmpdir))
+
+(define (get-tmpdir)
+ "/tmp/guix-pypi")
+
+(define (ensure-unpacked-sdist-exists name version api-root)
+ (let ((tmpdir (get-tmpdir))
+ (sdist-directory (get-sdist-directory name version)))
+ (begin
+ (unless (file-exists? tmpdir)
+ (mkdir tmpdir))
+ (unless (file-exists? sdist-directory)
+ (let* ((data (source-release (pypi-fetch name api-root) version))
+ (filename (assoc-ref* data "filename"))
+ (full-path (string-append tmpdir "/" filename))
+ (source-url (assoc-ref* data "url")))
+ (begin
+ (if (not (file-exists? full-path))
+ (url-fetch source-url full-path))
+ (if
+ (string-contains filename ".zip")
+ (let
+ ((exit-code
+ (system* "unzip" "-qq" full-path "-d" tmpdir)))
+ (if (not (zero? exit-code))
+ (begin
+ (log-msg 'ERROR "Attempted to unzip " full-path)
+ (error (_ "'unzip' failed with exit code ~a\n")
+ exit-code))
+ #f))
+ (let* ((compression-type
+ (cond
+ ((string-contains filename "gz") "z")
+ ((string-contains filename "bz2") "j")
+ ((begin
+ (error "unknown compression type")
+ #f))))
+ (exit-code
+ (system* "tar" (string-append compression-type "xf") full-path "--directory" tmpdir "--no-same-owner")))
+ (if (not (zero? exit-code))
+ (begin
+ (error (_ "'tar' failed with exit code ~a\n")
+ exit-code)
+ #f))))
+ (rename-file
+ (string-append tmpdir "/" (tarball-directory source-url))
+ sdist-directory)))))))
+
+(define (get-expected-sdist-name name version)
+ (string-append (string-downcase name) "-" version))
+
+(define (get-sdist-directory name version)
+ (string-append (get-tmpdir) "/" (get-expected-sdist-name name version)))
+
+(define (tarball-directory url)
+ ;; Given the URL of the package's tarball, return the name of the directory
+ ;; that will be created upon decompressing it. If the filetype is not
+ ;; supported, return #f.
+ ;; TODO: Support more archive formats.
+ (let ((basename (substring url (+ 1 (string-rindex url #\/)))))
+ (cond
+ ((string-suffix? ".tar.gz" basename)
+ (string-drop-right basename 7))
+ ((string-suffix? ".tar.bz2" basename)
+ (string-drop-right basename 8))
+ ((string-suffix? ".zip" basename)
+ (string-drop-right basename 4))
+ (else
+ (begin
+ (warning (_ "Unsupported archive format: \
+nnot determine package dependencies"))
+ #f)))))
+
+(define (search-for-egg-info startname depth)
+ (if (= depth 0)
+ '()
+ (let ((possibles (scandir
+ startname
+ (lambda (name) (string-contains name ".egg-info")))))
+ (if (> (length possibles) 0)
+ (map
+ (lambda (p) (string-append startname "/" p))
+ possibles)
+ (apply
+ append
+ (map
+ (lambda (sn) (search-for-egg-info
+ (string-append startname "/" sn) (- depth 1)))
+ (scandir
+ startname
+ (lambda (d) (eq?
+ 'directory
+ (stat:type
+ (stat (string-append startname "/" d))))))))))))
+
+(define-condition-type &missing-source-error &error
+ missing-source-error?
+ (package missing-source-error-package))
+
+(define (get-archive-suffix name)
+ (find
+ (lambda (suffix)
+ (string-suffix? suffix name))
+ archive-preference))
+
+(define archive-preference '(".tar.gz" ".tar.bz2" ".zip"))
+
+(define (source-release pypi-package version)
+ (let ((releases (assoc-ref* pypi-package "releases" version)))
+ (or (and
+ releases
+ (find (lambda (release)
+ (string=? "sdist" (assoc-ref release "packagetype")))
+ releases))
+ (raise (condition (&missing-source-error
+ (package pypi-package)))))))
+
+;;; RFC822 Parsing
+
+(define header-name-rx (make-regexp "^([^:]+):[ \t]*"))
+(define header-cont-rx (make-regexp "^[ \t]+"))
+
+(define (drain-message port)
+ (let loop ((line (read-line port)) (acc '()))
+ (cond ((eof-object? line)
+ (reverse acc))
+ (else
+ (loop (read-line port) (cons line acc))))))
+
+(define (parse-message port)
+ (let* ((body-lines #f)
+ (body #f)
+ (headers '())
+ (add-header! (lambda (reversed-hlines)
+ (let* ((hlines (reverse reversed-hlines))
+ (first (car hlines)))
+ (if (not (= (string-length first) 0))
+ (let* ((m (regexp-exec header-name-rx first))
+ (name (string->symbol (match:substring m 1)))
+ (data (string-join
+ (cons (substring first (match:end m))
+ (cdr hlines))
+ " ")))
+ (set! headers (acons name data headers))))))))
+ ;; "From " is only one line
+ (let loop ((line (read-line port)) (current-header #f))
+ (cond ((eof-object? line)
+ (and current-header (add-header! current-header))
+ (set! body-lines (drain-message port)))
+ ((regexp-exec header-cont-rx line)
+ => (lambda (m)
+ (loop (read-line port)
+ (cons (match:suffix m) current-header))))
+ (else
+ (and current-header (add-header! current-header))
+ (loop (read-line port) (list line)))))
+ (set! headers (reverse headers))
+ (lambda (component)
+ (case component
+ ((body-lines) body-lines)
+ ((headers) headers)
+ ((body) (or body
+ (begin (set! body (string-join body-lines "\n" 'suffix))
+ body)))
+ (else (error "bad component:" component))))))
+
+(define (read-rfc822 port)
+ (parse-message port))
+
+(define (display-rfc822 parse)
+ (cond ((parse 'from) => (lambda (from) (format #t "From ~A\n" from))))
+ (for-each (lambda (header)
+ (format #t "~A: ~A\n" (car header) (cdr header)))
+ (parse 'headers))
+ (format #t "\n~A" (parse 'body)))
+
+;; Graph utils
+
+(define (find-cycle-in-graph graph)
+ (recurse-and-return-cycle-if-found
+ graph
+ (car (hash-map->list
+ (lambda (k v) k)
+ graph))
+ '()))
+
+(define (recurse-and-return-cycle-if-found graph node visited-nodes)
+ (if (member node visited-nodes)
+ (memq node (reverse visited-nodes))
+ (let
+ ((links (hash-ref graph node)))
+ (if links
+ (any
+ (lambda (next-node)
+ (recurse-and-return-cycle-if-found
+ graph next-node (cons node visited-nodes)))
+ links)
+ #f))))
diff --git a/pypi/sdist.scm b/pypi/sdist.scm
new file mode 100644
index 0000000..e0e5233
--- /dev/null
+++ b/pypi/sdist.scm
@@ -0,0 +1,192 @@
+(define-module (pypi sdist)
+ #:use-module (logging logger)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
+ #:use-module (srfi srfi-13)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 pretty-print)
+ #:use-module (guix ui)
+ #:use-module (guix base32)
+ #:use-module (guix records)
+ #:use-module (guix download)
+ #:use-module (guix packages)
+ #:use-module (pypi requirement)
+ #:use-module (pypi utils)
+ #:export (sdist
+ sdist?
+ sdist-info
+ sdist-build-requires
+ sdist-tests-require
+ sdist-install-requires
+ sdist-extras-require
+ sdist-source
+
+ sdist-short-description
+
+ get-quoted-sdist
+ sdist-meets-requirement
+ add-build-requirements-to-sdist
+ add-test-requirements-to-sdist
+
+ pkg-info
+ pkg-info?
+ pkg-info-name
+ pkg-info-version
+ pkg-info-home-page
+ pkg-info-synopsis
+ pkg-info-description
+ pkg-info-license
+
+ get-quoted-pkg-info
+
+ get-extra-combinations
+ get-requirements-for-extras
+
+ extra
+ extra?
+ extra-name
+ extra-requires))
+
+(define-record-type* <sdist>
+ sdist make-sdist
+ sdist?
+ (info sdist-info)
+ (build-requires sdist-build-requires
+ (default '()))
+ (tests-require sdist-tests-require
+ (default '()))
+ (install-requires sdist-install-requires
+ (default '()))
+ (extras-require sdist-extras-require
+ (default '()))
+ (source sdist-source))
+
+(define (get-quoted-sdist sdist)
+ `(sdist
+ (info ,(get-quoted-pkg-info (sdist-info sdist)))
+ (build-requires ,(append '(list)
+ (map get-quoted-requirement
+ (sdist-build-requires sdist))))
+ (tests-require ,(append '(list)
+ (map get-quoted-requirement
+ (sdist-tests-require sdist))))
+ (install-requires ,(append '(list)
+ (map get-quoted-requirement
+ (sdist-install-requires sdist))))
+ (extras-require ,(append '(list)
+ (map
+ get-quoted-extra
+ (sdist-extras-require sdist))))
+ (source ,(get-quoted-origin (sdist-source sdist)))))
+
+(define (add-build-requirements-to-sdist sd reqs)
+ (let
+ ((duplicate
+ (any
+ (lambda (r)
+ (member r (sdist-build-requires sd)))
+ reqs)))
+ (if duplicate
+ (error "Cannot add duplicate build requirement " duplicate)))
+ (log-msg 'INFO
+ "Adding build requirements to "
+ (sdist-short-description sd)
+ " " reqs)
+ (sdist
+ (inherit sd)
+ (build-requires
+ (append
+ (sdist-build-requires sd)
+ reqs))))
+
+(define (add-test-requirements-to-sdist sd reqs)
+ (log-msg 'INFO
+ "Adding test requirements to "
+ (sdist-short-description sd)
+ " " reqs)
+ (let
+ ((duplicate
+ (any
+ (lambda (r)
+ (member r (sdist-tests-require sd)))
+ reqs)))
+ (if duplicate
+ (error "Cannot add duplicate test requirement " duplicate)))
+ (sdist
+ (inherit sd)
+ (tests-require
+ (append
+ (sdist-tests-require sd)
+ reqs))))
+
+(define (get-quoted-origin o)
+ `(origin
+ (method ,(let
+ ((m (origin-method o)))
+ (cond
+ ((eqv? url-fetch m)
+ 'url-fetch)
+ (else
+ (report-error (_ "unknown method ") m "\n")))))
+ (uri ,(origin-uri o))
+ (sha256
+ (base32
+ ,(bytevector->nix-base32-string (origin-sha256 o))))))
+
+(define-record-type* <pkg-info>
+ pkg-info make-pkg-info
+ pkg-info?
+ (name pkg-info-name)
+ (version pkg-info-version)
+ (home-page pkg-info-home-page)
+ (synopsis pkg-info-synopsis)
+ (description pkg-info-description)
+ (license pkg-info-license))
+
+(define (get-quoted-pkg-info pi)
+ `(pkg-info
+ (name ,(pkg-info-name pi))
+ (version ,(pkg-info-version pi))
+ (home-page ,(pkg-info-home-page pi))
+ (synopsis ,(pkg-info-synopsis pi))
+ (description ,(pkg-info-description pi))
+ (license ,(pkg-info-license pi))))
+
+(define (get-extra-combinations sdist)
+ (all-combinations
+ (sdist-extras-require sdist)))
+
+(define (get-requirements-for-extras sd extras)
+ (apply
+ append
+ (map
+ (lambda (extra)
+ (assoc-ref extra (sdist-extras-require sd)))
+ extras)))
+
+
+(define (sdist-meets-requirement sd r)
+ (version-meets-requirement r
+ (pkg-info-version (sdist-info sd))))
+
+(define-record-type <extra>
+ (extra name requirements)
+ extra?
+ (name extra-name)
+ (requirements extra-requires))
+
+(define (get-quoted-extra e)
+ `(extra
+ ,(extra-name e)
+ ,(append '(list)
+ (map get-quoted-requirement
+ (extra-requires e)))))
+
+(define (sdist-short-description sd)
+ (let
+ ((info (sdist-info sd)))
+ (string-append
+ (pkg-info-name info)
+ "@"
+ (pkg-info-version info))))
diff --git a/pypi/utils.scm b/pypi/utils.scm
new file mode 100644
index 0000000..88ec879
--- /dev/null
+++ b/pypi/utils.scm
@@ -0,0 +1,24 @@
+(define-module (pypi utils)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-69)
+ #:use-module (guix packages)
+ #:export (all-combinations))
+
+; Combinatorics
+
+(define (combinations lst len)
+ (cond ((= len 0)
+ '(()))
+ ((null? lst)
+ '())
+ (else (append (map (lambda (rest) (cons (car lst) rest))
+ (combinations (cdr lst) (- len 1)))
+ (combinations (cdr lst) len)))))
+
+(define (all-combinations lst)
+ (apply
+ append
+ (map
+ (lambda (len)
+ (combinations lst len))
+ (cdr (iota (+ 1 (length lst)))))))
diff --git a/pypi/version.scm b/pypi/version.scm
new file mode 100644
index 0000000..e4d0b35
--- /dev/null
+++ b/pypi/version.scm
@@ -0,0 +1,18 @@
+(define-module (pypi version)
+ #:use-module (pyguile)
+ #:export (sort-versions))
+
+(define (sort-versions versions)
+ (if (null? versions)
+ versions
+ (begin
+ (python-eval "from packaging.version import parse")
+ (let
+ ((sort
+ (python-eval
+ "lambda vs: [s for s, v in sorted([(s, parse(s)) for s in vs], key=lambda x: x[1], reverse=True)]"
+ #t)))
+ (python-apply
+ sort
+ (list versions)
+ '())))))
diff --git a/solver/__init__.py b/solver/__init__.py
new file mode 100644
index 0000000..0b8160a
--- /dev/null
+++ b/solver/__init__.py
@@ -0,0 +1,184 @@
+import solv
+
+OPERATOR_TO_FLAGS = {
+ "=": solv.REL_EQ,
+ "<": solv.REL_LT,
+ ">": solv.REL_GT,
+ "<=": solv.REL_EQ | solv.REL_LT,
+ ">=": solv.REL_EQ | solv.REL_GT,
+}
+
+def get_operator_and_version(spec):
+ spec.strip()
+ for operator in OPERATOR_TO_FLAGS.keys():
+ if spec.startswith(operator):
+ version = spec[len(operator):].strip()
+
+ return operator, version
+
+ raise Exception("Could not parse %s" % spec)
+
+def get_versions_or_error(sdists, overall_requirements, debug=False):
+ def log(*args):
+ if debug:
+ print(args)
+
+ if sdists is None or (len(sdists) == 1 and sdists[0] is None):
+ sdists = []
+
+ if overall_requirements is None or (
+ len(overall_requirements) == 1 and overall_requirements[0] is None
+ ):
+ overall_requirements = []
+
+ if len(overall_requirements) == 0:
+ log("overall_requirements", overall_requirements)
+ return []
+
+ log(sdists)
+ log(overall_requirements)
+
+ pool = solv.Pool()
+ pool.setarch()
+
+ sysrepo = pool.add_repo("@System")
+
+ repo = pool.add_repo("test")
+ repo.create_stubs()
+
+ solvables = {}
+
+ log("Creating solvables")
+ for name, version, requirements in sdists:
+ solvable = repo.add_solvable()
+
+ solvable.name = name
+ solvable.evr = version
+ solvable.arch = "noarch"
+
+ log(solvable.name, solvable.id)
+
+ solvables[(name, version)] = solvable
+
+ rel_id = pool.rel2id(
+ solvable.nameid,
+ solvable.evrid,
+ OPERATOR_TO_FLAGS["="],
+ True,
+ )
+
+ solvable.add_deparray(solv.SOLVABLE_PROVIDES, rel_id)
+
+ log("Adding requirements")
+ for name, version, requirements in sdists:
+ if requirements is None:
+ requirements = []
+
+ solvable = solvables[(name, version)]
+
+ log("requirements for", name, version)
+
+ for requirement_name, requirement_specifiers in requirements:
+ log("requirement name ", requirement_name)
+ requirement_name_id = pool.str2id(requirement_name, False)
+
+ if requirement_name_id == 0:
+ return "Could not find package for requirement %s" % requirement_name
+
+ if requirement_specifiers is None:
+ requirement_specifiers = []
+
+ log("specifiers ", requirement_specifiers)
+ if len(requirement_specifiers) == 0:
+ solvable.add_deparray(solv.SOLVABLE_REQUIRES, requirement_name_id)
+ else:
+ for spec in requirement_specifiers:
+ if "!=" in spec:
+ # TODO: Support this
+ continue
+
+ try:
+ spec_operator, spec_version = get_operator_and_version(spec)
+ except Exception as e:
+ return str(e)
+
+ requirement_evr_id = pool.str2id(spec_version, True)
+
+ log(requirement_name_id, requirement_evr_id)
+ rel_id = pool.rel2id(
+ requirement_name_id,
+ requirement_evr_id,
+ OPERATOR_TO_FLAGS[spec_operator],
+ True,
+ )
+
+ log("rel_id", rel_id, requirement_name, spec_operator, spec_version)
+
+ solvable.add_deparray(solv.SOLVABLE_REQUIRES, rel_id)
+
+ addedprovides = pool.addfileprovides_queue()
+ if addedprovides:
+ sysrepo.updateaddedprovides(addedprovides)
+ repo.updateaddedprovides(addedprovides)
+
+ pool.createwhatprovides()
+
+ jobs = []
+
+ for arg in overall_requirements:
+ flags = (
+ solv.Selection.SELECTION_REL |
+ solv.Selection.SELECTION_NAME |
+ solv.Selection.SELECTION_WITH_SOURCE
+ )
+
+ sel = pool.select(arg, flags)
+
+ if sel.isempty():
+ error = "nothing matches '%s'" % arg
+ log(error)
+ return error
+
+ if sel.flags() & solv.Selection.SELECTION_FILELIST:
+ log("[using file list match for '%s']" % arg)
+ if sel.flags() & solv.Selection.SELECTION_PROVIDES:
+ log("[using capability match for '%s']" % arg)
+
+ jobs += sel.jobs(solv.Job.SOLVER_INSTALL)
+
+ for job in jobs:
+ for solvable in job.solvables():
+ solvable_url = solvable.lookup_str(solv.SOLVABLE_URL)
+ if solvable_url:
+ log("Url: %s" % solvable_url)
+ solvable_license = solvable.lookup_str(solv.SOLVABLE_LICENSE)
+ if solvable_license:
+ log("License: %s" % solvable_license)
+
+ pool.set_debuglevel(0)
+ solver = pool.Solver()
+
+ while True:
+ problems = solver.solve(jobs)
+ if not problems:
+ break
+
+ return str([str(p) for p in problems])
+
+ # no problems, show transaction
+ trans = solver.transaction()
+ del solver
+ if trans.isempty():
+ return "transaction is empty"
+
+ for cl in trans.classify(
+ solv.Transaction.SOLVER_TRANSACTION_SHOW_OBSOLETES |
+ solv.Transaction.SOLVER_TRANSACTION_OBSOLETE_IS_UPGRADE,
+ ):
+ if cl.type == solv.Transaction.SOLVER_TRANSACTION_INSTALL:
+ versions = []
+ for p in cl.solvables():
+ log(" - %s" % p)
+ versions.append((p.name, p.evr))
+ return versions
+ return "unknown error"