(use test waffle files posix)

(define widget
  '((markup . `(div (@ (class ,class)) "content")) (attributes . ((class "test-class")))))

(test-group "add-widget"
  (widgets '())
  (widget-rules '())
  
  (add-widget 'test-widget widget)

  (test "(widgets)"
        '((test-widget (markup . `(div (@ (class ,class)) "content")) (attributes (class "test-class"))))
        (widgets))

  (test "(widget-rules) - 'widget-name *macro*' part"
        '(test-widget *macro*)
        (let ((rules (widget-rules)))
          (list (caar rules) (cadar rules))))

  (test-assert "(widget-rules) - procedure part"
               (procedure? (cddar (widget-rules)))))

(test-group "load-widget"
  (widgets '())
  (widget-rules '())

  (define file (create-temporary-file "widget.scm"))

  (with-output-to-file file 
    (lambda ()
      (write (car widget))
      (write (cadr widget))))

  (load-widget 'test-widget file)

  (test "(widgets)"
        '((test-widget (markup . `(div (@ (class ,class)) "content")) (attributes (class "test-class"))))
        (widgets))

  (test "(widget-rules) - 'widget-name *macro*' part"
        '(test-widget *macro*)
        (let ((rules (widget-rules)))
          (list (caar rules) (cadar rules))))

  (test-assert "(widget-rules) - procedure part"
               (procedure? (cddar (widget-rules))))
  
  (delete-file* file))


(test-group "load-widgets-from-directory"
  (widgets '())
  (widget-rules '())

  (define widget-name 'test-widget)
  (define dir (make-pathname (create-temporary-directory) #f)) ; needs trailing slash
  (define file (make-pathname dir (->string widget-name) "widget.scm"))

  (with-output-to-file file 
    (lambda ()
      (write (car widget))
      (write (cadr widget))))

  (load-widgets-from-directory dir ".widget.scm")

  (test "(widgets)"
        `((,widget-name (markup . `(div (@ (class ,class)) "content")) (attributes (class "test-class"))))
        (widgets))

  (test "(widget-rules) - 'widget-name *macro*' part"
        `(,widget-name *macro*)
        (let ((rules (widget-rules)))
          (list (caar rules) (cadar rules))))

  (test-assert "(widget-rules) - procedure part"
               (procedure? (cddar (widget-rules))))

  (delete-directory dir #t))

(test-exit)