textmate-bjolang/tests/demo.bjo
Linus Björnstam 0ecc65e134 textmate-bjolang: code highlighted as VS Code does, as Bjolang values
TextMateSharp runs VS Code's TextMate grammars and themes; this hands
the result over once, as Bjolang values, so nothing using it needs to
know TextMateSharp is there. `tokenize` gives each line's tokens and
their scopes, `highlight` each line's spans in the theme's colours, and
`highlight->node` and `code->node` give (text xml) nodes: a pre and a
code element around spans, coloured inline by the theme or by class
names taken from the scopes. `highlighter-css` writes the stylesheet
for the classes from a theme, choosing each class's rule the way
TextMateSharp's tokenizer chooses a token's.

Bjolang's own grammar is in grammars/bjolang, laid out as a VS Code
extension, and every highlighter reads it from beside the package's
src/. It follows what Bjolang's reader reads, including interpolated
strings with expressions in their holes.

There is no C# shim: everything goes through import/class and
import/extern. The package is kept within TextMateSharp 2.0, because
token colours are decoded with a class in its Internal namespace.

🤖 Generated with [ECA](https://eca.dev) (anthropic/claude-opus-4-7)

Co-Authored-By: eca-agent <git@eca.dev>
2026-09-30 15:51:24 +02:00

181 lines
10 KiB
Text

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;; textmate-bjolang/tests/demo.bjo — languages, tokens, spans, classes and
;; nodes, in Dark+.
;;
;; bjo run tests/demo.bjo
(import (std prelude))
(import (std simpletest))
(import (text xml))
(import (textmate-bjolang core))
(import/extern
(clr-index-of (: System.String.IndexOf (-> string string System.StringComparison int)))
(clr-ordinal (: System.StringComparison.Ordinal #:get)))
(: string-index-of (-> string string int))
(defun (string-index-of s needle) (clr-index-of s needle clr-ordinal))
(: language (-> TmHighlighter string TmLanguage))
(defun (language hl name)
(match (find-language hl name)
((Some l) l)
(None (panic! (str "no language " name)))))
(: texts (-> (Vec TmToken) (Vec string)))
(defun (texts tokens) (vec-map (fun (t) (record-ref t text)) tokens))
(: innermost (-> TmToken string))
(defun (innermost t)
(def scopes (record-ref t scopes))
(vec-ref scopes (- (vec-length scopes) 1)))
;; The classes of the first token whose text is `text`, in the first line.
(: classes-of (-> TmLanguage string string string))
(defun (classes-of lang code text)
(loop (:for t (vec-ref (tokenize lang code) 0))
(:acc found (folding "(no such token)"
(if (and (= found "(no such token)") (= (record-ref t text) text))
(string-join (token-classes t) " ")
found)))))
(: scope (-> string (Vec string) TmToken))
(defun (scope text scopes) (TmToken (text text) (scopes scopes)))
(defun (main args)
(def hl (highlighter #:theme 'dark-plus))
(def cs (language hl "csharp"))
(def bjo (language hl "bjolang"))
(def line "var x = 1; // hi")
;; --- languages --------------------------------------------------------------
(expect "a language by id, alias and extension, in any case, and none for the unknown"
(vec-map (fun (n) (match (find-language hl n) ((Some l) (language-id l)) (None "-")))
["csharp" "C#" "cs" ".CS" "bjo" ".bjo" "Bjolang" "klingon" ""])
["csharp" "csharp" "csharp" "csharp" "bjolang" "bjolang" "bjolang" "-" "-"])
(expect-true "VS Code's languages, and Bjolang's from beside the package's src/"
(and (vec-contains (language-names hl) "bjolang")
(vec-contains (language-names hl) "fsharp")
(> (vec-length (language-names hl)) 60)))
(expect "a grammar package that is not there is refused"
(match (try (highlighter #:grammars (list "/nonexistent/grammar")) #:catch (System.ArgumentException))
((Ok _) "accepted")
((Err _) "refused"))
"refused")
;; --- tokens -----------------------------------------------------------------
(def tokens (vec-ref (tokenize cs line) 0))
(expect "a line's tokens cover its text"
(texts tokens)
["var" " " "x" " " "=" " " "1" ";" " " "//" " hi"])
(expect "each has its scopes, the outermost first"
(record-ref (vec-ref tokens 9) scopes)
["source.cs" "comment.line.double-slash.cs" "punctuation.definition.comment.cs"])
(expect "a comment's state is carried to the next line"
(innermost (vec-ref (vec-ref (tokenize cs "/* a\n b */ int y;") 1) 0))
"comment.block.cs")
(expect "\\r\\n, \\r and \\n end lines, and a newline at the end starts none"
(vec-map (fun (code) (vec-length (tokenize cs code))) ["a\r\nb\rc\n" "" "\n" "a\n\n"])
[3 0 1 2])
;; --- spans ------------------------------------------------------------------
(def spans (vec-ref (highlight cs line) 0))
(expect "spans that look alike are joined, whitespace and the default colour are plain"
(vec-map (fun (s) (record-ref s text)) spans)
["var" " " "x" " = " "1" "; " "// hi"])
(expect "colours are the theme's, and None where the pre's colour will do"
(vec-map (fun (s) (option-value (record-ref (record-ref s style) color) "-")) spans)
["#569CD6" "-" "#9CDCFE" "-" "#B5CEA8" "-" "#6A9955"])
(expect "the editor's colours"
(Tuple (highlighter-foreground hl) (highlighter-background hl))
(Tuple "#D4D4D4" "#1E1E1E"))
;; --- classes ----------------------------------------------------------------
(expect "a class is the innermost scope the vocabulary knows, the general and the particular"
(vec-map (fun (t) (string-join (token-classes t) " "))
[(scope "var" ["source.cs" "storage.type.var.cs"])
(scope "f" ["source.bjolang" "entity.name.function.member.bjolang"])
(scope "if" ["source.x" "meta.block.x" "keyword.control.x"])
(scope "{" ["source.x" "meta.block.x"])])
["tm-storage tm-storage-type" "tm-entity tm-entity-name-function" "tm-keyword tm-keyword-control" ""])
(expect "a string's quotes and a comment's marker are the string and the comment"
(vec-map (fun (t) (string-join (token-classes t) " "))
[(scope "\"" ["source.cs" "string.quoted.double.cs" "punctuation.definition.string.begin.cs"])
(scope "//" ["source.cs" "comment.line.double-slash.cs" "punctuation.definition.comment.cs"])])
["tm-string" "tm-comment"])
(expect "embedded code is not coloured by what it is embedded in"
(string-join (token-classes (scope "x" ["source.bjolang" "string.interpolated.bjolang"
"meta.embedded.line.bjolang" "source.bjolang"]))
" ")
"")
;; --- nodes ------------------------------------------------------------------
(expect "inline: the theme's colours in style attributes"
(->str (highlight->node cs line))
(str "(pre (@ (class \"tm\") (style \"color:#D4D4D4;background-color:#1E1E1E\"))"
" (code (@ (class \"language-csharp\"))"
" (span (@ (style \"color:#569CD6\")) \"var\") \" \" (span (@ (style \"color:#9CDCFE\")) \"x\")"
" \" = \" (span (@ (style \"color:#B5CEA8\")) \"1\") \"; \" (span (@ (style \"color:#6A9955\")) \"// hi\")))"))
(expect "classes: the scopes' names, and no theme"
(->str (highlight->node cs line #:style 'classes))
(str "(pre (@ (class \"tm\")) (code (@ (class \"language-csharp\"))"
" (span (@ (class \"tm-storage tm-storage-type\")) \"var\") \" \""
" (span (@ (class \"tm-entity tm-entity-name-variable\")) \"x\") \" \""
" (span (@ (class \"tm-keyword tm-keyword-operator\")) \"=\") \" \""
" (span (@ (class \"tm-constant tm-constant-numeric\")) \"1\")"
" (span (@ (class \"tm-punctuation\")) \";\") \" \" (span (@ (class \"tm-comment\")) \"// hi\")))"))
(expect "lines, each a span with its newline inside, and an unknown language as plain text"
(->str (code->node hl "klingon" "one\n\nthree" #:style 'classes #:lines? #t))
(str "(pre (@ (class \"tm\")) (code (@ (class \"language-klingon\"))"
" (span (@ (class \"line\")) \"one\\n\") (span (@ (class \"line\")) \"\\n\")"
" (span (@ (class \"line\")) \"three\")))"))
(expect "a Markdown info string's first word names the language"
(->str (code->node hl "C# title=x" "1"))
(str "(pre (@ (class \"tm\") (style \"color:#D4D4D4;background-color:#1E1E1E\"))"
" (code (@ (class \"language-csharp\")) (span (@ (style \"color:#B5CEA8\")) \"1\")))"))
(expect "several lines, a newline between them"
(->str (highlight->nodes cs "1\n2" #:style 'classes))
(str "'((span (@ (class \"tm-constant tm-constant-numeric\")) \"1\") \"\\n\""
" (span (@ (class \"tm-constant tm-constant-numeric\")) \"2\"))"))
;; --- the stylesheet ---------------------------------------------------------
(def css (highlighter-css hl))
(expect-true "the stylesheet starts with the pre's colours"
(string-starts-with? css ".tm{color:#D4D4D4;background-color:#1E1E1E}\n"))
(expect-true "and has the theme's colour for each class it colours"
(and (string-contains? css ".tm .tm-comment{color:#6A9955}")
(string-contains? css ".tm .tm-keyword-control{color:#C586C0}")
(string-contains? css ".tm .tm-string{color:#CE9178}")
(string-contains? css ".tm .tm-storage-type{color:#569CD6}")))
(expect-true "the rule is the one TextMateSharp colours by: the theme's own before the one it includes"
(string-contains? (highlighter-css (highlighter #:theme 'light-plus))
".tm .tm-variable-language{color:#001080}"))
(expect-true "the general class comes before the particular"
(match (Tuple (string-index-of css ".tm .tm-keyword{") (string-index-of css ".tm .tm-keyword-control{"))
((Tuple a b) (and (>= a 0) (< a b)))))
(expect-true "under a selector of one's own"
(string-starts-with? (highlighter-css hl #:selector "pre.dark") "pre.dark{"))
(expect "another theme, other colours"
(let ((light (highlighter #:theme 'light-plus)))
(Tuple (highlighter-foreground light) (highlighter-background light)))
(Tuple "#000000" "#FFFFFF"))
;; --- Bjolang ----------------------------------------------------------------
(def src "(defun (greet name #:loud #f) #\"hi ${name}\" 'sym) ; ok")
(expect "Bjolang: a definition, its name, a keyword, a boolean, a symbol and a comment"
(vec-map (fun (text) (classes-of bjo src text)) ["defun" "greet" "#:loud" "#f" "'sym" " ok"])
["tm-storage tm-storage-type" "tm-entity tm-entity-name-function" "tm-variable tm-variable-parameter"
"tm-constant tm-constant-language" "tm-constant tm-constant-language" "tm-comment"])
(expect "Bjolang: an interpolated string, its hole, and the code inside it"
(vec-map (fun (text) (classes-of bjo src text)) ["#\"" "hi " "${" "name" "}"])
["tm-string" "tm-string" "tm-punctuation tm-punctuation-section-embedded" ""
"tm-punctuation tm-punctuation-section-embedded"])
(expect "Bjolang: a string runs over lines"
(innermost (vec-ref (vec-ref (tokenize bjo "(f \"one\ntwo\" x)") 1) 0))
"string.quoted.double.bjolang")
(println "textmate-bjolang ok")
0)