authority.lisp

(defpackage authority
  (:use :cl :gen-machine)
  (:export :make-machine :parse :leftover :valid))
(in-package authority)
(defclass machine (gen-machine) ())
(defun make-machine (chars) (make-instance 'machine :leftover chars))
(defmethod slash-start-p ((m machine))
  (consume m)
  (and (current m) (char= (current m) #\/)))
(defmethod restore ((m machine))
  (unconsume m)
  (setf (leftover m) (cons #\/ (leftover m))))
(defmethod setv ((m machine) &key userinfo host port leftover)
  (setf (values (leftover m) (value m) (state m))
        (values leftover (list userinfo host port) "final")))
(defmethod parse-port ((m machine) leftover userinfo host)
  (let ((port-machine (port:make-machine leftover)))
    (port:parse port-machine)
    (if (port:valid port-machine)
        (setv m
              :userinfo userinfo
              :host host
              :port (port:value port-machine)
              :leftover (port:leftover port-machine))
        (move m "error"))))
(defmethod parse-host ((m machine) leftover userinfo)
  (let ((host-machine (host:make-machine leftover)))
    (host:parse host-machine)
    (if	(host:valid host-machine)
        (parse-port m
                    (host:leftover host-machine)
                    userinfo
                    (host:value host-machine))
        (move m "error"))))
(defmethod parse-userinfo ((m machine) leftover)
  (let ((user-machine (userinfo:make-machine leftover)))
    (userinfo:parse user-machine)
    (if (string= (userinfo:state user-machine) "at")
        (parse-host m
                    (userinfo:leftover user-machine)
                    (userinfo:value user-machine))
        (parse-host m leftover nil))))
(defmethod parse ((m machine))
  (if (slash-start-p m)
      (if (slash-start-p m)
          (parse-userinfo m (leftover m))
          (restore m))
      (move m "error")))