summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-06-21 23:25:19 +0200
committerLudovic Courtès <ludo@gnu.org>2015-06-21 23:39:12 +0200
commita8f996c605c181e5adae0de24b235d463825beab (patch)
tree961a6ab8c294261cf3e8ac67514a6abf68e6cdab
parent550bd3f2da055f05760a439804d77facea7b2202 (diff)
downloadguix-a8f996c605c181e5adae0de24b235d463825beab.tar.gz
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.
-rw-r--r--doc.am4
-rw-r--r--doc/guix.texi15
-rw-r--r--doc/images/coreutils-size-map.pngbin0 -> 6755 bytes
-rw-r--r--guix/scripts/size.scm51
4 files changed, 67 insertions, 3 deletions
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
--- /dev/null
+++ b/doc/images/coreutils-size-map.png
Binary files differdiff --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
@@ -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")))))))