(module special-admin mzscheme
        (require "hwikireq.scm")
        (require "users.scm")
        (require "page.scm")
        (require "template.scm")
        (require "config.scm")
        (provide special:admin)


        (def-class
         (this (special:admin context))
         (supers (page-base))
         (private
          (define _template (template 'context context 'name "admin"))
          )
         (public
          (define (get-template)    _template)
          (define (css)             (-> _template css))
          (define (title)           (_ "HWiki Administration"))

          (define (create-html . message)
            (if (not (-> context role-admin?))
                (-> supers not-autorized context 
                    `(p ,(_ "You must login with 'admin' rights to administer HWiki")))
                (let ((P (page context (-> context from-where)))
                      (U (users context)))
                  (debug "create-html:P:" (-> P name))
                  (let ((T (-> P get-template)))
                    (let ((form (lambda (url)
                                  (adjust-timeout! (form-timeout))
                                  (-> context make-response/xhtml
                                      `(html
                                        ,(-> supers create-header context)
                                        (body
                                         (div ((class "users"))
                                              (h1 ,(_ "User Management"))
                                              ,(if (not (null? message))
                                                   `(p (b ((class "message")) ,(car message)))
                                                   (make-comment "no message"))
                                              (form ((name "users") (action ,url) (method "post"))
                                                    ,(append `(table
                                                               (tr
                                                                (td ((colspan "2")) (input ((type "text") (name "new-user") (size "40") (value ""))))
                                                                (td (select ((name "new-role") (value "editor"))
                                                                            (option "editor")
                                                                            (option "admin")))
                                                                (td ((class "tdbutton")) (input ((type "submit") (name "%new%") (value ,(_ "create"))))))
                                                               (tr (th ,(_ "Account")) (th ,(_ "Role")) (th " ") (th " ")))
                                                             (begin
                                                               (map (lambda (u)
                                                                      `(tr
                                                                        (td ,(user-name u))
                                                                        (td ,(symbol->string (user-role u)))
                                                                        (td ((class "tdbutton")) (input ((type "submit") (name ,(user-name u)) (value ,(_ "reset passwd")))))
                                                                        (td ((class "tdbutton")) (input ((type "submit") (name ,(user-name u)) (value ,(_ "remove"))))))
                                                                      )
                                                                    (-> U users)))
                                                             `((tr (td " ") (td " ") (td " ") (td ((class "tdbutton")) (input ((type "submit") (name "%done%") (value ,(_ "done")))))))
                                                             )))))))))
                      (let ((bindings (request-bindings (send/suspend form))))
                        (let ((action (extract-binding/choice (cons "%new%" (map (lambda (u) (user-name u)) (-> U users))) bindings (cons "" ""))))
                          (debug "admin: " action)
                          (cond ((string-ci=? (cdr action) (_ "reset passwd"))
                                 (let ((name (car action)))
                                   (-> U set-pass name "123456")
                                   (create-html (_ "Password for user '~a' reset to '123456'" name) )))
                                ((string-ci=? (cdr action) (_ "remove"))
                                 (let ((name (car action)))
                                   (-> U remove-user name)
                                   (create-html (_ "User '~a' removed" name))))
                                ((string-ci=? (car action) "%new%")
                                 (let ((name (string-trim-both (extract-binding/single 'new-user bindings))))
                                   (if (-> U exists? name)
                                       (-> this do-error (_ "The given user '~a' already exists" name) create-html)
                                       (if (string=? name "")
                                           (-> this do-error (_ "A username cannot be empty") create-html)
                                           (begin
                                             (-> U set-user name "123456" (string->symbol (extract-binding/single 'new-role bindings)))
                                             (create-html (_ "Created user '~a' with password '123456'" name) ))))))
                                (else (-> context to-from-where))))))))
            ))

          )
         (constructor
          (-> supers special!)
          )
         )


        (register-page "special:admin" special:admin)

        )