;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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)
  #:use-module (gnu packages bootstrap)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-64))


(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
                                     (list (derivation->output-path file2))))
                          (bash     (interned-file
                                     (search-bootstrap-binary
                                      "bash" (%current-system)) "bash"
                                      #:recursive? #t))
                          (guile    (package->derivation %bootstrap-guile)))
        (define (lookup-profile item)
          (find (matching-profile (if (derivation? item)
                                      (derivation->output-path item)
                                      item))
                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) 4)
                       (match* ((file1 => profile1)
                                (file2 => profile2)
                                (guile => profile3)
                                (bash  => profile4)) ;dependency of GUILE
                         (and (> (profile-closure-size profile2) 0)
                              (= (profile-closure-size profile2)
                                 (+ (profile-self-size profile1)
                                    (profile-self-size profile2)
                                    (profile-self-size profile3)
                                    (profile-self-size profile4))))))))))))

(test-assertm "store-profile with multiple items"
  (mlet* %store-monad ((file1 (gexp->derivation "file1"
                                                #~(symlink #$%bootstrap-guile
                                                           #$output)))
                       (file2 (text-file* "file2"
                                          "the file => " file1)))
    (mbegin %store-monad
      (built-derivations (list file2))
      (mlet %store-monad ((profiles  (store-profile
                                      (list (derivation->output-path file2)
                                            (derivation->output-path file1))))
                          (reference (store-profile
                                      (list (derivation->output-path file2)))))
        (return (and (= (length profiles) 4)
                     (lset= equal? profiles reference)))))))

(test-end "size")

;;; Local Variables:
;;; eval: (put 'match* 'scheme-indent-function 1)
;;; End:
n-json-cpp): Likewise.
* gnu/packages/games.scm (openrct2)[inputs]: Adjust accordingly.
* gnu/packages/cups.scm (escpr): Likewise.
* gnu/packages/django.scm (python-django-jsonfield): Likewise.
* gnu/packages/emacs-xyz.scm (emacs-modus-operandi-theme)
(emacs-modus-vivendi-theme): Likewise.
* gnu/packages/engineering.scm (kicad-i18l): Likewise.
* gnu/packages/enlightenment.scm (enlightenment-wayland): Likewise.
* gnu/packages/firmware.scm (opensbi-qemu-virt, opensbi-qemu-sifive-u):
Likewise.
* gnu/packages/fonts.scm (font-gnu-freefont-ttf, font-open-dyslexic):
Likewise.
* gnu/packages/game-development.scm (guile3.0-chickadee)
(python-sge-pygame): Likewise.
* gnu/packages/games.scm (retux)[inputs]: Adjust accordingly.
* gnu/packages/gnome-xyz.scm (numix-theme): Likewise.
* gnu/packages/gnupg.scm (guile3.0-gcrypt): Likewise.
* gnu/packages/gstreamer.scm (gst-transcoder): Likewise.
* gnu/packages/gtk.scm (guile3.0-cairo, guile3.0-present, guile3.0-rsvg):
Likewise.
* gnu/packages/guile-xyz.scm (guile3.0-colorized, guile3.0-commonmark)
(guile3.0-config, guile3.0-email, guile3.0-fibers, guile3.0-gi)
(guile3.0-hall, guile3.0-hashing, guile3.0-haunt, guile3.0-ics)
(guile3.0-irregex, guile3.0-lib, guile3.0-mcron, guile3.0-minikanren)
(guile3.0-ncurses, guile3.0-ncurses/gpm, guile3.0-newt, guile3.0-parted)
(guile3.0-pfds, guile3.0-picture-language, guile3.0-semver)
(guile3.0-simple-zmq, guile3.0-squee, guile3.0-syntax-highlight)
(guile3.0-websocket, guile3.0-wisp, guile3.0-xapian): Likewise.
* gnu/packages/guile.scm (define-deprecated-guile3.0-package)
(guile3.0-json, guile3.0-gdbm-ffi, guile3.0-sqlite3)
(guile3.0-bytestructures, guile3.0-git): Likewise.
* gnu/packages/haskell-apps.scm (ghc-stylish-haskell): Likewise.
* gnu/packages/linux.scm (linux-libre-arm-veyron): Likewise.
* gnu/packages/mail.scm (guile3.0-mailutils): Likewise.
* gnu/packages/monitoring.scm (python2-graphite-web): Likewise.
* gnu/packages/package-management.scm (guile3.0-guix): Likewise.
* gnu/packages/package-management.scm (python-conda): Likewise.
* gnu/packages/phabricator.scm (libphutil): Likewise.
* gnu/packages/plotutils.scm (guile3.0-charting): Likewise.
* gnu/packages/python-xyz.scm (python2-smmap2, python-glances)
(python-smmap2): Likewise.
* gnu/packages/shells.scm (oil-shell): Likewise.
* gnu/packages/sqlite.scm (sqlite-with-column-metadata): Likewise.
* gnu/packages/ssh.scm (guile3.0-ssh): Likewise.
* gnu/packages/terminals.scm (et): Likewise.
* gnu/packages/tls.scm (guile3.0-gnutls): Likewise.
* gnu/packages/vlang.scm (v): Likewise.
* gnu/packages/vpn.scm (wireguard): Likewise.
* gnu/packages/web-browsers.scm (next, sbcl-next): Likewise.
* gnu/packages/xorg.scm (transset-df): Likewise.


</td></tr>