[PATCH 1/1] import: Add gopkg importer.

[Rouby Pierre-Antoine]

* guix/import/gopkg.scm: New file.
* guix/scripts/import/gopkg.scm: New file.
* guix/scripts/import.scm: Add 'gopkg'.
* Makefile.am: Add 'gopkg' importer in modules list.
---
 Makefile.am                   |   1 +
 guix/import/gopkg.scm         | 294 ++++++++++++++++++++++++++++++++++
 guix/scripts/import.scm       |   2 +-
 guix/scripts/import/gopkg.scm |  99 ++++++++++++
 4 files changed, 395 insertions(+), 1 deletion(-)
 create mode 100644 guix/import/gopkg.scm
 create mode 100644 guix/scripts/import/gopkg.scm

diff --git a/Makefile.am b/Makefile.am
index 9f134c970..e103517fc 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -183,6 +183,7 @@ MODULES =                                   \
   guix/import/hackage.scm                      \
   guix/import/elpa.scm                         \
   guix/import/texlive.scm                      \
+  guix/import/gopkg.scm                        \
   guix/scripts.scm                             \
   guix/scripts/download.scm                    \
   guix/scripts/perform-download.scm            \
diff --git a/guix/import/gopkg.scm b/guix/import/gopkg.scm
new file mode 100644
index 000000000..451e94a8e
--- /dev/null
+++ b/guix/import/gopkg.scm
@@ -0,0 +1,294 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Pierre-Antoine Rouby <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import gopkg)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module ((ice-9 rdelim) #:select (read-line))
+  #:use-module (git)
+  #:use-module (guix hash)
+  #:use-module (guix base32)
+  #:use-module (guix serialization)
+  #:use-module (guix utils)
+  #:use-module (guix build utils)
+  #:use-module (srfi srfi-11)
+  #:use-module ((guix licenses) #:prefix license:)
+  #:export (gopkg->guix-package))
+
+(define (vcs-file? file stat)
+  (case (stat:type stat)
+    ((directory)
+     (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
+    ((regular)
+     ;; Git sub-modules have a '.git' file that is a regular text file.
+     (string=? (basename file) ".git"))
+    (else
+     #f)))
+
+(define (file-hash->base32 file)
+  (let-values (((port get-hash) (open-sha256-port)))
+    (write-file file port #:select? (negate vcs-file?))
+    (force-output port)
+    (bytevector->nix-base32-string (get-hash))))
+
+(define (append-inputs inputs name)
+  (append inputs
+          (list
+           (list name
+                 (list 'unquote
+                       (string->symbol name))))))
+
+(define (package-name url)
+  (string-downcase
+   (string-append "go-"
+                  (string-replace-substring
+                   (string-replace-substring url
+                                             "/" "-")
+                   "." "-"))))
+
+(define (cut-url url)
+  (string-replace-substring
+   (cond
+    ((string-match "http://";  url)
+     (string-replace-substring url "http://"; ""))
+    ((string-match "https://"; url)
+     (string-replace-substring url "https://"; ""))
+    ((string-match "git://"   url)
+     (string-replace-substring url "git://" ""))
+    (else
+     (values url)))
+   ".git" ""))
+
+(define (url-to-path url)
+  (string-replace-substring
+   (string-append "/tmp/"
+                  (cut-url url))
+   "." "-"))
+
+;; HACK system exec
+(define (git-checkout directory commit)
+  (let ((command (string-append "cd " directory " &&"
+                                "git checkout " commit
+                                " > /dev/null 2> /dev/null"))) ; HACK no 
command output
+    (if (not (or (equal? commit "0")
+                 (equal? commit "XXX")
+                 (equal? commit "master")))
+        (system command))))
+
+(define (git-clone url commit)
+  (define (clone-in-dir url directory)
+    (mkdir-p directory)
+    (clone url directory (clone-init-options))
+    (git-checkout directory commit)
+    (values directory))
+
+  (let ((directory (url-to-path url)))
+    (if (not (file-exists? (string-append directory)))
+        (clone-in-dir url directory)
+        (values directory))))
+
+(define (comment? line)
+  (eq? (string-ref (string-trim line) 0) #\#))
+
+(define (attribute? line str)
+  (equal? (string-trim-right
+           (string-trim
+            (car (string-split line #\=)))) str))
+
+(define (attribute-by-name line name)
+  (string-trim
+   (string-replace-substring
+    (string-replace-substring
+     line (string-append name " = ")
+     "")
+    "\"" "")))
+
+(define (make-go-sexp->package packages dependencies
+                               name url version revision
+                               commit str-license home-page
+                               git-url is-dep hash)
+  (define (package-inputs)
+    (if (not is-dep)
+        (values dependencies)
+        '()))
+
+  (values
+   `(define-public ,(string->symbol name)
+      (let ((commit ,commit)
+            (revision ,revision))
+        (package
+          (name ,name)
+          (version (git-version ,version revision commit))
+          (source (origin
+                    (method git-fetch)
+                    (uri (git-reference
+                          (url ,git-url)
+                          (commit commit)))
+                    (file-name (git-file-name name version))
+                    (sha256
+                     (base32
+                      ,hash))))
+          (build-system go-build-system)
+          (arguments
+           '(#:import-path ,url))
+          (native-inputs ,(list 'quasiquote (package-inputs)))
+          (home-page ,home-page)
+          (synopsis "XXX")
+          (description "XXX")
+          (license #f))))))
+
+(define (create-package->packages+dependencies packages dependencies
+                                               url version
+                                               revision commit
+                                               containt is-dep)
+  (let ((synopsis "XXX")
+        (description "XXX")
+        (license "XXX")
+        (name (package-name url))
+        (home-page (string-append "https://"; url))
+        (git-url (string-append "https://"; url ".git"))
+        (hash (file-hash->base32
+               (git-clone (string-append "https://";
+                                         url ".git")
+                          commit))))
+    (values 
+     (append packages
+             (list (make-go-sexp->package packages dependencies
+                                          name url version
+                                          revision commit license
+                                          home-page git-url
+                                          is-dep hash)))
+     (if containt
+         (append-inputs dependencies name)
+         dependencies))))
+
+(define (website? url)
+  (car (string-split url #\/)))
+
+(define (parse-dependencies->packages+dependencies port constraint
+                                                   packages dependencies)
+  (let ((url "XXX")
+        (version "0.0.0")
+        (revision "0")
+        (commit "XXX"))
+    (define (loop port url commit packages dependencies)
+      (let ((line (read-line port)))
+        (cond
+         ((eof-object? line)                       ; EOF
+          (values packages dependencies))
+         ((string-null? (string-trim line))        ; Empty line
+          (if (not (or (equal? "k8s.io" (website? url))             ; HACK 
bypass k8s
+                       (equal? "golang.org" (website? url))         ; HACK 
bypass golang
+                       (equal? "cloud.google.com" (website? url)))) ; HACK 
bypass cloud.google
+              (create-package->packages+dependencies packages dependencies
+                                                     url version revision
+                                                     commit
+                                                     constraint #t)
+              (values packages dependencies)))
+         ((comment? line)                          ; Comment
+          (loop port url commit
+                packages dependencies))
+         ((attribute? line "name")                 ; Name
+          (loop port
+                (attribute-by-name line "name")
+                commit
+                packages dependencies))
+         ((attribute? line "revision")             ; Revision
+          (loop port
+                url
+                (attribute-by-name line "revision")
+                packages dependencies))
+         ((attribute? line "version")              ; Version
+          (loop port
+                url
+                (attribute-by-name line "version")
+                packages dependencies))
+         ((attribute? line "branch")               ; Branch
+          (loop port
+                url
+                (attribute-by-name line "branch")
+                packages dependencies))
+         ((string-match "=" line)                  ; Other options
+          (loop port url commit
+                packages dependencies))
+         (else (loop port url commit
+                     packages dependencies)))))
+    (loop port url commit
+          packages dependencies)))
+
+(define (parse-toml->packages+dependencies port packages dependencies)
+  "Read toml file on 'port' and return all dependencies packages sexp and list 
of
+constraint dependencies."
+  (define (loop port packages dependencies)
+    (let ((line (read-line port)))
+      (cond
+       ((eof-object? line)                ; EOF
+        (values packages dependencies))
+       ((string-null? line)               ; Empty line
+        (loop port packages dependencies))
+       ((comment? line)                   ; Comment
+        (loop port packages dependencies))
+       ((equal? line "[prune]")           ; Ignored
+        (loop port packages dependencies)) 
+       ((equal? "[[constraint]]" line)    ; Direct dependencies
+        (let-values (((packages dependencies)
+                      (parse-dependencies->packages+dependencies port #t
+                                                                 packages
+                                                                 
dependencies)))
+          (loop port packages dependencies)))
+       ((equal? "[[override]]" line)      ; Dependencies of dependencies
+        (let-values (((packages dependencies)
+                      (parse-dependencies->packages+dependencies port #f
+                                                                 packages
+                                                                 
dependencies)))
+          (loop port packages dependencies)))
+       (else (loop port packages dependencies)))))
+  (loop port packages dependencies))
+
+(define (gopkg-dep->packages+dependencies path)
+  "Open toml file if exist and parse it and return packages sexp and
+dependencies list. Or return two empty list if file not found."
+  (if (file-exists? path)
+      (let ((port (open-input-file path)))
+        (let-values (((packages dependencies)
+                      (parse-toml->packages+dependencies port
+                                                         '()
+                                                         '())))
+          (close-port port)
+          (values packages dependencies)))
+      (values '() '())))
+
+(define (gopkg->guix-package url branch)
+  "Create package for git repository dans branch verison and all dependencies 
sexp packages with
+Gopkg.toml file."
+  (let ((output (url-to-path url))
+        (name (package-name (cut-url url)))
+        (version "0.0.0")
+        (revision "0"))
+    (git-clone url branch)
+    
+    (let-values (((packages dependencies)
+                  (gopkg-dep->packages+dependencies
+                   (string-append output
+                                  "/Gopkg.toml"))))
+      (let-values (((packages dependencies)
+                    (create-package->packages+dependencies packages 
dependencies
+                                                           (cut-url url) 
version
+                                                           revision branch
+                                                           #f #f)))
+        (values packages)))))
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index 67bc7a755..3c55bfaff 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -74,7 +74,7 @@ rather than \\n."
 ;;;
 
 (define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem"
-                    "cran" "crate" "texlive" "json"))
+                    "cran" "crate" "texlive" "json" "gopkg"))
 
 (define (resolve-importer name)
   (let ((module (resolve-interface
diff --git a/guix/scripts/import/gopkg.scm b/guix/scripts/import/gopkg.scm
new file mode 100644
index 000000000..f513779ed
--- /dev/null
+++ b/guix/scripts/import/gopkg.scm
@@ -0,0 +1,99 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Pierre-Antoine Rouby <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts import gopkg)
+  #:use-module (guix ui)
+  #:use-module (guix utils)
+  #:use-module (guix scripts)
+  #:use-module (guix import gopkg)
+  #:use-module (guix scripts import)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:export (guix-import-gopkg))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  '())
+
+(define (show-help)
+  (display (G_ "Usage: guix import gopkg PACKAGE-URL BRANCH
+Import and convert the git repo with toml file to guix package using
+PACKAGE-URL and matching BRANCH.\n"))
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specification of the command-line options.
+  (cons* (option '(#\h "help") #f #f
+                 (lambda args
+                   (show-help)
+                   (exit 0)))
+         (option '(#\V "version") #f #f
+                 (lambda args
+                   (show-version-and-exit "guix import gopkg")))
+         %standard-import-options))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-import-gopkg . args)
+  (define (parse-options)
+    ;; Return the alist of option values.
+    (args-fold* args %options
+                (lambda (opt name arg result)
+                  (leave (G_ "~A: unrecognized option~%") name))
+                (lambda (arg result)
+                  (alist-cons 'argument arg result))
+                %default-options))
+
+  (let* ((opts (parse-options))
+         (args (filter-map (match-lambda
+                            (('argument . value)
+                             value)
+                            (_ #f))
+                           (reverse opts))))
+    (match args
+      ((package-url branch)
+       (let ((sexp (gopkg->guix-package package-url branch)))
+         (unless sexp
+           (leave (G_ "failed to download meta-data for package '~a'~%")
+                  package-url))
+         sexp))
+      ((package-url)
+       (let ((sexp (gopkg->guix-package package-url "master")))
+         (unless sexp
+           (leave (G_ "failed to download meta-data for package '~a'~%")
+                  package-url))
+         sexp))
+      (()
+       (leave (G_ "too few arguments~%")))
+      ((many ...)
+       (leave (G_ "too many arguments~%"))))))
-- 
2.17.0