(in-package #:monparser)

(defstruct parsing
  tree
  start
  end)

(defstruct failure
  place
  (message "")
  (priority 0))

(defmethod print-object ((obj failure) stream)
  (if (failure-place obj)
    (let ((linecol (str:line-and-column (cursed:data (failure-place obj))
                                        (cursed:index (failure-place obj)))))
      (format stream "~a:~a: ~a~&~a~&"
              (car linecol) (cdr linecol) (failure-message obj) (failure-place obj)))
    (format stream "~a~&" (failure-message obj))))

(defun new (tree)
  (lambda (input)
    (make-parsing :tree tree :start input :end input)))

(defun fail (message &key (priority 1))
  (lambda (input)
    (make-failure :place input :message message :priority priority)))

(defun bind (parser f)
  (lambda (input)
    (let ((r (funcall parser input)))
      (cond ((parsing-p r)
             (funcall (funcall f r) (parsing-end r)))
            ((failure-p r) r)
            (t (error (format nil "Invalid return value: ~a" r)))))))

(defmacro comp (bindings &body body)
  (if (null bindings)
    `(new (progn ,@body))
    (let ((var (first (car bindings)))
          (parser (second (car bindings)))
          (unused (gensym)))
      (cond ((symbolp var)
             (if (string= (symbol-name var) "_")
               `(bind ,parser
                      (lambda (&rest ,unused)
                        (declare (ignore ,unused))
                        (comp ,(cdr bindings) ,@body)))
               `(bind ,parser
                      (lambda (,var &rest ,unused)
                        (let ((,var (parsing-tree ,var)))
                          (declare (ignore ,unused))
                          (comp ,(cdr bindings) ,@body))))))
            ((and (listp var) (= (length var) 1) (symbolp (car var)))
             `(bind ,parser
                    (lambda (,(first var) &rest ,unused)
                      (declare (ignore ,unused))
                      (comp ,(cdr bindings) ,@body))))
            (t (error "Binding must be either a symbol or a list of one symbol."))))))