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:
Ludovic Courtès 2015-06-21 23:25:19 +02:00
parent 550bd3f2da
commit a8f996c605
4 changed files with 67 additions and 3 deletions

4
doc.am
View File

@ -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.

View File

@ -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}.

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.6 KiB

View File

@ -183,6 +183,45 @@ as \"guile:debug\" or \"gcc-4.8\" and return its store file name."
;; 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 @@ as \"guile:debug\" or \"gcc-4.8\" and return its store file name."
(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 @@ Report the size of PACKAGE and its dependencies.\n"))
(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 @@ Report the size of PACKAGE and its dependencies.\n"))
(('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 @@ Report the size of PACKAGE and its dependencies.\n"))
(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")))))))