(define-module (gpip package-fixes)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (guix utils)
  #:use-module (guix packages)
  #:use-module (guix build utils)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages xml)
  #:use-module (gnu packages image)
  #:use-module (gnu packages libffi)
  #:use-module (gnu packages databases)
  #:use-module (gnu packages fontutils)
  #:use-module (gnu packages ghostscript)
  #:use-module (gnu packages compression)
  #:use-module (pypi sdist)
  #:use-module (pypi package)
  #:use-module (pypi requirement)
  #:export (get-fixed-package))

(define-record-type <fix>
  (fix requirement operation)
  fix?
  (requirement    fix-requirement)
  (operation     fix-operation))

(define disable-tests
  (lambda (pkg)
      (package
        (inherit pkg)
        (arguments
          (ensure-keyword-arguments
            (package-arguments pkg)
            '(#:tests? #f))))))

(define (add-inputs inputs)
  (lambda (pkg)
    (package
      (inherit pkg)
      (inputs
        (append
          (package-inputs pkg)
          inputs)))))

(define pbr-snippet
  '(replace
     'install
     (lambda* (#:key outputs #:allow-other-keys)
       (let* ((out (assoc-ref outputs "out"))
              (command "install")
              (params `("--root" "/" "--prefix" ,out
                "--single-version-externally-managed")))
             (simple-format #t "running \"python setup.py\" with command ~s and parameters ~s~%"
                     command params)
             (apply system* "python" "setup.py" command params)))))

(define fixes (list
  (fix
    (requirement
      (name "pbr"))
    disable-tests) ; Tests try to use virtualenv

  (fix
    (requirement
      (name "cssutils"))
    disable-tests) ; The tests try to download from the network

  (fix
    (requirement
      (name "nose"))
    disable-tests)

  (fix
    (requirement
      (name "testscenarios"))
    disable-tests)

  (fix
    (requirement
      (name "py"))
    disable-tests)

  (fix
    (requirement
      (name "scripttest"))
    disable-tests)

  (fix
    (requirement
      (name "fixtures")
      (specifiers ">=3.0.0"))
    (lambda (pkg)
      (package
        (inherit pkg)
        (arguments
          (ensure-keyword-arguments
            (package-arguments pkg)
            `(#:phases
               (modify-phases %standard-phases
                 ,pbr-snippet)))))))

  (fix
    (requirement
      (name "testtools")
      (specifiers ">=2.2.0"))
    (lambda (pkg)
      (package
        (inherit pkg)
        (arguments
          (ensure-keyword-arguments
            (package-arguments pkg)
            `(#:tests? #f
              #:phases
               (modify-phases %standard-phases
                 ,pbr-snippet)))))))

  (fix
    (requirement
      (name "linecache2")
      (specifiers ">=2.2.0"))
    (lambda (pkg)
      (package
        (inherit pkg)
        (arguments
          (ensure-keyword-arguments
            (package-arguments pkg)
            `(#:phases
               (modify-phases %standard-phases
                 ,pbr-snippet)))))))

  (fix
    (requirement
      (name "traceback2")
      (specifiers ">=2.2.0"))
    (lambda (pkg)
      (package
        (inherit pkg)
        (arguments
          (ensure-keyword-arguments
            (package-arguments pkg)
            `(#:phases
               (modify-phases %standard-phases
                 ,pbr-snippet)))))))

  (fix
    (requirement
      (name "pip"))
    disable-tests)

  (fix
    (requirement
      (name "virtualenv"))
    disable-tests)

  (fix
    (requirement
      (name "coverage"))
    disable-tests)

  (fix
    (requirement
      (name "cssselect"))
    disable-tests)

  (fix
    (requirement
      (name "six"))
    disable-tests)

  (fix
    (requirement
      (name "django-celery"))
    disable-tests)

  (fix
    (requirement
      (name "bottle"))
    disable-tests)

  (fix
    (requirement
      (name "raven"))
    disable-tests)

  (fix
    (requirement
      (name "urllib3"))
    disable-tests)

  (fix
    (requirement
      (name "web.py"))
    disable-tests)

  (fix
    (requirement
      (name "backports.ssl_match_hostname"))
    disable-tests)

  (fix
    (requirement
      (name "tornado"))
    disable-tests)

  (fix
    (requirement
      (name "Flask-Login"))
    disable-tests)

  (fix
    (requirement
      (name "requests"))
    disable-tests)

  (fix
    (requirement
      (name "Paste"))
    disable-tests)

  (fix
    (requirement
      (name "python-u2flib-server"))
    disable-tests)

  (fix
    (requirement
      (name "django-sudo"))
    disable-tests)

  (fix
    (requirement
      (name "celery"))
    disable-tests)

  (fix
    (requirement
      (name "oauth2"))
    disable-tests) ; The tests try to download from the network

  (fix
    (requirement
      (name "django-paging"))
    disable-tests) ; The tests fail for an unknown reason

  (fix
    (requirement
      (name "django-nose"))
    disable-tests) ; The tests fail for an unknown reason

  (fix
    (requirement
      (name "django-recaptcha"))
    disable-tests) ; The tests fail for an unknown reason

  (fix
    (requirement
      (name "django-bitfield"))
    disable-tests) ; The tests fail for an unknown reason

  (fix
    (requirement
      (name "djangorestframework"))
    disable-tests) ; The tests fail for an unknown reason

  (fix
    (requirement
      (name "paste"))
    disable-tests)

  (fix
    (requirement
      (name "redis"))
    disable-tests)

  (fix
    (requirement
      (name "hiredis"))
    disable-tests) ; Missing tests

  (fix
    (requirement
      (name "python-openid"))
    disable-tests) ; Missing tests

  (fix
    (requirement
      (name "hashlib"))
    disable-tests) ; Missing tests

  (fix
    (requirement
      (name "hashlib"))
    (add-inputs
      `(("openssl" ,openssl))))

  (fix
    (requirement
      (name "ipaddr"))
    disable-tests) ; Missing tests

  (fix
    (requirement
      (name "statsd"))
    disable-tests)

  (fix
    (requirement
      (name "psycopg2"))
    disable-tests) ; Needs running postgres

  (fix
    (requirement
      (name "cryptography"))
    (add-inputs
      `(("openssl" ,openssl))))

  (fix
    (requirement
      (name "psycopg2"))
    (add-inputs
      `(("postgresql" ,postgresql))))

  (fix
    (requirement
      (name "cffi"))
    (add-inputs
      `(("libffi" ,libffi))))

  (fix
    (requirement
      (name "email-reply-parser"))
    disable-tests) ; The tests hang for an unknown reason

  (fix
    (requirement
      (name "BeautifulSoup"))
    (lambda (pkg)
      (package
        (inherit pkg)
        (arguments
          (ensure-keyword-arguments
            (package-arguments pkg)
            '(#:tests? #f))))))

  (fix
    (requirement
      (name "lxml"))
    (add-inputs
      `(("libxml2" ,libxml2)
        ("libxslt" ,libxslt))))
  (fix
    (requirement
      (name "Pillow"))
    (add-inputs
      `(("freetype" ,freetype)
        ("lcms"     ,lcms)
        ("zlib"     ,zlib)
        ("libjpeg"  ,libjpeg)
        ("openjpeg" ,openjpeg)
        ("libtiff"  ,libtiff)
        ("libwebp"  ,libwebp))))

  (fix
    (requirement
      (name "Django"))
    (lambda (pkg)
      (package
        (inherit pkg)
        (arguments
          (ensure-keyword-arguments
            (package-arguments pkg)
           '(#:phases
             (modify-phases %standard-phases
               (replace 'check
                 (lambda _
                   (with-directory-excursion "tests"
                     (system* "python" "./runtests.py" "--settings=test_sqlite")))))))))))

  (fix
    (requirement
      (name "uwsgi"))
    (lambda (pkg)
      (package
        (inherit pkg)
        (arguments
          (ensure-keyword-arguments
            (package-arguments pkg)
            '(#:phases
              (modify-phases %standard-phases
                (add-before 'check 'set-path-for-check
                 (lambda* (#:key outputs #:allow-other-keys)
                  (let ((out (assoc-ref outputs "out")))
                   (mkdir-p (string-append out "/bin"))
                   (setenv "UWSGI_BIN_NAME" (string-append out "/bin/uwsgi"))))))))))))

  (fix
    (requirement
      (name "unittest2"))
    (lambda (pkg)
      (package
        (inherit pkg)
        (arguments
          (ensure-keyword-arguments
            (package-arguments pkg)
           '(#:phases
             (modify-phases %standard-phases
               (replace 'check
                 (lambda _ (system* "python" "-m" "unittest2"))))))))))

  (fix
    (requirement
      (name "setuptools"))
    (lambda (pkg)
      (package
        (inherit pkg)
        (arguments
          (ensure-keyword-arguments
            (package-arguments pkg)
            `(#:phases
              (alist-cons-before
               'check 'set-PYTHON_EGG_CACHE
               (lambda* _ (setenv "PYTHON_EGG_CACHE" "/tmp"))
                %standard-phases)))))))

  (fix
    (requirement
      (name "extras"))
    (lambda (pkg)
      (package
        (inherit pkg)
        (arguments
          (ensure-keyword-arguments
            (package-arguments pkg)
            '(#:phases
              (modify-phases %standard-phases
                (replace 'check
                  (lambda _ (system* "make" "test"))))))))))

  (fix
    (requirement
      (name "hmac"))
    (lambda (pkg)
      (package
        (inherit pkg)
        (source
          (origin
            (inherit (package-source pkg))
            (modules '((guix build utils)))
            (snippet
             '(substitute* "setup.py"
                (("'hashlib',") ""))))))))

  (fix
    (requirement
      (name "pytest"))
    (lambda (pkg)
      (package
        (inherit pkg)
        (source
          (origin
            (inherit (package-source pkg))
            (modules '((guix build utils)))
            (snippet
             ;; One of the tests involves the /usr directory, so it fails.
             '(substitute* "testing/test_argcomplete.py"
                (("def test_remove_dir_prefix\\(self\\):")
                 "@pytest.mark.xfail\n    def test_remove_dir_prefix(self):"))))))))))

(define indexed-fixes
  (let ((ht (make-hash-table)))
    (for-each
      (lambda (fx)
        (let* ((key (requirement-name (fix-requirement fx)))
               (fixes (hash-ref ht key)))
          (hash-set!
            ht
            key
            (if fixes
              (cons fx fixes)
              (list fx)))))
      fixes)
      ht))

(define (get-fixed-package sd pkg)
  (let* ((key (pkg-info-name (sdist-info sd)))
         (fixes
           (filter
             (lambda (fix)
               (version-meets-requirement
                 (fix-requirement fix)
                 (pkg-info-version (sdist-info sd))))
             (or
               (hash-ref indexed-fixes key)
               '()))))
    (fold
      (lambda (f pkg)
        (f pkg))
      pkg
      (map
        fix-operation
        fixes))))