(in-package :u02s03)

(defvar *headers* #("What's up?"
		    "What's bothering you?"
		    "How can I help?"))

(define-easy-handler (entry :uri "/") (query)
  (if query
      (with-basic-page (:title "Try one of these...")
	(navbar)
	(:h1 "Can you answer any of these?")
	(:ul
	 (let ((entries (match-entry-nodes query)))
	   (if entries
	       (loop
		  for entry-handler in entries
		  for node = (get-dao 'node (slot-value entry-handler 'entry-node))
		    do (htm
			(:li
			 (:a :href (format nil "/node?node=~d"
					   (slot-value node 'id))
			     (esc (slot-value node 'question))))))
	       (htm
		(:p "I don't have anything to give you. Would you like to "
		    (:a :href "/" "ask something else?"))))))
	(footer))
      (with-basic-page (:title "What can I help with?")
	(navbar)
	(:h1 (esc (random-elt *headers*)))
	(:form
	 (:input :name "query")
	 (:button :type :submit "Submit"))
	(footer))))

(define-easy-handler (view-node :uri "/node") (node)
  (let ((node (and node (parse-integer node :junk-allowed t))))
    (unless node
      (setf (return-code*) 400
	    (content-type*) "text/plain")
      (return-from view-node
	(format nil "~a is not a valid node name. Try an integer next time." node)))
    (let ((node-dao (get-dao 'node node)))
      (unless node-dao
	(setf (return-code*) 404
	      (content-type*) "text/plain")
	(return-from view-node
	  (format nil "I don't know about node #~d." node)))
      (with-basic-page (:title (format nil "Node #~d" node))
	(navbar :node node)
	(:h2 (esc (slot-value node-dao 'question)))
	(let ((responses (string->nodes (slot-value node-dao 'values))))
	  (if responses
	      (htm
	       (:ul
		(loop for (keyword . node) in responses
		   do (htm
		       (:li
			(:a :href (format nil "/node?node=~d" (slot-value node 'id))
			    (esc keyword)))))))
	      (htm
	       (:p "That's it."))))
	(footer)))))

(define-easy-handler (node-list :uri "/nodes") ()
  (let ((nodes (select-dao 'node))
	(entry-nodes (select-dao 'entry-query)))
    (with-basic-page (:title (format nil "~d node~:p"
				     (length nodes)))
      (navbar)
      (:h1 "Node list")
      (:p
       (:a :class "button" :href "/update-form" "Create a node")
       (:a :class "button" :href "/update-form?entryp=t" "Create an entry node")
       (:a :class "button" :href "/graph" "Node graph")
       (:h2 "Question nodes")
       (let ((warnings (search-node-errors)))
	 (when warnings
	   (htm
	    (:div :class "card warning fluid"
		  (:h3 "Question node value warnings")
		  (:ul
		   (loop for (warning-type warning-value) in warnings
		      do (htm
			  (:li (:b (esc (format nil "~:(~a~)" warning-type)))
			       (esc warning-value)))))))))
       (:ul
	(loop for node in (sort nodes #'< :key (lambda (node)
						 (slot-value node 'id)))
	   do (htm
	       (:li
		(:a :href (format nil "/update-form?node=~d" (slot-value node 'id))
		    (esc (format nil "#~d: " (slot-value node 'id)))
		    (:i (esc (slot-value node 'question))))))))
       (:h2 "Entry nodes")
       (let ((warnings (search-entry-errors)))
	 (when warnings
	   (htm
	    (:div :class "card warning fluid"
		  (:h3 "Entry node value warnings")
		  (:ul
		   (loop for (warning-type warning-value) in warnings
		      do (htm
			  (:li (:b (esc (format nil "~:(~a~)" warning-type)))
			       (esc warning-value)))))))))
       (:ul
	(loop for node in (sort entry-nodes #'< :key (lambda (node)
						       (slot-value node 'id)))
	   do (htm
	       (:li
		(:a :href (format nil "/update-form?entryp=t&node=~d" (slot-value node 'id))
		    (esc (format nil "#~d: " (slot-value node 'id)))
		    (:i (esc (slot-value node 'pattern)))))))))
      (footer))))

(define-easy-handler (update-node :uri "/update-node") (node question values entryp)
  (let* ((node (and node (parse-integer node :junk-allowed t)))
	 (node (when node (get-dao (if entryp 'entry-query 'node)
				   node)))
	 (node-n (when node (slot-value node 'id))))
    (unless node
      (setf (return-code*) 400
	    (content-type*) "text/plain")
      (return-from update-node "What am I updating?"))
    (if entryp
	(setf (slot-value node 'pattern) question
	      (slot-value node 'entry-node) (parse-integer values))
	(setf (slot-value node 'question) question
	      (slot-value node 'values) values))
    (update-dao node)
    (with-redirect-page (:title (format nil "Updated node #~d" node-n)
    		         :url "/nodes")
      (esc (format nil "Updated node #~d. Redirecting you now to the node list." node-n)))))

(define-easy-handler (create-node :uri "/create-node") (question values entryp)
  (let ((node (if entryp
		  (make-instance 'entry-query
				 :pattern question
				 :entry-node (parse-integer values))
		  (make-instance 'node
				 :question question
				 :values values))))
    (insert-dao node)
    (with-redirect-page (:title (format nil "Created node #~d" (slot-value node 'id))
    		         :url "/nodes")
      (esc (format nil "Updated node #~d. Redirecting you now to the node list."
		   (slot-value node 'id))))))

(define-easy-handler (update-node-form :uri "/update-form") (node entryp)
  (with-basic-page (:title (if node
			       (format nil "Editing node #~d" node)
			       "Creating a node"))
    (navbar)
    (:h1 (esc (if node
		  (format nil "Editing node #~d" node)
		  "Creating a node")))
    (let ((node (when node (get-dao (if entryp 'entry-query 'node)
				    (parse-integer node)))))
      (htm
       (:form :action (if node "/update-node" "/create-node")
	      (when node
		(htm
		 (:input :name "node" :type "hidden" :value (slot-value node 'id))))
	      (when entryp
		(htm
		 (:input :name "entryp" :type "hidden" :value "t")))
	      (:p (str (if entryp "Regular expression" "Question or answer"))
		  (:input :size 80
			  :name "question"
			  :value (if node
				     (escape-string (slot-value node
								(if entryp 'pattern 'question)))
				     "")))
	      (:p (str (if entryp "This loads node #" "Next nodes"))
		  (:input :size 80
			  :name "values"
			  :value (if node
				     (if entryp
					 (format nil "~d" (slot-value node 'entry-node))
					 (escape-string (slot-value node 'values)))
				     "")))
	      (:button :type :submit
		       (esc
			(if node "Update" "Create"))))))))

(define-easy-handler (node-backtrace :uri "/backwards") (node)
  (let ((node (when node (parse-integer node :junk-allowed t))))
    (unless node
      (setf (return-code*) 400)
      (setf (content-type*) "text/plain")
      (return-from node-backtrace "What am I backtracing?"))
    (with-basic-page (:title (format nil "Nodes that link to node #~d" node))
      ;; Genius kludge: conservatively SELECT anything that contains the string
      ;; of the node ID, then parse matching nodes and see if they're really there.
      (navbar)
      (:h1 (esc (format nil "Nodes that link to node #~d" node)))
      (:ul
       (loop for link in (select-dao 'node (:like 'values (format nil "%~d%" node)))
	  when (member node (mapcar #'cdr (string->nodes (slot-value link 'values)))
		       :key (lambda (node) (slot-value node 'id)))
	  do (htm
	      (:li (:a :href (format nil "/node?node=~d" (slot-value link 'id))
		       (esc (format nil "Node #~d: " (slot-value link 'id)))
		       (:i (esc (slot-value link 'question))))))))
      (footer))))

(defvar *acceptor* (make-instance 'easy-acceptor
				  :read-timeout 20
				  :write-timeout 20
				  :access-log-destination nil
				  :message-log-destination nil
				  :address "0.0.0.0"
				  :port 8080))

(start *acceptor*)
