#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)

; 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)
           (p
             (small "I really dislike writing frontends, please don't laugh at my CSS"))
           (div ((style "display: none;"))
                (a ((href "sicp.jpg")) "Hidden url :o "))))))

(define (render-intro)
  `(div ((class "intro"))
        (h2 "Scheme Programming Challenges")
        (h3 "Instructions")
        (ul
          (li (b "You must write an expression in Scheme that evaluates to a lambda."))
          (li "This lambda should have one parameter.")
          (li "The lambda will be called for every given input. If the lambda returns the expected output every time, you get the flag.")
          (li "The procedures and variable names you can use are restricted, solve the challenge using only what is available (literals are allowed though).")
          (li "Please don't write infinite loops, it will cause your session to hang (sorry, I didn't solve the halting problem).")
          (li "There are no exploits possible (I think), digging through the HTML is most likely a waste of time. Solve the challenge the way it's intended.")
          (li "The racket dialect is used, see its documentation for details about all given procedures")
          (li "Hint: you can only write a single expression, use a begin to make your life easier"))))

; 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 ~v (challenge-input challenge) #:separator " | "))
        (div ((class "output-str"))
            "Expected output:")
        (div ((class "output"))
             ,(apply ~v (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
(displayln "serving on port 8000")
(serve/servlet start
               #:servlet-path "/"
               #:listen-ip #f
               #:command-line? #t
               #:extra-files-paths (list (build-path "assets/")))
