#| 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))
     (raise (non-integer-movement-exception 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)
  (define iterator
    (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)
       (iteratively-apply-predicate
        (lambda (x y)
          (let ((x (iterator-get-private x))
                (y (iterator-get-private y)))
            (and (eq? (get-str x) (get-str y))
                 (predicate? string-cursor-comparator
                             (get-cursor x)
                             (get-cursor y)))))
        iterator
        other-iterators))
     (raw-fat-cursor str cursor)))
  iterator)

(define-record-type <string-iterator-constructor-exception>
  (string-iterator-constructor-exception obj)
  string-iterator-constructor-exception?
  (obj string-iterator-constructor-exception:obj))

(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 (raise (string-iterator-constructor-exception
                       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)))