(import
  (chicken io)
  (srfi-1)
  test)

(include-relative "../dag")
(include-relative "../egg")
(include-relative "../list")
(include-relative "../string")

(test-group "list"
  (test-group "any"
    (test "empty" #f (lay:list:any (lambda _ #t) '()))
    (test "none" #f (lay:list:any (lambda _ #f) '(1 2 3 4 5)))
    (test "all" #t (lay:list:any (lambda _ #t) '(1 2 3 4 5)))
    (test "some" #t (lay:list:any (lambda (elem) (eq? elem 3)) '(1 2 3 4 5))))

  (test-group "all"
    (test "empty" #t (lay:list:all (lambda _ #t) '()))
    (test "none" #f (lay:list:all (lambda _ #f) '(1 2 3 4 5)))
    (test "all" #t (lay:list:all (lambda _ #t) '(1 2 3 4 5)))
    (test "some" #f (lay:list:all (lambda (elem) (eq? elem 3)) '(1 2 3 4 5)))))

(test-group "string"
  (test-group "trim"
    (test "empty" "" (lay:string:trim ""))
    (test "spaces" "" (lay:string:trim "    "))
    (test "something" "foo bar baz" (lay:string:trim "  foo bar baz  ")))

  (test-group "downcase"
    (test "empty" "" (lay:string:downcase "")) 
    (test "something" "foo bar baz" (lay:string:downcase "FoO BAR baZ")) ))

(test-group "dag"
  (let ((index (with-input-from-file "index" read-list))
        (dag   #f))

    (test-group "generate"
      (test-assert (set! dag (lay:dag:generate index))))

    (test-group "prune"
      (test-assert "simple egg"
        (lset=
          equal?
          (lay:dag:prune dag '(locale))
          '((check-errors:3.8.2)
            (iset:2.2)
            (locale:0.9.2 check-errors:3.8.2 utf8:3.6.3 srfi-1:0.5.1)
            (regex:2.0)
            (srfi-1:0.5.1)
            (srfi-69:0.4.3)
            (utf8:3.6.3 regex:2.0 iset:2.2 srfi-69:0.4.3))))

      (test-assert "last egg"
        (lay:dag:prune dag '(chicken-doc-admin)))

      (test "skipped eggs"
        '()
        (lay:dag:prune dag '(srfi-4 chicken))))

    (test-group "to-levels"
      (test
        "simple deps"
        '((scheme chicken.format)
          (f3 f2 f1)
          (e2 e3 e1)
          (d2 d1)
          (c2 c1)
          (b)
          (a))
        (lay:dag:to-levels
          '((f1 chicken.format scheme)
            (f2 chicken.format scheme)
            (f3 chicken.format scheme)
            (e1 f1 f2)
            (e2 f1 f2)
            (e3 f2 f3)
            (d1 e1)
            (d2 e2 e3)
            (c1 d1 e3 f1)
            (c2 d2 e2 f2)
            (b c1 c2)
            (a b))))

      (test
        "real-world deps"
        '((chicken.process-context
            doctype srfi-13
            chicken.base
            awful
            chicken.string
            chicken.sort
            intarweb
            chicken.irregex
            srfi-19
            chicken.format
            chicken.io
            spiffy
            scheme
            regex
            srfi-1)
          (page.listen fatc.markup)  
          (fatc.gigs fatc.bio)
          (page.main fatc.i18n)  
          (site)
          (main))
        (lay:dag:to-levels
          '((site fatc.i18n page.listen page.main srfi-13 srfi-1 spiffy doctype awful regex chicken.format scheme)
            (main site spiffy awful srfi-1 chicken.process-context scheme)
            (page.main fatc.gigs srfi-19 srfi-1 awful chicken.format scheme)
            (page.listen awful srfi-1 chicken.format chicken.base scheme)
            (fatc.markup srfi-1 regex scheme)
            (fatc.i18n fatc.bio intarweb spiffy srfi-1 chicken.sort chicken.string chicken.format scheme)
            (fatc.gigs fatc.markup srfi-19 srfi-1 spiffy chicken.irregex chicken.io chicken.format scheme)
            (fatc.bio fatc.markup spiffy chicken.io chicken.format scheme))))

      (test
        "linear deps"
        '((C)
          (B D10)
          (D9)
          (D8)
          (D7)
          (D6)
          (D5)
          (D4)
          (D3)
          (D2)
          (D1)
          (A))
        (lay:dag:to-levels
          '((A B D1)
            (B C)
            (D1 D2)
            (D2 D3)
            (D3 D4)
            (D4 D5)
            (D5 D6)
            (D6 D7)
            (D7 D8)
            (D8 D9)
            (D9 D10)
            (D10 C)))))))

(test-group "egg"
  (test-group "name+version"
    (test "name only" 'foo (egg-name+version 'foo))
    (test "name and version string" 'foo:2.4.3 (egg-name+version '(foo "2.4.3")))
    (test "name and version symbol" 'foo:2.4.3 (egg-name+version '(foo 2.4.3)))
    (test "name and version number" 'foo:2.4 (egg-name+version '(foo 2.4))))

  (test-group "name"
    (test "name only" 'foo (egg-name 'foo))
    (test "name and version" 'foo (egg-name 'foo:2.4.3)))

  (test-group "version"
    (test "name only" "" (egg-version 'foo))
    (test "name and version" '2.4.3 (egg-version 'foo:2.4.3)))

  (test-group "version>=?"
    (test-assert "3.2.1 vs. 1.2.3" (version>=? '3.2.1 '1.2.3))
    (test-assert "1.2.3 vs. 3.2.1" (not (version>=? '1.2.3 '3.2.1)))
    (test-assert "1.2.3 vs. none" (version>=? '1.2.3 ""))
    (test-assert "none vs. 1.2.3" (not (version>=? "" '1.2.3)))
    (test-assert "1.2 vs. 1" (version>=? '1.2 '1))
    (test-assert "1 vs. 1.2" (not (version>=? '1 '1.2)))
    (test-assert "1.2 vs. 2" (not (version>=? '1.2 '2)))
    (test-assert "2 vs. 1.2" (version>=? '2 '1.2))))

(test-exit)