(defpackage :advtrains-serialize-lib
  (:use :cl :parse-float)
  (:nicknames :atsl)
  (:export :from-file :from-stream))
(in-package :atsl)

(defmacro unescape (seq)
  (let ((match (gensym)) (replacef (gensym)))
    `(flet ((,replacef (,match)
	      (string (ecase (char ,match 1)
			(#\: #\:)
			(#\n #\Newline)
			(#\r #\Return)
			(#\& #\&)))))
       (cl-ppcre:regex-replace-all "&[:nr&]" ,seq #',replacef :simple-calls t))))

(defmacro string-to-value (seq table-allow)
  (let ((str (gensym)) (datatype (gensym)) (restdata (gensym)))
    `(let* ((,str ,seq)
	    (,datatype (char ,str 0))
	    (,restdata (subseq ,str 1)))
       (ecase ,datatype
	 (#\T (if ,table-allow 'table (error "table not allowed")))
	 (#\N (parse-float ,restdata))
	 (#\B (ecase (parse-integer ,restdata)
		(0 t)
		(1 nil)))
	 (#\S (unescape ,restdata))))))

(defmacro adjust-line (line)
  `(string-right-trim '(#\Return) ,line))

(defun read-table (stream restype)
  (let ((ht (case restype
	      (:alist nil)
	      (otherwise (make-hash-table)))))
    (do ((line (adjust-line (read-line stream nil))
	       (adjust-line (read-line stream nil))))
	((or (null line) (equal line "E")) ht)
      (cl-ppcre:register-groups-bind
       (key value)
       ("^(.*[^&]):(.+)$" line)
       (let* ((kv (string-to-value key nil))
	      (vt (string-to-value value t))
	      (vv (if (equal vt 'table)
		      (read-table stream restype)
		      vt)))
	 (case restype
	   (:alist (push (cons kv vv) ht))
	   (otherwise (setf (gethash kv ht) vv))))))))

(defun from-stream (stream restype)
  (let* ((header (adjust-line (read-line stream nil)))
	 (sver (parse-integer
		(cl-ppcre:regex-replace "^LUA_SER v=([12])$" header "\\1"))))
    ;; We don't need much checking here for now
    (assert sver)
    (read-table stream restype)))

(defmacro from-file (fn restype)
  (let ((stream (gensym)))
    `(with-open-file (,stream ,fn)
       (from-stream ,stream ,restype))))