#lang racket (provide (all-defined-out)) (define (read-tnetstring) (define size (read-size)) (if (not size) eof (let ([body (read-bytes size)] [type-marker (read-byte)]) (if (eof-object? type-marker) (error (format "Error reading: ~a:~a" size body)) (parse-object type-marker body))))) (define (read-size) (define (rs ls) (let ([b (read-byte)]) (cond [(eof-object? b) #f] [(= b (char->integer #\:)) (reverse ls)] [(<= (char->integer #\0) b (char->integer #\9)) (rs (cons b ls))] [else #f]))) (define nums (rs '())) (if (not nums) #f (bytes->number (list->bytes nums)))) (define (read-all) (let ([obj (read-tnetstring)]) (if (eof-object? obj) '() (cons obj (read-all))))) (define (with-bytes fn b) (parameterize ([current-input-port (open-input-bytes b)]) (fn))) (define (bytes->number b) (string->number (bytes->string/latin-1 b))) (define (parse-object type-marker body) (case (integer->char type-marker) [(#\,) body] [(#\# #\^) (bytes->number body)] [(#\!) (equal? #"true" body)] [(#\~) (void)] [(#\}) (make-dictionary (with-bytes read-all body))] [(#\]) (with-bytes read-all body)] [else (error (format "Invalid type \"~A\"" type-marker))])) (define (make-dictionary ls) (define (make-dictionary* ls) (if (empty? ls) '() (cons (let ([key (first ls)] [value (second ls)]) (if (not (bytes? key)) (error "keys must be bytestrings") (cons key value))) (make-dictionary* (drop ls 2))))) (make-immutable-hash (make-dictionary* ls)))