guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

05/05: Add 'guix size'.


From: Ludovic Courtès
Subject: 05/05: Add 'guix size'.
Date: Wed, 17 Jun 2015 22:36:28 +0000

civodul pushed a commit to branch master
in repository guix.

commit fcc58db68b2af59dea0cae41bc1e2df47911d588
Author: Ludovic Courtès <address@hidden>
Date:   Thu Jun 18 00:22:13 2015 +0200

    Add 'guix size'.
    
    * guix/scripts/size.scm: New file.
    * Makefile.am (MODULES): Add it.
      (SCM_TESTS): Add tests/size.scm.
    * doc.am (SUBCOMMANDS): Add 'size'.
    * po/guix/POTFILES.in: Add guix/scripts/size.scm.
    * tests/size.scm: New file.
    * doc/guix.texi (Packages with Multiple Outputs): Add xref to "Invoking guix
      size".
      (Invoking guix size): New node.
      (Invoking guix gc): Add index for "closure" and xref to the above.
    * doc/contributing.texi (Submitting Patches): Use @enumerate for the check
      list.  Add item about 'guix size'.
---
 Makefile.am           |    4 +-
 doc.am                |    1 +
 doc/contributing.texi |   28 +++++-
 doc/guix.texi         |   78 +++++++++++++++-
 guix/scripts/size.scm |  247 +++++++++++++++++++++++++++++++++++++++++++++++++
 po/guix/POTFILES.in   |    1 +
 tests/size.scm        |   87 +++++++++++++++++
 7 files changed, 438 insertions(+), 8 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index 784848d..9b1d31c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -114,6 +114,7 @@ MODULES =                                   \
   guix/scripts/environment.scm                 \
   guix/scripts/publish.scm                     \
   guix/scripts/edit.scm                                \
+  guix/scripts/size.scm                                \
   guix.scm                                     \
   $(GNU_SYSTEM_MODULES)
 
@@ -192,7 +193,8 @@ SCM_TESTS =                                 \
   tests/syscalls.scm                           \
   tests/gremlin.scm                            \
   tests/lint.scm                               \
-  tests/publish.scm
+  tests/publish.scm                            \
+  tests/size.scm
 
 if HAVE_GUILE_JSON
 
diff --git a/doc.am b/doc.am
index 1c52066..ee896c1 100644
--- a/doc.am
+++ b/doc.am
@@ -100,6 +100,7 @@ SUBCOMMANDS :=                                      \
   publish                                      \
   pull                                         \
   refresh                                      \
+  size                                         \
   system
 
 $(eval $(foreach subcommand,$(SUBCOMMANDS),                    \
diff --git a/doc/contributing.texi b/doc/contributing.texi
index 536f223..7b16ea3 100644
--- a/doc/contributing.texi
+++ b/doc/contributing.texi
@@ -203,14 +203,32 @@ standards, GNU Coding Standards}); you can check the 
commit history for
 examples.
 
 Before submitting a patch that adds or modifies a package definition,
-please run @code{guix lint @var{package}}, where @var{package} is the
+please run through this check list:
+
address@hidden
address@hidden
+Run @code{guix lint @var{package}}, where @var{package} is the
 name of the new or modified package, and fix any errors it reports
