Subject: [PATCH v2] import: opam: Allow importing local files.

From: Julien Lepiller <[email-masked]>
Date: Sun, 12 Jun 2022 08:31:21 +0200

* guix/scripts/import/opam.scm (guix-import-opam): Support `--scan-project` flag.
* guix/import/opam.scm (opam-scan-projects): New procedure.
---
 guix/import/opam.scm         | 32 ++++++++++++++++++++++++++++++--
 guix/scripts/import/opam.scm | 11 +++++++++++
 2 files changed, 41 insertions(+), 2 deletions(-)

diff --git a/guix/import/opam.scm b/guix/import/opam.scm
index b4b5a6eaad..3989dff58e 100644
--- a/guix/import/opam.scm
+++ b/guix/import/opam.scm
@@ -32,9 +32,11 @@ (define-module (guix import opam)
   #:use-module (srfi srfi-2)
   #:use-module ((srfi srfi-26) #:select (cut))
   #:use-module ((web uri) #:select (string->uri uri->string))
-  #:use-module ((guix build utils) #:select (dump-port find-files mkdir-p))
+  #:use-module ((guix build utils) #:select (dump-port find-files mkdir-p
+                                             delete-file-recursively))
   #:use-module (guix build-system)
   #:use-module (guix build-system ocaml)
+  #:use-module (guix git)
   #:use-module (guix http-client)
   #:use-module (guix ui)
   #:use-module (guix packages)
@@ -48,7 +50,8 @@ (define-module (guix import opam)
                                               spdx-string->license
                                               url-fetch))
   #:use-module ((guix licenses) #:prefix license:)
-  #:export (opam->guix-package
+  #:export (opam-scan-projects
+            opam->guix-package
             opam-recursive-import
             %opam-updater
 
@@ -178,6 +181,31 @@ (define* (get-opam-repository #:optional (repo "opam"))
 ;; Prevent Guile 3 from inlining this procedure so we can mock it in tests.
 (set! get-opam-repository get-opam-repository)
 
+(define (opam-scan-dir dir)
+  (let* ((opam-files (find-files dir "\\.opam$"))
+         (dir (opam-cache-directory dir))
+         (packages (string-append dir "/packages")))
+    (when (file-exists? dir)
+      (delete-file-recursively dir))
+    (mkdir-p packages)
+    (for-each
+      (lambda (package)
+        (let* ((name (basename package ".opam"))
+               (version (metadata-ref (get-metadata package) "version"))
+               (file (string-append packages "/" name "." version "/opam")))
+          (mkdir-p (dirname file))
+          (copy-file package file)))
+      opam-files)
+    dir))
+
+(define (opam-scan-project project)
+  (if (file-exists? project)
+    (opam-scan-dir project)
+    (opam-scan-dir (update-cached-checkout project))))
+
+(define (opam-scan-projects projects)
+  (map opam-scan-project projects))
+
 (define (get-version-and-file path)
   "Analyse a candidate path and return an list containing information for proper
   version comparison as well as the source path for metadata."
diff --git a/guix/scripts/import/opam.scm b/guix/scripts/import/opam.scm
index 834ac34cb0..0b15a81541 100644
--- a/guix/scripts/import/opam.scm
+++ b/guix/scripts/import/opam.scm
@@ -50,6 +50,10 @@ (define (show-help)
       --repo             import packages from this opam repository (name, URL or local path)
                          can be used more than once"))
   (display (G_ "
+  -p, --scan-project     import packages from this OCaml project (URL of a
+                         Git repository or local path).  Can be used more
+                         than once."))
+  (display (G_ "
   -V, --version          display version information and exit"))
   (newline)
   (show-bug-report-information))
@@ -69,6 +73,9 @@ (define %options
          (option '(#\r "recursive") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'recursive #t result)))
+         (option '(#\p "scan-project") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'project arg result)))
          %standard-import-options))
 
 
@@ -86,6 +93,10 @@ (define (parse-options)
          (repo (filter-map (match-lambda
                              (('repo . name) name)
                              (_ #f)) opts))
+         (projects (filter-map (match-lambda
+                                 (('project . name) name)
+                                 (_ #f)) opts))
+         (repo (append repo (opam-scan-projects projects)))
          (args (filter-map (match-lambda
                             (('argument . value)
                              value)
-- 
2.35.1