special-admin.scm
(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)
            (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)

        )