42 lines
1.3 KiB
Racket

#lang br
(require brag/support syntax-color/racket-lexer racket/contract)
(define in-racket-expr? #f)
(define (color-jsonic port)
(define jsonic-lexer
(lexer
[(eof) (values lexeme 'eof #f #f #f)]
["@$" (begin
(set! in-racket-expr? #t)
(values lexeme 'parenthesis '|(|
(pos lexeme-start) (pos lexeme-end)))]
["$@" (begin
(set! in-racket-expr? #f)
(values lexeme 'parenthesis '|)|
(pos lexeme-start) (pos lexeme-end)))]
[(from/to "//" "\n")
(values lexeme 'comment #f
(pos lexeme-start) (pos lexeme-end))]
[any-char
(values lexeme 'string #f
(pos lexeme-start) (pos lexeme-end))]))
(if (and in-racket-expr?
(not (equal? (peek-string 2 0 port) "$@")))
(racket-lexer port)
(jsonic-lexer port)))
(provide
(contract-out
[color-jsonic
(input-port? . -> . (values
(or/c string? eof-object?)
symbol?
(or/c symbol? #f)
(or/c exact-positive-integer? #f)
(or/c exact-positive-integer? #f)))]))
(module+ test
(require rackunit)
(check-equal? (values->list
(color-jsonic (open-input-string "x")))
(list "x" 'string #f 1 2)))