Add gitlab upstream

Author: quicklisp

quicklisp-controller.asd

@@ -12,24 +12,24 @@
                #:drakma
                #:yason
                #:function-cache
-	       #:trivial-utf-8
+               #:trivial-utf-8
                #:ironclad
                #:lparallel
-	       #:cl-who
+               #:cl-who
                #:githappy
                #:project-info
-	       #:westbrook)
+               #:westbrook)
   :serial t
   :components ((:file "tarhash")
-	       (:file "github-issues")
+               (:file "github-issues")
                (:file "package")
                (:file "config")
                (:file "logical-host")
                (:file "commands")
                (:file "utils")
                (:file "setup")
                (:file "upstream")
-	       (:file "system-file-magic-cache")
+               (:file "system-file-magic-cache")
                (:file "dist-cache")
                (:file "upstream-vcs")
                (:file "upstream-http")
@@ -38,6 +38,7 @@
                (:file "upstream-darcs")
                (:file "upstream-git")
                (:file "upstream-github")
+               (:file "upstream-gitlab")
                (:file "upstream-mercurial")
                (:file "upstream-svn")
                (:file "upstream-bzr")
@@ -51,11 +52,12 @@
                (:file "update-client-version")
                (:file "descriptions")
                (:file "ng-indexes")
-	       (:file "git")
-	       (:file "html-failure-report")
-	       (:file "rss-failure-feeds")
+               (:file "git")
+               (:file "html-failure-report")
+               (:file "rss-failure-feeds")
                (:file "recrank")
-               (:file "irepl")))
+               (:file "irepl")
+               (:file "submit-bug-report")))
 
 (defpackage #:quicklisp-controller-config
   (:use)

upstream-gitlab.lisp

@@ -0,0 +1,38 @@
+;;;; upstream-gitlab.lisp
+;;;;
+;;;; Fetch some basic info about a source from gitlab
+;;;;
+
+(in-package #:quicklisp-controller)
+
+(defun gitlab-project-id (url)
+  (ppcre:register-groups-bind (user project)
+      ("gitlab.com/(.*?)/(.*?)(.git)?$" url)
+    (when user
+      (format nil "~A%2F~A" user project))))
+
+(defun gitlab-project-release-json (url)
+  (let* ((uri (format nil "https://gitlab.com/api/v4/projects/~A/releases"
+		      (gitlab-project-id url)))
+	 (request (make-instance 'githappy::request
+				 :uri uri))
+	 (response (githappy::submit request))
+	 (json (yason:parse (githappy::utf8-string (githappy::body response)))))
+    json))
+
+(defun gitlab-latest-tag-info (url)
+  (let ((json (gitlab-project-release-json url)))
+    (when json
+      (let ((tag-data (githappy:jref json '(0 "tag_name")))
+	    (sources (githappy:jref json '(0 "assets" "sources"))))
+	(dolist (source sources)
+	  (when (equal (githappy:jref source "format") "tar.gz")
+	    (return (list :tag tag-data
+			  :url (githappy:jref source "url")))))))))
+
+
+(defclass latest-gitlab-release-source (latest-github-release-source)
+  ())
+
+(defmethod github-info-plist ((source latest-gitlab-release-source))
+  (gitlab-latest-tag-info (location source)))