for-derivations.org

State Monad for Functional Packages

API

(use-modules (guix gexp)
             (guix store)
             (guix monads)
             (guix modules)
             (guix packages)
             (guix download)
             (guix derivations)
             (guix build-system trivial)
             (guix licenses)
             (gnu packages)
             (gnu packages base)

             (ice-9 match))

Monad Instance

(define (stateful-package-return value)
  (lambda (state)
    (with-monad %store-monad
      (return (cons value state)))))

(define (stateful-package-bind mvalue mproc)
  "Bind MVALUE, a value in the stateful-package monad, and pass it to MPROC."
  (lambda (state)
    (mlet* %store-monad
        ((mpair -> (mvalue state))
         (pair mpair)
         (x -> (car pair))
         (s -> (cdr pair))
         (act2 -> (mproc x)))
      (act2 s))))

(define-monad %stateful-package-monad
  (bind stateful-package-bind)
  (return stateful-package-return))

Utilities

lift

(define (stateful-package-lift mvalue)
  (lambda (state)
    (mlet %store-monad
        ((value mvalue))
      (return (cons value state)))))

get

(define (get)
  "Return the current state as a monadic value."
  (lambda (state)
    (with-monad %store-monad
      (return (cons state state)))))

put

(define (put value)
  "Set the current state to VALUE and return the previous state as a monadic
value."
  (lambda (state)
    (with-monad %store-monad
      (return (cons state value)))))

Examples

(define initial-state
  (computed-file "initial-state"
                 #~(begin
                     (mkdir #$output)
                     (call-with-output-file (string-append #$output "/state")
                       (lambda (p)
                         (display 0 p))))))

(define new-state
  (computed-file "new-state"
                 #~(begin
                     (mkdir #$output)
                     (call-with-output-file (string-append #$output "/state")
                       (lambda (p)
                         (display 3 p))))))

(define store (open-connection))

Example 4

(define mhello
  (stateful-package-lift (package->derivation hello)))

(define mgrep
  (stateful-package-lift (package->derivation grep)))

(define msed
  (stateful-package-lift (package->derivation sed)))

(define mdrvs
  (sequence %stateful-package-monad
            (list mhello
                  mgrep
                  msed)))

(run-with-store store (run-with-state mdrvs initial-state))