#lang racket/base
;; Preserve, as in Fruit Preserve, as in a remarkably weak pun on pickling/dehydration etc

(provide (all-from-out "record.rkt")
         (all-from-out "float.rkt")
         (all-from-out "annotation.rkt")
         (all-from-out "order.rkt")
         (all-from-out "embedded.rkt")
         (all-from-out "merge.rkt")
         (all-from-out "pexprs.rkt")

         (all-from-out "read-binary.rkt")
         (all-from-out "read-text.rkt")
         (all-from-out "write-binary.rkt")
         (all-from-out "write-text.rkt")

         has-any-annotations?

         detect-preserve-syntax
         read-preserve
         port->preserves
         file->preserves
         port->pexprs
         file->pexprs
         string->pexprs)

(require racket/dict)
(require racket/match)
(require racket/set)
(require (only-in racket/file file->list))
(require (only-in racket/port port->list))

(require "record.rkt")
(require "float.rkt")
(require "annotation.rkt")
(require "order.rkt")
(require "embedded.rkt")
(require "merge.rkt")
(require "pexprs.rkt")

(require "read-binary.rkt")
(require "read-text.rkt")
(require "write-binary.rkt")
(require "write-text.rkt")

(define (has-any-annotations? v #:check-embedded? [check-embedded? #t])
  (let walk ((v v))
    (match v
      [(annotated '() _ item) (walk item)]
      [(annotated _ _ _) #t]
      [(record label fields) (or (walk label) (ormap walk fields))]
      [(? list?) (ormap walk v)]
      [(? set?) (for/or [(i (in-set v))] (walk i))]
      [(? dict?) (for/or [((k v) (in-dict v))] (or (walk k) (walk v)))]
      [(embedded v) (and check-embedded? (walk v))]
      [_ #f])))

(define (detect-preserve-syntax [in-port (current-input-port)])
  (define b (peek-byte in-port))
  (cond [(eof-object? b) b]
        [(<= #x80 b #xBF) 'binary]
        [else 'text]))

(define (read-preserve [in-port (current-input-port)]
                       #:read-syntax? [read-syntax? #f]
                       #:decode-embedded [decode-embedded #f]
                       #:source [source (object-name in-port)])
  (match (detect-preserve-syntax in-port)
    [(? eof-object? e) e]
    ['binary (read-preserve/binary in-port
                                   #:read-syntax? read-syntax?
                                   #:decode-embedded decode-embedded)]
    ['text (read-preserve/text in-port
                               #:read-syntax? read-syntax?
                               #:decode-embedded decode-embedded
                               #:source source)]))

(define (file->preserves path
                         #:read-syntax? [read-syntax? #f]
                         #:decode-embedded [decode-embedded #f])
  (file->list path (lambda (in-port)
                     (read-preserve in-port
                                    #:read-syntax? read-syntax?
                                    #:decode-embedded decode-embedded
                                    #:source path))))

(define (port->preserves [in-port (current-input-port)]
                         #:read-syntax? [read-syntax? #f]
                         #:decode-embedded [decode-embedded #f]
                         #:source [source (object-name in-port)])
  (port->list (lambda (in-port)
                (read-preserve in-port
                               #:read-syntax? read-syntax?
                               #:decode-embedded decode-embedded
                               #:source source))
              in-port))

(define (file->pexprs path
                      #:read-syntax? [read-syntax? #f]
                      #:decode-embedded [decode-embedded #f])
  (call-with-input-file path (lambda (p) (port->pexprs p
                                                       #:read-syntax? read-syntax?
                                                       #:decode-embedded decode-embedded))))

(define (port->pexprs [in-port (current-input-port)]
                      #:read-syntax? [read-syntax? #f]
                      #:decode-embedded [decode-embedded #f]
                      #:source [source (object-name in-port)])
  (define vs
    (port->list (lambda (in-port)
                  (read-pexpr in-port
                              #:read-syntax? read-syntax?
                              #:decode-embedded decode-embedded
                              #:source source))
                in-port))
  (if read-syntax?
      vs
      (remove-trailer vs)))

(define (string->pexprs s
                        #:read-syntax? [read-syntax? #f]
                        #:decode-embedded [decode-embedded #f]
                        #:source [source "<string>"])
  (port->pexprs (open-input-string s)
                #:read-syntax? read-syntax?
                #:decode-embedded decode-embedded
                #:source source))