listit/servlets/control.scm
;;; control.scm

(module control mzscheme
  (provide interface-version timeout start)

  (require (planet "web.scm" ("soegaard" "web.plt" 2 1))
           (lib "match.ss")
           "config.scm"
           "model.scm" 
           "view.scm")
  
  ;;;
  ;;; SERVLET INTERFACE
  ;;;

  (define interface-version 'v1)
  (define timeout 6000)
  (define start
    ; servlet sets up the various parameters such as
    ; current-bindings and current-cookies, evaluates
    ; the body expressions, the last of which should
    ; evaluate to an xepxr.
    (servlet 
     (with-errors-to-browser 
      send/finish
      dispatch-on-action)))
  
  ;;;
  ;;; DISPATCH
  ;;;
  
  ; this web-site uses "action" to dispatch on
  (define (dispatch-on-action)
    (with-binding (current-bindings) (action)
      (match action
        ["updown"     (do-updown)]
        ["submitnew"  (do-submit-new)]
        ["submit"     (do-submit)]
        [else         (do-front-page)])))
  
  ;;;
  ;;; ACTIONS
  ;;;
  
  (define (do-front-page)
    (html-front-page 0 1 (page 0)))

  (define (do-updown)
    ; an arrow was clicked
    (with-binding (current-bindings) (entry_id arrowitem)
      (match arrowitem
        ["down" (when entry_id
                  (decrease-score entry_id))]
        ["up"   (when entry_id
                  (increase-score entry_id))]
        [else
         'do-nothing]))
    ; to make sure a reload doesn't resubmit, we redirect to the front page
    (current-redirect-temporarily (format "http://localhost:~a/servlets/control.scm" port))
    (html-redirect-page "Redirecting to frontpage"))

  (define (do-submit-new)
    (html-submit-new-page))
  
  (define (do-submit)
    (with-binding (current-bindings) (url title)
      (when (and url title)
        (insert-entry title url 10)))
    ; to make sure a reload doesn't resubmit, we redirect to the front page
    (current-redirect-temporarily (format "http://localhost:~a/servlets/control.scm" port))
    (html-redirect-page "Redirecting to frontpage"))

  )