diff --git a/Makefile b/Makefile
index d8cbfc9..9cdf6b6 100644
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,7 @@
LISP ?= sbcl
+default: build
+
# https://lispcookbook.github.io/cl-cookbook/scripting.html
build:
$(LISP) --eval '(require :asdf)' \
@@ -7,3 +9,6 @@ build:
--eval '(asdf:load-system "ywatds")' \
--eval '(asdf:make :ywatds)' \
--eval '(quit)'
+
+clean:
+ -rm ywatds *~ *.backup API.md
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..528bcc2
--- /dev/null
+++ b/README.md
@@ -0,0 +1,15 @@
+ywatds - a simple server program that provides data based on advtrains savefiles
+
+**Please note that this project is still WIP and experimental. Use at your own risk.**
+
+## Usage
+
+### Command-line arguments
+
+**ywatds** _world-path_ _port-number_
+
+_world-path_: path to the advtrains savefiles, usually the world directory
+
+_port-number_: the port to use for the server
+
+Further documentation is available on `/doc` on the server.
\ No newline at end of file
diff --git a/dataserver.lisp b/dataserver.lisp
index 73f2eff..a8facec 100644
--- a/dataserver.lisp
+++ b/dataserver.lisp
@@ -21,19 +21,29 @@
`(progn
(setf *ildb* (atil:import-data (savefilepath "interlocking.ls"))))))
(ywsw:safe-text-route
+ dumpser
("/dumpser/:p" :method :get) (&path (p 'string))
+ ("Deserialize advtrains_p 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-json-route ("/tcbinfo" :method :get) () *ildb*)
(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 (x,y,z). If side is provided, return only information related to side side of the TCB. If ln and/or rc is provided in addition to side, return the first route with ARS rule(s) matching the line ln or routing code rc. If next is specified in addition to side and any of ln and rc, 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
@@ -54,7 +64,23 @@
(t route))))
(t tcbs))))
(t tcb)))))
+ (easy-routes:defroute
+ 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)))))))
+
(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)
diff --git a/server-wrapper.lisp b/server-wrapper.lisp
index 75f47fc..db0b1b1 100644
--- a/server-wrapper.lisp
+++ b/server-wrapper.lisp
@@ -1,7 +1,8 @@
(defpackage :ywatds-server-wrapper
(:use :cl)
(:nicknames :ywsw)
- (:export :toxml :safe-text-route :safe-json-route))
+ (:export :toxml :wrap-html
+ :safe-text-route :safe-json-route))
(in-package :ywsw)
(defun toxml (l)
@@ -15,6 +16,9 @@
((eql t l) "true")
(t (format nil "~a" l))))
+(defmacro toxml-multiple (&body body)
+ `(concatenate 'string ,@(loop for i in body collect `(toxml ,i))))
+
(defmacro wrap-html (title &body body)
`(progn
(setf (hunchentoot:content-type*) "text/html")
@@ -36,18 +40,50 @@
(hunchentoot:log-message* :error (format nil "~a" ,c))
nil))))
-(defmacro safe-text-route (options params &body body)
- (let ((name (gensym)) (response (gensym)))
- `(easy-routes:defroute
- ,name ,options ,params
- (setf (hunchentoot:content-type*) "text/plain")
- (let ((,response (safe-route ,@body)))
- (if (stringp ,response) ,response nil)))))
+(defmacro with-documentation ((name options params desc) &body body)
+ (alexandria:with-gensyms (docroute)
+ (let ((lowername (string-downcase (string name)))
+ (path (cl-ppcre:regex-replace-all
+ ":([^:/]+)"
+ (if (listp options) (car options) options)
+ "\\1")))
+ `(progn
+ (easy-routes:defroute
+ ,docroute ,(format nil "/doc/http_~a" lowername) ()
+ (wrap-html
+ ,(format nil "API ~a" lowername)
+ ,(toxml-multiple
+ `("h2" () (i () "API ") ,lowername)
+ `("h3" () (b () "Path and parameters"))
+ `("p" () (b () ,path)
+ ,@(loop for ent in params
+ for i = (string-downcase (string (if (listp ent) (car ent) ent)))
+ collect " "
+ collect
+ (if (char= #\& (char i 0))
+ (let ((sym (subseq i 1)))
+ (format nil "&~a" sym))
+ `("i" () ,i))))
+ `("h3" () (b () "Description"))
+ `("p" () ,@desc))))
+ ,@body))))
-(defmacro safe-json-route (options params &body body)
- (alexandria:with-gensyms (name response)
- `(easy-routes:defroute
- ,name ,options ,params
- (setf (hunchentoot:content-type*) "application/json")
- (let ((,response (safe-route (json:encode-json-to-string (progn ,@body)))))
- (if (stringp ,response) ,response "null")))))
+(defmacro safe-text-route (name options params doc &body body)
+ (let ((response (gensym)))
+ `(with-documentation
+ (,name ,options ,params ,doc)
+ (easy-routes:defroute
+ ,name ,options ,params
+ (setf (hunchentoot:content-type*) "text/plain")
+ (let ((,response (safe-route ,@body)))
+ (if (stringp ,response) ,response nil))))))
+
+(defmacro safe-json-route (name options params doc &body body)
+ (alexandria:with-gensyms (response)
+ `(with-documentation
+ (,name ,options ,params ,doc)
+ (easy-routes:defroute
+ ,name ,options ,params
+ (setf (hunchentoot:content-type*) "application/json")
+ (let ((,response (safe-route (json:encode-json-to-string (progn ,@body)))))
+ (if (stringp ,response) ,response "null"))))))