* 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 <pierre-antoine.ro...@inria.fr> +;;; +;;; 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 <pierre-antoine.ro...@inria.fr> +;;; +;;; 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
