;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; 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-channels)
  #:use-module (guix channels)
  #:use-module (guix profiles)
  #:use-module ((guix build syscalls) #:select (mkdtemp!))
  #:use-module (guix tests)
  #:use-module (guix store)
  #:use-module ((guix grafts) #:select (%graft?))
  #:use-module (guix derivations)
  #:use-module (guix sets)
  #:use-module (guix gexp)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match))

(test-begin "channels")

(define* (make-instance #:key
                        (name 'fake)
                        (commit "cafebabe")
                        (spec #f))
  (define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX"))
  (and spec
       (with-output-to-file (string-append instance-dir "/.guix-channel")
         (lambda _ (format #t "~a" spec))))
  (checkout->channel-instance instance-dir
                              #:commit commit
                              #:name name))

(define instance--boring (make-instance))
(define instance--no-deps
  (make-instance #:spec
                 '(channel
                   (version 0)
                   (dependencies
                    (channel
                     (name test-channel)
                     (url "https://example.com/test-channel"))))))
(define instance--simple
  (make-instance #:spec
                 '(channel
                   (version 0)
                   (dependencies
                    (channel
                     (name test-channel)
                     (url "https://example.com/test-channel"))))))
(define instance--with-dupes
  (make-instance #:spec
                 '(channel
                   (version 0)
                   (dependencies
                    (channel
                     (name test-channel)
                     (url "https://example.com/test-channel"))
                    (channel
                     (name test-channel)
                     (url "https://example.com/test-channel")
                     (commit "abc1234"))
                    (channel
                     (name test-channel)
                     (url "https://example.com/test-channel-elsewhere"))))))

(define read-channel-metadata
  (@@ (guix channels) read-channel-metadata))


(test-equal "read-channel-metadata returns #f if .guix-channel does not exist"
  #f
  (read-channel-metadata instance--boring))

(test-assert "read-channel-metadata returns <channel-metadata>"
  (every (@@ (guix channels) channel-metadata?)
         (map read-channel-metadata
              (list instance--no-deps
                    instance--simple
                    instance--with-dupes))))

(test-assert "read-channel-metadata dependencies are channels"
  (let ((deps ((@@ (guix channels) channel-metadata-dependencies)
               (read-channel-metadata instance--simple))))
    (match deps
      (((? channel? dep)) #t)
      (_ #f))))

(test-assert "latest-channel-instances includes channel dependencies"
  (let* ((channel (channel
                   (name 'test)
                   (url "test")))
         (test-dir (channel-instance-checkout instance--simple)))
    (mock ((guix git) latest-repository-commit
           (lambda* (store url #:key ref)
             (match url
               ("test" (values test-dir 'whatever))
               (_ (values "/not-important" 'not-important)))))
        <tr><td><span title='2017-08-23 00:29:22 +0200'>2017-08-23</span></td><td><a href='/guix/commit/gnu/services/herd.scm?id=7d14082d56462f7bef4254d65a21fd265fbce471'>services: herd: Actions return a list of results.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2017-08-08 20:49:08 +0100'>2017-08-08</span></td><td><a href='/guix/commit/gnu/services/herd.scm?id=0642838b2e9ab2bd988dccb64b9e1130006347bf'>services: herd: Add a stop-service procedure.</a><span class='msg-avail'>...</span></td><td>Christopher Baines</td></tr>
<tr><td><span title='2017-08-08 20:48:53 +0100'>2017-08-08</span></td><td><a href='/guix/commit/gnu/services/herd.scm?id=dc7b3e56337ee9d8dcd8fe7d5cab71ef536d024f'>services: herd: Fix matching ok responses from shepherd service.</a><span class='msg-avail'>...</span></td><td>Christopher Baines</td></tr>
<tr><td><span title='2017-05-03 11:35:25 +0200'>2017-05-03</span></td><td><a href='/guix/commit/gnu/services/herd.scm?id=5e03b122cf295d24e01861ca942505d47f9aa59e'>services: herd: Make %shepherd-socket-file a parameter and export it.</a><span class='msg-avail'>...</span></td><td>Mathieu Othacehe</td></tr>
<tr><td><span title='2016-08-31 15:44:19 +0200'>2016-08-31</span></td><td><a href='/guix/commit/gnu/services/herd.scm?id=183605c8533ad321ff8bba209b64071a9e84714a'>services: herd: Provide &lt;live-service&gt; objects.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2016-05-04 23:35:55 +0200'>2016-05-04</span></td><td><a href='/guix/commit/gnu/services/herd.scm?id=958dd3ce68733bcd5c1231424c7e4ad39e67594a'>utils: Move combinators to (guix combinators).</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2016-05-04 23:35:55 +0200'>2016-05-04</span></td><td><a href='/guix/commit/gnu/services/herd.scm?id=8bf92e3904cb656d4c2160fc8befebaf21a65492'>services: herd: Move UI handling to 'guix system'.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2016-02-23 13:03:23 +0100'>2016-02-23</span></td><td><a href='/guix/commit/gnu/services/herd.scm?id=f2d8faff040986e498575de889a22d16aa1037e5'>services: herd: Add missing newlines in error messages.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2016-02-05 14:01:46 +0100'>2016-02-05</span></td><td><a href='/guix/commit/gnu/services/herd.scm?id=1d6b7d584736ff0ad9e852a39c7c151e10713580'>guix system: Simply warn if we cannot talk to the shepherd.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2016-02-03 22:28:28 +0100'>2016-02-03</span></td><td><a href='/guix/commit/gnu/services/herd.scm?id=240b57f0ca576708ebf6cfa0dfe2803fa9ff2323'>guix system: 'reconfigure' loads and starts new services.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
</table><ul class='pager'></ul></div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
ine manifest
          (run-with-store store
            (channel-instances->manifest (list guix
                                               instance0 instance1
                                               instance2 instance3))))

        (define entries
          (manifest-entries manifest))

        (define (depends? drv in out)
          ;; Return true if DRV depends (directly or indirectly) on all of IN
          ;; and none of OUT.
          (let ((set (list->set
                      (requisites store
                                  (list (derivation-file-name drv)))))
                (in  (map derivation-file-name in))
                (out (map derivation-file-name out)))
            (and (every (cut set-contains? set <>) in)
                 (not (any (cut set-contains? set <>) out)))))

        (define (lookup name)
          (run-with-store store
            (lower-object
             (manifest-entry-item
              (manifest-lookup manifest
                               (manifest-pattern (name name)))))))

        (let ((drv-guix (lookup "guix"))
              (drv0     (lookup "a"))
              (drv1     (lookup "b"))
              (drv2     (lookup "c"))
              (drv3     (lookup "d")))
          (and (depends? drv-guix '() (list drv0 drv1 drv2 drv3))
               (depends? drv0
                         (list) (list drv1 drv2 drv3))
               (depends? drv1
                         (list drv0) (list drv2 drv3))
               (depends? drv2
                         (list drv1) (list drv3))
               (depends? drv3
                         (list drv2 drv0) (list))))))))

(test-end "channels")