start jsonic-demo-3
parent
763bb5165e
commit
46f389f64d
@ -0,0 +1,21 @@
|
||||
#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))
|
||||
|
||||
|
||||
@ -0,0 +1,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)))
|
||||
@ -0,0 +1,22 @@
|
||||
#lang br/quicklang
|
||||
(require json)
|
||||
|
||||
(define-macro (js-module-begin PARSE-TREE)
|
||||
#'(#%module-begin
|
||||
(define result-string PARSE-TREE)
|
||||
(define validated-jsexpr (string->jsexpr result-string))
|
||||
(display result-string)))
|
||||
(provide (rename-out [js-module-begin #%module-begin]))
|
||||
|
||||
(define-macro (jsonic-program SEXP-OR-JSON-STR ...)
|
||||
#'(string-trim (string-append SEXP-OR-JSON-STR ...)))
|
||||
(provide jsonic-program)
|
||||
|
||||
(define-macro (json-char CHAR-STR)
|
||||
#'CHAR-STR)
|
||||
(provide json-char)
|
||||
|
||||
(define-macro (s-exp SEXP-STR)
|
||||
(with-pattern ([SEXP-DATUM (format-datum '~a #'SEXP-STR)])
|
||||
#'(jsexpr->string SEXP-DATUM)))
|
||||
(provide s-exp)
|
||||
@ -0,0 +1,48 @@
|
||||
#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))
|
||||
(define prev-indent (or (line-indent tbox prev-line) 0))
|
||||
(define current-indent
|
||||
(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]))
|
||||
(and (exact-positive-integer? current-indent) current-indent))
|
||||
(provide
|
||||
(contract-out
|
||||
[indent-jsonic (((is-a?/c text%))
|
||||
(exact-nonnegative-integer?) . ->* .
|
||||
(or/c exact-nonnegative-integer? #f))]))
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
(define test-str #<<HERE
|
||||
#lang jsonic
|
||||
{
|
||||
"value",
|
||||
"string":
|
||||
[
|
||||
{
|
||||
"array": @$(range 5)$@,
|
||||
"object": @$(hash 'k1 "valstring")$@
|
||||
}
|
||||
]
|
||||
// "bar"
|
||||
}
|
||||
HERE
|
||||
)
|
||||
(check-equal?
|
||||
(string-indents (apply-indenter indent-jsonic test-str))
|
||||
'(#f #f 2 2 2 4 6 6 4 2 2 #f)))
|
||||
|
||||
@ -0,0 +1,3 @@
|
||||
#lang info
|
||||
|
||||
(define scribblings '(("scribblings/jsonic.scrbl")))
|
||||
@ -0,0 +1,11 @@
|
||||
#lang jsonic-demo-2
|
||||
// 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)) $@
|
||||
]
|
||||
@ -0,0 +1,16 @@
|
||||
#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-demo-2/colorer 'color-jsonic)]
|
||||
[(drracket:indentation)
|
||||
(dynamic-require 'jsonic-demo-2/indenter 'indent-jsonic)]
|
||||
[(drracket:toolbar-buttons)
|
||||
(dynamic-require 'jsonic-demo-2/buttons 'button-list)]
|
||||
[else default]))
|
||||
handle-query))
|
||||
|
||||
@ -0,0 +1,21 @@
|
||||
#lang br
|
||||
(require "parser.rkt" "tokenizer.rkt" brag/support rackunit)
|
||||
|
||||
(check-equal?
|
||||
(parse-tree (apply-tokenizer tokenize "// line commment\n"))
|
||||
'(jsonic-program))
|
||||
(check-equal?
|
||||
(parse-tree (apply-tokenizer tokenize "@$ 42 $@"))
|
||||
'(jsonic-program (s-exp " 42 ")))
|
||||
(check-equal?
|
||||
(parse-tree (apply-tokenizer tokenize "hi"))
|
||||
'(jsonic-program
|
||||
(json-char "h")
|
||||
(json-char "i")))
|
||||
(check-equal?
|
||||
(parse-tree (apply-tokenizer tokenize "hi\n// comment\n@$ 42 $@"))
|
||||
'(jsonic-program
|
||||
(json-char "h")
|
||||
(json-char "i")
|
||||
(json-char "\n")
|
||||
(s-exp " 42 ")))
|
||||
@ -0,0 +1,4 @@
|
||||
#lang brag
|
||||
jsonic-program: (json-char | s-exp)*
|
||||
json-char: CHAR-TOK
|
||||
s-exp: SEXP-TOK
|
||||
@ -0,0 +1,10 @@
|
||||
#lang br/quicklang
|
||||
(require "tokenizer.rkt" "parser.rkt" racket/contract)
|
||||
|
||||
(define (read-syntax path port)
|
||||
(define parse-tree (parse path (tokenize port)))
|
||||
(define module-datum `(module jsonic-module jsonic-demo-2/expander
|
||||
,parse-tree))
|
||||
(datum->syntax #f module-datum))
|
||||
(provide (contract-out
|
||||
[read-syntax (any/c input-port? . -> . syntax?)]))
|
||||
@ -0,0 +1,9 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@title[#:style 'toc]{@tt{jsonic}: because JSON is boring}
|
||||
|
||||
@author[(author+email "Roger Freenbean" "roger@freenbean.com")]
|
||||
|
||||
@defmodulelang[jsonic]
|
||||
|
||||
Let's document.
|
||||
@ -0,0 +1,61 @@
|
||||
#lang br/quicklang
|
||||
(require brag/support racket/contract)
|
||||
|
||||
(module+ test
|
||||
(require rackunit))
|
||||
|
||||
(define (token? x)
|
||||
(or (eof-object? x) (string? x) (token-struct? x)))
|
||||
|
||||
(module+ test
|
||||
(check-true (token? eof))
|
||||
(check-true (token? "a string"))
|
||||
(check-true (token? (token 'A-TOKEN-STRUCT "hi")))
|
||||
(check-false (token? 42)))
|
||||
|
||||
(define (tokenize port)
|
||||
(port-count-lines! port)
|
||||
(define (next-token)
|
||||
(define our-lexer
|
||||
(lexer
|
||||
[(eof) eof]
|
||||
[(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)))]))
|
||||
(our-lexer port))
|
||||
next-token)
|
||||
(provide (contract-out
|
||||
[tokenize (input-port? . -> . (-> token?))]))
|
||||
|
||||
(module+ test
|
||||
(check-equal? (apply-tokenizer tokenize "// comment\n") empty)
|
||||
(check-equal?
|
||||
(apply-tokenizer tokenize "@$ (+ 6 7) $@")
|
||||
(list (token 'SEXP-TOK " (+ 6 7) "
|
||||
#:position 3
|
||||
#:line 1
|
||||
#:column 2
|
||||
#:span 9)))
|
||||
(check-equal?
|
||||
(apply-tokenizer tokenize "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))))
|
||||
Loading…
Reference in New Issue