(use-modules (srfi srfi-2) (alterator glob))

(define *local-help-index* "help/*.scm")
(define *system-help-index* "/etc/alterator/help/*.scm")

(define (plist-ref key plist)
  (cond-cdr (plistq key plist)))

(define (hash-ref-or-create! table name)
  (or (hash-ref table name #f)
      (begin (hash-set! table name (make-hash-table 10))
             (hash-ref table name))))

(define (add-fmt! fmt file table)
  (and fmt
       file
       (hash-set! table fmt file)))

(define (add-language! language table item)
  (and language
       (add-fmt! (plist-ref 'fmt item)
                 (plist-ref 'file item)
                 (hash-ref-or-create! table language))))
        
(define (add-topic! topic table item)
  (and topic
       (add-language! (plist-ref 'language item)
                      (hash-ref-or-create! table topic)
                      item)))

(define (process-index-file! filename table)
  (call-with-input-file
      filename
    (lambda(port)
     (let loop ((item (read port)))
       (or (eof-object? item)
           (begin (add-topic! (plist-ref 'topic item) table item)
                  (loop (read port))))))))


(define (load-indexes! table)
  (let ((system-indexes (glob *system-help-index*))
        (local-indexes (glob *local-help-index*)))
    (for-each (lambda(name) (process-index-file! name table))
              (append system-indexes local-indexes))
    table))

(define index-hash (load-indexes! (make-hash-table 10)))

(define (default-help language fmt)
  (string-append "/usr/share/alterator/help/"
                 (safe-substring (car language) 0 2)
                 "/default."
                 fmt))

;;append short two-letter names to expand
(define (expand-languages lst)
  (fold (lambda (x y)
              (append y (list x (safe-substring x 0 2))))
        '()
        lst))


(object
 #f
 ((read self objects options)
  (let ((language (cond-cdr (plistq 'language options)))
        (topic (cond-cdr (plistq 'topic options)))
        (fmt   (cond-cdr (plistq 'format options))))
    (list 'source
          (or (and-let* ((topic-table (hash-ref index-hash topic #f))
                         (language-table (any (lambda(lang)
                                                (hash-ref topic-table lang #f))
                                              (expand-languages language))))
                        (hash-ref language-table fmt #f))
              (default-help language fmt))))))
