#!/usr/bin/guile
-*- scheme -*-
!#

(define-module (pypi2guix)
  #:use-module (ice-9 binary-ports)
  #:use-module (ice-9 match)
  #:use-module (ice-9 pretty-print)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-1)
  #:use-module (rnrs bytevectors)
  #:use-module (curl)
  #:use-module (json)
  #:use-module (web uri)
  #:use-module (guix base32)
  #:use-module (guix hash))

(define (hash-table->alist table)
  (map (lambda (pair)
         (match pair
           ((key . (? list? lst))
            (cons key
                  (map (lambda (x)
                         (if (hash-table? x)
                             (hash-table->alist x)
                             x))
                       lst)))
           ((key . (? hash-table? table))
            (cons key (hash-table->alist table)))
           (pair pair)))
       (hash-map->list cons table)))

(define (flatten lst)
  (fold-right
   (lambda (elem memo)
     (if (list? elem)
         (append (flatten elem) memo)
         (cons elem memo)))
   '() lst))

(define (join lst delimiter)
  (match lst
    (() '())
    ((elem)
     (list elem))
    ((elem . rest)
     (cons* elem delimiter (join rest delimiter)))))

(define (assoc-ref* alist key . rest)
  (if (null? rest)
      (assoc-ref alist key)
      (apply assoc-ref* (assoc-ref alist key) rest)))

(define (string->license license)
  (match license
    ("GNU LGPL" 'lgpl2.0)
    ("GPL" 'gpl3)
    ("BSD" 'bsd-3)
    ("MIT" 'expat)
    ("Public domain" 'public-domain)
    ("UNKNOWN" 'unknown)))

(define* (curl-fetch url #:optional (bytevector? #f))
  (let ((curl-handle (curl-easy-init)))
    (curl-easy-setopt curl-handle 'url url)
    (curl-easy-perform curl-handle bytevector?)))

(define (json-fetch url)
  (hash-table->alist
   (json-string->scm (curl-fetch url))))

(define (pypi-fetch name)
  (json-fetch (string-append "https://pypi.python.org/pypi/" name "/json")))

(define (latest-source-release package)
  (find (lambda (release)
          (string=? "sdist" (assoc-ref release "packagetype")))
        (assoc-ref* package "releases" (assoc-ref* package "info" "version"))))

(define (snake-case str)
  (string-join (string-split (string-downcase str) #\_) "-"))

(define tar.gz-regex (make-regexp "\\.tar\\.gz$"))
(define tarball-regex (make-regexp ".*-(.*)\\.tar\\.gz"))

(define (tarball-url->string-append package url)
  (define (package-version? part)
    (string=? part (assoc-ref* package "info" "version")))

  (define (ends-in-tar.gz? part)
    (regexp-exec tar.gz-regex part))

  (define (fold-strings lst)
    (fold-right
     (lambda (elem memo)
       (cond
        ((null? memo)
         (list elem))
        ((and (string? elem) (string? (car memo)))
         (cons (string-append elem (car memo)) (cdr memo)))
        (else
         (cons elem memo))))
     '() lst))

  (let ((uri (string->uri url)))
    (fold-strings
     (cons* 'string-append
            (symbol->string (uri-scheme uri)) "://"
            (uri-host uri)
            (flatten
             (join
              (map (lambda (part)
                     (match part
                       ((? package-version? part)
                        'version)
                       ((? ends-in-tar.gz? part)
                        (let ((matches (regexp-exec tarball-regex part)))
                          `(,(assoc-ref* package "info" "name")
                            "-" version ".tar.gz")))
                       (_ part)))
                   (string-split (uri-path uri) #\/))
              "/"))))))

(define (guix-hash-url url)
  (let* ((port (open-bytevector-input-port (curl-fetch url #t)))
         (result (bytevector->nix-base32-string (port-sha256 port))))
    (close-port port)
    result))

(define (pypi->guix package)
  (let* ((base-name (snake-case (assoc-ref* package "info" "name")))
         (name (string-append "python-" base-name))
         (python2-name (string-append "python2-" base-name))
         (source (latest-source-release package)))
    `((define-public ,(string->symbol name)
        (package
          (name ,name)
          (version ,(assoc-ref* package "info" "version"))
          (source (origin
                    (method url-fetch)
                    (uri ,(tarball-url->string-append
                           package
                           (assoc-ref source "url")))
                    (sha256
                     (base32
                      ,(guix-hash-url (assoc-ref source "url"))))))
          (build-system python-build-system)
          (inputs
           `(("python-setuptools" ,python-setuptools)))
          (home-page ,(assoc-ref* package "info" "home_page"))
          (synopsis ,(assoc-ref* package "info" "summary"))
          (description ,(assoc-ref* package "info" "summary"))
          (license ,(string->license (assoc-ref* package "info" "license")))))
      (define-public ,(string->symbol python2-name)
        (package-with-python2 ,(string->symbol name))))))

(when (batch-mode?)
  (match (program-arguments)
    ((_ pypi-package)
     (for-each (lambda (sexp)
                 (pretty-print sexp)
                 (newline))
               (pypi->guix (pypi-fetch pypi-package))))))