yw05
/
ywatds
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add documentation

master
y5nw 2021-08-18 17:11:46 +02:00
parent d7bff59e1c
commit 4e53e1c1c0
4 changed files with 98 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Makefile
View File

@ -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

15
README.md Normal file
View File

@ -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.

28
dataserver.lisp
View File

@ -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 <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-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 (<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
@ -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)

66
server-wrapper.lisp
View File

@ -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)
"</b><i>\\1</i><b>")))
`(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 "&amp;~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"))))))