futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

size: Pass 'requisites' a list of items.

Browse Source 
* guix/scripts/size.scm (substitutable-requisites): Change 'item' to
'items' and adjust.
(requisites*): Likewise.
(mappend-map): Remove.
(store-profile): Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2016-05-24 23:41:30 +02:00
parent f6fee16e93
commit 92ed837a1e
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 8 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
guix/scripts/size.scm
View File

@ -97,10 +97,10 @@ if ITEM is not in the store."
(define display-profile* (define display-profile*
(lift display-profile %store-monad)) (lift display-profile %store-monad))
(define (substitutable-requisites store item) (define (substitutable-requisites store items)
"Return the list of requisites of ITEM based on information available in "Return the list of requisites of ITEMS based on information available in
substitutes." substitutes."
(let loop ((items (list item)) (let loop ((items items)
(result '())) (result '()))
(match items (match items
(() (()
@ -114,27 +114,20 @@ substitutes."
(append (append-map substitutable-references info) (append (append-map substitutable-references info)
result))))))) result)))))))
(define (requisites* item) (define (requisites* items)
"Return as a monadic value the requisites of ITEMS, based either on the "Return as a monadic value the requisites of ITEMS, based either on the
information available in the local store or using information about information available in the local store or using information about
substitutes." substitutes."
(lambda (store) (lambda (store)
(guard (c ((nix-protocol-error? c) (guard (c ((nix-protocol-error? c)
(values (substitutable-requisites store item) (values (substitutable-requisites store items)
store))) store)))
(values (requisites store (list item)) store)))) (values (requisites store items) store))))
(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) (define (store-profile items)
"Return as a monadic value a list of <profile> objects representing the "Return as a monadic value a list of <profile> objects representing the
profile of ITEMS and their requisites." profile of ITEMS and their requisites."
(mlet* %store-monad ((refs (>>= (mappend-map requisites* items) (mlet* %store-monad ((refs (>>= (requisites* items)
(lambda (refs) (lambda (refs)
(return (delete-duplicates (return (delete-duplicates
(append items refs)))))) (append items refs))))))
@ -145,7 +138,7 @@ profile of ITEMS and their requisites."
(return (cons item size))))) (return (cons item size)))))
refs))) refs)))
(define (dependency-size item) (define (dependency-size item)
(mlet %store-monad ((deps (requisites* item))) (mlet %store-monad ((deps (requisites* (list item))))
(foldm %store-monad (foldm %store-monad
(lambda (item total) (lambda (item total)
(return (+ (assoc-ref sizes item) total))) (return (+ (assoc-ref sizes item) total)))