diff --git a/doc.am b/doc.am index ee896c189b..9d72b11caa 100644 --- a/doc.am +++ b/doc.am @@ -40,7 +40,9 @@ doc/os-config-%.texi: gnu/system/examples/%.tmpl cp "$<" "$@" 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 # in an Info or PDF document. diff --git a/doc/guix.texi b/doc/guix.texi index a669464feb..f9c9f2ab93 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4038,10 +4038,23 @@ reports information based on information about the available substitutes (@pxref{Substitutes}). This allows it to profile disk usage of store items that are not even on disk, only available remotely. -A single option is available: +The available options are: @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} @itemx -s @var{system} Consider packages for @var{system}---e.g., @code{x86_64-linux}. diff --git a/doc/images/coreutils-size-map.png b/doc/images/coreutils-size-map.png new file mode 100644 index 0000000000..21d73a8458 Binary files /dev/null and b/doc/images/coreutils-size-map.png differ diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm index 2fe2f02356..13341fdfe2 100644 --- a/guix/scripts/size.scm +++ b/guix/scripts/size.scm @@ -183,6 +183,45 @@ (define* (ensure-store-item spec-or-item) ;; substitute meta-data. (return (derivation->output-path drv output))))))) + +;;; +;;; Charts. +;;; + +;; Autoload Guile-Charting. +;; XXX: Use this hack instead of #:autoload to avoid compilation errors. +;; See . +(module-autoload! (current-module) + '(charting) '(make-page-map)) + +(define (profile->page-map profiles file) + "Write a 'page map' chart of PROFILES, a list of 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 + (($ name self) + (let ((self (inexact->exact + (round (/ self (expt 2. 10)))))) + (values `((,(strip name) ,offset . ,self) + ,@result) + (+ offset self)))))) + '() + 0 + (sort profiles + (match-lambda* + ((($ _ _ total1) ($ _ _ 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. @@ -191,6 +230,8 @@ (define* (ensure-store-item spec-or-item) (define (show-help) (display (_ "Usage: guix size [OPTION]... PACKAGE Report the size of PACKAGE and its dependencies.\n")) + (display (_ " + -m, --map-file=FILE write to FILE a graphical map of disk usage")) (display (_ " -s, --system=SYSTEM consider packages for SYSTEM--e.g., \"i686-linux\"")) (newline) @@ -207,6 +248,9 @@ (define %options (lambda (opt name arg result) (alist-cons 'system arg (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 (lambda args (show-help) @@ -230,6 +274,7 @@ (define (guix-size . args) (('argument . file) file) (_ #f)) opts)) + (map-file (assoc-ref opts 'map-file)) (system (assoc-ref opts 'system))) (match files (() @@ -239,7 +284,11 @@ (define (guix-size . args) (run-with-store store (mlet* %store-monad ((item (ensure-store-item file)) (profile (store-profile item))) - (display-profile* profile)) + (if map-file + (begin + (profile->page-map profile map-file) + (return #t)) + (display-profile* profile))) #:system system))) ((files ...) (leave (_ "too many arguments\n")))))))