;; SPDX-License-Identifier: EUPL-1.2
;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
(defpackage :ukkoclot/strings
  (:use :c2cl :iterate)
  (:import-from :cl-unicode :general-category)
  (:export
   :ends-with
   :escape-xml
   :is-tg-whitespace
   :is-tg-whitespace-str
   :lisp->camel-case
   :lisp->snake-case
   :snake->lisp-case
   :starts-with
   :starts-with-ignore-case))
(in-package :ukkoclot/strings)

;; These are very inefficient but I don't care until I profile

(defun ends-with (str suffix)
  (and (> (length str) (length suffix))
       (string= str suffix :start1 (- (length str) (length suffix)))))

(defun escape-xml (str &optional out)
  (if out
      (escape-xml% str out)
      (with-output-to-string (out)
        (escape-xml% str out))))

(defun escape-xml% (str out)
  (loop for ch across str do
    (case ch
      (#\< (write-string "&lt;" out))
      (#\> (write-string "&gt;" out))
      (#\& (write-string "&amp;" out))
      (#\" (write-string "&quot;" out))
      (t (write-char ch out)))))

(defun is-tg-whitespace (ch)
  (let ((gc (general-category ch)))
    (or (string= gc "Zs")               ; Separator, space
        (string= gc "Zl")               ; Separator, line
        (string= gc "Zp")               ; Separator, paragraph
        (string= gc "Cc")               ; Other, control
        (= (char-code ch) #x2800))))    ; BRAILLE PATTERN BLANK

(defun is-tg-whitespace-str (str)
  (iter (for ch in-string str)
    (always (is-tg-whitespace ch))))

(defun lisp->camel-case (str)
  (with-output-to-string (out)
    (let ((should-caps nil))
      (iter (for ch in-string str)
            (cond ((char= ch #\-)
                   (setf should-caps t))
                  (should-caps
                   (write-char (char-upcase ch) out)
                   (setf should-caps nil))
                  (t
                   (write-char (char-downcase ch) out)))))))

(defun lisp->snake-case (str)
  (with-output-to-string (out)
    (loop for ch across str do
      (case ch
        (#\- (write-char #\_ out))
        (t (write-char ch out))))))

(defun snake->lisp-case (str)
  (with-output-to-string (out)
    (loop for ch across str do
      (case ch
        (#\_ (write-char #\- out))
        (t (write-char ch out))))))

(defun starts-with (str prefix)
  (and (> (length str) (length prefix))
       (string= str prefix :end1 (length prefix))))

(defun starts-with-ignore-case (str prefix)
  (and (> (length str) (length prefix))
       (string-equal str prefix :end1 (length prefix))))