-(@pxref{Invoking guix lint}).  In addition, please make sure the package
-builds on your platform, using @code{guix build @var{package}}.  You may
-also want to check that dependent package (if applicable) are not
-affected by the change; @code{guix refresh --list-dependent
+(@pxref{Invoking guix lint}).
+
address@hidden
+Make sure the package builds on your platform, using @code{guix build
address@hidden
+
address@hidden
+Take a look at the profile reported by @command{guix size}
+(@pxref{Invoking guix size}).  This will allow you to notice references
+to other packages unwillingly retained.  It may also help determine
+whether to split the package (@pxref{Packages with Multiple Outputs}),
+and which optional dependencies should be used.
+
address@hidden
+For important changes, check that dependent package (if applicable) are
+not affected by the change; @code{guix refresh --list-dependent
 @var{package}} will help you do that (@pxref{Invoking guix refresh}).
 
address@hidden enumerate
+
 When posting a patch to the mailing list, use @samp{[PATCH] @dots{}} as a
 subject.  You may use your email client or the @command{git send-mail}
 command.
diff --git a/doc/guix.texi b/doc/guix.texi
index a93003d..a669464 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -124,12 +124,13 @@ Defining Packages
 Utilities
 
 * Invoking guix build::         Building packages from the command line.
-* Invoking guix edit::
+* Invoking guix edit::          Editing package definitions.
 * Invoking guix download::      Downloading a file and printing its hash.
 * Invoking guix hash::          Computing the cryptographic hash of a file.
 * Invoking guix import::        Importing package definitions.
 * Invoking guix refresh::       Updating package definitions.
 * Invoking guix lint::          Finding errors in package definitions.
+* Invoking guix size::          Profiling disk usage.
 * Invoking guix environment::   Setting up development environments.
 * Invoking guix publish::       Sharing substitutes.
 
@@ -1495,7 +1496,8 @@ graphical user interfaces (GUIs).  The former depend 
solely on the C
 library, whereas the latter depend on Tcl/Tk and the underlying X
 libraries.  In this case, we leave the command-line tools in the default
 output, whereas the GUIs are in a separate output.  This allows users
-who do not need the GUIs to save space.
+who do not need the GUIs to save space.  The @command{guix size} command
+can help find out about such situations (@pxref{Invoking guix size}).
 
 There are several such multiple-output packages in the GNU distribution.
 Other conventional output names include @code{lib} for libraries and
@@ -1575,11 +1577,15 @@ as arguments.
 
 @item --requisites
 @itemx -R
address@hidden closure
 List the requisites of the store files passed as arguments.  Requisites
 include the store files themselves, their references, and the references
 of these, recursively.  In other words, the returned list is the
 @dfn{transitive closure} of the store files.
 
address@hidden guix size}, for a tool to profile the size of an
+element's closure.
+
 @end table
 
 Lastly, the following options allow you to check the integrity of the
@@ -3271,6 +3277,7 @@ programming interface of Guix in a convenient way.
 * Invoking guix import::        Importing package definitions.
 * Invoking guix refresh::       Updating package definitions.
 * Invoking guix lint::          Finding errors in package definitions.
+* Invoking guix size::          Profiling disk usage.
 * Invoking guix environment::   Setting up development environments.
 * Invoking guix publish::       Sharing substitutes.
 @end menu
@@ -3974,6 +3981,73 @@ and exit.
 
 @end table
 
address@hidden Invoking guix size
address@hidden Invoking @command{guix size}
+
+The @command{guix size} command helps package developers profile the
+disk usage of packages.  It is easy to overlook the impact of an
+additional dependency added to a package, or the impact of using a
+single output for a package that could easily be split (@pxref{Packages
+with Multiple Outputs}).  These are the typical issues that
address@hidden size} can highlight.
+
+The command can be passed a package specification such as @code{gcc-4.8}
+or @code{guile:debug}, or a file name in the store.  Consider this
+example:
+
address@hidden
+$ guix size coreutils
+store item                               total    self
+/gnu/store/@dots{}-coreutils-8.23          70.0    13.9  19.8%
+/gnu/store/@dots{}-gmp-6.0.0a              55.3     2.5   3.6%
+/gnu/store/@dots{}-acl-2.2.52              53.7     0.5   0.7%
+/gnu/store/@dots{}-attr-2.4.46             53.2     0.3   0.5%
+/gnu/store/@dots{}-gcc-4.8.4-lib           52.9    15.7  22.4%
+/gnu/store/@dots{}-glibc-2.21              37.2    37.2  53.1%
address@hidden example
+
address@hidden closure
+The store items listed here constitute the @dfn{transitive closure} of
+Coreutils---i.e., Coreutils and all its dependencies, recursively---as
+would be returned by:
+
address@hidden
+$ guix gc -R /gnu/store/@dots{}-coreutils-8.23
address@hidden example
+
+Here the output shows 3 columns next to store items.  The first column,
+labeled ``total'', shows the size in mebibytes (MiB) of the closure of
+the store item---that is, its own size plus the size of all its
+dependencies.  The next column, labeled ``self'', shows the size of the
+item itself.  The last column shows the ratio of the item's size to the
+space occupied by all the items listed here.
+
+In this example, we see that the closure of Coreutils weighs in at
address@hidden, half of which is taken by libc.  (That libc represents a
+large fraction of the closure is not a problem @i{per se} because it is
+always available on the system anyway.)
+
+When the package passed to @command{guix size} is available in the
+store, @command{guix size} queries the daemon to determine its
+dependencies, and measures its size in the store, similar to @command{du
+-ms --apparent-size} (@pxref{du invocation,,, coreutils, GNU
+Coreutils}).
+
+When the given package is @emph{not} in the store, @command{guix size}
+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:
+
address@hidden @option
+
address@hidden address@hidden
address@hidden -s @var{system}
+Consider packages for @var{system}---e.g., @code{x86_64-linux}.
+
address@hidden table
+
 @node Invoking guix environment
 @section Invoking @command{guix environment}
 
diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm
new file mode 100644
index 0000000..41dd604
--- /dev/null
+++ b/guix/scripts/size.scm
@@ -0,0 +1,247 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Ludovic Courtès <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts size)
+  #:use-module (guix ui)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:use-module (guix utils)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
+  #:use-module (gnu packages)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:export (profile?
+            profile-file
+            profile-self-size
+            profile-closure-size
+            store-profile
+
+            guix-size))
+
+;; Size profile of a store item.
+(define-record-type <profile>
+  (profile file self-size closure-size)
+  profile?
+  (file          profile-file)                 ;store item
+  (self-size     profile-self-size)            ;size in bytes
+  (closure-size  profile-closure-size))        ;size of dependencies in bytes
+
+(define (file-size file)
+  "Return the size of bytes of FILE, entering it if FILE is a directory."
+  (file-system-fold (const #t)
+                    (lambda (file stat result)    ;leaf
+                      (+ (stat:size stat) result))
+                    (lambda (directory stat result) ;down
+                      (+ (stat:size stat) result))
+                    (lambda (directory stat result) ;up
+                      result)
+                    (lambda (file stat result)    ;skip
+                      result)
+                    (lambda (file stat errno result)
+                      (format (current-error-port)
+                              "file-size: ~a: ~a~%" file
+                              (strerror errno))
+                      result)
+                    0
+                    file
+                    lstat))
+
+(define substitutable-path-info*
+  (store-lift substitutable-path-info))
+
+(define (store-item-exists? item)
+  "Return #t if ITEM is in the store, and protect it from GC.  Otherwise
+return #f."
+  (lambda (store)
+    (add-temp-root store item)
+    (values (valid-path? store item) store)))
+
+(define (file-size* item)
+  "Like 'file-size', but resort to information from substitutes if ITEM is not
+in the store."
+  (mlet %store-monad ((exists? (store-item-exists? item)))
+    (if exists?
+        (return (file-size item))
+        (mlet %store-monad ((info (substitutable-path-info* (list item))))
+          (match info
+            ((info)
+             ;; The nar size is an approximation, but a good one.
+             (return (substitutable-nar-size info)))
+            (()
+             (leave (_ "no available substitute information for '~a'~%")
+                    item)))))))
+
+(define* (display-profile profile #:optional (port (current-output-port)))
+  "Display PROFILE, a list of PROFILE objects, to PORT."
+  (define MiB (expt 2 20))
+
+  (format port "~64a ~8a ~a\n"
+          (_ "store item") (_ "total") (_ "self"))
+  (let ((whole (reduce + 0 (map profile-self-size profile))))
+    (for-each (match-lambda
+                (($ <profile> name self total)
+                 (format port "~64a  ~6,1f  ~6,1f ~5,1f%\n"
+                         name (/ total MiB) (/ self MiB)
+                         (* 100. (/ self whole 1.)))))
+              (sort profile
+                    (match-lambda*
+                      ((($ <profile> _ _ total1) ($ <profile> _ _ total2))
+                       (> total1 total2)))))))
+
+(define display-profile*
+  (lift display-profile %store-monad))
+
+(define (substitutable-requisites store item)
+  "Return the list of requisites of ITEM based on information available in
+substitutes."
+  (let loop ((items  (list item))
+             (result '()))
+    (match items
+      (()
+       (delete-duplicates result))
+      (items
+       (let ((info (substitutable-path-info store
+                                            (delete-duplicates items))))
+         (loop (remove (lambda (item)             ;XXX: complexity
+                         (member item result))
+                       (append-map substitutable-references info))
+               (append (append-map substitutable-references info)
+                       result)))))))
+
+(define (requisites* item)
+  "Return as a monadic value the requisites of ITEMS, based either on the
+information available in the local store or using information about
+substitutes."
+  (lambda (store)
+    (guard (c ((nix-protocol-error? c)
+               (values (substitutable-requisites store item)
+                       store)))
+      (values (requisites store item) store))))
+
+(define (store-profile item)
+  "Return as a monadic value a list of <profile> objects representing the
+profile of ITEM and its requisites."
+  (mlet* %store-monad ((refs  (>>= (requisites* item)
+                                   (lambda (refs)
+                                     (return (delete-duplicates
+                                              (cons item refs))))))
+                       (sizes (mapm %store-monad
+                                    (lambda (item)
+                                      (>>= (file-size* item)
+                                           (lambda (size)
+                                             (return (cons item size)))))
+                                    refs)))
+    (define (dependency-size item)
+      (mlet %store-monad ((deps (requisites* item)))
+        (foldm %store-monad
+               (lambda (item total)
+                 (return (+ (assoc-ref sizes item) total)))
+               0
+               (delete-duplicates (cons item deps)))))
+
+    (mapm %store-monad
+          (match-lambda
+            ((item . size)
+             (mlet %store-monad ((dependencies (dependency-size item)))
+               (return (profile item size dependencies)))))
+          sizes)))
+
+(define* (ensure-store-item spec-or-item
+                            #:key dry-run?)
+  "Return a store file name.  If SPEC-OR-ITEM is a store file name, return it
+as is.  Otherwise, assume SPEC-OR-ITEM is a package output specification such
+as \"guile:debug\" or \"gcc-4.8\" and return its store file name."
+  (with-monad %store-monad
+    (if (store-path? spec-or-item)
+        (return spec-or-item)
+        (let-values (((package output)
+                      (specification->package+output spec-or-item)))
+          (mlet %store-monad ((drv (package->derivation package)))
+            ;; Note: we don't try building DRV like 'guix archive' does
+            ;; because we don't have to since we can instead rely on
+            ;; substitute meta-data.
+            (return (derivation->output-path drv output)))))))
+
+
+;;;
+;;; Options.
+;;;
+
+(define (show-help)
+  (display (_ "Usage: guix size [OPTION]... PACKAGE
+Report the size of PACKAGE and its dependencies.\n"))
+  (display (_ "
+  -s, --system=SYSTEM    consider packages for SYSTEM--e.g., \"i686-linux\""))
+  (newline)
+  (display (_ "
+  -h, --help             display this help and exit"))
+  (display (_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specifications of the command-line options.
+  (list (option '(#\s "system") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'system arg
+                              (alist-delete 'system result eq?))))
+        (option '(#\h "help") #f #f
+                (lambda args
+                  (show-help)
+                  (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda args
+                  (show-version-and-exit "guix size")))))
+
+(define %default-options
+  `((system . ,(%current-system))))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-size . args)
+  (with-error-handling
+    (let* ((opts     (parse-command-line args %options (list 
%default-options)))
+           (files    (filter-map (match-lambda
+                                   (('argument . file) file)
+                                   (_ #f))
+                                 opts))
+           (system   (assoc-ref opts 'system))
+           (dry-run? (assoc-ref opts 'dry-run?)))
+      (match files
+        (()
+         (leave (_ "missing store item argument\n")))
+        ((file)
+         (with-store store
+           (run-with-store store
+             (mlet* %store-monad ((item    (ensure-store-item file))
+                                  (profile (store-profile item)))
+               (display-profile* profile))
+             #:system system)))
+        ((files ...)
+         (leave (_ "too many arguments\n")))))))
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index 300486b..247fe2c 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -17,6 +17,7 @@ guix/scripts/system.scm
 guix/scripts/lint.scm
 guix/scripts/publish.scm
 guix/scripts/edit.scm
+guix/scripts/size.scm
 guix/gnu-maintenance.scm
 guix/ui.scm
 guix/http-client.scm
diff --git a/tests/size.scm b/tests/size.scm
new file mode 100644
index 0000000..95b99a8
--- /dev/null
+++ b/tests/size.scm
@@ -0,0 +1,87 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Ludovic Courtès <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-size)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
+  #:use-module (guix gexp)
+  #:use-module (guix tests)
+  #:use-module (guix scripts size)
+  #:use-module (gnu packages bootstrap)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64))
+
+(define %store
+  (open-connection-for-tests))
+
+(define-syntax-rule (test-assertm name exp)
+  (test-assert name
+    (run-with-store %store exp
+                    #:guile-for-build (%guile-for-build))))
+
+
+(test-begin "size")
+
+(test-assertm "store-profile"
+  (mlet* %store-monad ((file1 (gexp->derivation "file1"
+                                                #~(symlink #$%bootstrap-guile
+                                                           #$output)))
+                       (file2 (text-file* "file2"
+                                          "the file => " file1)))
+    (define (matching-profile item)
+      (lambda (profile)
+        (string=? item (profile-file profile))))
+
+    (mbegin %store-monad
+      (built-derivations (list file2))
+      (mlet %store-monad ((profiles (store-profile
+                                     (derivation->output-path file2)))
+                          (guile    (package->derivation %bootstrap-guile)))
+        (define (lookup-profile drv)
+          (find (matching-profile (derivation->output-path drv))
+                profiles))
+
+        (letrec-syntax ((match* (syntax-rules (=>)
+                                  ((_ ((drv => profile) rest ...) body)
+                                   (match (lookup-profile drv)
+                                     ((? profile? profile)
+                                      (match* (rest ...) body))))
+                                  ((_ () body)
+                                   body))))
+          ;; Make sure we get all three profiles with sensible values.
+          (return (and (= (length profiles) 3)
+                       (match* ((file1 => profile1)
+                                (file2 => profile2)
+                                (guile => profile3))
+                         (and (> (profile-closure-size profile2) 0)
+                              (= (profile-closure-size profile2)
+                                 (+ (profile-self-size profile1)
+                                    (profile-self-size profile2)
+                                    (profile-self-size profile3))))))))))))
+
+(test-end "size")
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
+
+;;; Local Variables:
+;;; eval: (put 'match* 'scheme-indent-function 1)
+;;; End:



reply via email to

[Prev in Thread] Current Thread [Next in Thread]