>From df7d38c18de670d71e829408d0b7e5b6666b5564 Mon Sep 17 00:00:00 2001 From: Amar Singh Date: Thu, 2 May 2019 00:38:56 +0530 Subject: [PATCH 05/10] Removed: alist-sexp; Added: shell-command; go-name->guix-name Use-Modules: (ice-9 popen) (web uri) (srfi srfi-26) Export: go-name*; Add: string-replace-substrings; shell-command; string->license; format-inputs; Rename: go-name->name TO go-name->guix-name Memoize: latest-release; url->store; go-name->sha256 go-name->readme-string; Remove: alist-sexp Signed-off-by: Amar Singh --- guix/import/golang.scm | 150 +++++++++++++++++++++++------------------ 1 file changed, 85 insertions(+), 65 deletions(-) diff --git a/guix/import/golang.scm b/guix/import/golang.scm index e6ef62a3b4..e0ffca4b42 100644 --- a/guix/import/golang.scm +++ b/guix/import/golang.scm @@ -2,23 +2,27 @@ ;;; Copyright © 2019 by Amar Singh ;;; ;;; This file is part of GNU Guix. -;;; +;;; ;;; This program 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. -;;; +;;; ;;; This program 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 this program. If not, see . (define-module (guix import golang)) (use-modules + (srfi srfi-1) ;; fold + (ice-9 rdelim) ;; read-string (guix import github) ;; latest-release + (guix utils) ;; string-replace-substring + (guix memoization) ;; memoize network operations (guix download) ;; download-to-store ((guix import utils) #:prefix utils:) ;; hash (guix packages) ;; packages @@ -27,86 +31,102 @@ (guix store) ;; with-store (gnu packages golang) ;; inherit (simple) go package (ice-9 textual-ports) ;; to parse readme.md + (ice-9 popen) ;; open-input-ouput-pipe + (web uri) ;; uri->string + (srfi srfi-26) ;; cut ) -(define go-name* "github.com/gohugoio/hugo") ;; for tests +(define-public go-name* "github.com/gohugoio/hugo") ;; for tests -(define (go-name->url go-name) - (string-append "https://" go-name)) +(define* (go-name->url go-name #:rest args) + (if (string-contains go-name ".") + (uri->string (string->uri (apply string-append + "https://" go-name args))) + #f)) (define (go-name->tarball go-name version) - (string-append (go-name->url go-name) "/archive/v" version - ".tar.gz")) + (go-name->url go-name "/archive/v" + version ".tar.gz")) + +(define* (string-replace-substrings string substrings + #:optional (replacement "-")) + (if (null-list? substrings) + string + ((cut string-replace-substring <> (car substrings) replacement) + (string-replace-substrings string (cdr substrings))))) ;;; Possible remove @@ if upstream exports the symbols -(define (go-name->name go-name) - ((@@ (guix import github) github-repository) - (go-name->url go-name))) - -;;; Slow; accesses the network -(define (latest-release go-name) - ((@@ (guix import github) latest-released-version) - (go-name->url go-name) - (go-name->name go-name))) - -;;; Slow; downloads the url from network; -(define (url->store url) - (with-store store - (download-to-store store - url))) -;;; Slow; download the source tarball from network and returns base32 -;;; nix-hash +(define (go-name->guix-name go-name) + (string-append "go-" + (string-replace-substrings go-name '("." "/") "-"))) + +;;; Slow; accesses the network; memoized +(define latest-release + (memoize + (lambda (go-name) + ((@@ (guix import github) latest-released-version) + (go-name->url go-name) + (go-name->guix-name go-name))))) + +;;; Slow; downloads the url from network; memoized +(define url->store + (@@ (guix import cran) download)) + +;;; Slow; download src tarball from network, returns base32 nix-hash; +;;; memoized (define (go-name->sha256 go-name version) (utils:guix-hash-url (url->store (go-name->tarball go-name version)))) -;;; Towards go-name->synopsis,description -(define (go-name->readme go-name) - (string-append "https://raw.githubusercontent.com" - (substring go-name - (string-length "github.com")) - "/master/" - "README.md")) - -;;; Slow; network access -(define (go-name->readme-string go-name) - "Slow; network access." - (call-with-input-file (url->store (go-name->readme go-name)) - (lambda (port) (get-string-n port 4096)))) +;;; Slow; network access; memoized +(define go-name->readme-string + (memoize + (lambda (go-name) + (define (go-name->readme go-name) + (go-name->url "raw.githubusercontent.com" + ;; TODO, detect the domain + (substring go-name + (string-length "github.com")) + "/master/" + "README.md")) + (call-with-input-file (url->store (go-name->readme go-name)) + read-string)))) ;;; Maybe try to match the first sentence. -(define (go-name->synopsis go-name readme-string) - (string-append (go-name->name go-name) - (substring readme-string 0 100))) +(define (go-name->synopsis go-name) + (substring (go-name->readme-string go-name) 0 100)) ;;; Maybe try to match the the next two sentences. -(define (go-name->description go-name readme-string) - (string-append (go-name->name go-name) - (substring readme-string 100 300))) - -;;; go list -f '{{ join .Deps "\n" }}',recursively find dependencies -;;; go list -f '{{ join .Imports "\n" }}' ,non recursive -(define (go-name->inputs go-name) - (let ((tmp (tmpnam))) - (and (zero? (system (string-append - "go list -f '{{ join .Deps \"\\n\" }}'" - " " go-name " > " tmp))) - (string-split (string-trim-both (call-with-input-file tmp get-string-all)) - (string->char-set "\n"))))) +(define (go-name->description go-name) + (substring (go-name->readme-string go-name) 100 300)) +(go-name->description go-name*) + +(define shell-command + (lambda* (command #:rest args) + (let* ((cmd (string-join (cons command (delete #f (delete '() args))) " ")) + (port (open-input-output-pipe cmd)) + (result (read-string port)) + (exit-code (close-pipe port))) + (and (zero? exit-code) + (string-split (string-trim-right result) #\newline))))) + +(define go-name->inputs + (lambda (go-name) + (let ((recursive-depends "-f '{{ join .Deps \"\\n\" }}'") + (direct-depends "-f '{{ join .Imports \"\\n\" }}'") + (go-command (car (shell-command "which go")))) + (shell-command go-command "list" direct-depends go-name)))) + +;;; License +(define (string->license license-string) + ((@@ (guix import cran) string->license) (string-upcase license-string))) ;;; For inputs -(define (alist-sexp alist) - (let ((magic (lambda (x) - (list x - (string->symbol (string-append x)))))) - (if (and (list? alist) (not (equal? '() alist))) - (map magic - (if (list? (car alist)) - (map car alist) - alist)) - '()))) +(define format-inputs + (@@ (guix import cran) format-inputs)) (define-public (make-go-package go-name) - ;; Do the expensive operations only once; query network for latest version + ;; Do the expensive operations only once; query network for latest + ;; version (let* ((version (latest-release go-name)) (sha256 (go-name->sha256 go-name version)) (readme-string (go-name->readme-string go-name))) -- 2.21.0