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