aboutsummaryrefslogtreecommitdiff
path: root/guix/monads.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/monads.scm')
-rw-r--r--guix/monads.scm137
1 files changed, 1 insertions, 136 deletions
diff --git a/guix/monads.scm b/guix/monads.scm
index 20fee79602..7fec3d5168 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -17,9 +17,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix monads)
- #:use-module (guix store)
- #:use-module (guix derivations)
- #:use-module (guix packages)
#:use-module ((system syntax)
#:select (syntax-local-binding))
#:use-module (ice-9 match)
@@ -49,22 +46,7 @@
anym
;; Concrete monads.
- %identity-monad
-
- %store-monad
- store-bind
- store-return
- store-lift
- run-with-store
- text-file
- interned-file
- package-file
- origin->derivation
- package->derivation
- package->cross-derivation
- built-derivations)
- #:replace (imported-modules
- compiled-modules))
+ %identity-monad))
;;; Commentary:
;;;
@@ -309,121 +291,4 @@ lifted in MONAD, for which PROC returns true."
(bind identity-bind)
(return identity-return))
-
-;;;
-;;; Store monad.
-;;;
-
-;; return:: a -> StoreM a
-(define-inlinable (store-return value)
- "Return VALUE from a monadic function."
- ;; The monadic value is just this.
- (lambda (store)
- value))
-
-;; >>=:: StoreM a -> (a -> StoreM b) -> StoreM b
-(define-inlinable (store-bind mvalue mproc)
- "Bind MVALUE in MPROC."
- (lambda (store)
- (let* ((value (mvalue store))
- (mresult (mproc value)))
- (mresult store))))
-
-(define-monad %store-monad
- (bind store-bind)
- (return store-return))
-
-
-(define (store-lift proc)
- "Lift PROC, a procedure whose first argument is a connection to the store,
-in the store monad."
- (define result
- (lambda args
- (lambda (store)
- (apply proc store args))))
-
- (set-object-property! result 'documentation
- (procedure-property proc 'documentation))
- result)
-
-;;;
-;;; Store monad operators.
-;;;
-
-(define* (text-file name text)
- "Return as a monadic value the absolute file name in the store of the file
-containing TEXT, a string."
- (lambda (store)
- (add-text-to-store store name text '())))
-
-(define* (interned-file file #:optional name
- #:key (recursive? #t))
- "Return the name of FILE once interned in the store. Use NAME as its store
-name, or the basename of FILE if NAME is omitted.
-
-When RECURSIVE? is true, the contents of FILE are added recursively; if FILE
-designates a flat file and RECURSIVE? is true, its contents are added, and its
-permission bits are kept."
- (lambda (store)
- (add-to-store store (or name (basename file))
- recursive? "sha256" file)))
-
-(define* (package-file package
- #:optional file
- #:key
- system (output "out") target)
- "Return as a monadic value the absolute file name of FILE within the
-OUTPUT directory of PACKAGE. When FILE is omitted, return the name of the
-OUTPUT directory of PACKAGE. When TARGET is true, use it as a
-cross-compilation target triplet."
- (lambda (store)
- (define compute-derivation
- (if target
- (cut package-cross-derivation <> <> target <>)
- package-derivation))
-
- (let* ((system (or system (%current-system)))
- (drv (compute-derivation store package system))
- (out (derivation->output-path drv output)))
- (if file
- (string-append out "/" file)
- out))))
-
-(define package->derivation
- (store-lift package-derivation))
-
-(define package->cross-derivation
- (store-lift package-cross-derivation))
-
-(define origin->derivation
- (store-lift package-source-derivation))
-
-(define imported-modules
- (store-lift (@ (guix derivations) imported-modules)))
-
-(define compiled-modules
- (store-lift (@ (guix derivations) compiled-modules)))
-
-(define built-derivations
- (store-lift build-derivations))
-
-(define* (run-with-store store mval
- #:key
- (guile-for-build (%guile-for-build))
- (system (%current-system)))
- "Run MVAL, a monadic value in the store monad, in STORE, an open store
-connection."
- (define (default-guile)
- ;; Lazily resolve 'guile-final'. This module must not refer to (gnu …)
- ;; modules directly, to avoid circular dependencies, hence this hack.
- (module-ref (resolve-interface '(gnu packages commencement))
- 'guile-final))
-
- (parameterize ((%guile-for-build (or guile-for-build
- (package-derivation store
- (default-guile)
- system)))
- (%current-system system))
- (mval store)))
-
;;; monads.scm end here