diff options
Diffstat (limited to 'pypi/requirement.scm')
| -rw-r--r-- | pypi/requirement.scm | 210 |
1 files changed, 210 insertions, 0 deletions
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) '())))))) |