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