guix/monad-repl.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014, 2015, 2016, 2022 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix monad-repl)
  20   #:use-module (guix store)
  21   #:use-module (guix monads)
  22   #:use-module (guix utils)
  23   #:use-module (guix packages)
  24   #:use-module (guix status)
  25   #:autoload   (guix gexp) (lower-object)
  26   #:use-module ((guix derivations)
  27                 #:select (derivation?
  28                           derivation->output-paths built-derivations))
  29   #:use-module (ice-9 match)
  30   #:use-module (ice-9 pretty-print)
  31   #:use-module (system repl repl)
  32   #:use-module (system repl common)
  33   #:use-module (system repl command)
  34   #:use-module (system base language)
  35   #:use-module (system base compile)
  36   #:use-module (srfi srfi-26)
  37   #:export (run-in-store
  38             enter-store-monad))
  39
  40 ;;; Comment:
  41 ;;;
  42 ;;; This modules provides a couple of REPL meta-commands that make it easier
  43 ;;; to work with monadic procedures in the store monad.
  44 ;;;
  45 ;;; Code:
  46
  47 (define* (monad-language monad run #:optional (name 'monad))
  48   "Return a language with a special evaluator that causes monadic values
  49  to be \"run\" in MONAD using procedure RUN."
  50   (let ((scheme (lookup-language 'scheme)))
  51     (define (evaluate-monadic-expression exp env)
  52       (let ((mvalue (compile exp #:to 'value #:env env)))
  53         (run mvalue)))
  54
  55     (make-language #:name name
  56                    #:title "Monad"
  57                    #:reader (language-reader scheme)
  58                    #:compilers (language-compilers scheme)
  59                    #:decompilers (language-decompilers scheme)
  60                    #:evaluator evaluate-monadic-expression
  61                    #:printer (language-printer scheme)
  62                    #:make-default-environment
  63                    (language-make-default-environment scheme))))
  64
  65 (define* (default-guile-derivation store #:optional (system (%current-system)))
  66   "Return the derivation of the default "
  67   (package-derivation store (default-guile) system))
  68
  69 (define (store-monad-language store)
  70   "Return a compiler language for the store monad using STORE."
  71   (let ((guile (or (%guile-for-build)
  72                    (default-guile-derivation store))))
  73     (monad-language %store-monad
  74                     (cut run-with-store store <>
  75                          #:guile-for-build guile)
  76                     'store-monad)))
  77
  78 (define %build-verbosity
  79   ;; Current build verbosity level.
  80   1)
  81
  82 (define* (evaluate/print-with-store mvalue #:key build?)
  83   "Run monadic value MVALUE in the store monad and print its value."
  84   (with-store store
  85     (set-build-options store
  86                        #:print-build-trace #t
  87                        #:print-extended-build-trace? #t
  88                        #:multiplexed-build-output? #t)
  89     (with-status-verbosity %build-verbosity
  90       (let* ((guile  (or (%guile-for-build)
  91                          (default-guile-derivation store)))
  92              (values (run-with-store store
  93                        (if build?
  94                            (mlet %store-monad ((obj mvalue))
  95                              (if (derivation? obj)
  96                                  (mbegin %store-monad
  97                                    (built-derivations (list obj))
  98                                    (return
  99                                     (match (derivation->output-paths obj)
 100                                       (((_ . files) ...) files))))
 101                                  (return (list obj))))
 102                            (mlet %store-monad ((obj mvalue))
 103                              (return (list obj))))
 104                        #:guile-for-build guile)))
 105         (for-each (lambda (value)
 106                     (run-hook before-print-hook value)
 107                     (pretty-print value))
 108                   values)))))
 109
 110 (define-meta-command ((run-in-store guix) repl (form))
 111   "run-in-store EXP
 112 Run EXP through the store monad."
 113   (evaluate/print-with-store (repl-eval repl form)))
 114
 115 (define-meta-command ((verbosity guix) repl (level))
 116   "verbosity LEVEL
 117 Change build verbosity to LEVEL."
 118   (set! %build-verbosity (repl-eval repl level)))
 119
 120 (define-meta-command ((lower guix) repl (form))
 121   "lower OBJECT
 122 Lower OBJECT into a derivation or store file and return it."
 123   (evaluate/print-with-store (lower-object (repl-eval repl form))))
 124
 125 (define-meta-command ((build guix) repl (form))
 126   "build OBJECT
 127 Lower OBJECT and build it, returning its output file name(s)."
 128   (evaluate/print-with-store (lower-object (repl-eval repl form))
 129                              #:build? #t))
 130
 131 (define-meta-command ((enter-store-monad guix) repl)
 132   "enter-store-monad
 133 Enter a REPL for values in the store monad."
 134   (with-store store
 135     (let ((new (make-repl (store-monad-language store))))
 136       ;; Force interpretation so that our specially-crafted language evaluator
 137       ;; is actually used.
 138       (repl-option-set! new 'interp #t)
 139       (run-repl new))))
 140
 141 ;;; monad-repl.scm ends here