beautiful-racket/beautiful-racket-demo/jsonic-2-demo/colorer.rkt

#lang br
(require brag/support
         syntax-color/racket-lexer)

(define in-racket-expr? #f)

(define/contract (color-jsonic port)
  (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)))
  (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 color-jsonic)

(module+ test
  (require rackunit)
  (check-equal? (values->list (color-jsonic (open-input-string "x")))
                (list "x" 'string #f 1 2)))