03/03: size: Add '--map-file' option.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit a8f996c605c181e5adae0de24b235d463825beab
Author: Ludovic Courtès <address@hidden>
Date:   Sun Jun 21 23:25:19 2015 +0200

    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.
---
 doc.am                            |    4 ++-
 doc/guix.texi                     |   15 ++++++++++-
 doc/images/coreutils-size-map.png |  Bin 0 -> 6755 bytes
 guix/scripts/size.scm             |   51 ++++++++++++++++++++++++++++++++++++-
 4 files changed, 67 insertions(+), 3 deletions(-)

diff --git a/doc.am b/doc.am
index ee896c1..9d72b11 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 a669464..f9c9f2a 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
 
address@hidden address@hidden
+Write to @var{file} a graphical map of disk usage as a PNG file.
+
+For the example above, the map looks like this:
+
address@hidden/coreutils-size-map,5in,, map of Coreutils disk usage
+produced by @command{guix size}}
+
+This option requires that
address@hidden://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 address@hidden
 @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 0000000..21d73a8
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 2fe2f02..13341fd 100644
--- a/guix/scripts/size.scm
+++ b/guix/scripts/size.scm
@@ -185,6 +185,45 @@ as \"guile:debug\" or \"gcc-4.8\" and return its store 
file name."
 
 
 ;;;
+;;; 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.
 ;;;
 
@@ -192,6 +231,8 @@ as \"guile:debug\" or \"gcc-4.8\" and return its store file 
name."
   (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)
   (display (_ "
@@ -207,6 +248,9 @@ Report the size of PACKAGE and its dependencies.\n"))
                 (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 @@ Report the size of PACKAGE and its dependencies.\n"))
                                    (('argument . file) file)
                                    (_ #f))
                                  opts))
+           (map-file (assoc-ref opts 'map-file))
            (system   (assoc-ref opts 'system)))
       (match files
         (()
@@ -239,7 +284,11 @@ 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)))
-               (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")))))))