;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 swedebugia <swedebugia@riseup.net>
;;;
;;; 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 go)
  #:use-module (ice-9 match)
  #:use-module (ice-9 textual-ports)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-2) ;and-let
  #:use-module (guix utils)
  #:use-module (guix build git)
  #:use-module (guix import github)
  #:use-module (guix import json)
  #:use-module (guix import utils)
  #:use-module (guix packages)
  #:use-module (web uri))

;;; Commentary:
;;; This utilizes the https://go-search.org/infoapi API.
;;; This API contains no licenses or versions. We fetch those from github when
;;; possible.

;;; Code:

(define (go-name->url name)
  "Takes a go-name on the form github.com/andyleap/go-ssb and turns it into
https://github.com/andyleap/go-ssb"
  (string-append "https://" name))

;; from opam.scm - should probably be factored out to utils.scm
(define (substitute-char str what with)
  (string-join (string-split str what) with))

(define (go-name->guix-name name)
  "Takes a go-name e.g. on the form github.com/x/y and turns it into
go-github-com-x-y"
  (substitute-char
   (substitute-char
    (cond
     ;;((equal? name "ocamlfind") "ocaml-findlib")
     ;;((string-prefix? "ocaml" name) name)
     ((string-prefix? "github.com/" name) (string-append "go-github-com-" (substring name 11)))
     ((string-prefix? "golang.org/x/" name) (string-append "go-golang-org-" (substring name 11)))
     ((string-prefix? "cryptoscope.co/go/" name) (string-append "go-cryptoscope-co-" (substring name 11)))
     (else (string-append "go-" name)))
    #\_ "-")
   #\/ "-"))
;;(display (go-name->guix-name "golang.org/x/text/transform"))

(define (fetch-data name)
  "Fetches data about imports and description"
  (json-fetch (string-append "https://go-search.org/api"
                             "?action=package&id=" name)))
;;(display (hash-table->alist (fetch-data "golang.org/x/text/transform")))

(define (synopsis name)
  (and-let* ((data (fetch-data name)))
    (if (assoc-ref data "Synopsis")
        (assoc-ref data "Synopsis")
        ;; If synopsis is empty get the description instead
        (assoc-ref data "Description"))))

;;(display (synopsis "golang.org/x/text/transform"))

;; Github projects enable us to get the license and readme
(define (github-url? url)
  (->bool (string-prefix? "https://github.com/" url)))

(define (string->license name)
  "Get SPDX-id from github if github-url"
  (and-let* ((url (go-name->url name))
            (github-url? url)
            (data (fetch-license url))
            (hasht (assoc-ref data "license"))
            (str (string-downcase (assoc-ref hasht "spdx_id"))))
    (cond
     ((equal? str "gpl-3.0") '(license:gpl-3))
     (else `(,string-append "license:" ,str)))))

;;(display (string->license "github.com/andyleap/go-ssb"))

(define (readme name)
  "We get the first 1000 characters for the description"
  (and-let* ((url (go-name->url name))
            (github-url? url))
    (get-string-n (fetch-readme url) 1000)))

(define (description name)
  (and-let* ((data (fetch-data name)))
    (if (assoc-ref data "Synopsis")
        ;; Synopsis is non-empty.
        (if (assoc-ref data "Description")
            (assoc-ref data "Description")
            ;; Description is empty
            (readme name))
        ;; Synopsis is empty and the description from GSAPI has been used as
        ;; synopsis, get the readme instead
        (readme name))))

;;(display (description "golang.org/x/text/transform"))

;; Versions are tricky because the go-ecosystem does not rely on them at
;; all. We get the latest released or tagged version from github and fall
;; backto the latest commit.
(define (version name)
  "Get the latest release or tag if any."
  (and-let* ((url (go-name->url name))
             (github-url? url))
    (latest-released-version url name)))

;;(display (version "github.com/andyleap/go-ssb"))

(define (commit name)
  "Get latest commit-id"
  (and-let* ((url (go-name->url name))
             (github-url? url))
    (fetch-latest-commit url)))

;;(display (commit "github.com/andyleap/go-ssb"))

(define (dependencies name)
  (and-let* ((data (fetch-data name)))
    ;; Join with (assoc-ref data "TestImports")?
    (assoc-ref data "Imports")))

;;(display (dependencies "golang.org/x/text/transform"))

(define (test-dependencies name)
  (and-let* ((data (fetch-data name)))
    ;; Join with (assoc-ref data "TestImports")?
    (assoc-ref data "TestImports")))

;; this is from ocaml.scm
(define (dependencies->inputs dependencies)
  "Transform the list of dependencies in a list of inputs."
  (if (not dependencies)
    '()
    (map (lambda (input)
           (list input (list 'unquote (string->symbol input))))
         (map go-name->guix-name dependencies))))

;;(display (dependencies->inputs (dependencies "github.com/andyleap/go-ssb")))

(define (go->guix-package name)
  (let ((version (version name)))
    (if (equal? version #t)
        ;; Got release or tag
        (let ((source-url (go-name->url name))
              (commit version)
              (inputs (dependencies->inputs (dependencies name)))
              (synopsis (synopsis name))
              (description (description name)))
          ;; This is broken because of git-fetch from git-download does not at
          ;; all work like the similar url-fetch-procedure.
          (call-with-temporary-directory
           (lambda (temp)
             (and (git-fetch source-url commit temp)
                  `(package
                     (name ,(go-name->guix-name name))
                     (version ,version)
                     (source
                      (origin
                        (method git-fetch)
                        (uri (git-reference
                              (url ,source-url)
                              (commit ,commit)))
                        (file-name (git-file-name name version))
                        (sha256 (base32 ,(guix-hash-directory temp)))))
                     (build-system go-build-system)
                     ,@(if (null? inputs)
                           '()
                           `((inputs ,(list 'quasiquote inputs))))
                     (home-page ,source-url)
                     (synopsis ,synopsis)
                     (description ,description)
                     (license ,@(string->license name)))))))
        ;; No release or tag, fall back to latest commit
        (let ((source-url (go-name->url name))
              (commit (commit name))
              (inputs (dependencies->inputs (dependencies name)))
              (synopsis (synopsis name))
              (description (description name)))
          (call-with-temporary-directory
           (lambda (temp)
             (and (git-fetch source-url commit temp)
                  `(package
                     (name ,(go-name->guix-name name))
                     (version ,version)
                     (source
                      (origin
                        (method git-fetch)
                        (uri (git-reference
                              (url ,source-url)
                              (commit ,commit)))
                        (file-name (git-file-name name version))
                        (sha256 (base32 ,(guix-hash-directory temp)))))
                     (build-system go-build-system)
                     ,@(if (null? inputs)
                           '()
                           `((inputs ,(list 'quasiquote inputs))))
                     (home-page ,source-url)
                     (synopsis ,synopsis)
                     (description ,description)
                     (license ,@(string->license name))))))))))
#;
(go->guix-package "github.com/gogo/protobuf")

;; Debug
#;
(display
 (call-with-temporary-directory
  (lambda (temp)
    (let* ((name "github.com/gogo/protobuf")
           (url (go-name->url name))
           (commit "28a6bbf47e48e0b2220b2a244750b660c83d4942"))
      (let ((path (string-append "/tmp" name)))
        (git-fetch url commit temp)
        (guix-hash . ("-r" "-x" temp)))))))