#lang racket/base

(provide read-preserve/text
         string->preserve)

(require racket/match)
(require racket/set)
(require "record.rkt")
(require "read-text-generic.rkt")
(require syntax/readerr)

(define *reader-name* 'read-preserve/text)

(define text-reader
  (make-preserve-text-reader
   #:reader-name *reader-name*
   #:read-annotated-value (lambda (in-port source next parse-error*) next)
   #:on-hash (lambda (in-port source next parse-error* default)
               (match-lambda
                 [#\{ (sequence-fold in-port
                                     source
                                     next
                                     skip-whitespace/commas
                                     (set)
                                     (lambda (s e)
                                       (when (set-member? s e)
                                         (parse-error* "Duplicate set element: ~v" e))
                                       (set-add s e))
                                     values
                                     #\})]
                 [c (default c)]))
   #:on-char (lambda (in-port source next parse-error* default)
               (match-lambda
                 [#\< (match (read-sequence in-port source next skip-whitespace #\>)
                        ['() (parse-error* "Missing record label")]
                        [(cons label fields) (record label fields)])]
                 [#\[ (read-sequence in-port source next skip-whitespace/commas #\])]
                 [#\{ (read-dictionary in-port source next parse-error*)]

                 [#\; (parse-error* "Semicolon is reserved syntax")]
                 [#\: (parse-error* "Unexpected key/value separator between items")]
                 [#\> (parse-error* "Unexpected >")]
                 [#\] (parse-error* "Unexpected ]")]
                 [#\} (parse-error* "Unexpected }")]
                 [#\, (parse-error* "Unexpected ,")]

                 [c (default c)]))))

(define string->preserve (make-preserve-string-reader *reader-name* text-reader))

(define (sequence-fold in-port source next skip-ws acc accumulate-one finish terminator-char)
  (let loop ((acc acc))
    (skip-ws in-port)
    (match (eof-guard *reader-name* in-port source (peek-char in-port))
      [(== terminator-char) (read-char in-port) (finish acc)]
      [_ (loop (accumulate-one acc (next)))])))

(define (read-sequence in-port source next skip-ws terminator)
  (sequence-fold in-port source next skip-ws '() (lambda (acc v) (cons v acc)) reverse terminator))

(define (read-dictionary in-port source next parse-error*)
  (sequence-fold in-port
                 source
                 next
                 skip-whitespace/commas
                 (hash)
                 (lambda (acc k)
                   (skip-whitespace in-port)
                   (match (peek-char in-port)
                     [#\: (read-char in-port)
                          (when (hash-has-key? acc k) (parse-error* "Duplicate key: ~v" k))
                          (hash-set acc k (next))]
                     [_ (parse-error* "Missing expected key/value separator")]))
                 values
                 #\}))

(define (read-preserve/text [in-port (current-input-port)]
                            #:read-syntax? [read-syntax? #f]
                            #:decode-embedded [decode-embedded #f]
                            #:source [source (object-name in-port)])
  (text-reader in-port source read-syntax? decode-embedded))