(in-package #:monparser)

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

(defmacro unit (&optional predicate)
  (cond ((null predicate)
         (setf predicate 't))
        ((symbolp predicate)
         (setf predicate `(,predicate it)))
        ((characterp predicate)
         (setf predicate `(char-equal ,predicate it)))
        ((listp predicate)
         (if (eq (car predicate) 'function)
           (setf predicate `(funcall ,predicate it))
           (setf predicate
                 (nsubst-if 'it
                            (lambda (x)
                              (and (symbolp x)
                                   (string-equal (symbol-name x) "IT"))) predicate))))
        (t (error (format nil "Invalid predicate: ~a." predicate))))
  `(lambda (input)
     (if (has-data? input)
       (let ((it (peek input)))
         (if ,predicate
           (make-parsing :tree it :left (advance input))
           (make-failure :place input
                         :message (format nil "Expected: ~a, Got: ~:c." ',predicate it))))
       (make-failure :place input
                     :message (format nil "Reached end of input. Expected: ~a." ',predicate)))))

(defun one-of (first-parser second-parser &rest other-parsers)
  (lambda (input)
    (let ((parsers `(,first-parser ,second-parser ,@other-parsers))
          (result (make-failure :place input)))
      (dolist (p parsers)
        (let ((r (funcall p input)))
          (cond ((parsing-p r)
                 (when (or (not (parsing-p result))
                           (> (input-cursor (parsing-left r))
                              (input-cursor (parsing-left result))))
                   (setf result r)))
                ((failure-p r)
                 (when (failure-p result)
                   (let ((priority-cmp (- (failure-priority r)
                                          (failure-priority result))))
                     (when (or (> priority-cmp 0)
                               (and (= priority-cmp 0)
                                    (>= (input-cursor (failure-place r))
                                        (input-cursor (failure-place result)))))
                       (setf result r)))))
                (t (error (format nil "Invalid return value: ~a." r))))))
      result)))

;;; TODO: Find a way to be able to use the input without needing to define a name for it.
(defmacro comp (bindings &body body)
  (if (null bindings)
    `(new (progn ,@body))
    (let ((var (first (car bindings)))
          (parser (second (car bindings)))
          (unused (gensym)))
      (if (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)
                   (declare (ignore ,unused))
                   (comp ,(cdr bindings) ,@body))))
        (if (and (consp var) (symbolp (car var)) (symbolp (cdr var)))
          `(bind ,parser
                 (lambda (,(car var) ,(cdr var) &rest ,unused)
                   (declare (ignore ,unused))
                   (comp ,(cdr bindings) ,@body)))
          (error "Binding must be either a symbol or a cons of symbols."))))))