(in-package #:monparser)

(defparameter nothing
  (new nil))

(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
                 (symbol:normalize 'it predicate))))
        (t (error (format nil "Invalid predicate: ~a." predicate))))
  `(lambda (input)
     (if (cursed:has-data? input)
       (let ((it (cursed:peek input)))
         (if ,predicate
           (make-parsing :tree it
                         :start input
                         :end (cursed: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 (cons first-parser (cons 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))
                           (> (cursed:distance (parsing-end result)
                                               (parsing-end r))
                              0))
                   (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)
                                    (>= (cursed:distance (failure-place result)
                                                         (failure-place r))
                                        0)))
                       (setf result r)))))
                (t (error (format nil "Invalid return value: ~a." r))))))
      result)))

(defun optional (p)
  (one-of p nothing))

(defun many (p &key all)
  (lambda (input)
    (let* ((result '())
           (input-left input)
           (last-failure
             (do ((r (funcall p input-left) (funcall p input-left))) ((failure-p r) r)
               (when (parsing-p r)
                 (setf input-left (parsing-end r))
                 (when (parsing-tree r)
                   (push (parsing-tree r) result))))))
      (if (or (not result)
              (and result all (cursed:has-data? (failure-place last-failure))))
        (make-failure :place (failure-place last-failure)
                      :message (failure-message last-failure))
        (make-parsing :tree (reverse result)
                      :start input
                      :end input-left)))))