(module controller mzscheme
  (require (lib "class.ss")
           "interfaces.ss"
           "../base.ss")

  (provide controller%)
  
  (define controller%
    (class* object% (controller<%>)
      (init-field model-case%
                  model-suite%
                  view%
                  display-window
                  test
                  (embedded? #f))
      
      (define root-model #f)
      (define view #f)

      (define/public (get-root-model) root-model)
      (define/public (get-view) view)
      
      (define/public (run)
        (run-model root-model))

      (define/public (run-model model)
        (send model run))

      (define/public (clear-model model)
        (send model clear))
      
      (define/public (select-model model)
        (send (send model get-view-link) select #t))
        
      ;; create : -> void
      (define/private (create)
        (set! root-model (create-model test #f))
        (set! view (new view% 
                        (root-model root-model)
                        (controller this)
                        (include-run+clear-buttons? (not embedded?))
                        (parent display-window)))
        (send display-window show #t))
      
      ;; create-model : test model<%> -> model<%>
      (define/private (create-model test parent)
        (cond [(schemeunit-test-case? test)
               (new model-case% (controller this) (parent parent) (test test))]
              [(schemeunit-test-suite? test)
               (let* [(model (new model-suite% 
                                  (controller this) (parent parent) (test test)))
                      (children (map (lambda (c) (create-model c model))
                                     (schemeunit-test-suite-tests test)))]
                 (send model set-children children)
                 model)]))
      
      ;; on-model-status-change : model<%> boolean -> void
      ;; The changed? flag indicates whether the given model actually changed
      ;; status.
      (define/public (on-model-status-change model changed?)
        (send (get-view) update-model-view model)
        (let [(parent (send model get-parent))]
          (when parent (send parent on-child-status-change model changed?))))
      
      (define/public (on-view-selection-change view model)
        (send (get-view) set-selection model))
      
      (super-new)
      (create)
      ))
  )