#lang scheme/base

(require scheme/list scheme/contract "syntax.ss")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  TEXT DATATYPE
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (literal? pred? v)
  (and (syntax? v) (pred? (syntax-e v))))

(define (string-literal? v) (literal? string? v))
(define (bytes-literal? v) (literal? bytes? v))
(define (keyword-literal? v) (literal? keyword? v))

(define (text? v)
  (or (symbol? v)
      (string? v)
      (keyword? v)
      (bytes? v)
      (and (syntax? v) (text? (syntax-e v)))))

(define (text=? a b)
  (string=? (to-string a) (to-string b)))

(define (text>? a b)
  (string>? (to-string a) (to-string b)))

(define (text>=? a b)
  (string>=? (to-string a) (to-string b)))

(define (text<? a b)
  (string<? (to-string a) (to-string b)))

(define (text<=? a b)
  (string<=? (to-string a) (to-string b)))

(define (to-string t)
  (cond
   [(string? t) t]
   [(symbol? t) (symbol->string t)]
   [(keyword? t) (keyword->string t)]
   [(bytes? t) (bytes->string/utf-8 t)]
   [(syntax? t) (to-string (syntax-e t))]))

(define (text-append #:before [before ""]
                     #:between [between ""]
                     #:after [after ""]
                     . ts)
  (apply string-append
         (append (list before)
                 (add-between (map to-string ts) between)
                 (list after))))

(define (convert-text convert ts)
  (convert (apply text-append ts)))

(define (text->string . ns)
  (apply text-append ns))

(define (text->symbol . ns)
  (string->symbol (apply text-append ns)))

(define (text->keyword . ns)
  (string->keyword (apply text-append ns)))

(define (text->bytes . ns)
  (string->bytes/utf-8 (apply text-append ns)))

(define (text->identifier #:stx [stx #f] . ns)
  (to-syntax #:stx stx (apply text->symbol ns)))

(define (text->string-literal #:stx [stx #f] . ns)
  (to-syntax #:stx stx (apply text->string ns)))

(define (text->keyword-literal #:stx [stx #f] . ns)
  (to-syntax #:stx stx (apply text->keyword ns)))

(define (text->bytes-literal #:stx [stx #f] . ns)
  (to-syntax #:stx stx (apply text->bytes ns)))

(define text/c (flat-named-contract "text" text?))

(define (convert/c result/c)
  (->* [] [] #:rest (listof text/c) result/c))

(define (convert-literal/c result/c)
  (->* [] [#:stx (or/c false/c syntax?)] #:rest (listof text/c) result/c))

(provide/contract
 [text/c flat-contract?]
 [text? (-> any/c boolean?)]
 [string-literal? (-> any/c boolean?)]
 [keyword-literal? (-> any/c boolean?)]
 [bytes-literal? (-> any/c boolean?)]
 [text=? (-> text/c text/c boolean?)]
 [text>? (-> text/c text/c boolean?)]
 [text>=? (-> text/c text/c boolean?)]
 [text<? (-> text/c text/c boolean?)]
 [text<=? (-> text/c text/c boolean?)]
 [text-append
  (->* []
       [#:before string? #:between string? #:after string?]
       #:rest (listof text/c)
       text/c)]
 [text->string (convert/c string?)]
 [text->symbol (convert/c symbol?)]
 [text->keyword (convert/c keyword?)]
 [text->bytes (convert/c bytes?)]
 [text->identifier (convert-literal/c identifier?)]
 [text->string-literal (convert-literal/c string-literal?)]
 [text->keyword-literal (convert-literal/c keyword-literal?)]
 [text->bytes-literal (convert-literal/c bytes-literal?)])