(module getinfo mzscheme

  (require (lib "match.ss")
           (lib "list.ss")
           (lib "etc.ss")
           
           (lib "contract.ss")
           
           (lib "cachepath.ss" "planet"))

  (define info? (opt-> (symbol?) ((-> any/c)) any/c))
  (define path-or-string? (lambda (x) (or (path? x) (string? x))))
  
  
  ;; in addition to infodomain/compiled/cache.ss, getinfo will look in this 
  ;; file to find mappings. PLaneT uses this to put info about installed
  ;; planet packages.
  (define user-infotable (get-planet-cache-path))
  
  (define (get-info coll-path)
    (let* ([coll-path (map (lambda (x) (if (path? x) (path->string x) x)) coll-path)]
	   [dir (apply collection-path coll-path)])
      (get-info/full dir)))
  
  (define (get-info/full dir)
    (let ([file (build-path dir "info.ss")])
      (if (file-exists? file)
	  (begin
	    (with-input-from-file file
	      (lambda ()
		(let ([r (read)])
		  (unless (eof-object? (read))
		    (error "info.ss file has multiple expressions in ~a" dir))
		  (match r
		    [('module 'info '(lib "infotab.ss" "setup")
		       expr ...)
		     'ok]
		    [else (error 
			   'get-info
			   "info file does not contain a module of the right shape: \"~a\""
			   file)]))))
	    (dynamic-require file '#%info-lookup))
	  #f)))

  ;; item : (list path (listof symbol) nat nat)
  
  (define-struct table (insert   ; item * listof item -> listof item
                        ht       ; hashtable[key -o> item]
                        paths    ; listof path
                        ))
  
  (define preferred-table 
    (make-table 
     (lambda (i l)
       (cond
         [(null? l)
          (list i)]
         [else 
          (match-let ([(_ _ my-maj my-min) i]
                      [(_ _ their-maj their-min) (car l)])
            (if
             (or (> my-maj their-maj)
                 (and (= my-maj their-maj) (>= my-min their-min)))
               (list i)
               l))]))
     #f #f))
  
  (define all-available-table (make-table cons #f #f))
  
  (define (populate-table! t)
    ;; Use the colls ht because a collection might be in multiple
    ;;  collection paths, and we only want one
    (let ([colls (make-hash-table 'equal)])
      (for-each (lambda (f+root-dir)
		  (let ([f (car f+root-dir)]
			[root-dir (cdr f+root-dir)])
		    (when (file-exists? f)
		      (for-each 
		       (lambda (i)
			 (match i
			   [((? bytes? pathbytes) 
			     ((? symbol? fields) ...)
			     key ;; anything is okay here
			     (? integer? maj)
			     (? integer? min))
			    (let ((old-items (hash-table-get 
					      colls
					      key
					      (lambda () '())))
				  (new-item (list (let ([p (bytes->path pathbytes)])
						    (if (and (relative-path? p) root-dir)
							(build-path root-dir p)
							p))
						  fields 
						  maj 
						  min)))
			      (hash-table-put! colls 
					       key
					       ((table-insert t) new-item old-items)))]
			   [_
			    (error 'find-relevant-directories
				   "bad info-domain cache entry: ~e in: ~a" 
				   i
				   f)]))
		       (let ([l (with-input-from-file f read)])
			 (cond
                           [(list? l) l]
                           [(eof-object? l) '()] ;; allow completely empty files
                           [else
                            (error 'find-relevant-directories
                                   "bad info-domain cache file: ~a" 
                                   f)]))))))
		(reverse (table-paths t)))
      ;; For each coll, invert the mapping, adding the col name to the list for each sym: 
      (hash-table-for-each colls
			   (lambda (key vals)
                             (for-each
                              (lambda (val)
                                (match val
                                  [(path syms maj min)
                                   (for-each (lambda (sym)
                                               (hash-table-put! 
                                                (table-ht t)
                                                sym
                                                (cons path (hash-table-get (table-ht t) sym (lambda () null)))))
                                             syms)]
                                  [_ (error 'get-info 
                                            "Internal error: invalid info-domain value format: ~s" val)]))
                              vals)))))

  (define find-relevant-directories
    (opt-lambda (syms [key 'preferred])
      (define t (cond 
                  [(eq? key 'preferred) preferred-table]
                  [(eq? key 'all-available) all-available-table]
                  [else (error 'find-relevant-directories "Invalid key: ~s" key)]))

      ;; A list of (cons cache.ss-path root-dir-path)
      ;;  If root-dir-path is not #f, then paths in the cache.ss
      ;;  file are relative to it. #f is used for the planet cache.ss file.
      (define search-path 
        (cons (cons user-infotable #f)
              (map (lambda (coll) (cons (build-path coll "info-domain" "compiled" "cache.ss") coll))
                   (current-library-collection-paths))))
      
      (unless (equal? (table-paths t) search-path)
        (set-table-ht! t (make-hash-table))
        (set-table-paths! t search-path)
        (populate-table! t))
      
      (let ([unsorted (if (= (length syms) 1)
                          ;; Simple case: look up in table
                          (hash-table-get (table-ht t) (car syms) (lambda () null))
                          ;; Use a hash table, because the same collection might work for multiple syms
                          (let ([result (make-hash-table 'equal)])
                            (for-each (lambda (sym)
                                        (let ([l (hash-table-get (table-ht t) sym (lambda () null))])
                                          (for-each (lambda (c) (hash-table-put! result c #t))
                                                    l)))
                                      syms)
                            ;; Extract the relevant collections:
                            (hash-table-map result (lambda (k v) k))))])
        (sort unsorted compare-directories))))
  
  (define (compare-directories a b)
    (bytes<? (dir->sort-key a) (dir->sort-key b)))
  
  ;; dir->sort-key : path -> bytes
  ;; extracts the name of the directory, dropping any "."s it finds at the ends.
  (define (dir->sort-key path)
    (let-values ([(base name dir?) (split-path path)])
      (cond
        [(eq? name 'same) (dir->sort-key base)]
        [else (path->bytes name)])))
  
  (provide/contract
   (get-info ((listof path-or-string?) . -> . (or/c info? boolean?)))
   (get-info/full (path? . -> . (or/c info? boolean?)))
   (find-relevant-directories (opt-> ((listof symbol?))
                                     ((lambda (x) (or (eq? x 'preferred)
                                                      (eq? x 'all-available))))
                                     (listof path?)))))