#lang racket

(require web-server/servlet
         web-server/servlet-env)

(require "challenge.rkt")
(require "either.rkt")
(require "challenges.rkt")
(require "validate.rkt")
(require racket/format)

(define intro (file->string "intro.txt"))

; start: request -> response
; Consumes a request and produces a page that displays all of the
; web content.
(define (start request)
  (define updated-challenges
    (cond ((can-parse-attempt? (request-bindings request))
           (process-attempt (request-bindings request)))
          (else
           challenges)))
  (render-page updated-challenges))

; Produces true if bindings contains values for 'id and 'code
(define (can-parse-attempt? bindings)
  (and (exists-binding? 'id bindings)
       (exists-binding? 'code bindings)))

; The main piece of code for processing a request
; Takes care of all necesarry error handling and updates a challenge based on the results
(define (process-attempt bindings)
  (define input-id (extract-binding/single 'id bindings))
  (define result 
    (do
      (<- id (parse-id input-id))
      (let code (extract-binding/single 'code bindings))
      (<- challenge (get-challenge id))
      (let allowed (challenge-allowed challenge))
      (<- validated-code (validate code allowed))
      (run challenge validated-code)))
  (reduce (add-response input-id 'fail) (add-response input-id 'success) result))
    

; Parse the id of the request
(define (parse-id id)
  (define num (string->number id))
  (if num
    (right num)
    (left "Error parsing challenge id, not a valid number")))

; Adds a result to a single challenge (1 arg curried)
(define (add-response id status)
  (define id-num (string->number id))
  (lambda (err)
    (map (lambda (ch)
           (if (equal? id-num (challenge-id ch))
             (add-status status err ch)
             ch))
         challenges)))

; Tries to obtain a certain challenge
(define (get-challenge id)
  (if (or (< id 0) (>= id (length challenges)))
    (left "Bad challenge id given, stop hacking my platform >:(")
    (right (list-ref challenges id))))

; Renders the entire page
(define (render-page challenges)
  (response/xexpr
   `(html (head 
            (title "Scheme Challenges!")
            (link ((rel "stylesheet") (href "style.css")))
            (link ((rel "shortcut icon") (href "favicon.ico") (type "image/x-icon"))))
          (body
           ,(render-intro)
           ,(render-challenges challenges)
           (div ((style "display: none;"))
                (a ((href "sicp.jpg")) "Hidden url :o "))))))

; Renders the explanations etc
(define (render-intro)
  `(div ((class "intro"))
        (h2 "Scheme Programming Challenges")
        (p ,intro)))

; Renders all challenges
(define (render-challenges challenges)
  `(div ((class "challenges"))
        ,@(map render-challenge challenges)))

; Renders a single challenge
(define (render-challenge challenge)
  (define status (challenge-status challenge))
  (define err? (eq? status 'fail))
  (define succ? (eq? status 'success))
  `(div ((class "challenge"))
        (h3 ,(string-append "Challenge " (number->string(challenge-id challenge))))
        (p ,(challenge-description challenge))
        (div ((class "input-str"))
             "Allowed procedures, special-forms and variable names:")
        (div ((class "output"))
             ,(apply ~a (challenge-allowed challenge) #:separator " | "))
        (div ((class "input-str"))
            "Given input:")
        (div ((class "output"))
             ,(apply ~a (challenge-input challenge) #:separator " | "))
        (div ((class "output-str"))
            "Expected output:")
        (div ((class "output"))
             ,(apply ~a (challenge-output challenge) #:separator " | "))
        (form
          (input ((name "id") (type "hidden") (value ,(number->string (challenge-id challenge)))))
          (textarea ((name "code")))
          (button ((type "submit")) "Get flag!"))
        (div ((class "error") (style ,(if err? "" "display: none;")))
             ,(if (pair? (challenge-err challenge))
                (apply ~a (challenge-err challenge) #:separator " | ")
                (~a (challenge-err challenge))))
        (div ((class "flag") (style ,(if succ? "" "display: none;")))
             ,(if succ?
                (challenge-flag challenge)
                "")))) ;TODO input is cleared after submission

; #:listen-ip #f
; #:command-line? #t
(serve/servlet start
               #:servlet-path "/"
               #:listen-ip #f
               #:command-line? #t
               #:extra-files-paths (list (build-path "assets/")))