#lang racket (define-struct packing (reader writer contract)) (define (with-eof-value/p eof-value packing) (make-packing (λ (in) (let ([v ((packing-reader packing) in)]) (if (eof-object? v) eof-value v))) (packing-writer packing) (packing-contract packing))) (define (wrap/p unwrapper wrapper packing [wrapped-contract any/c]) (let ([unwrapper (contract (-> (packing-contract packing) wrapped-contract) unwrapper 'packed-data 'unpacked-value #f #'wrap/p)] [wrapper (contract (-> wrapped-contract (packing-contract packing)) wrapper 'unpacked-value 'packed-data #f #'wrap/p)]) (make-packing (λ (in) (let ([v ((packing-reader packing) in)]) (if (not (eof-object? v)) (unwrapper v) eof))) (λ (v out) ((packing-writer packing) (wrapper v) out)) wrapped-contract))) (provide/contract (struct packing ([reader (-> input-port? any/c)] [writer (-> any/c output-port? any)] [contract contract?])) [with-eof-value/p (-> any/c packing? packing?)] [wrap/p (->* (procedure? procedure? packing?) (contract?) packing?)]) (define (read-packed packing [in (current-input-port)]) (contract (or/c (packing-contract packing) eof-object?) ((packing-reader packing) in) 'packed-data 'unpacked-value #f #'read-packed)) (define (unpack packing b) (contract (packing-contract packing) (call-with-input-bytes b (packing-reader packing)) 'packed-data 'unpacked-value #f #'unpack)) (define (write-packed packing v [out (current-output-port)]) ((packing-writer packing) (contract (packing-contract packing) v 'unpacked-value 'packed-data #f #'write-packed) out)) (define (pack packing v) (call-with-output-bytes (curry (packing-writer packing) (contract (packing-contract packing) v 'unpacked-value 'packed-data #f #'pack)))) (provide/contract [read-packed (->* (packing?) (input-port?) any/c)] [unpack (-> packing? bytes? any/c)] [write-packed (->* (packing? any/c) (output-port?) any)] [pack (-> packing? any/c bytes?)])