size: 'store-profile' takes a list of store items.
* guix/scripts/size.scm (mappend-map): New procedure. (store-profile): Change 'item' to 'items' and adjust code accordingly. (guix-size): Update caller. * tests/size.scm ("store-profile"): Likewise.
This commit is contained in:
parent
a61cd1d0fd
commit
a371aa225c
@ -123,13 +123,20 @@ substitutes."
|
||||
store)))
|
||||
(values (requisites store item) store))))
|
||||
|
||||
(define (store-profile item)
|
||||
(define (mappend-map mproc lst)
|
||||
"Apply MPROC to each item of LST and concatenate the resulting list."
|
||||
(with-monad %store-monad
|
||||
(>>= (mapm %store-monad mproc lst)
|
||||
(lambda (lstlst)
|
||||
(return (concatenate lstlst))))))
|
||||
|
||||
(define (store-profile items)
|
||||
"Return as a monadic value a list of <profile> objects representing the
|
||||
profile of ITEM and its requisites."
|
||||
(mlet* %store-monad ((refs (>>= (requisites* item)
|
||||
profile of ITEMS and their requisites."
|
||||
(mlet* %store-monad ((refs (>>= (mappend-map requisites* items)
|
||||
(lambda (refs)
|
||||
(return (delete-duplicates
|
||||
(cons item refs))))))
|
||||
(append items refs))))))
|
||||
(sizes (mapm %store-monad
|
||||
(lambda (item)
|
||||
(>>= (file-size item)
|
||||
@ -286,7 +293,7 @@ Report the size of PACKAGE and its dependencies.\n"))
|
||||
|
||||
(run-with-store store
|
||||
(mlet* %store-monad ((item (ensure-store-item file))
|
||||
(profile (store-profile item)))
|
||||
(profile (store-profile (list item))))
|
||||
(if map-file
|
||||
(begin
|
||||
(profile->page-map profile map-file)
|
||||
|
@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@ -54,7 +54,7 @@
|
||||
(mbegin %store-monad
|
||||
(built-derivations (list file2))
|
||||
(mlet %store-monad ((profiles (store-profile
|
||||
(derivation->output-path file2)))
|
||||
(list (derivation->output-path file2))))
|
||||
(bash (interned-file
|
||||
(search-bootstrap-binary
|
||||
"bash" (%current-system)) "bash"
|
||||
|
Loading…
Reference in New Issue
Block a user