From 46f389f64d791b815cad8bfdd5934f3eff8dab2b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 10 Jan 2017 15:29:10 -0800 Subject: [PATCH] start jsonic-demo-3 --- .../jsonic-demo-3/buttons.rkt | 21 +++++++ .../jsonic-demo-3/colorer.rkt | 42 +++++++++++++ .../jsonic-demo-3/expander.rkt | 22 +++++++ .../jsonic-demo-3/indenter.rkt | 48 +++++++++++++++ beautiful-racket-demo/jsonic-demo-3/info.rkt | 3 + .../jsonic-demo-3/jsonic-test.rkt | 11 ++++ beautiful-racket-demo/jsonic-demo-3/main.rkt | 16 +++++ .../jsonic-demo-3/parser-test.rkt | 21 +++++++ .../jsonic-demo-3/parser.rkt | 4 ++ .../jsonic-demo-3/reader.rkt | 10 +++ .../jsonic-demo-3/scribblings/jsonic.scrbl | 9 +++ .../jsonic-demo-3/tokenizer.rkt | 61 +++++++++++++++++++ 12 files changed, 268 insertions(+) create mode 100644 beautiful-racket-demo/jsonic-demo-3/buttons.rkt create mode 100644 beautiful-racket-demo/jsonic-demo-3/colorer.rkt create mode 100644 beautiful-racket-demo/jsonic-demo-3/expander.rkt create mode 100644 beautiful-racket-demo/jsonic-demo-3/indenter.rkt create mode 100644 beautiful-racket-demo/jsonic-demo-3/info.rkt create mode 100644 beautiful-racket-demo/jsonic-demo-3/jsonic-test.rkt create mode 100644 beautiful-racket-demo/jsonic-demo-3/main.rkt create mode 100644 beautiful-racket-demo/jsonic-demo-3/parser-test.rkt create mode 100644 beautiful-racket-demo/jsonic-demo-3/parser.rkt create mode 100644 beautiful-racket-demo/jsonic-demo-3/reader.rkt create mode 100644 beautiful-racket-demo/jsonic-demo-3/scribblings/jsonic.scrbl create mode 100644 beautiful-racket-demo/jsonic-demo-3/tokenizer.rkt diff --git a/beautiful-racket-demo/jsonic-demo-3/buttons.rkt b/beautiful-racket-demo/jsonic-demo-3/buttons.rkt new file mode 100644 index 0000000..8fdf6b9 --- /dev/null +++ b/beautiful-racket-demo/jsonic-demo-3/buttons.rkt @@ -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)) + + diff --git a/beautiful-racket-demo/jsonic-demo-3/colorer.rkt b/beautiful-racket-demo/jsonic-demo-3/colorer.rkt new file mode 100644 index 0000000..cc43da2 --- /dev/null +++ b/beautiful-racket-demo/jsonic-demo-3/colorer.rkt @@ -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))) \ No newline at end of file diff --git a/beautiful-racket-demo/jsonic-demo-3/expander.rkt b/beautiful-racket-demo/jsonic-demo-3/expander.rkt new file mode 100644 index 0000000..2744e5a --- /dev/null +++ b/beautiful-racket-demo/jsonic-demo-3/expander.rkt @@ -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) \ No newline at end of file diff --git a/beautiful-racket-demo/jsonic-demo-3/indenter.rkt b/beautiful-racket-demo/jsonic-demo-3/indenter.rkt new file mode 100644 index 0000000..7c2b5ac --- /dev/null +++ b/beautiful-racket-demo/jsonic-demo-3/indenter.rkt @@ -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 #<syntax #f module-datum)) +(provide (contract-out + [read-syntax (any/c input-port? . -> . syntax?)])) diff --git a/beautiful-racket-demo/jsonic-demo-3/scribblings/jsonic.scrbl b/beautiful-racket-demo/jsonic-demo-3/scribblings/jsonic.scrbl new file mode 100644 index 0000000..7fb3c5a --- /dev/null +++ b/beautiful-racket-demo/jsonic-demo-3/scribblings/jsonic.scrbl @@ -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. \ No newline at end of file diff --git a/beautiful-racket-demo/jsonic-demo-3/tokenizer.rkt b/beautiful-racket-demo/jsonic-demo-3/tokenizer.rkt new file mode 100644 index 0000000..5887f01 --- /dev/null +++ b/beautiful-racket-demo/jsonic-demo-3/tokenizer.rkt @@ -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)))) \ No newline at end of file