gnu: libsoundio: Fix indentation.

[jackhill/guix/guix.git] / gnu / machine.scm

diff --git a/gnu/machine.scm b/gnu/machine.scm
index 0b79402..667a988 100644 (file)
--- a/gnu/machine.scm
+++ b/gnu/machine.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 David Thompson <davet@gnu.org>
-;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.org>
+;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,7 +23,8 @@
   #:use-module (guix monads)
   #:use-module (guix records)
   #:use-module (guix store)
-  #:use-module ((guix utils) #:select (source-properties->location))
+  #:use-module ((guix diagnostics) #:select (source-properties->location))
+  #:use-module (srfi srfi-35)
   #:export (environment-type
             environment-type?
             environment-type-name
@@ -32,15 +33,20 @@
 
             machine
             machine?
-            this-machine
 
-            machine-system
+            machine-operating-system
             machine-environment
             machine-configuration
             machine-display-name
 
             deploy-machine
-            machine-remote-eval))
+            roll-back-machine
+            machine-remote-eval
+
+            &deploy-error
+            deploy-error?
+            deploy-error-should-roll-back
+            deploy-error-captured-args))
 
 ;;; Commentary:
 ;;;
@@ -66,6 +72,7 @@
   ;; of the form '(machine-remote-eval machine exp)'.
   (machine-remote-eval environment-type-machine-remote-eval) ; procedure
   (deploy-machine      environment-type-deploy-machine)      ; procedure
+  (roll-back-machine   environment-type-roll-back-machine)   ; procedure
 
   ;; Metadata.
   (name        environment-type-name)       ; symbol
@@ -81,18 +88,21 @@
 ;;; Declarations for machines in a deployment.
 ;;;
 
-(define-record-type* <machine> machine
-  make-machine
+(define-record-type* <machine> machine make-machine
   machine?
-  this-machine
-  (system        machine-system)       ; <operating-system>
-  (environment   machine-environment)  ; symbol
-  (configuration machine-configuration ; configuration object
-                 (default #f)))        ; specific to environment
+  (operating-system %machine-operating-system); <operating-system>
+  (environment      machine-environment)      ; symbol
+  (configuration    machine-configuration     ; configuration object
+                    (default #f)))            ; specific to environment
+
+(define (machine-operating-system machine)
+  "Return the operating system of MACHINE."
+  (operating-system-with-provenance
+   (%machine-operating-system machine)))
 
 (define (machine-display-name machine)
   "Return the host-name identifying MACHINE."
-  (operating-system-host-name (machine-system machine)))
+  (operating-system-host-name (machine-operating-system machine)))
 
 (define (machine-remote-eval machine exp)
   "Evaluate EXP, a gexp, on MACHINE. Ensure that all the elements EXP refers to
@@ -105,3 +115,20 @@ are built and deployed to MACHINE beforehand."
 MACHINE, activating it on MACHINE and switching MACHINE to the new generation."
   (let ((environment (machine-environment machine)))
     ((environment-type-deploy-machine environment) machine)))
+
+(define (roll-back-machine machine)
+  "Monadic procedure rolling back to the previous system generation on
+MACHINE. Return the number of the generation that was current before switching
+and the new generation number."
+  (let ((environment (machine-environment machine)))
+    ((environment-type-roll-back-machine environment) machine)))
+
+\f
+;;;
+;;; Error types.
+;;;
+
+(define-condition-type &deploy-error &error
+  deploy-error?
+  (should-roll-back deploy-error-should-roll-back)
+  (captured-args deploy-error-captured-args))