You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
typesetting/pitfall/restructure/stream.rkt

140 lines
4.7 KiB
Racket

#lang restructure/racket
(provide (all-defined-out))
;; helper class
(define-subclass object% (PortWrapper _port)
(unless (port? _port)
(raise-argument-error 'PortWrapper:constructor "port" _port))
(define/public-final (pos [where #f])
(when where
(set-port-position! _port where))
(port-position _port))
(define/public (dump) (void)))
(test-module
(check-not-exn (λ () (make-object PortWrapper (open-input-bytes #"Foo"))))
(check-not-exn (λ () (make-object PortWrapper (open-output-bytes))))
(check-exn exn:fail? (λ () (make-object PortWrapper -42))))
#| approximates
https://github.com/mbutterick/restructure/blob/master/src/EncodeStream.coffee
|#
;; basically just a wrapper for a Racket output port
(define-subclass* PortWrapper (EncodeStream [maybe-output-port (open-output-bytes)])
(unless (output-port? maybe-output-port)
(raise-argument-error 'EncodeStream:constructor "output port" maybe-output-port))
(super-make-object maybe-output-port)
(inherit-field _port)
(define/override-final (dump) (get-output-bytes _port))
(define/public-final (write val)
(unless (bytes? val)
(raise-argument-error 'EncodeStream:write "bytes" val))
(void (write-bytes val (· this _port))))
(define/public-final (writeBuffer buffer)
(write buffer)))
(test-module
(define es (+EncodeStream))
(check-true (EncodeStream? es))
(send es write #"AB")
(check-equal? (· es pos) 2)
(send es write #"C")
(check-equal? (· es pos) 3)
(send es write #"D")
(check-equal? (· es pos) 4)
(check-exn exn:fail? (λ () (send es write -42)))
(check-exn exn:fail? (λ () (send es write 1)))
(define op (open-output-bytes))
(define es2 (+EncodeStream op))
(send es2 write #"FOOBAR")
(check-equal? (send es2 dump) #"FOOBAR")
(check-equal? (send es2 dump) #"FOOBAR") ; dump can repeat
(check-equal? (get-output-bytes op) #"FOOBAR"))
#| approximates
https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee
|#
;; basically just a wrapper for a Racket port
;; but needs to start with a buffer so length can be found
(define-subclass* PortWrapper (DecodeStream [buffer #""])
(unless (bytes? buffer)
(raise-argument-error 'DecodeStream:constructor "bytes" buffer))
(super-make-object (open-input-bytes buffer))
(inherit-field _port)
(getter-field [length (bytes-length buffer)])
(define/override-final (dump)
(define current-position (port-position _port))
(set-port-position! _port 0)
(define bs (port->bytes _port))
(set-port-position! _port current-position)
bs)
(define/public-final (readUInt8) (read 1))
(define/public-final (readInt8) (read 1))
(define/public-final (read count)
(unless (index? count)
(raise-argument-error 'DecodeStream:read "positive integer" count))
(define bytes-remaining (- length (port-position _port)))
(when (> count bytes-remaining)
(raise-argument-error 'DecodeStream:read (format "byte count not more than bytes remaining = ~a" bytes-remaining) count))
(read-bytes count _port))
(define/public-final (readBuffer count)
(read count)))
(test-module
(define ds (+DecodeStream #"ABCD"))
(check-true (DecodeStream? ds))
(check-equal? (send ds dump) #"ABCD")
(check-equal? (send ds dump) #"ABCD") ; dump can repeat
(check-equal? (send ds read 2) #"AB")
(check-equal? (send ds dump) #"ABCD")
(check-equal? (· ds pos) 2)
(check-equal? (send ds read 1) #"C")
(check-equal? (· ds pos) 3)
(check-equal? (send ds read 1) #"D")
(check-equal? (· ds pos) 4)
(check-exn exn:fail? (λ () (send ds read -42)))
(check-exn exn:fail? (λ () (send ds read 1))))
;; Streamcoder is a helper class that checks / converts stream arguments before decode / encode
;; not a subclass of DecodeStream or EncodeStream, however.
(define-subclass RestructureBase (Streamcoder)
(define/overment (decode x . args)
(define stream (if (bytes? x) (+DecodeStream x) x))
(unless (DecodeStream? stream)
(raise-argument-error 'Streamcoder:decode "bytes or DecodeStream" x))
(inner (void) decode stream . args))
(define/overment (encode x . args)
(define stream (if (output-port? x) (+EncodeStream x) x))
(unless (EncodeStream? stream)
(raise-argument-error 'Streamcoder:encode "output port or EncodeStream" x))
(inner (void) encode stream . args)))
(test-module
(define-subclass Streamcoder (Dummy)
(define/augment (decode stream) "foo")
(define/augment (encode stream val) "bar")
(define/override (size) 42))
(define d (+Dummy))
(check-true (Dummy? d))
(check-exn exn:fail:contract? (λ () (send d decode 42)))
(check-not-exn (λ () (send d decode #"foo")))
(check-exn exn:fail:contract? (λ () (send d encode 42 21)))
(check-not-exn (λ () (send d encode (open-output-bytes) 42))))