(defpackage :ywatds
  (:use :cl)
  (:export :program-entry))
(in-package :ywatds)

;; Databases
(defparameter *ildb* nil)
(defparameter *trackdb* nil)

;; Command-line arguments
(defparameter *debugp* nil)
(defparameter *gcp* nil)
(defparameter *world-path* nil)
;; Note: do NOT change *server-port* and *server* at debug time
(defparameter *server-port* nil)
(defparameter *server* nil)
;; Note: please call (ywatds::update-savefile-paths) if you change the world path at runtime
(defparameter *ildb-path* nil)
(defparameter *nodedb-path* nil)

#+sbcl(declaim (sb-ext:always-bound *ildb* *trackdb* *ildb-path* *nodedb-path*
				    *debugp* *gcp* *world-path* *server-port* *server*))

(defmacro ensure-world-path (path)
  `(uiop:ensure-pathname ,path :defaults (uiop:getcwd) :ensure-directory t
			 :want-existing t :ensure-absolute t))

(defmacro savefilepath (name)
  `(uiop:subpathname *world-path* ,(if (stringp name)
				       (concatenate 'string "advtrains_" name)
				       `(concatenate 'string "advtrains_" ,name))))

(defun update-savefile-paths ()
  (psetf *ildb-path* (savefilepath "interlocking.ls")
	 *nodedb-path* (savefilepath "ndb4.ls")))

(defun load-data ()
  (let* ((ildb (atil:load-ildb *ildb-path*))
	 (tdb (tracks:load-trackdb *nodedb-path* ildb)))
    (psetf *ildb* ildb *trackdb* tdb)
    (when *gcp*
      #+sbcl(sb-ext:gc :full t))
    (hunchentoot:acceptor-log-message *server* :info "Database updated")))

(defmacro mainloop ()
  `(loop (load-data) (sleep 20)))

(defun program-entry ()
  (let ((argv (uiop:command-line-arguments)))
    (setf *world-path* (ensure-world-path (car argv)))
    (setf *server-port* (coerce (parse-integer (cadr argv)) '(integer 0 65535)))
    (setf *debugp* (member "--debug" (cddr argv) :test #'string=))
    (setf *gcp* (member "--force-periodic-gc" (cddr argv) :test #'string=))
    (setf *server* (make-instance 'easy-routes:routes-acceptor :port *server-port*))
    (register-routes)
    (register-debugging-routes)
    (start-server)))

(defun register-routes ()
  (ywsw:safe-text-route
   dumpser
   ("/dumpser/:p" :method :get) (&path (p 'string))
   ("Deserialize <code>advtrains_<i>p</i></code> into a possibly nested associated list and return the result")
   (format nil "~s" (atsl:from-file (savefilepath p) :alist)))
  (ywsw:safe-text-route
   pretty-dump-interlocking
   ("/pretty-dump/interlocking" :method :get) ()
   ("Return the interlocking database that is in use")
   (format nil "~s" *ildb*))
  (ywsw:safe-text-route
   pretty-dump-registered-tracks
   ("/pretty-dump/registered-tracks" :method :get) ()
   ("Return the list of tracks known to the server")
   (tracks:dump-track-definitions))
  (ywsw:safe-json-route
   tcbinfo
   ("/tcbinfo" :method :get) ()
   ("Return a list of TCBs and associated information")
   *ildb*)
  (ywsw:safe-json-route
   tcbinfo-pos
   ("/tcbinfo/:x/:y/:z" :method :get)
   (&get
    (ln :parameter-type 'string) (rc :parameter-type 'string)
    (side :parameter-type 'string)
    (next :parameter-type 'boolean)
    &path (x 'integer) (y 'integer) (z 'integer))
   ("Return information on the TCB assigned to the track at (<i>x</i>,<i>y</i>,<i>z</i>). If <i>side</i> is provided, return only information related to side <i>side</i> of the TCB. If <i>ln</i> and/or <i>rc</i> is provided in addition to <i>side</i>, return the first route with ARS rule(s) matching the line <i>ln</i> or routing code <i>rc</i>. If <i>next</i> is specified in addition to <i>side</i> and any of <i>ln</i> and <i>rc</i>, return where the route ends.")
   (if (and x y z)
       (let ((tcb (atil:find-tcb-at *ildb* (aux:make-v3d :x x :y y :z z))))
	 (cond
	   ((not tcb) nil)
	   (side
	    (let ((tcbs (cond
			  ((string-equal side "a") (atil:tcb-side-a tcb))
			  ((string-equal side "b") (atil:tcb-side-b tcb))
			  (t nil))))
	      (cond
		((not tcbs) nil)
		((or ln rc)
		 (let ((route (atil:match-route (atil:tcbdata-routes tcbs)
						(or ln "") (or rc ""))))
		   (cond
		     ((not route) nil)
		     (next (atil:route-next route))
		     (t route))))
		(t tcbs))))
	   (t tcb)))))
  (ywsw:safe-graphviz-route
   graph-ilroutes ("/graph/ilroutes" :method :get) ()
   ("Return a simple graph of TCBs and available routes")
   (format nil "digraph{~%~{\"~a\"->\"~a\";~%~}}"
	   (loop for pos being the hash-keys of (atil:ildb-tcbs *ildb*)
	      using (hash-value tcb)
	      append (loop with side = (atil:make-tcbside :pos pos :side 0)
			for i across (atil:tcbdata-routes (atil:tcb-side-a tcb))
			append (list side (atil:route-next i)))
	      append (loop with side = (atil:make-tcbside :pos pos :side 1)
			for i across (atil:tcbdata-routes (atil:tcb-side-b tcb))
			append (list side (atil:route-next i))))))
  (ywsw:safe-text-route
   graph-tracks ("/graph/paths" :method :get) ()
   ("Return a simple graph of paths")
   (tracks:gvdump *trackdb*))
  (ywsw:safe-text-route
   find-path ("/find-path/:from-pos/:from-side/:to-pos/:to-side" :method :get)
   (&path (from-pos 'string) (from-side 'integer)
	  (to-pos 'string) (to-side 'integer))
   ("Find path between two entries in the track database")
   (multiple-value-bind (path dist)
       (tracks:dijkstra *trackdb*
			(tracks:trackside (aux:string-to-v3d from-pos) from-side)
			(tracks:trackside (aux:string-to-v3d to-pos) to-side))
     (if path (format nil "Distance: ~a~%~{~#[~;To~:;From~] ~a~@{~%~#[~;To~:;Via~] ~a~}~}"
		      dist path)
	 "No path")))
  (ywsw:defsafe
      docroute-master ("/doc" :method :get) ()
      (let ((entries (loop for i being the hash-keys of easy-routes::*routes*
			for s = (string-downcase (string i))
			when (string/= (subseq s 0 3) "doc")
			collect s)))
	(ywsw:wrap-html
	 "Documentation"
	 `("h2" () "Documentation")
	 `("ul" () ,@(loop for i in (stable-sort entries #'string<)
			collect `("li" () ("a" ("href" ,(format nil "/doc/http-~a" i))
					       ,i))))))))

(defun register-debugging-routes ()
  (macrolet
      ((debug-routes (&body body)
	 `(progn ,@(loop for i in body collect
			`(ywsw:safe-text-route
			  ,(car i) ,(cadr i) ,(caddr i)
			  ,(cons "<b>[Only available in debugging mode]</b> " (cadddr i))
			  (if *debugp* (progn ,@(cddddr i))
			      "Debugging mode is disabled. Please run the server with --debug or set ywatds::*debugp* to a non-nil value."))))))
    (debug-routes
     (debug-room ("/debug/room" :method :get) () ("Dumps the output of <code>(room t)</code>")
		 (with-output-to-string (*standard-output*) (room t)))
     (debug-routes ("/debug/routes" :method :get) () ("List defined routes")
		   (with-output-to-string (s)
		     (describe easy-routes:*routes-mapper* s))))))

(defun start-server ()
  (tracks:init-tracks)
  (update-savefile-paths)
  (if *debugp* (break))
  (load-data)
  (hunchentoot:start *server*)
  ;; loop until an error occurs
  (if *debugp* (mainloop) (handler-case (mainloop)
			    (t (c) (format *error-output* "~&~a~%" c))))
  (ignore-errors
    (hunchentoot:stop *server*)
    (uiop:quit)))