mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
size: Add '--map-file' option.
* guix/scripts/size.scm (profile->page-map): New procedures. (show-help, %options): Add --map-file. (guix-size): Honor it. * doc/guix.texi (Invoking guix size): Document it. * doc/images/coreutils-size-map.png: New file. * doc.am (dist_infoimage_DATA): Add it.
This commit is contained in:
parent
550bd3f2da
commit
a8f996c605
4 changed files with 67 additions and 3 deletions
4
doc.am
4
doc.am
|
@ -40,7 +40,9 @@ doc/os-config-%.texi: gnu/system/examples/%.tmpl
|
||||||
cp "$<" "$@"
|
cp "$<" "$@"
|
||||||
|
|
||||||
infoimagedir = $(infodir)/images
|
infoimagedir = $(infodir)/images
|
||||||
dist_infoimage_DATA = doc/images/bootstrap-graph.png
|
dist_infoimage_DATA = \
|
||||||
|
doc/images/bootstrap-graph.png \
|
||||||
|
doc/images/coreutils-size-map.png
|
||||||
|
|
||||||
# Try hard to obtain an image size and aspect that's reasonable for inclusion
|
# Try hard to obtain an image size and aspect that's reasonable for inclusion
|
||||||
# in an Info or PDF document.
|
# in an Info or PDF document.
|
||||||
|
|
|
@ -4038,10 +4038,23 @@ reports information based on information about the available substitutes
|
||||||
(@pxref{Substitutes}). This allows it to profile disk usage of store
|
(@pxref{Substitutes}). This allows it to profile disk usage of store
|
||||||
items that are not even on disk, only available remotely.
|
items that are not even on disk, only available remotely.
|
||||||
|
|
||||||
A single option is available:
|
The available options are:
|
||||||
|
|
||||||
@table @option
|
@table @option
|
||||||
|
|
||||||
|
@item --map-file=@var{file}
|
||||||
|
Write to @var{file} a graphical map of disk usage as a PNG file.
|
||||||
|
|
||||||
|
For the example above, the map looks like this:
|
||||||
|
|
||||||
|
@image{images/coreutils-size-map,5in,, map of Coreutils disk usage
|
||||||
|
produced by @command{guix size}}
|
||||||
|
|
||||||
|
This option requires that
|
||||||
|
@uref{http://wingolog.org/software/guile-charting/, Guile-Charting} be
|
||||||
|
installed and visible in Guile's module search path. When that is not
|
||||||
|
the case, @command{guix size} fails as it tries to load it.
|
||||||
|
|
||||||
@item --system=@var{system}
|
@item --system=@var{system}
|
||||||
@itemx -s @var{system}
|
@itemx -s @var{system}
|
||||||
Consider packages for @var{system}---e.g., @code{x86_64-linux}.
|
Consider packages for @var{system}---e.g., @code{x86_64-linux}.
|
||||||
|
|
BIN
doc/images/coreutils-size-map.png
Normal file
BIN
doc/images/coreutils-size-map.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 6.6 KiB |
|
@ -183,6 +183,45 @@ (define* (ensure-store-item spec-or-item)
|
||||||
;; substitute meta-data.
|
;; substitute meta-data.
|
||||||
(return (derivation->output-path drv output)))))))
|
(return (derivation->output-path drv output)))))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Charts.
|
||||||
|
;;;
|
||||||
|
|
||||||
|
;; Autoload Guile-Charting.
|
||||||
|
;; XXX: Use this hack instead of #:autoload to avoid compilation errors.
|
||||||
|
;; See <http://bugs.gnu.org/12202>.
|
||||||
|
(module-autoload! (current-module)
|
||||||
|
'(charting) '(make-page-map))
|
||||||
|
|
||||||
|
(define (profile->page-map profiles file)
|
||||||
|
"Write a 'page map' chart of PROFILES, a list of <profile> objects, to FILE,
|
||||||
|
the name of a PNG file."
|
||||||
|
(define (strip name)
|
||||||
|
(string-drop name (+ (string-length (%store-prefix)) 28)))
|
||||||
|
|
||||||
|
(define data
|
||||||
|
(fold2 (lambda (profile result offset)
|
||||||
|
(match profile
|
||||||
|
(($ <profile> name self)
|
||||||
|
(let ((self (inexact->exact
|
||||||
|
(round (/ self (expt 2. 10))))))
|
||||||
|
(values `((,(strip name) ,offset . ,self)
|
||||||
|
,@result)
|
||||||
|
(+ offset self))))))
|
||||||
|
'()
|
||||||
|
0
|
||||||
|
(sort profiles
|
||||||
|
(match-lambda*
|
||||||
|
((($ <profile> _ _ total1) ($ <profile> _ _ total2))
|
||||||
|
(> total1 total2))))))
|
||||||
|
|
||||||
|
;; TRANSLATORS: This is the title of a graph, meaning that the graph
|
||||||
|
;; represents a profile of the store (the "store" being the place where
|
||||||
|
;; packages are stored.)
|
||||||
|
(make-page-map (_ "store profile") (pk data)
|
||||||
|
#:write-to-png file))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Options.
|
;;; Options.
|
||||||
|
@ -191,6 +230,8 @@ (define* (ensure-store-item spec-or-item)
|
||||||
(define (show-help)
|
(define (show-help)
|
||||||
(display (_ "Usage: guix size [OPTION]... PACKAGE
|
(display (_ "Usage: guix size [OPTION]... PACKAGE
|
||||||
Report the size of PACKAGE and its dependencies.\n"))
|
Report the size of PACKAGE and its dependencies.\n"))
|
||||||
|
(display (_ "
|
||||||
|
-m, --map-file=FILE write to FILE a graphical map of disk usage"))
|
||||||
(display (_ "
|
(display (_ "
|
||||||
-s, --system=SYSTEM consider packages for SYSTEM--e.g., \"i686-linux\""))
|
-s, --system=SYSTEM consider packages for SYSTEM--e.g., \"i686-linux\""))
|
||||||
(newline)
|
(newline)
|
||||||
|
@ -207,6 +248,9 @@ (define %options
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'system arg
|
(alist-cons 'system arg
|
||||||
(alist-delete 'system result eq?))))
|
(alist-delete 'system result eq?))))
|
||||||
|
(option '(#\m "map-file") #t #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(alist-cons 'map-file arg result)))
|
||||||
(option '(#\h "help") #f #f
|
(option '(#\h "help") #f #f
|
||||||
(lambda args
|
(lambda args
|
||||||
(show-help)
|
(show-help)
|
||||||
|
@ -230,6 +274,7 @@ (define (guix-size . args)
|
||||||
(('argument . file) file)
|
(('argument . file) file)
|
||||||
(_ #f))
|
(_ #f))
|
||||||
opts))
|
opts))
|
||||||
|
(map-file (assoc-ref opts 'map-file))
|
||||||
(system (assoc-ref opts 'system)))
|
(system (assoc-ref opts 'system)))
|
||||||
(match files
|
(match files
|
||||||
(()
|
(()
|
||||||
|
@ -239,7 +284,11 @@ (define (guix-size . args)
|
||||||
(run-with-store store
|
(run-with-store store
|
||||||
(mlet* %store-monad ((item (ensure-store-item file))
|
(mlet* %store-monad ((item (ensure-store-item file))
|
||||||
(profile (store-profile item)))
|
(profile (store-profile item)))
|
||||||
(display-profile* profile))
|
(if map-file
|
||||||
|
(begin
|
||||||
|
(profile->page-map profile map-file)
|
||||||
|
(return #t))
|
||||||
|
(display-profile* profile)))
|
||||||
#:system system)))
|
#:system system)))
|
||||||
((files ...)
|
((files ...)
|
||||||
(leave (_ "too many arguments\n")))))))
|
(leave (_ "too many arguments\n")))))))
|
||||||
|
|
Loading…
Reference in a new issue