From 86de22b526313a68e5c8bb8a361d5904c30d8b51 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 16 May 2016 22:20:12 +0100
Subject: Initial commit

---
 pypi/api.scm | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)
 create mode 100644 pypi/api.scm

(limited to 'pypi/api.scm')

diff --git a/pypi/api.scm b/pypi/api.scm
new file mode 100644
index 0000000..9d884fb
--- /dev/null
+++ b/pypi/api.scm
@@ -0,0 +1,62 @@
+(define-module (pypi api)
+  #:use-module (json)
+  #:use-module (logging logger)
+  #:use-module (web uri)
+  #:use-module (guix ui)
+  #:use-module (guix utils)
+  #:use-module (guix import utils)
+  #:use-module ((guix download) #:prefix download:)
+  #:use-module (guix import json)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix licenses)
+  #:use-module (guix build-system python)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (gnu packages python)
+  #:use-module (pypi version)
+  #:export (pypi-fetch
+            get-sdist-releases
+            available-versions))
+
+(define pypi-fetch
+  (memoize
+    (lambda (name api-root)
+      (begin
+        (log-msg 'INFO (string-append "Fetching... " name))
+        (let
+          ((data
+            (call-with-output-file "/dev/null"
+              (lambda (null)
+                (with-error-to-port (current-error-port)
+                  (lambda ()
+                    (json-fetch (string-append api-root name "/json"))))))))
+          (if (eq? data #f)
+            (begin
+              (error (string-append "data from " api-root " is false"))
+              (sleep 2)
+              (pypi-fetch name api-root))
+            data))))))
+
+(define (available-versions name api-root)
+  (sort-versions
+    (map
+      car
+      (get-sdist-releases (pypi-fetch name api-root)))))
+
+(define (get-sdist-releases data)
+  (filter
+    (match-lambda
+      ((version . releases)
+        (> (length (car releases)) 0)))
+    (map
+      (match-lambda
+        ((version . releases)
+          (list
+            version
+            (filter
+              (lambda (r) (string=? "sdist" (assoc-ref r "packagetype")))
+              releases))))
+      (filter
+        (lambda (r) (> (length r) 1))
+        (assoc-ref* data "releases")))))
-- 
cgit v1.2.3