#| 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 (string-cursor-valid-movement? str cursor spaces)
  ;; Return #T if moving CURSOR forwards or backwards SPACES is well
  ;; defined.
  (cond
    ((zero? spaces) #t)
    ((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 #f)))

(define-invocation string-iterator-str)
(define-invocation string-iterator->cursor)

(define (string-iterator? x)
  (and (iterator? x) (eq? (iterator-type x) 'string-iterator)))

(define (string-cursor-advance str cursor spaces)
  ;; Move CURSOR SPACES forward or backward.
  (cond
    ((negative? spaces)
     (string-cursor-back str cursor (- spaces)))
    (else (string-cursor-forward str cursor spaces))))

(define-iterator-implementation (string-iterator str cursor) self
  ((iterator-at-start?)
   (string-cursor=? (string-cursor-start str) cursor))
  ((iterator-at-end?)
   (string-cursor=? (string-cursor-end str) cursor))
  ((iterator-advance spaces)
   (cond
     ((not (integer? spaces))
      (raise (non-integer-movement-exception self spaces)))
     ((string-cursor-valid-movement? str cursor spaces)
      (let ((cursor (string-cursor-advance str cursor spaces)))
        (string-iterator str cursor)))
     (else #f)))
  ((iterator-ref)
   (if (iterator-at-end? self)
       (raise (ref-at-end-exception self))
       (string-ref/cursor str cursor)))
  ((iterator->index)
   (string-cursor->index str cursor))
  ((string-iterator-str) str)
  ((string-iterator->cursor) cursor)
  ((get-iterator-comparator)
   (make-comparator
    (lambda (x)
      (and (string-iterator? x)
           (let ((x-str (string-iterator-str str)))
             (eq? str x-str))))
    (lambda (x y)
      (let ((x-cur (string-iterator->cursor x))
            (y-cur (string-iterator->cursor y)))
        (string-cursor=? x-cur y-cur)))
    (lambda (x y)
      (let ((x-cur (string-iterator->cursor x))
            (y-cur (string-iterator->cursor y)))
        (string-cursor<? x-cur y-cur)))
    #f)))

(define (string-constructor-exception obj)
  (make-iterator-exception #f
                           'string-constructor
                           (list (cons 'obj obj))))

(define-syntax define-for-iterator-or-string
  ;; Define a function such that the first argument can either be a string
  ;; or a string iterator. The string iterator has its string extracted
  ;; before use.
  (syntax-rules ()
    ((_ (name str args ...) body ...)
     (define (name str args ...)
       (let ((str (cond
                    ((string? str) str)
                    ((string-iterator? str) (string-iterator-str str))
                    (else (raise (string-constructor-exception str))))))
         body ...)))))

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

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

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