#| Copyright 2024 Peter McGoron
 |
 | Licensed under the Apache License, Version 2.0 (the "License");
 | you may not use this file except in compliance with the License.
 | You may obtain a copy of the License at
 |
 |     http://www.apache.org/licenses/LICENSE-2.0
 |
 | Unless required by applicable law or agreed to in writing, software
 | distributed under the License is distributed on an "AS IS" BASIS,
 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 | See the License for the specific language governing permissions and
 | limitations under the License.
 |#

(define-record-type <fat-cursor>
  (raw-fat-cursor str cursor)
  fat-cursor?
  (str get-str)
  (cursor get-cursor))

(define string-cursor-comparator
  (make-comparator
   string-cursor?
   string-cursor=?
   string-cursor<?
   #f))

(define (string-cursor-valid-movement? str cursor spaces)
  (cond
    ((not (integer? spaces)) (error "can only move by exact integer"
                                    spaces))
    ((negative? spaces)
     (<= (- spaces)
         (string-cursor-diff str (string-cursor-start str) cursor)))
    ((positive? spaces)
     (<= spaces
         (string-cursor-diff str cursor (string-cursor-end str))))
    (else #t)))

(define (cursor->iterator str cursor)
  (make-iterator
   (lambda ()
     (string-cursor=? cursor (string-cursor-start str)))
   (lambda ()
     (string-cursor=? cursor (string-cursor-end str)))
   (lambda (spaces)
     (cond
       ((not (string-cursor-valid-movement? str cursor spaces))
        #f)
       ((negative? spaces)
        (cursor->iterator str
                          (string-cursor-back str
                                              cursor
                                              (- spaces))))
       (else
        (cursor->iterator str
                          (string-cursor-forward str
                                                 cursor
                                                 spaces)))))
   (lambda ()
     (string-ref/cursor str cursor))
   (lambda ()
     (string-cursor->index str cursor))
   (lambda (predicate? other-iterators)
     (let loop ((rest other-iterators)
                (current cursor))
       (if (null? rest)
           #t
           (let* ((next-private (iterator-get-private (car rest)))
                  (next-str (get-str next-private))
                  (next (get-cursor next-private)))
             ;; All comparisons are to STR, the string in the first
             ;; iterator, since they all must be equal.
             (if (or (not (eq? next-str str))
                     (not (predicate? string-cursor-comparator
                                      current
                                      next)))
                 #f
                 (loop (cdr rest) next))))))
   (raw-fat-cursor str cursor)))

(define-syntax define-for-iterator-or-string
  (syntax-rules ()
    ((_ (name str args ...) body ...)
     (define (name object args ...)
       (define (internal str args ...)
         body ...)
       (cond
         ((string? object) (internal object args ...))
         ((iterator? object) (internal (get-str (iterator-get-private
                                                 object))
                                       args ...))
         (else (error "invalid type of object" object)))))))

(define-for-iterator-or-string (string-iterator-start str)
  (cursor->iterator str (string-cursor-start str)))

(define-for-iterator-or-string (string-iterator-end str)
  (cursor->iterator str (string-cursor-end str)))

(define-for-iterator-or-string (string-index->iterator str idx)
  (cursor->iterator str (string-index->cursor str idx)))