This source listing assumes that we’ve created a jsonic directory and installed it as a package as described in setup.
#lang br/quicklang
(module reader br
(require "reader.rkt")
(provide read-syntax get-info)
(define (get-info port src-mod src-line src-col src-pos)
(define (handle-query key default)
(case key
[(color-lexer)
(dynamic-require 'jsonic/colorer 'color-jsonic)]
[(drracket:indentation)
(dynamic-require 'jsonic/indenter 'indent-jsonic)]
[(drracket:toolbar-buttons)
(dynamic-require 'jsonic/buttons 'button-list)]
[else default]))
handle-query))
#lang br/quicklang
(require "tokenizer.rkt" "parser.rkt" racket/contract)
(define (read-syntax path port)
(define parse-tree (parse path (make-tokenizer port)))
(define module-datum `(module jsonic-module jsonic/expander
,parse-tree))
(datum->syntax #f module-datum))
(provide (contract-out
[read-syntax (any/c input-port? . -> . syntax?)]))
#lang br/quicklang
(require brag/support racket/contract)
(module+ test
(require rackunit))
(define (jsonic-token? x)
(or (eof-object? x) (token-struct? x)))
(module+ test
(check-true (jsonic-token? eof))
(check-true (jsonic-token? (token 'A-TOKEN-STRUCT "hi")))
(check-false (jsonic-token? 42)))
(define (make-tokenizer port)
(port-count-lines! port)
(define (next-token)
(define jsonic-lexer
(lexer
[(from/to "//" "\n") (next-token)]
[(from/to "@$" "$@")
(token 'SEXP-TOK (trim-ends "@$" lexeme "$@")
#:position (+ (pos lexeme-start) 2)
#:line (line lexeme-start)
#:column (+ (col lexeme-start) 2)
#:span (- (pos lexeme-end)
(pos lexeme-start) 4))]
[any-char (token 'CHAR-TOK lexeme
#:position (pos lexeme-start)
#:line (line lexeme-start)
#:column (col lexeme-start)
#:span (- (pos lexeme-end)
(pos lexeme-start)))]))
(jsonic-lexer port))
next-token)
(provide
(contract-out
[make-tokenizer (input-port? . -> . (-> jsonic-token?))]))
(module+ test
(check-equal?
(apply-tokenizer-maker make-tokenizer "// comment\n")
empty)
(check-equal?
(apply-tokenizer-maker make-tokenizer "@$ (+ 6 7) $@")
(list (token 'SEXP-TOK " (+ 6 7) "
#:position 3
#:line 1
#:column 2
#:span 9)))
(check-equal?
(apply-tokenizer-maker make-tokenizer "hi")
(list (token 'CHAR-TOK "h"
#:position 1
#:line 1
#:column 0
#:span 1)
(token 'CHAR-TOK "i"
#:position 2
#:line 1
#:column 1
#:span 1))))
#lang brag
jsonic-program : (jsonic-char | jsonic-sexp)*
jsonic-char : CHAR-TOK
jsonic-sexp : SEXP-TOK
#lang br/quicklang
(require json)
(define-macro (jsonic-mb PARSE-TREE)
#'(#%module-begin
(define result-string PARSE-TREE)
(define validated-jsexpr (string->jsexpr result-string))
(display result-string)))
(provide (rename-out [jsonic-mb #%module-begin]))
(define-macro (jsonic-char CHAR-TOK-VALUE)
#'CHAR-TOK-VALUE)
(provide jsonic-char)
(define-macro (jsonic-program SEXP-OR-JSON-STR ...)
#'(string-trim (string-append SEXP-OR-JSON-STR ...)))
(provide jsonic-program)
(define-macro (jsonic-sexp SEXP-STR)
(with-pattern ([SEXP-DATUM (format-datum '~a #'SEXP-STR)])
#'(jsexpr->string SEXP-DATUM)))
(provide jsonic-sexp)
#lang br
(require "parser.rkt" "tokenizer.rkt" brag/support rackunit)
(check-equal?
(parse-to-datum
(apply-tokenizer-maker make-tokenizer "// line commment\n"))
'(jsonic-program))
(check-equal?
(parse-to-datum
(apply-tokenizer-maker make-tokenizer "@$ 42 $@"))
'(jsonic-program (jsonic-sexp " 42 ")))
(check-equal?
(parse-to-datum
(apply-tokenizer-maker make-tokenizer "hi"))
'(jsonic-program
(jsonic-char "h")
(jsonic-char "i")))
(check-equal?
(parse-to-datum
(apply-tokenizer-maker make-tokenizer
"hi\n// comment\n@$ 42 $@"))
'(jsonic-program
(jsonic-char "h")
(jsonic-char "i")
(jsonic-char "\n")
(jsonic-sexp " 42 ")))
#lang br
(require brag/support syntax-color/racket-lexer
racket/contract)
(define jsonic-lexer
(lexer
[(eof) (values lexeme 'eof #f #f #f)]
[(:or "@$" "$@")
(values lexeme 'parenthesis
(if (equal? lexeme "@$") '|(| '|)|)
(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))]))
(define (color-jsonic port offset racket-coloring-mode?)
(cond
[(or (not racket-coloring-mode?)
(equal? (peek-string 2 0 port) "$@"))
(define-values (str cat paren start end)
(jsonic-lexer port))
(define switch-to-racket-mode (equal? str "@$"))
(values str cat paren start end 0 switch-to-racket-mode)]
[else
(define-values (str cat paren start end)
(racket-lexer port))
(values str cat paren start end 0 #t)]))
(provide
(contract-out
[color-jsonic
(input-port? exact-nonnegative-integer? boolean?
. -> . (values
(or/c string? eof-object?)
symbol?
(or/c symbol? #f)
(or/c exact-positive-integer? #f)
(or/c exact-positive-integer? #f)
exact-nonnegative-integer?
boolean?))]))
(module+ test
(require rackunit)
(check-equal? (values->list
(color-jsonic (open-input-string "x") 0 #f))
(list "x" 'string #f 1 2 0 #f)))
#lang br
(require br/indent racket/contract racket/gui/base)
(define indent-width 2)
(define (left-bracket? c) (member c (list #\{ #\[)))
(define (right-bracket? c) (member c (list #\} #\])))
(define (indent-jsonic tbox [posn 0])
(define prev-line (previous-line tbox posn))
(define current-line (line tbox posn))
(cond
[(not prev-line) 0]
[else
(define prev-indent (line-indent tbox prev-line))
(cond
[(left-bracket?
(line-first-visible-char tbox prev-line))
(+ prev-indent indent-width)]
[(right-bracket?
(line-first-visible-char tbox current-line))
(- prev-indent indent-width)]
[else prev-indent])]))
(provide
(contract-out
[indent-jsonic (((is-a?/c text%))
(exact-nonnegative-integer?) . ->* .
exact-nonnegative-integer?)]))
(module+ test
(require rackunit)
(define test-str #<<HERE
#lang jsonic
{
"value": 42,
"string":
[
{
"array": @$(range 5)$@,
"object": @$(hash 'k1 "valstring")$@
}
]
// "bar"
}
HERE
)
(check-equal?
(string-indents (apply-indenter indent-jsonic test-str))
'(0 0 2 2 2 4 6 6 4 2 2 0)))
#lang br
(require racket/draw)
(define (button-func drr-window)
(define expr-string "@$ $@")
(define editor (send drr-window get-definitions-text))
(send editor insert expr-string)
(define pos (send editor get-start-position))
(send editor set-position (- pos 3)))
(define our-jsonic-button
(list
"Insert expression"
(make-object bitmap% 16 16)
button-func
#f))
(provide button-list)
(define button-list (list our-jsonic-button))
#lang jsonic
// a line comment
[
@$ 'null $@,
@$ (* 6 7) $@,
@$ (= 2 (+ 1 1)) $@,
@$ (list "array" "of" "strings") $@,
@$ (hash 'key-1 'null
'key-2 (even? 3)
'key-3 (hash 'subkey 21)) $@
]