[bug#74900,v2,6/6] build-system/tree-sitter: Add guile-json extension.

Message ID 20250217234823.10533-7-ngraves@ngraves.fr
State New
Headers
Series build-system/node: Replace (guix build json) by (json). |

Commit Message

Nicolas Graves Feb. 17, 2025, 11:43 p.m. UTC
  * guix/build-system/tree-sitter.scm (default-guile-json): New variable.
(tree-sitter-cross-build, tree-sitter-build): Use guile-json extension.
---
 guix/build-system/tree-sitter.scm | 101 ++++++++++++++++--------------
 1 file changed, 55 insertions(+), 46 deletions(-)
  

Patch

diff --git a/guix/build-system/tree-sitter.scm b/guix/build-system/tree-sitter.scm
index 21c4eb35b2..f59a255307 100644
--- a/guix/build-system/tree-sitter.scm
+++ b/guix/build-system/tree-sitter.scm
@@ -36,6 +36,12 @@  (define %tree-sitter-build-system-modules
   `((guix build tree-sitter-build-system)
     ,@%node-build-system-modules))
 
+(define (default-guile-json)
+  "Return the default guile-json package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((mod (resolve-interface '(gnu packages guile))))
+    (module-ref mod 'guile-json-4)))
+
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
                 #:allow-other-keys
@@ -98,26 +104,27 @@  (define* (tree-sitter-build name inputs
                             (outputs '("out" "js"))
                             (search-paths '())
                             (system (%current-system))
-                            (guile #f)
+                            (guile-json (default-guile-json))
                             (imported-modules %tree-sitter-build-system-modules)
                             (modules '((guix build utils)
                                        (guix build tree-sitter-build-system))))
   (define builder
-    (with-imported-modules imported-modules
-      #~(begin
-          (use-modules #$@(sexp->gexp modules))
-          (tree-sitter-build #:name #$name
-                             #:source #+source
-                             #:system #$system
-                             #:phases #$phases
-                             #:tests? #$tests?
-                             #:grammar-directories '#$grammar-directories
-                             #:outputs #$(outputs->gexp outputs)
-                             #:search-paths
-                             '#$(sexp->gexp
-                                 (map search-path-specification->sexp
-                                      search-paths))
-                             #:inputs #$(input-tuples->gexp inputs)))))
+    (with-extensions (list guile-json)
+      (with-imported-modules imported-modules
+        #~(begin
+            (use-modules #$@(sexp->gexp modules))
+            (tree-sitter-build #:name #$name
+                               #:source #+source
+                               #:system #$system
+                               #:phases #$phases
+                               #:tests? #$tests?
+                               #:grammar-directories '#$grammar-directories
+                               #:outputs #$(outputs->gexp outputs)
+                               #:search-paths
+                               '#$(sexp->gexp
+                                   (map search-path-specification->sexp
+                                        search-paths))
+                               #:inputs #$(input-tuples->gexp inputs))))))
 
   (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
                                                   system #:graft? #f)))
@@ -137,6 +144,7 @@  (define* (tree-sitter-cross-build name
                                   (search-paths '())
                                   (native-search-paths '())
                                   (system (%current-system))
+                                  (guile-json (default-guile-json))
                                   (build (nix-system->gnu-triplet system))
                                   (imported-modules
                                    %tree-sitter-build-system-modules)
@@ -144,40 +152,41 @@  (define* (tree-sitter-cross-build name
                                    '((guix build utils)
                                      (guix build tree-sitter-build-system))))
   (define builder
-    (with-imported-modules imported-modules
-      #~(begin
-          (use-modules #$@(sexp->gexp modules))
+    (with-extensions (list guile-json)
+      (with-imported-modules imported-modules
+        #~(begin
+            (use-modules #$@(sexp->gexp modules))
 
-          (define %build-host-inputs
-            #+(input-tuples->gexp build-inputs))
+            (define %build-host-inputs
+              #+(input-tuples->gexp build-inputs))
 
-          (define %build-target-inputs
-            (append #$(input-tuples->gexp host-inputs)
-                    #+(input-tuples->gexp target-inputs)))
+            (define %build-target-inputs
+              (append #$(input-tuples->gexp host-inputs)
+                      #+(input-tuples->gexp target-inputs)))
 
-          (define %build-inputs
-            (append %build-host-inputs %build-target-inputs))
+            (define %build-inputs
+              (append %build-host-inputs %build-target-inputs))
 
-          (tree-sitter-build #:name #$name
-                             #:source #+source
-                             #:system #$system
-                             #:build #$build
-                             #:target #$target
-                             #:phases #$phases
-                             #:tests? #$tests?
-                             #:grammar-directories '#$grammar-directories
-                             #:outputs #$(outputs->gexp outputs)
-                             #:inputs %build-target-inputs
-                             #:native-inputs %build-host-inputs
-                             #:search-paths '
-                             #$(sexp->gexp
-                                (map search-path-specification->sexp
-                                     search-paths))
-                             #:native-search-paths
-                             '#$(sexp->gexp
-                                 (map
-                                  search-path-specification->sexp
-                                  native-search-paths))))))
+            (tree-sitter-build #:name #$name
+                               #:source #+source
+                               #:system #$system
+                               #:build #$build
+                               #:target #$target
+                               #:phases #$phases
+                               #:tests? #$tests?
+                               #:grammar-directories '#$grammar-directories
+                               #:outputs #$(outputs->gexp outputs)
+                               #:inputs %build-target-inputs
+                               #:native-inputs %build-host-inputs
+                               #:search-paths '
+                               #$(sexp->gexp
+                                  (map search-path-specification->sexp
+                                       search-paths))
+                               #:native-search-paths
+                               '#$(sexp->gexp
+                                   (map
+                                    search-path-specification->sexp
+                                    native-search-paths)))))))
 
   (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
                                                   system #:graft? #f)))