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 mod line col 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 (token? x)
(or (eof-object? x) (token-struct? x)))
(module+ test
(check-true (token? eof))
(check-true (token? (token 'A-TOKEN-STRUCT "hi")))
(check-false (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? . -> . (-> 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 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)))
#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)) $@
]
#lang scribble/manual
@(require (for-label json))
@title{jsonic: because JSON is boring}
@author{Roxy Lexington}
@defmodulelang[jsonic]
@section{Introduction}
This is a domain-specific language
that relies on the @racketmodname[json] library.
In particular, the @racket[jsexpr->string] function.
If we start with this:
@verbatim|{
#lang jsonic
[
@$ 'null $@,
@$ (* 6 7) $@,
@$ (= 2 (+ 1 1)) $@
]
}|
We'll end up with this:
@verbatim{
[
null,
42,
true
]
}
#lang info
(define collection "jsonic")
(define version "1.0")
(define scribblings '(("scribblings/jsonic.scrbl")))
(define test-omit-paths '("jsonic-test.rkt"))
(define deps '("base"
"beautiful-racket-lib"
"brag"
"draw-lib"
"gui-lib"
"br-parser-tools-lib"
"rackunit-lib"
"syntax-color-lib"))
(define build-deps '("scribble-lib"))