zpstring.zp

(define string:extend string:append)
(define (string:join l . delim) "join list of strings to string; optional delimiter"
  (if (null? l)
    ""
    (if (or (null? delim) (= (length l) 1))
      (++ "" (car l) (string:join (cdr l)))
      (++ "" (car l) (string (car delim)) (string:join (cdr l) (car delim))))))

(define (string:split s delim)
  "splits a string s on a certain delimiter, returning a list; 
   the delimiter is lost"
  (let ((x (string:find s delim))
        (l (string:length s))
        (ldelim (string:length (string delim))))
    (if (or (= x -1) (= l 1))
      (list s)
      (let ((sub (substring s (+ x ldelim) l))
            (fil (let ((sub (substring s 0 x))) (if (truthy? sub) (list sub) []))))
        (if (= 0 (string:length sub))
          fil
          (++ fil (string:split sub delim)))))))

(define (string:last s) "get last element of string"
  (let ((l (string:length s)))
    (string:ref s (sub1 l))))

(define (string:in? s el) "is element in string?"
  (given el
    (regex? ($ (regex:in? % s)))
    (($ (or (string? %) (char? %))) ($ (/= -1 (string:find s %))))))

(define (string:head s)
  "gets head of a string, i.e. first character (as character, not string)"
  (string:ref s 0))

(define (string:tail s)
  "gets tail of a string, i.e. everything except for the first element"
  (substring s 1 (length s)))

(define (string:remove-non-ascii s)
  "removes all non-ascii characters from a string"
  (let ((s (string->list s)))
    (list->string [x | x <- s, (< (char->integer x) 128)])))

(define (string:marquee s . args)
  "returns marqueed string; default width 30 chars, default symbol -"
  (let* ((args (get-from args 0 (make-hash)))
         (width (get-from args "width" 30))
         (symbol (get-from args "symbol" "-"))
         (side (replicate (/ (- width (length s) 2) (length symbol)) symbol)))
    (++ side " " s " " side)))

(define (string:box s . args)
  "returns boxed string; default width 30 chars, default symbol -"
  (let* ((args (get-from args 0 (make-hash)))
         (width (get-from args "width" 30))
         (symbol (get-from args "symbol" "-"))
         (len (/ (- width (length s) 2) 2 (length symbol)))
         (side (replicate len symbol))
         (top (replicate (+ (* len 2) 2 (length s)) symbol)))
    (++ top "\n" side " " s " " side "\n" top)))

(define (string:count s c) "returns number of occurences of c in s"
  (list:count (string->list s) c))

(define (string:indent s . args)
  "indent lines in a string by padding (default 2) with symbol (default whitespace)"
  (let* ((args (get-from args 0 (make-hash)))
         (width (get-from args "padding" 2))
         (symbol (get-from args "symbol" " "))
         (padding (replicate width symbol)))
  (++ padding (string:join (string:split s #\newline) (++ "\n" padding)))))

(define (string:starts-with s sub)
  "check whether a string starts with another string"
  (eqv? sub (substring s 0 (string:length (string sub)))))

(define (string:ends-with s sub)
  "check whether a string ends with another string"
  (let ((len (length s)))
  (eqv? sub (substring s (- len (length sub)) len))))

(define (string:find-right str el)
  "finds element in string, begin at its end"
  (define (internal str el i)
    (cond
      ((< i 0) -1)
      ((eq? (string:ref str i) el) i)
      (else (internal str el (sub1 i)))))
  (internal str el (sub1 (string:length str))))

(define (string:replicate count char)
  "make string of length count containing only character char"
  (define (internal acc count) (if (< count 1) acc (internal (++ acc char) (sub1 count))))
  (internal "" count))

(define (string:empty? str)
  "checks whether string is empty"
  (eq? str ""))

(define (string:copy str) "copies string; basically a typesafe noop"
  (if (string? str) str :no))

(define (string:trim-front s)
  "removes whitespace at the front of a string"
  (list->string (list:drop-while char:whitespace? (string->list s))))

(define (string:trim-back s)
  "removes whitespace at the end of a string"
  (list->string (reverse (list:drop-while char:whitespace? (reverse (string->list s))))))

(define (string:trim s)
  "removes whitespace at both ends of a string"
  (string:trim-back (string:trim-front s)))

(define (string:map f s)
  "map function f over string s"
  (list->string (map f (string->list s))))

(define (string:reduce f acc . s)
  "reduce string s using function f and accumulator acc"
  (if (null? s)
    (reduce f (string->list acc))
    (reduce f acc (string->list (car s)))))

(define (string:filter f s)
  "filter string s using function f"
  (list->string (filter f (string->list s))))

(define (string:upper? s)
  "check whether string is upper case"
  (string:reduce (lambda (acc x) (and acc (char:upper? x))) #t s))

(define (string:lower? s)
  "check whether string is lower case"
  (string:reduce (lambda (acc x) (and acc (char:lower? x))) #t s))

(define (string:num? s)
  "check whether string is numerical"
  (string:reduce (lambda (acc x) (and acc (char:num? x))) #t s))

(define (string:alpha? s)
  "check whether string is alphabetical"
  (string:reduce (lambda (acc x) (and acc (char:alpha? x))) #t s))

(define (string:alphanum? s)
  "check whether string is alphanumerical"
  (string:reduce (lambda (acc x) (and acc (char:alphanum? x))) #t s))

(define-syntax string:update!
  (syntax-rules ()
    ((_ v i f) (string:set! v i (f (v i))))))

(define (string:remove-whitespace str) "removes all whitespace characters from a string"
  (string:filter (lambda (x) (not (char:whitespace? x))) str))

(define (string:remove-newlines str) "removes all newline characters from a string"
  (string:filter (lambda (x) (not (or (eq? x #\newline) (eq? x #\carriage)))) str))

(define (string:drop-while f s) "drops elements from s as long as f matches"
  (list->string (list:drop-while f (string->list s))))

(define (string:take-while f s) "takes elements from s as long as f matches"
  (list->string (list:take-while f (string->list s))))