(in-package #:monparser)

(defun fail (message)
  (lambda (input &key limit lazy)
    (make-failure :place input :message message)))

(defmacro unit (&optional predicate)
  (cond ((null predicate)
         (setf predicate '(characterp it)))
        ((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 &key limit lazy)
     (declare (ignore lazy))
     (if (and limit (<= limit 0))
       (make-failure :place input :message "Reached established limit.")
       (if (has-data? input)
         (let ((it (peek input)))
           (if ,predicate
             (make-parsing :tree it :left (advance input) :limit (if limit (1- limit)))
             (make-failure :place input
                           :message (format nil "Expected: ~a, Got: ~a" ',predicate it))))
         (make-failure :place input :message "Reached end of input.")))))

(defun one-of (first-parser second-parser &rest other-parsers)
  (lambda (input &key limit lazy)
    (declare (ignore lazy))
    (labels ((one-of-rec (parsers)
                         (let ((intermediate-parsers '())
                               (result (make-failure :place input
                                                     :message "Exhausted options.")))
                           (dolist (p parsers)
                             (let ((r (funcall p
                                               input
                                               :lazy (> (length parsers) 1)
                                               :limit limit)))
                               (cond ((functionp r)
                                      (push r intermediate-parsers))
                                     ((parsing-p r)
                                      (when (or (not (parsing-p result))
                                                (> (cursor (parsing-left r))
                                                   (cursor (parsing-left result))))
                                        (setf result r)))
                                     ((failure-p r)
                                      (when (or (failure-p result)
                                                (= (length parsers) 1))
                                        (setf result r)))
                                     (t (error (format nil "Invalid return value: ~a" r))))))
                           (if intermediate-parsers
                             (one-of-rec intermediate-parsers)
                             result))))
      (one-of-rec (cons first-parser (cons second-parser other-parsers))))))

(defmacro comp (bindings &body body)
  (if (null bindings)
    `(new (progn ,@body))
    (let ((var (first (car bindings)))
          (parser (second (car bindings)))
          (lazy (third (car bindings)))
          (unused (gensym)))
      (if (symbolp var)
        (if (string= (symbol-name var) "_")
          `(bind ,parser
                 (lambda (&rest ,unused)
                   (declare (ignore ,unused))
                   (comp ,(cdr bindings) ,@body))
                 :greedy ,(not lazy))
          `(bind ,parser
                 (lambda (,var &rest ,unused)
                   (declare (ignore ,unused))
                   (comp ,(cdr bindings) ,@body))
                 :greedy ,(not lazy)))
        (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))
                 :greedy ,(not lazy))
          (error "Binding must be either a symbol or a cons of symbols."))))))