os: New module.

The os! macro provides a way to compose operating-systems in layers
that do not know each other directly. While allowing for more
flexibility, this approach also avoids having to pass through function
parameters to nested operating system functions.

src/stern-kit/os.scm

+;;; Stern Kit --- Guix channel by Stern Data
+;;; Copyright © 2021 Aljosha Papsch <ep@stern-data.com>
+;;;
+;;; This file is part of Stern Kit.
+;;;
+;;; Stern Kit 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.
+;;;
+;;; Stern Kit 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 Stern Kit.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (stern-kit os)
+  #:export (os!))
+
+;;; Commentary: Utilities for composing operating systems.
+
+(define-syntax os!
+  (syntax-rules (base)
+    ((_ base base-os os-func os-args os-func* os-args* ...)
+     (let ((c (os-func base-os)))
+       (os! base (apply c os-args)
+	    os-func* os-args* ...)))
+    ((_ base base-os os-func os-args)
+     (let ((c (os-func base-os)))
+       (apply c os-args)))
+    ((_ base base-os)
+     base-os)))

tests/os.scm

+;;; Stern Kit --- Guix channel by Stern Data
+;;; Copyright © 2021 Aljosha Papsch <ep@stern-data.com>
+;;;
+;;; This file is part of Stern Kit.
+;;;
+;;; Stern Kit 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.
+;;;
+;;; Stern Kit 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 Stern Kit.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-os)
+  #:use-module (gnu)
+  #:use-module (stern-kit os)
+  #:use-module (srfi srfi-64))
+
+(test-begin "os")
+
+(define base-os
+  (operating-system
+   (bootloader #f)
+   (file-systems #f)
+   (timezone "Etc/UTC")
+   (host-name "base")))
+
+(test-assert "os! with one inheritance"
+  (let ((os (os! base base-os
+		 (lambda (inherit-from)
+		   (lambda ()
+		     (operating-system
+		      (inherit inherit-from)
+		      (host-name "upper"))))
+		 '())))
+    (string=? "upper" (operating-system-host-name os))))
+
+(test-assert "os! with args"
+  (let ((os (os! base base-os
+		 (lambda (i)
+		   (lambda (name)
+		     (operating-system
+		      (inherit i)
+		      (host-name name))))
+		 '("passed"))))
+    (string=? "passed" (operating-system-host-name os))))
+
+(test-assert "os! with two inheritance"
+  (let ((os (os! base base-os
+		 (lambda (i)
+		   (lambda ()
+		     (operating-system
+		      (inherit i)
+		      (timezone "Europe/Berlin")
+		      (host-name "first"))))
+		 '()
+		 (lambda (i)
+		   (lambda ()
+		     (operating-system
+		      (inherit i)
+		      (host-name "second"))))
+		 '())))
+    (and (string=? "Europe/Berlin" (operating-system-timezone os))
+	 (string=? "second" (operating-system-host-name os)))))
+
+(test-end "os")