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

(defparameter *ildb* nil)
(defparameter *nodedb* nil)
(defparameter *trackdb* nil)

(defun program-entry ()
  (let* ((argv (uiop:command-line-arguments))
	 (worldpath (uiop:ensure-pathname (car argv)
					  :defaults (uiop:getcwd)
					  :ensure-directory t
					  :want-existing t
					  :ensure-absolute t))
	 (serverport (parse-integer (cadr argv)))
	 (debugp (member "--debug" (cddr argv) :test #'string=))
	 (server (make-instance 'easy-routes:routes-acceptor
				:port serverport)))
    (macrolet ((savefilepath (n)
		 `(uiop:subpathname worldpath (format nil "advtrains_~a" ,n)))
	       (load-data ()
		 `(progn
		    (setf *ildb* (atil:import-data (savefilepath "interlocking.ls")))
		    (setf *nodedb* (ndb:import-data (savefilepath "ndb4.ls")))
		    (setf *trackdb* (tracks:import-data *nodedb*))
		    (if (not debugp) (setf *nodedb* nil))
		    (hunchentoot:acceptor-log-message server :info "Database updated"))))
      (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-graphviz-route
       graph-tracks ("/graph/tracks" :method :get) ()
       ("Return a simple graph of tracks")
       (tracks:gvdump *trackdb*))
      (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)))))))
      (tracks:init-tracks)
      (hunchentoot:start server)
      (hunchentoot:acceptor-log-message server :info "~s"
					(with-output-to-string (s)
					  (describe easy-routes:*routes-mapper* s)))
      ;; loop until an error occurs
      (handler-case (loop do
			 (load-data)
			 (sleep 20))
	(t (c)
	  (format t "~&~a~%" c)
	  (when debugp (uiop:handle-fatal-condition c))))
      (ignore-errors
	(hunchentoot:stop server)
	(uiop:quit)))))