(module config-list
  (config-ref config-subsection config-let)
  (import chicken scheme extras)
  (import (only data-structures alist-ref identity))

  ;;post-process is applied even to default-value
  (define (config-ref cfg path #!key (default #f) (post-process identity))
    (post-process
     (cond
      ((null? cfg) default)
      ((null? path) (or (and (list? cfg) (car cfg)) default)) 
      ((alist-ref (car path) cfg)
       => (lambda (new-cfg)
            (config-ref new-cfg (cdr path) default: default)))
      (else default))))
        
  (define (config-subsection cfg path #!key (default #f))
    (cond
     ((null? cfg) default)
     ((null? path) cfg)
     ((assv (car path) cfg)
      => (lambda (new-cfg)
           (or (and (not (null? new-cfg))
                    (config-subsection (cdr new-cfg) (cdr path) default: default))
               default)))
     (else default)))

  (define-syntax config-let
    (syntax-rules ()
      ((_ cfg ((var (path path+ ...)) ...) body body+ ...)
       (let ((var (config-ref cfg '(path path+ ...))) ...)
         body
         body+
         ...)))))

;; tests 
(use test)
(import config-list)

(test-begin "unit-tests")

(define sample-config
  '((connection
     (username "test")
     (password "testpass")
     (another-level
      (yes "yes")
      (no "no")))
    (logging
     (destination "/this/is/a/test")
     (levels (error warning)))))

(test "non-list-value"
      "test"
      (config-ref sample-config '(connection username)))

(test "non-list-value second pos"
      "testpass"
      (config-ref sample-config '(connection password)))

(test "list-value"
      '(error warning)
      (config-ref sample-config '(logging levels)))

(test "default-value"
      'just-a-test
      (config-ref sample-config '(i dont exist) default: 'just-a-test))

(test "post-process"
      '(warning error)
      (config-ref sample-config '(logging levels) post-process: reverse))
      
(test "config-let"
      '("test" "testpass")
      (config-let sample-config ((uname (connection username))
                                 (pw (connection password)))
                  (list uname pw)))

(test "subsection"
      '((yes "yes") (no "no"))
      (config-subsection sample-config '(connection another-level)))


(test "subsection+config-let"
      '((error warning) "/this/is/a/test")
      (let ((subsec (config-subsection sample-config '(logging))))
        (config-let subsec ((dest (destination))
                            (lvls (levels)))
                    (list lvls dest))))