2018-08-19 21:13:42 +00:00
|
|
|
#lang racket/base
|
2018-08-27 09:24:11 +00:00
|
|
|
;; Preserve, as in Fruit Preserve, as in a remarkably weak pun on pickling/dehydration etc
|
2018-08-19 21:13:42 +00:00
|
|
|
|
2020-12-30 15:43:18 +00:00
|
|
|
(provide (all-from-out "record.rkt")
|
|
|
|
(all-from-out "float.rkt")
|
|
|
|
(all-from-out "annotation.rkt")
|
|
|
|
(all-from-out "order.rkt")
|
2021-05-26 19:09:06 +00:00
|
|
|
(all-from-out "embedded.rkt")
|
2022-11-28 21:38:23 +00:00
|
|
|
(all-from-out "merge.rkt")
|
2023-11-04 15:10:08 +00:00
|
|
|
(all-from-out "pexprs.rkt")
|
2018-08-19 21:13:42 +00:00
|
|
|
|
2020-12-30 15:43:18 +00:00
|
|
|
(all-from-out "read-binary.rkt")
|
|
|
|
(all-from-out "read-text.rkt")
|
|
|
|
(all-from-out "write-binary.rkt")
|
|
|
|
(all-from-out "write-text.rkt")
|
2019-08-20 19:44:07 +00:00
|
|
|
|
2023-10-30 16:28:19 +00:00
|
|
|
has-any-annotations?
|
|
|
|
|
2021-05-25 09:04:51 +00:00
|
|
|
detect-preserve-syntax
|
|
|
|
read-preserve
|
2021-05-26 11:56:37 +00:00
|
|
|
port->preserves
|
2023-11-04 15:10:08 +00:00
|
|
|
file->preserves
|
|
|
|
port->pexprs
|
|
|
|
file->pexprs)
|
2021-05-25 09:04:51 +00:00
|
|
|
|
2023-10-30 16:28:19 +00:00
|
|
|
(require racket/dict)
|
2021-05-25 09:04:51 +00:00
|
|
|
(require racket/match)
|
2023-10-30 16:28:19 +00:00
|
|
|
(require racket/set)
|
2021-05-25 09:04:51 +00:00
|
|
|
(require (only-in racket/file file->list))
|
2021-05-26 11:56:37 +00:00
|
|
|
(require (only-in racket/port port->list))
|
2019-08-20 19:44:07 +00:00
|
|
|
|
2020-12-30 15:43:18 +00:00
|
|
|
(require "record.rkt")
|
|
|
|
(require "float.rkt")
|
|
|
|
(require "annotation.rkt")
|
|
|
|
(require "order.rkt")
|
2021-05-26 19:09:06 +00:00
|
|
|
(require "embedded.rkt")
|
2022-11-28 21:38:23 +00:00
|
|
|
(require "merge.rkt")
|
2023-11-04 15:10:08 +00:00
|
|
|
(require "pexprs.rkt")
|
2018-09-27 20:35:03 +00:00
|
|
|
|
2020-12-30 15:43:18 +00:00
|
|
|
(require "read-binary.rkt")
|
|
|
|
(require "read-text.rkt")
|
|
|
|
(require "write-binary.rkt")
|
|
|
|
(require "write-text.rkt")
|
2018-09-27 20:35:03 +00:00
|
|
|
|
2023-10-30 16:28:19 +00:00
|
|
|
(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])))
|
|
|
|
|
2021-05-25 09:04:51 +00:00
|
|
|
(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]))
|
|
|
|
|
2020-12-30 15:43:18 +00:00
|
|
|
(define (read-preserve [in-port (current-input-port)]
|
2019-08-20 19:44:07 +00:00
|
|
|
#:read-syntax? [read-syntax? #f]
|
2021-05-17 12:54:06 +00:00
|
|
|
#:decode-embedded [decode-embedded #f]
|
2020-12-30 15:43:18 +00:00
|
|
|
#:source [source (object-name in-port)])
|
2021-05-25 09:04:51 +00:00
|
|
|
(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))))
|
2021-05-26 11:56:37 +00:00
|
|
|
|
2023-11-04 15:10:08 +00:00
|
|
|
(define (port->preserves [in-port (current-input-port)]
|
2021-05-26 11:56:37 +00:00
|
|
|
#: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))
|
2023-11-04 15:10:08 +00:00
|
|
|
|
|
|
|
(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)))
|