(define-record-type <cursor>
  (cursor offset)
  string-cursor?
  (offset cursor-offset : fixnum))

(define-type cursor (struct <cursor>))

;;;; Cursor operations

(: string-cursor-start (string --> cursor))
(define (string-cursor-start s)
  (cursor 0))

;; string-length is expected to produce the number of bytes in s.
(: string-cursor-end (string --> cursor))
(define (string-cursor-end s)
  (cursor (string-length s)))

(: string-cursor-next (string cursor --> cursor))
(define (string-cursor-next s curs)
  (cond ((utf8-next-char s (cursor-offset curs)) => cursor)
        (else
         (bounds-exception 'string-cursor-next
                           "invalid cursor"
                           curs
                           s))))

(: string-cursor-prev (string cursor --> cursor))
(define (string-cursor-prev s curs)
  (cond ((utf8-prev-char s (cursor-offset curs)) => cursor)
        (else
         (bounds-exception 'string-cursor-prev
                           "invalid cursor"
                           curs
                           s))))

(: string-cursor-forward (string cursor fixnum --> cursor))
(define (string-cursor-forward s curs n)
  (let lp ((off (cursor-offset curs)) (n n))
    (if (zero? n)
        (cursor off)
        (lp (utf8-next-char s off) (- n 1)))))

(: string-cursor-back (string cursor fixnum --> cursor))
(define (string-cursor-back s curs n)
  (let lp ((off (cursor-offset curs)) (n n))
    (if (zero? n)
        (cursor off)
        (lp (utf8-prev-char s off) (- n 1)))))

(: %compare-cursors (procedure cursor cursor --> boolean))
(define (%compare-cursors compare c1 c2)
  (compare (cursor-offset c1) (cursor-offset c2)))

(define string-cursor=? (cut %compare-cursors = <> <>))
(define string-cursor<? (cut %compare-cursors < <> <>))
(define string-cursor>? (cut %compare-cursors > <> <>))
(define string-cursor<=? (cut %compare-cursors <= <> <>))
(define string-cursor>=? (cut %compare-cursors >= <> <>))

(: string-cursor-diff (string cursor cursor --> fixnum))
(define (string-cursor-diff s start end)
  (let ((end-off (cursor-offset end)))
    (let lp ((off (cursor-offset start)) (n 0))
      (if (>= off end-off)
          n
          (lp (utf8-next-char off) (+ n 1))))))

(: string-cursor->index (string cursor --> fixnum))
(define (string-cursor->index s curs)
  (cursor-offset curs))

(: string-index->cursor (string fixnum --> cursor))
(define (string-index->cursor s i)
  (cursor i))

;;;; Predicates

;;; string-null? is taken from utf8-srfi-13.

;;;; Constructors

;;; string-tabulate & string-unfold[-right] are taken from utf8-srfi-13.

;;;; Conversion

;;; string-join is taken from utf8-srfi-13.

;;;; Selection

;; This should be O(1), a major advantage of cursors
;; containing offsets.
(: string-ref/cursor (string cursor --> char))
(define (string-ref/cursor s curs)
  (sp-ref s (cursor-offset curs)))

;; Needs byte-wise substring
(: substring/cursors (string cursor cursor --> string))
(define (substring/cursors s start end)
  (substring s (cursor-offset start) (cursor-offset end)))

;; Needs byte-wise string-copy
(: string-copy/cursors (string #!optional cursor cursor --> string))
(define string-copy/cursors
  (case-lambda
    ((s) (string-copy s))
    ((s start) (string-copy s start (string-cursor-end s)))
    ((s start end)
     (string-copy s (cursor-offset start) (cursor-offset end)))))

;;; string-take, etc. are taken from utf8-srfi-13.