;; 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)