summaryrefslogtreecommitdiff
path: root/guix/monad-repl.scm
diff options
context:
space:
mode:
authorJohn Kehayias <john.kehayias@protonmail.com>2023-12-16 23:14:56 -0500
committerJohn Kehayias <john.kehayias@protonmail.com>2023-12-16 23:14:56 -0500
commit17c3a3bfff150a42c904233fa39818d73c9f68f3 (patch)
treea7614b7cd9a7106ea59f5ac1caad0c2c496b3a45 /guix/monad-repl.scm
parentf5493629e2650c0d30caf0f01f76b2383f78b9de (diff)
parentfe86819d8bde674766659c22b215d3a689a8026e (diff)
Merge branch 'master' into mesa-updates
Change-Id: I0c6e2410c51335c68634738be030e374f5b492e9
Diffstat (limited to 'guix/monad-repl.scm')
-rw-r--r--guix/monad-repl.scm74
1 files changed, 70 insertions, 4 deletions
diff --git a/guix/monad-repl.scm b/guix/monad-repl.scm
index 8a6053edd5..d6b39112b7 100644
--- a/guix/monad-repl.scm
+++ b/guix/monad-repl.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2016, 2022-2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,13 +21,15 @@
#:use-module (guix monads)
#:use-module (guix utils)
#:use-module (guix packages)
+ #:autoload (guix build-system) (bag)
#:use-module (guix status)
- #:autoload (guix gexp) (lower-object)
+ #:autoload (guix gexp) (gexp gexp? lower-gexp lowered-gexp-sexp lower-object)
#:use-module ((guix derivations)
#:select (derivation?
derivation->output-paths built-derivations))
+ #:autoload (guix read-print) (pretty-print-with-comments)
#:use-module (ice-9 match)
- #:use-module (ice-9 pretty-print)
+ #:autoload (ice-9 pretty-print) (pretty-print)
#:use-module (system repl repl)
#:use-module (system repl common)
#:use-module (system repl command)
@@ -138,4 +140,68 @@ Enter a REPL for values in the store monad."
(repl-option-set! new 'interp #t)
(run-repl new))))
-;;; monad-repl.scm ends here
+
+;;;
+;;; Viewing package arguments.
+;;;
+
+(define (keyword-argument-value args keyword default)
+ "Return the value associated with KEYWORD in ARGS, a keyword/value sequence,
+or DEFAULT if KEYWORD is missing from ARGS."
+ (let loop ((args args))
+ (match args
+ (()
+ default)
+ ((kw value rest ...)
+ (if (eq? kw keyword)
+ value
+ (loop rest))))))
+
+(define (package-argument-command repl form keyword default)
+ "Implement a command that display KEYWORD, a keyword such as #:phases, in
+the arguments of the package FORM evaluates to. Return DEFAULT is KEYWORD is
+missing from those arguments."
+ (match (repl-eval repl form)
+ ((? package? package)
+ (let* ((bag* (bag
+ (inherit (package->bag package))
+ (build (lambda* (name inputs #:rest args)
+ (with-monad %store-monad
+ (return (keyword-argument-value args keyword
+ default))))))))
+ (define phases
+ (parameterize ((%graft? #f))
+ (with-store store
+ (set-build-options store
+ #:print-build-trace #t
+ #:print-extended-build-trace? #t
+ #:multiplexed-build-output? #t)
+ (run-with-store store
+ (mlet %store-monad ((exp (bag->derivation bag*)))
+ (if (gexp? exp)
+ (mlet %store-monad ((gexp (lower-gexp exp)))
+ (return (lowered-gexp-sexp gexp)))
+ (return exp)))))))
+
+ (run-hook before-print-hook phases)
+ (let ((column (port-column (current-output-port))))
+ (pretty-print-with-comments (current-output-port) phases
+ #:indent column)
+ (newline (current-output-port)))))
+ (_
+ (format #t ";; ERROR: This command only accepts package records.~%"))))
+
+(define-meta-command ((phases guix) repl (form))
+ "phases
+Return the build phases of the package defined by FORM."
+ (package-argument-command repl form #:phases #~%standard-phases))
+
+(define-meta-command ((configure-flags guix) repl (form))
+ "configure-flags
+Return the configure flags of the package defined by FORM."
+ (package-argument-command repl form #:configure-flags #~'()))
+
+(define-meta-command ((make-flags guix) repl (form))
+ "make-flags
+Return the make flags of the package defined by FORM."
+ (package-argument-command repl form #:make-flags #~'()))