;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.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 juliahub)
  #:use-module (ice-9 textual-ports)
  #:use-module (ice-9 regex)
  #:use-module (ice-9 match)
  #:use-module (ice-9 streams)
  #:use-module (ice-9 string-fun)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-11)
  #:use-module (guix http-client)
  #:use-module (guix import utils)
  #:use-module (guix import json)
  #:use-module (guix base32)
  #:use-module (guix packages)
  #:use-module (guix upstream)
  #:use-module (json)
  #:use-module ((guix licenses) #:prefix license:)

  #:export (juliahub->guix-package
            %juliahub-updater
            juliahub-recursive-import))

(define (juliahub-uri name)
  (let* ((url (string-append "https://docs.juliahub.com/" name "/"))
         (port (http-fetch url #:text? #t))
         (_ (get-line port))
         (meta (get-line port))
         (regex "url=[a-zA-Z0-9]{5}\\/[0-9\\.]*")
         (redirect (match:substring (string-match regex meta))))
    (close-port port)
    (string-drop redirect 4)))

(define (juliahub-url name)
  (let* ((url (string-append "https://docs.juliahub.com/" name "/"))
         (uri (juliahub-uri name)))
    (string-append url uri "/")))

(define (juliahub-slug-version name)
  (let* ((uri (juliahub-uri name))
         (slug (string-take uri 5))
         (latest-version (string-drop uri 6)))
    `(,slug ,latest-version)))

(define (json->juliahub-direct-dependencies vector)
  (if (vector? vector)
      (filter-map
       (lambda (el)
         (let ((dep (json->juliahub-dependency el)))
           (if (juliahub-dependency-direct? dep)
               dep
               #f)))
       (vector->list vector))))

(define (json->juliahub-indirect-dependencies vector)
  (if (vector? vector)
      (filter-map
       (lambda (el)
         (let ((dep (json->juliahub-dependency el)))
           (if (not (juliahub-dependency-direct? dep))
               dep
               #f)))
       (vector->list vector))))

(define (ini-list->extra-dependencies lst)
  (match lst
    (('(extras) ooo ...)
     (extra-list->extra-dependencies ooo))
    (((tag) ooo ...)
     (ini-list->extra-dependencies ooo))
    ((attribute '= value ooo ...)
     (ini-list->extra-dependencies ooo))
    ('()
     '())))

(define (extra-list->extra-dependencies lst)
  (match lst
    ((attribute '= value ooo ...)
     `(,(symbol->string attribute) ,@(extra-list->extra-dependencies ooo)))
    (((tag) ooo ...)
     '())
    ('()
     '())))

(define (parse-extra-dependencies directory)
  (let* ((port (open-input-file (string-append directory "/Project.toml")))
         (ini-list (stream->list (port->stream port read))))
    (close-port port)
    (ini-list->extra-dependencies ini-list)))

;; Julia package.
(define-json-mapping <juliahub-package> make-juliahub-package juliahub-package?
  json->juliahub-package
  (homepage juliahub-package-homepage) ;string
  (readme juliahub-package-readme) ;string
  (version juliahub-package-version) ;string
  (description juliahub-package-description) ;string
  (direct-dependencies
   juliahub-package-direct-dependencies "deps"
   json->juliahub-direct-dependencies) ;list of <juliahub-dependency>
  (indirect-dependencies
   juliahub-package-indirect-dependencies "deps"
   json->juliahub-indirect-dependencies) ;list of <juliahub-dependency>
  (url juliahub-package-url) ;string
  (uuid juliahub-package-uuid) ;string
  (license juliahub-package-license)) ;string

(define-json-mapping <juliahub-dependency>
  make-juliahub-dependency juliahub-dependency?
  json->juliahub-dependency
  (direct? juliahub-dependency-direct? "direct") ;boolean
  (name juliahub-dependency-name) ;string
  (uuid juliahub-dependency-uuid) ;string
  (versions juliahub-dependency-versions "versions" vector->list)) ;list of strings

(define (julia-name->guix-name name)
  (string-append "julia-" (snake-case name)))

(define* (juliahub-fetch name #:key (version #f))
  "Return a <juliahub-package> record for package NAME, or #f on failure."
  (and=> (json-fetch (string-append (juliahub-url name) "pkg.json"))
         json->juliahub-package))

(define (make-julia-sexp name source home-page synopsis description
                         direct-dependencies test-dependencies-names licenses)
  "Return the `package' s-expression for a Julia package with the given NAME,
VERSION, URI, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES,
TEST-DEPENDENCIES-NAMES and LICENSES."
  `(package
     (name ,(julia-name->guix-name name))
     (version ,version)
     (source ,source)
     (build-system julia-build-system)
     ,@(if (null? direct-dependencies)
           '()
           `((propagated-inputs
              (list ,@(map (compose julia-name->guix-name juliahub-dependency-name)
                           direct-dependencies)))))
     ,@(if (null? test-dependencies-names)
           '()
           `((native-inputs
              (list ,@(map julia-name->guix-name test-dependencies-names)))))
     (synopsis ,synopsis)
     (description ,description)
     (home-page ,home-page)
     (license ,(match licenses
                 (() #f)
                 ((license) (license->symbol license))
                 (_ `(list ,@(map license->symbol licenses)))))))

(define* (juliahub->guix-package package-name
                                 #:key version #:allow-other-keys)
  "Fetch the metadata for PACKAGE-NAME from juliahub.org, and return the
`package' s-expression corresponding to that package, or #f on failure.
Optionally include a VERSION string to fetch a specific version juliahub."
  (let ((package (if version
                     (juliahub-fetch package-name version)
                     (juliahub-fetch package-name))))
    (if package
        (let-values (((source directory)
                      (git->origin+dir
                       (juliahub-package-url package)
                       `(tag-or-commit
                         . ,(string-append
                             "v" (juliahub-package-version package))))))
          (let* ((dependencies-names
                  (map juliahub-dependency-name
                       (juliahub-package-direct-dependencies package)))
                 (licenses
                  (map spdx-string->license
                       (list (juliahub-package-license package))))
                 (test-dependencies-names (parse-extra-dependencies directory)))
            (values (make-julia-sexp
                     package-name
                     source
                     (juliahub-package-homepage package)
                     (juliahub-package-description package)
                     (beautify-description (juliahub-package-readme package))
                     (juliahub-package-direct-dependencies package)
                     test-dependencies-names
                     licenses)
                    (append dependencies-names test-dependencies-names))))
        (values #f '()))))

(define (guix-package->juliahub-name package)
  (let* ((url (juliahub-package-url package))
         (git-name (car (last-pair (string-split url #\/))))
         (ungitted-name (if (string-suffix? ".git" git-name)
                            (string-drop-right git-name 4)
                            git-name))
         (package-name (if (string-suffix? ".jl" ungitted-name)
                            (string-drop-right ungitted-name 4)
                            ungitted-name)))
    package-name))

(define* (import-release package #:key (version #f))
  "Return an <upstream-source> for the latest release of PACKAGE."
  (let* ((package-name (guix-package->juliahub-name package))
         (package      (juliahub-fetch package-name))
         (version  (or version (juliahub-package-version package))))
    (upstream-source
     (package (package-name package))
     (version version)
     (urls (list (juliahub-package-url package))))))

(define %juliahub-updater
  (upstream-updater
   (name 'juliahub)
   (description "Updater for Juliahub packages")
   (pred juliahub-package?)
   (import import-release)))

(define* (juliahub-recursive-import package-name #:optional version)
  (recursive-import package-name
                    #:repo '()
                    #:repo->guix-package juliahub->guix-package
                    #:guix-name julia-name->guix-name
                    #:version version))