(in-package #:monparser)

(defstruct cursor
  (start 0 :type (unsigned-byte 44))
  (end 0 :type (unsigned-byte 44))
  (data "" :type simple-string))

(declaim (ftype (function (cursor) boolean) cursor-has-data?))
(defun cursor-has-data? (cursor)
  (< (cursor-end cursor) (length (cursor-data cursor))))

(declaim (ftype (function (cursor) boolean) cursor-at-start?))
(defun cursor-at-start? (cursor)
  (= (cursor-start cursor) (cursor-end cursor)))

(declaim (ftype (function (cursor) standard-char) cursor-peek))
(defun cursor-peek (cursor)
  (char (cursor-data cursor)
        (cursor-end cursor)))

(declaim (ftype (function (cursor) cursor) cursor-advance))
(defun cursor-advance (cursor)
  (make-cursor :data (cursor-data cursor)
               :start (cursor-start cursor)
               :end (+ (cursor-end cursor) 1)))

(declaim (ftype (function (cursor) cursor) cursor-rebase))
(defun cursor-rebase (cursor)
  (make-cursor :data (cursor-data cursor)
               :start (cursor-end cursor)
               :end (cursor-end cursor)))

(declaim (ftype (function (cursor cursor) cursor) cursor-merge))
(defun cursor-merge (prev next)
  (assert (eq (cursor-data prev) (cursor-data next)))
  (make-cursor :data (cursor-data next)
               :start (cursor-start prev)
               :end (cursor-end next)))

(declaim (ftype (function (cursor cursor) fixnum) distance))
(defun distance (from to)
  (assert (eq (cursor-data from) (cursor-data to)))
  (- (cursor-end to)
     (cursor-end from)))

(declaim (ftype (function (cursor &key (:side-length fixnum)) t) context-window))
(defun context-window (cursor &key (side-length 20))
  (let ((begin (max (- (cursor-start cursor) side-length) 0))
        (end (min (+ (cursor-end cursor) side-length) (length (cursor-data cursor))))
        (result '()))
    (push (subseq (cursor-data cursor) (cursor-end cursor) end) result)
    (push (subseq (cursor-data cursor) (cursor-start cursor) (cursor-end cursor)) result)
    (push (subseq (cursor-data cursor) begin (cursor-start cursor)) result)
    result))

(declaim (ftype (function (cursor) (cons fixnum fixnum)) line-and-column))
(defun line-and-column (cursor)
  (let ((line 1) (column 1))
    (dotimes (i (cursor-end cursor))
      (let ((c (char (cursor-data cursor) i)))
        (case c
          (#\Newline
           (incf line)
           (setf column 1))
          (t (incf column)))))
    (cons line column)))

(defmethod print-object ((obj cursor) stream)
  (print-unreadable-object (obj stream :type t)
    (let ((str (if (cursor-has-data? obj)
                 (format nil "~{~a~a~a~}"
                         (context-window obj :side-length 10))
                 "END OF DATA")))
      (format stream "~s" (substitute #\~ #\Newline str)))))