From 46f389f64d791b815cad8bfdd5934f3eff8dab2b Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
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 #<<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)))
+  
diff --git a/beautiful-racket-demo/jsonic-demo-3/info.rkt b/beautiful-racket-demo/jsonic-demo-3/info.rkt
new file mode 100644
index 0000000..f8c7240
--- /dev/null
+++ b/beautiful-racket-demo/jsonic-demo-3/info.rkt
@@ -0,0 +1,3 @@
+#lang info
+
+(define scribblings '(("scribblings/jsonic.scrbl")))
diff --git a/beautiful-racket-demo/jsonic-demo-3/jsonic-test.rkt b/beautiful-racket-demo/jsonic-demo-3/jsonic-test.rkt
new file mode 100644
index 0000000..6a1039c
--- /dev/null
+++ b/beautiful-racket-demo/jsonic-demo-3/jsonic-test.rkt
@@ -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)) $@
+]
\ No newline at end of file
diff --git a/beautiful-racket-demo/jsonic-demo-3/main.rkt b/beautiful-racket-demo/jsonic-demo-3/main.rkt
new file mode 100644
index 0000000..b252746
--- /dev/null
+++ b/beautiful-racket-demo/jsonic-demo-3/main.rkt
@@ -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))
+
diff --git a/beautiful-racket-demo/jsonic-demo-3/parser-test.rkt b/beautiful-racket-demo/jsonic-demo-3/parser-test.rkt
new file mode 100644
index 0000000..6d68926
--- /dev/null
+++ b/beautiful-racket-demo/jsonic-demo-3/parser-test.rkt
@@ -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 ")))
\ No newline at end of file
diff --git a/beautiful-racket-demo/jsonic-demo-3/parser.rkt b/beautiful-racket-demo/jsonic-demo-3/parser.rkt
new file mode 100644
index 0000000..69a706d
--- /dev/null
+++ b/beautiful-racket-demo/jsonic-demo-3/parser.rkt
@@ -0,0 +1,4 @@
+#lang brag
+jsonic-program: (json-char | s-exp)*
+json-char: CHAR-TOK
+s-exp: SEXP-TOK
diff --git a/beautiful-racket-demo/jsonic-demo-3/reader.rkt b/beautiful-racket-demo/jsonic-demo-3/reader.rkt
new file mode 100644
index 0000000..82b8b1e
--- /dev/null
+++ b/beautiful-racket-demo/jsonic-demo-3/reader.rkt
@@ -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?)]))
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