From f42b68499c4e2a9bd368fe6a516932f5afa7a189 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 15 Nov 2020 16:58:52 +0100
Subject: [PATCH 1/4] DRAFT Add (guix parameters).

DRAFT: Missing tests & doc.

* guix/parameters.scm: New file.
* Makefile.am (MODULES): Add it.
---
 Makefile.am         |   1 +
 guix/parameters.scm | 131 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 132 insertions(+)
 create mode 100644 guix/parameters.scm

diff --git a/Makefile.am b/Makefile.am
index e7053ee4f4..72f955360d 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -235,6 +235,7 @@ MODULES =					\
   guix/build/make-bootstrap.scm			\
   guix/search-paths.scm				\
   guix/packages.scm				\
+  guix/parameters.scm				\
   guix/import/cabal.scm				\
   guix/import/cpan.scm				\
   guix/import/cran.scm				\
diff --git a/guix/parameters.scm b/guix/parameters.scm
new file mode 100644
index 0000000000..e4f8240aa4
--- /dev/null
+++ b/guix/parameters.scm
@@ -0,0 +1,131 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 parameters)
+  #:use-module (guix packages)
+  #:use-module (guix records)
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (ice-9 match)
+  #:export (package-parameter
+            package-parameter?
+            package-parameter-name
+            package-parameter-property
+            package-parameter-type
+            package-parameter-description
+
+            boolean
+            optionally
+
+            package-parameters
+            lookup-package-parameter
+            package-parameter-value
+            set-package-parameter-value))
+
+;;; Commentary:
+;;;
+;;; This module provides a way to express high-level "package parameters",
+;;; which allow users to customize how packages are built.  Parameters are an
+;;; interface that package developers define, where each parameter has a name
+;;; and type.  The user interface then converts parameter values from string
+;;; to Scheme values and records them in the package properties.
+;;;
+;;; Package parameters are discoverable; their description is
+;;; internationalized.  The possible values of a parameter can be enumerated,
+;;; and thus the Cartesian product of all possible parameter values for a
+;;; package can be enumerated as well.
+;;;
+;;; Code:
+
+;; Package parameter interface.
+(define-record-type* <package-parameter> package-parameter
+  make-package-parameter
+  package-parameter?
+  (name          package-parameter-name)
+  (property      package-parameter-property (default (string->symbol name)))
+  (type          package-parameter-type)
+  (description   package-parameter-description))
+
+;; Type of a package parameter.
+(define-record-type* <parameter-type> parameter-type
+  make-parameter-type
+  parameter-type?
+  (name          parameter-type-name)              ;debugging purposes only!
+  (string->value parameter-type-string->value)
+  (value->string parameter-type-value->string)
+  (universe      parameter-type-universe))
+
+(define boolean
+  ;; The Boolean parameter type.
+  (parameter-type (name 'boolean)
+                  (universe '(#true #false))
+                  (value->string
+                   (match-lambda
+                     (#f "false")
+                     (#t "true")))
+                  (string->value
+                   (lambda (str)
+                     (cond ((string-ci=? str "true")
+                            #t)
+                           ((string-ci=? str "false")
+                            #f)
+                           (else
+                            (raise (condition
+                                    (&message (message "wrong value"))))))))))
+
+(define (package-parameters package)
+  (or (assq-ref (package-properties package) 'parameters)
+      '()))
+
+(define (package-parameter-value package parameter)
+  (assq-ref (package-properties package)
+            (package-parameter-property parameter)))
+
+(define (lookup-package-parameter package name)
+  (find (lambda (parameter)
+          (string=? (package-parameter-name parameter) name))
+        (package-parameters package)))
+
+(define (set-package-parameter-value package name value)
+  (let ((parameter (lookup-package-parameter package name))
+        (location  (package-field-location package 'properties)))
+    (unless parameter
+      (raise (apply make-compound-condition
+                    (formatted-message
+                     (G_ "~a: no such package parameter")
+                     name)
+                    (if location
+                        (list (condition
+                               (&error-location (location location))))
+                        '()))))
+    (let* ((property (package-parameter-property parameter))
+           (type     (package-parameter-type parameter))
+           (value    ((parameter-type-string->value type) value)))
+      (package/inherit package
+        (properties
+         (alist-cons property value
+                     (alist-delete property (package-properties package)
+                                   eq?)))))))
+
+(define-syntax-rule (optionally property exp)
+  (if (assq-ref (package-properties this-package) property)
+      (list exp)
+      '()))
-- 
2.29.2