From 12908d03411882eaa04302d61a8643e8f9ed3eda Mon Sep 17 00:00:00 2001 From: Neil Date: Fri, 23 Oct 2026 08:14:19 -0700 Subject: [PATCH] fix(editor): highlight recognized Haskell source and diffs Adapt existing PR #25411 (c1fa6cee62ad0ae3ac5281e7799fbf6d51879f68) to main 120f01331ca7c5785da2e529ad698ced18bd53f6. Keep the current isolated Shiki core and bounded tokenizer, add an optional scope mapping, and recognize Haskell signatures and boot files in the shared detector. Retain the original maintained Haskell grammar and BSD-3-Clause license from David Wis's #25315 contribution. Exercise production Monaco setup, real tokenization, nested multiline comments, and existing language controls. Co-authored-by: davidwis --- .../licenses/language-haskell/LICENSE.txt | 30 + .../licenses/language-haskell/UPSTREAM.txt | 4 + .../haskell-highlighting.test.ts | 70 + .../lib/monaco-languages/register-haskell.ts | 71 + .../textmate-grammars/haskell.tmLanguage.json | 2639 +++++++++++++++++ .../textmate-language-registration.ts | 8 +- .../textmate-token-provider.ts | 9 +- src/renderer/src/lib/monaco-setup.ts | 2 + .../editor-language/editor-language-detect.ts | 2 + tests/e2e/editor-haskell-highlighting.spec.ts | 104 + 10 files changed, 2934 insertions(+), 5 deletions(-) create mode 100644 resources/licenses/language-haskell/LICENSE.txt create mode 100644 resources/licenses/language-haskell/UPSTREAM.txt create mode 100644 src/renderer/src/lib/monaco-languages/haskell-highlighting.test.ts create mode 100644 src/renderer/src/lib/monaco-languages/register-haskell.ts create mode 100644 src/renderer/src/lib/monaco-languages/textmate-grammars/haskell.tmLanguage.json create mode 100644 tests/e2e/editor-haskell-highlighting.spec.ts diff --git a/resources/licenses/language-haskell/LICENSE.txt b/resources/licenses/language-haskell/LICENSE.txt new file mode 100644 index 00000000000..d071fb9ef84 --- /dev/null +++ b/resources/licenses/language-haskell/LICENSE.txt @@ -0,0 +1,30 @@ +Copyright (c) 2017 Justus Adam + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Justus Adam nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/resources/licenses/language-haskell/UPSTREAM.txt b/resources/licenses/language-haskell/UPSTREAM.txt new file mode 100644 index 00000000000..131f49c16f2 --- /dev/null +++ b/resources/licenses/language-haskell/UPSTREAM.txt @@ -0,0 +1,4 @@ +Source: https://github.com/haskell/language-haskell +Version: 3.8.0 (commit 417bdaf7d997b8561d8d52066120faca395a1ec7) +Grammar: syntaxes/haskell.YAML-tmLanguage, converted to JSON without changing its content. +License: BSD-3-Clause; the full upstream license is in LICENSE.txt. diff --git a/src/renderer/src/lib/monaco-languages/haskell-highlighting.test.ts b/src/renderer/src/lib/monaco-languages/haskell-highlighting.test.ts new file mode 100644 index 00000000000..1860ea748f6 --- /dev/null +++ b/src/renderer/src/lib/monaco-languages/haskell-highlighting.test.ts @@ -0,0 +1,70 @@ +// @vitest-environment happy-dom +import { describe, expect, it, vi } from 'vitest' +import { loadNodeOniguruma } from '../syntax-highlighting/oniguruma-test-harness' +import { monaco } from '../monaco-setup' +import { detectLanguage } from '../../../../shared/editor-language/editor-language-detect' + +vi.mock('../syntax-highlighting/oniguruma', () => ({ loadOniguruma: loadNodeOniguruma })) + +describe('Haskell highlighting through production Monaco setup', () => { + it.each(['Main.hs', 'Signature.hsig', 'Main.hs-boot', 'C:\\folder workspace\\MAIN.HSIG'])( + 'recognizes and tokenizes %s through production Monaco setup', + async (filename) => { + const language = detectLanguage(filename) + expect(language).toBe('haskell') + const source = + 'module Main where\n-- comment\nanswer :: Int\nanswer = 42\nmain = putStrLn "hello"' + await monaco.editor.colorize(source, language, {}) + const tokens = monaco.editor.tokenize(source, language) + expect(tokens[0].map((token) => token.type)).toContain('keyword.other.module.haskell') + expect(new Set(tokens[1].map((token) => token.type))).toEqual(new Set(['comment.haskell'])) + expect(tokens[2].map((token) => token.type)).toEqual( + expect.arrayContaining(['type.identifier.haskell', 'type.haskell']) + ) + expect(tokens[3].map((token) => token.type)).toContain('number.haskell') + expect(tokens[4].map((token) => token.type)).toContain('string.quoted.double.haskell') + } + ) + + it('highlights a signature module in an hsig model', async () => { + const source = 'signature Example where\nanswer :: Int' + const language = detectLanguage('Example.hsig') + await monaco.editor.colorize(source, language, {}) + const tokens = monaco.editor.tokenize(source, language) + expect(tokens[0].map((token) => token.type)).toContain('keyword.other.signature.haskell') + expect(tokens[1].map((token) => token.type)).toContain('type.haskell') + }) + + it('retains the tokenization limit and leaves unknown following state plain', async () => { + const source = `${'x'.repeat(1001)}\nanswer = 42` + await monaco.editor.colorize(source, 'haskell', {}) + const tokens = monaco.editor.tokenize(source, 'haskell') + expect(tokens.map((line) => line.map((token) => token.type))).toEqual([ + ['source.haskell'], + ['source.haskell'] + ]) + }) + + it('keeps unrelated built-in language highlighting intact', async () => { + await monaco.editor.colorize('const answer = 42', 'typescript', {}) + expect( + monaco.editor.tokenize('const answer = 42', 'typescript')[0].map((token) => token.type) + ).toEqual(expect.arrayContaining(['keyword.ts', 'number.ts'])) + await monaco.editor.colorize('answer = 42 # comment', 'python', {}) + expect( + monaco.editor.tokenize('answer = 42 # comment', 'python')[0].map((token) => token.type) + ).toEqual(expect.arrayContaining(['number.python', 'comment.python'])) + }) + + it('carries nested comments across lines and returns to code after both closers', async () => { + const source = '{- outer {- inner\n-} still outer\n-}\nanswer = 42\ntext = "-- literal"' + await monaco.editor.colorize(source, 'haskell', {}) + const tokens = monaco.editor.tokenize(source, 'haskell') + expect(new Set(tokens[0].map((token) => token.type))).toEqual(new Set(['comment.haskell'])) + expect(new Set(tokens[1].map((token) => token.type))).toEqual(new Set(['comment.haskell'])) + expect(tokens[3].map((token) => token.type)).toContain('number.haskell') + expect(tokens[3].map((token) => token.type)).not.toContain('comment.haskell') + expect(tokens[4].map((token) => token.type)).toContain('string.quoted.double.haskell') + expect(tokens[4].map((token) => token.type)).not.toContain('comment.haskell') + }) +}) diff --git a/src/renderer/src/lib/monaco-languages/register-haskell.ts b/src/renderer/src/lib/monaco-languages/register-haskell.ts new file mode 100644 index 00000000000..3325b7697ab --- /dev/null +++ b/src/renderer/src/lib/monaco-languages/register-haskell.ts @@ -0,0 +1,71 @@ +import type * as Monaco from 'monaco-editor' +import type { LanguageRegistration } from 'shiki/core' +import { registerTextMateLanguage } from './textmate-language-registration' + +const HASKELL_SCOPE = 'source.haskell' + +export const haskellLanguageConfiguration: Monaco.languages.LanguageConfiguration = { + comments: { lineComment: '--', blockComment: ['{-', '-}'] }, + brackets: [ + ['{', '}'], + ['[', ']'], + ['(', ')'] + ], + autoClosingPairs: [ + { open: '{', close: '}' }, + { open: '[', close: ']' }, + { open: '(', close: ')' }, + { open: '"', close: '"', notIn: ['string', 'comment'] } + ], + surroundingPairs: [ + { open: '{', close: '}' }, + { open: '[', close: ']' }, + { open: '(', close: ')' }, + { open: '"', close: '"' }, + { open: "'", close: "'" } + ] +} + +function mapHaskellTokenScopes(scopes: readonly string[]): string { + if (scopes.some((scope) => scope.startsWith('comment.'))) { + return 'comment.haskell' + } + const scope = scopes.at(-1) ?? HASKELL_SCOPE + if (scope.startsWith('constant.numeric.')) { + return 'number.haskell' + } + if (scope.startsWith('constant.character.escape.')) { + return 'string.escape.haskell' + } + if (scope.startsWith('entity.name.function.')) { + return 'type.identifier.haskell' + } + if (scope.startsWith('storage.type.')) { + return 'type.haskell' + } + if (scope.startsWith('variable.other.generic-type.')) { + return 'variable.parameter.haskell' + } + return scope +} + +export async function loadHaskellTextMateGrammar(): Promise { + // BSD-3-Clause grammar; provenance and license ship in resources/licenses/language-haskell. + const grammarModule = await import('./textmate-grammars/haskell.tmLanguage.json') + // oxlint-disable-next-line typescript/consistent-type-assertions -- SAFETY: TextMate adds the required $self/$base repository entries; real tokenizer tests validate this generated upstream grammar. + const grammar = grammarModule.default as unknown as LanguageRegistration + return { ...grammar, name: 'haskell' } +} + +export function registerHaskellLanguage(monaco: Pick): void { + registerTextMateLanguage(monaco, { + language: { + id: 'haskell', + extensions: ['.hs', '.hsig', '.hs-boot'], + aliases: ['Haskell', 'haskell'] + }, + configuration: haskellLanguageConfiguration, + loadGrammar: loadHaskellTextMateGrammar, + mapTokenScopes: mapHaskellTokenScopes + }) +} diff --git a/src/renderer/src/lib/monaco-languages/textmate-grammars/haskell.tmLanguage.json b/src/renderer/src/lib/monaco-languages/textmate-grammars/haskell.tmLanguage.json new file mode 100644 index 00000000000..804aad899c5 --- /dev/null +++ b/src/renderer/src/lib/monaco-languages/textmate-grammars/haskell.tmLanguage.json @@ -0,0 +1,2639 @@ +{ + "fileTypes": ["hs", "hs-boot", "hsig"], + "keyEquivalent": "^~H", + "name": "Haskell", + "patterns": [ + { + "include": "#liquid_haskell" + }, + { + "include": "#comment_like" + }, + { + "include": "#numeric_literals" + }, + { + "include": "#string_literal" + }, + { + "include": "#char_literal" + }, + { + "match": "(?\n (?:\n [\\p{Lu}\\p{Lt}][\\p{Ll}_\\p{Lu}\\p{Lt}\\p{Lm}\\p{Lo}\\p{Nd}']*\n | \\(\\s*\n :[\\p{S}\\p{P}&&[^(),;\\[\\]`{}_\"']]*\n \\s*\\)\n )\n (?:\\s*,\\s*\\g)?\n)\n\\s+(::|∷)(?![\\p{S}\\p{P}&&[^(),;\\[\\]`{}_\"'']])\n", + "beginCaptures": { + "2": { + "name": "keyword.other.pattern.haskell" + }, + "3": { + "patterns": [ + { + "include": "#comma" + }, + { + "include": "#data_constructor" + } + ] + }, + "4": { + "name": "keyword.operator.double-colon.haskell" + } + }, + "end": "(?x) # Detect end of pattern type definition by decreasing indentation:\n (?=\\}|;) # Explicit indentation\n |^(?! # Implicit indentation: end match on newline *unless* the new line is either:\n \\1\\s+\\S # - more indented, or\n | \\s* # - starts with whitespace, followed by:\n (?: $ # - the end of the line (i.e. empty line), or\n |\\{-[^@] # - the start of a block comment, or\n |--+ # - the start of a single-line comment.\n (?![\\p{S}\\p{P}&&[^(),;\\[\\]{}`_\"']]).*$) # non-symbol\n # The double dash may not be followed by other operator characters\n # (then it would be an operator, not a comment)\n )\n", + "patterns": [ + { + "include": "#type_signature" + } + ] + }, + { + "name": "meta.declaration.pattern.haskell", + "begin": "(?:^(\\s*)|(?[\\p{Lu}\\p{Lt}][\\p{Ll}_\\p{Lu}\\p{Lt}\\p{Lm}\\p{Lo}\\p{Nd}']*(\\.\\g)?)", + "name": "entity.name.namespace.haskell" + }, + "pragma": { + "begin": "\\{-#", + "end": "#-\\}", + "name": "meta.preprocessor.haskell", + "patterns": [ + { + "include": "#comments" + }, + { + "include": "#string_literal" + }, + { + "begin": "(?xi) \\b(?\n \\(\n (?:\n \\g # Recurse first: consume nested parens before trying non-paren chars\n | [^()]++ # Non-parens (possessive: no backtracking into consumed chars)\n )*\n \\)\n )\n |\n \\{-(?:[^-]|-(?!\\}))*-\\}\n )*)\n (?|⇒)\n (?![\\p{S}\\p{P}&&[^(),;\\[\\]`{}_\"']])\n", + "captures": { + "1": { + "patterns": [ + { + "include": "#comment_like" + }, + { + "include": "#forall" + }, + { + "begin": "(?='?\\()", + "end": "(?=\\))", + "patterns": [ + { + "include": "#type_signature" + } + ] + }, + { + "begin": "(?='?\\[)", + "end": "(?=\\])", + "patterns": [ + { + "include": "#type_signature" + } + ] + }, + { + "match": "(?x)\n (\\S*)\\s*\n (?\n (?:\n [\\p{Ll}_\\p{Lm}\\p{Lo}][\\p{Ll}_\\p{Lu}\\p{Lt}\\p{Lm}\\p{Lo}\\p{Nd}']*\\#*\n | \\(\\s*\n (?!--+\\))\n [\\p{S}\\p{P}&&[^(),:;\\[\\]`{}_\"']]\n [\\p{S}\\p{P}&&[^(),;\\[\\]`{}_\"']]*\n \\s*\\)\n )\n (?:\\s*,\\s*\\g)?\n )\n \\s*(?)\n ((<-|←)|(=)|(-<|↢)|(-<<|⤛))\n # non-symbolic character\n ([(),;\\[\\]`{}_\"']|[^\\p{S}\\p{P}])\n )\n # Decreasing indentation:\n |(?=\\}|;) # Explicit indentation\n |^(?! # Implicit indentation: end match on newline *unless* the new line is either:\n \\1\\s+\\S # - more indented, or\n | \\s* # - starts with whitespace, followed by:\n (?: $ # - the end of the line (i.e. empty line), or\n |\\{-[^@] # - the start of a block comment, or\n |--+ # - the start of a single-line comment.\n (?![\\p{S}\\p{P}&&[^(),;\\[\\]{}`_\"']]).*$) # non-symbol\n # The double dash may not be followed by other operator characters\n # (then it would be an operator, not a comment)\n )\n" + }, + "adt_constructor": { + "patterns": [ + { + "include": "#comment_like" + }, + { + "begin": "(?x)\n (?\n \\( # Opening parenthesis\n (?:\n \\g # Recurse first: consume nested parens before trying non-paren chars\n | [^\\(\\)]++ # Non-parentheses (possessive: no backtracking into consumed chars)\n )*\n \\) # Closing parenthesis\n )\n )\n # Type inside balanced brackets\n | ('? # Optional promotion tick\n (?\n \\[ # Opening bracket\n (?:\n \\g # Recurse first: consume nested brackets before trying non-bracket chars\n | [^\\[\\]]++ # Non-brackets (possessive: no backtracking into consumed chars)\n )*\n \\] # Closing bracket\n )\n )\n )\n # Then either\n \\s*\n # - a symbolic infix constructor, or\n (?:(?\"\n (?!\n (?: # Match allowed intermediate tokens between the word and the '=>'\n # Note: we don't use inner '+' quantifier, to avoid excessive backtracking.\n\n # Valid characters: letters, digits, allowed symbols, spaces, and tabs\n [\\p{Ll}_\\p{Lu}\\p{Lt}\\p{Lm}\\p{Lo}\\p{Nd}'\\., \\t]\n\n # OR a newline, but ONLY if strictly followed by indentation (tabs or spaces)\n # (This prevents the lookahead from bleeding into unindented top-level declarations)\n | \\r?\\n[ \\t]+\n\n # OR a multiline block comment: {- ... -}\n | \\{-(?:[^-]|-(?!\\}))*-\\}\n\n )*\n\n # ... and a constraint arrow '=>' (not part of a larger custom operator such as '==>')\n (?|⇒)\n (?![\\p{S}\\p{P}&&[^(),;\\[\\]`{}_\"']])\n )\n | # - a symbolic (prefix) data constructor\n (\\()\\s*(:[\\p{S}\\p{P}&&[^(),;\\[\\]`{}_\"']]*)\\s*(\\))\n | # Otherwise, try to fail early to avoid excessive backtracking (https://github.com/haskell/language-haskell/issues/161)\n # Fail when detecting a lowercase identifier and then something not starting with a tick or colon\n (?=\\b(?|⇒", + "name": "keyword.operator.big-arrow.haskell" + }, + { + "include": "#string_literal" + }, + { + "match": "'[^']'", + "name": "invalid" + }, + { + "include": "#type_application" + }, + { + "include": "#reserved_symbol" + }, + { + "include": "#type_operator" + }, + { + "include": "#type_constructor" + }, + { + "begin": "(\\()(#)", + "end": "(#)(\\))", + "beginCaptures": { + "1": { + "name": "punctuation.paren.haskell" + }, + "2": { + "name": "keyword.operator.hash.haskell" + } + }, + "endCaptures": { + "1": { + "name": "keyword.operator.hash.haskell" + }, + "2": { + "name": "punctuation.paren.haskell" + } + }, + "patterns": [ + { + "include": "#comma" + }, + { + "include": "#type_signature" + } + ] + }, + { + "begin": "(')?(\\()", + "end": "(\\))", + "beginCaptures": { + "1": { + "name": "keyword.operator.promotion.haskell" + }, + "2": { + "name": "punctuation.paren.haskell" + } + }, + "endCaptures": { + "1": { + "name": "punctuation.paren.haskell" + } + }, + "patterns": [ + { + "include": "#comma" + }, + { + "include": "#type_signature" + } + ] + }, + { + "begin": "(')?(\\[)", + "end": "(\\])", + "beginCaptures": { + "1": { + "name": "keyword.operator.promotion.haskell" + }, + "2": { + "name": "punctuation.bracket.haskell" + } + }, + "endCaptures": { + "1": { + "name": "punctuation.bracket.haskell" + } + }, + "patterns": [ + { + "include": "#comma" + }, + { + "include": "#type_signature" + } + ] + }, + { + "include": "#type_variable" + } + ] + }, + "double_colon": { + "match": "\\s*(::|∷)(?![\\p{S}\\p{P}&&[^(),;\\[\\]`{}_\"']])\\s*", + "captures": { + "1": { + "name": "keyword.operator.double-colon.haskell" + } + } + }, + "start_type_signature": { + "patterns": [ + { + "begin": "^(\\s*)(::|∷)(?![\\p{S}\\p{P}&&[^(),;\\[\\]{}`_\"']])\\s*", + "beginCaptures": { + "2": { + "name": "keyword.operator.double-colon.haskell" + } + }, + "end": "(?x)\n # End type annotation when seeing one of:\n (?=\n \\#?\\) # closing parenthesis\n |\\] # closing bracket\n |, # comma\n |(?)\n (?)\n (?|→)\n |(-<|↢)\n |(-<<|⤛)\n |(>-|⤚)\n |(>>-|⤜)\n )\n (?![\\p{S}\\p{P}&&[^(),;\\[\\]`{}_\"'']])", + "captures": { + "1": { + "name": "keyword.operator.double-dot.haskell" + }, + "2": { + "name": "keyword.operator.colon.haskell" + }, + "3": { + "name": "keyword.operator.eq.haskell" + }, + "4": { + "name": "keyword.operator.lambda.haskell" + }, + "5": { + "name": "keyword.operator.pipe.haskell" + }, + "6": { + "name": "keyword.operator.arrow.left.haskell" + }, + "7": { + "name": "keyword.operator.arrow.haskell" + }, + "8": { + "name": "keyword.operator.arrow.left.tail.haskell" + }, + "9": { + "name": "keyword.operator.arrow.left.tail.double.haskell" + }, + "10": { + "name": "keyword.operator.arrow.tail.haskell" + }, + "11": { + "name": "keyword.operator.arrow.tail.double.haskell" + } + } + }, + { + "match": "(?x)\n # Require a preceding final operator character\n (?<=[\\p{Ll}_\\p{Lu}\\p{Lt}\\p{Lm}\\p{Lo}\\p{Nd}\\p{S}\\p{P}&&[^\\#(,;\\[`{]])\n (\\#+)\n # Disallow a following operator character, but allow parentheses\n # to handle e.g. 'Solo#(..)'.\n (?![\\p{Ll}_\\p{Lu}\\p{Lt}\\p{Lm}\\p{Lo}\\p{Nd}\\p{S}\\p{P}&&[^(),;\\[\\]`{}]])", + "captures": { + "1": { + "name": "keyword.operator.postfix.hash.haskell" + } + } + }, + { + "match": "(?x)\n (?<=[\\p{Ll}_\\p{Lu}\\p{Lt}\\p{Lm}\\p{Lo}\\p{Nd}'\\)\\}\\]]) # Require closing characters\n (@)\n (?=[\\p{Ll}_\\p{Lu}\\p{Lt}\\p{Lm}\\p{Lo}\\p{Nd}'\\(\\[\\{]) # Require opening character", + "captures": { + "1": { + "name": "keyword.operator.infix.tight.at.haskell" + } + } + }, + { + "match": "(?x)\n (?|→)", + "beginCaptures": { + "1": { + "name": "keyword.other.forall.haskell" + }, + "2": { + "name": "keyword.other.forall.haskell" + } + }, + "endCaptures": { + "1": { + "name": "keyword.operator.period.haskell" + }, + "2": { + "name": "keyword.operator.arrow.haskell" + } + }, + "patterns": [ + { + "include": "#comment_like" + }, + { + "include": "#type_variable" + }, + { + "include": "#type_signature" + } + ] + }, + "string_literal": { + "begin": "\"", + "beginCaptures": { + "0": { + "name": "punctuation.definition.string.begin.haskell" + } + }, + "end": "\"", + "endCaptures": { + "0": { + "name": "punctuation.definition.string.end.haskell" + } + }, + "name": "string.quoted.double.haskell", + "patterns": [ + { + "include": "#string_escapes" + }, + { + "begin": "\\\\(?=[\\p{Zs}\\t\\v\\f])", + "beginCaptures": { + "0": { + "name": "constant.character.escape.begin.haskell" + } + }, + "end": "(?<=[\\s\\p{Zs}])\\\\|(?=\")", + "endCaptures": { + "0": { + "name": "constant.character.escape.end.haskell" + } + }, + "patterns": [ + { + "begin": "(?=[^\\s\\\\])", + "end": "(?=\")", + "patterns": [ + { + "match": "[^\\s\\\\\"]+", + "name": "invalid.illegal.character-not-allowed-here.haskell" + } + ] + } + ] + }, + { + "begin": "\\\\$", + "beginCaptures": { + "0": { + "name": "constant.character.escape.begin.haskell" + } + }, + "end": "\\\\|(?=[^\\s\\\\])", + "endCaptures": { + "0": { + "name": "constant.character.escape.end.haskell" + } + } + } + ] + }, + "char_literal": { + "captures": { + "1": { + "name": "punctuation.definition.string.begin.haskell" + }, + "2": { + "name": "constant.character.escape.haskell" + }, + "3": { + "name": "constant.character.escape.octal.haskell" + }, + "4": { + "name": "constant.character.escape.hexadecimal.haskell" + }, + "5": { + "name": "constant.character.escape.control.haskell" + }, + "6": { + "name": "punctuation.definition.string.end.haskell" + } + }, + "match": "(?x)\n (? type TextMateTokensProvider = Monaco.languages.TokensProvider type TextMateTokenProviderModule = { createTextMateTokensProvider: typeof createTextMateTokensProviderType @@ -14,6 +14,7 @@ export type TextMateLanguageRegistration = { language: Monaco.languages.ILanguageExtensionPoint configuration?: Monaco.languages.LanguageConfiguration loadGrammar: TextMateGrammarLoader + mapTokenScopes?: (scopes: readonly string[]) => string loadProviderModule?: () => Promise } @@ -45,7 +46,10 @@ export function registerTextMateLanguage( tokensProviderPromise ??= ( registration.loadProviderModule ?? loadDefaultProviderModule )().then(({ createTextMateTokensProvider }) => - createTextMateTokensProvider({ loadGrammar: registration.loadGrammar }) + createTextMateTokensProvider({ + loadGrammar: registration.loadGrammar, + ...(registration.mapTokenScopes ? { mapTokenScopes: registration.mapTokenScopes } : {}) + }) ) return tokensProviderPromise } diff --git a/src/renderer/src/lib/monaco-languages/textmate-token-provider.ts b/src/renderer/src/lib/monaco-languages/textmate-token-provider.ts index 3838ec85206..9150bb97e45 100644 --- a/src/renderer/src/lib/monaco-languages/textmate-token-provider.ts +++ b/src/renderer/src/lib/monaco-languages/textmate-token-provider.ts @@ -14,6 +14,7 @@ export type TextMateGrammarLoader = () => Promise export type TextMateTokensProviderOptions = { loadGrammar: TextMateGrammarLoader + mapTokenScopes?: (scopes: readonly string[]) => string } let editorCorePromise: Promise | undefined @@ -49,7 +50,8 @@ class TextMateTokenizerState implements Monaco.languages.IState { function createTokensProvider( { textmate }: TextMateCore, grammar: Grammar, - fallbackScopeName: string + fallbackScopeName: string, + mapTokenScopes?: (scopes: readonly string[]) => string ): TextMateTokensProvider { const plain = (state: TextMateTokenizerState): Monaco.languages.ILineTokens => ({ endState: state, @@ -78,7 +80,7 @@ function createTokensProvider( startIndex: token.startIndex, // Why: Monaco themes match a single token scope; TextMate returns a // scope stack, and the final entry is the most specific reusable one. - scopes: token.scopes.at(-1) ?? fallbackScopeName + scopes: mapTokenScopes?.(token.scopes) ?? token.scopes.at(-1) ?? fallbackScopeName })) } } @@ -93,6 +95,7 @@ export async function createTextMateTokensProvider( return createTokensProvider( editorCore, editorCore.core.getLanguage(registration.name), - registration.scopeName + registration.scopeName, + options.mapTokenScopes ) } diff --git a/src/renderer/src/lib/monaco-setup.ts b/src/renderer/src/lib/monaco-setup.ts index be9b001adf4..f98dfbc5e57 100644 --- a/src/renderer/src/lib/monaco-setup.ts +++ b/src/renderer/src/lib/monaco-setup.ts @@ -10,6 +10,7 @@ import htmlWorker from 'monaco-editor/esm/vs/language/html/html.worker?worker' import tsWorker from 'monaco-editor/esm/vs/language/typescript/ts.worker?worker' import { registerAstroLanguage } from './monaco-languages/register-astro' import { registerJsonlLanguage } from './monaco-languages/register-jsonl' +import { registerHaskellLanguage } from './monaco-languages/register-haskell' import { registerNimLanguage } from './monaco-languages/register-nim' import { registerQuartoLanguage } from './monaco-languages/register-quarto' import { registerShellMarkdownAliases } from './monaco-languages/register-shell-markdown-aliases' @@ -83,6 +84,7 @@ runMonacoSetupSteps([ ['Vue language registration', () => registerVueLanguage(monaco)], ['Svelte language registration', () => registerSvelteLanguage(monaco)], ['Astro language registration', () => registerAstroLanguage(monaco)], + ['Haskell language registration', () => registerHaskellLanguage(monaco)], ['Nim language registration', () => registerNimLanguage(monaco)], ['Typst language registration', () => registerTypstLanguage(monaco)], ['JSONL language registration', () => registerJsonlLanguage(monaco)], diff --git a/src/shared/editor-language/editor-language-detect.ts b/src/shared/editor-language/editor-language-detect.ts index a58c0e8e5c7..443fd907eb5 100644 --- a/src/shared/editor-language/editor-language-detect.ts +++ b/src/shared/editor-language/editor-language-detect.ts @@ -99,6 +99,8 @@ const EXT_TO_LANGUAGE: Record = { '.erl': 'erlang', '.hrl': 'erlang', '.hs': 'haskell', + '.hsig': 'haskell', + '.hs-boot': 'haskell', '.clj': 'clojure', // Why: Monaco registers Solidity under the id 'sol'; 'solidity' is only an alias. '.sol': 'sol', diff --git a/tests/e2e/editor-haskell-highlighting.spec.ts b/tests/e2e/editor-haskell-highlighting.spec.ts new file mode 100644 index 00000000000..ec33d8f0921 --- /dev/null +++ b/tests/e2e/editor-haskell-highlighting.spec.ts @@ -0,0 +1,104 @@ +import { writeFileSync } from 'node:fs' +import path from 'node:path' +import type { Locator } from '@stablyai/playwright-test' +import { detectLanguage } from '../../src/renderer/src/lib/language-detect' +import { test, expect } from './helpers/orca-app' +import { + cleanupGoldenWorktree, + createGoldenWorktree, + openGoldenSourceControl +} from './helpers/golden-source-control' +import { waitForSessionReady } from './helpers/store' + +const source = [ + 'module Main where', + '-- A comment', + 'answer :: Int', + 'answer = 42', + 'main = putStrLn "hello"', + '' +].join('\n') + +async function colors(editor: Locator): Promise> { + return editor.locator('.view-lines:not(.line-delete)').evaluate((lines) => { + const colorOf = (text: string) => { + const span = [...lines.querySelectorAll('span[class*="mtk"]')].find((entry) => + entry.textContent?.includes(text) + ) + return span ? getComputedStyle(span).color : null + } + return { + keyword: colorOf('module'), + comment: colorOf('comment'), + type: colorOf('Int'), + number: colorOf('42'), + string: colorOf('hello') + } + }) +} + +async function expectHighlighted(editor: Locator): Promise { + await expect(editor.locator('.view-lines:not(.line-delete)')).toContainText('module Main where') + await expect + .poll( + async () => { + const painted = await colors(editor) + return ( + Object.values(painted).every((color) => color !== null) && + new Set(Object.values(painted)).size >= 4 + ) + }, + { timeout: 25_000 } + ) + .toBe(true) +} + +test('highlights recognized Haskell source and an untracked file diff', async ({ + orcaPage, + testRepoPath, + registerPostElectronShutdownCleanup +}, testInfo) => { + const fixture = createGoldenWorktree(testRepoPath, 'haskell-highlighting') + registerPostElectronShutdownCleanup(async () => cleanupGoldenWorktree(testRepoPath, fixture)) + const filePath = path.join(fixture.worktreePath, 'Main.hs') + writeFileSync(filePath, source) + + await waitForSessionReady(orcaPage) + await openGoldenSourceControl(orcaPage, testRepoPath, fixture) + await orcaPage.evaluate( + ({ filePath, language }) => { + const store = window.__store + const worktreeId = store?.getState().activeWorktreeId + if (!store || !worktreeId) { + throw new Error('Haskell fixture worktree unavailable') + } + store + .getState() + .openFile({ filePath, relativePath: 'Main.hs', worktreeId, language, mode: 'edit' }) + }, + { filePath, language: detectLanguage(filePath) } + ) + await orcaPage.evaluate(() => window.__store?.getState().updateSettings({ theme: 'light' })) + const sourceEditor = orcaPage.locator('.monaco-editor.vs').first() + await expectHighlighted(sourceEditor) + await expect + .poll(() => orcaPage.evaluate(() => window.__monacoEditorE2E?.snapshot().valueLength)) + .toBe(source.length) + await orcaPage.screenshot({ path: testInfo.outputPath('haskell-source-light.png') }) + await orcaPage.evaluate(() => window.__store?.getState().updateSettings({ theme: 'dark' })) + await expectHighlighted(orcaPage.locator('.monaco-editor.vs-dark').first()) + await orcaPage.screenshot({ path: testInfo.outputPath('haskell-source-dark.png') }) + await orcaPage.evaluate(() => window.__store?.getState().updateSettings({ theme: 'light' })) + + await orcaPage + .locator('[data-testid="source-control-entry"]') + .filter({ hasText: 'Main.hs' }) + .click() + await expectHighlighted(orcaPage.locator('.modified-in-monaco-diff-editor.vs')) + await orcaPage.screenshot({ path: testInfo.outputPath('haskell-diff.png') }) + + await orcaPage.evaluate(() => window.__store?.getState().updateSettings({ theme: 'dark' })) + const darkDiff = orcaPage.locator('.modified-in-monaco-diff-editor.vs-dark') + await expectHighlighted(darkDiff) + await orcaPage.screenshot({ path: testInfo.outputPath('haskell-diff-dark.png') }) +})