fix(editor): highlight recognized Haskell source and diffs

Adapt existing PR #25411 (c1fa6cee62)
to main 120f01331c. 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 <davidwis000@gmail.com>

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.

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.

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')
+  })
+})

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<LanguageRegistration> {
+  // 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<typeof Monaco, 'languages'>): void {
+  registerTextMateLanguage(monaco, {
+    language: {
+      id: 'haskell',
+      extensions: ['.hs', '.hsig', '.hs-boot'],
+      aliases: ['Haskell', 'haskell']
+    },
+    configuration: haskellLanguageConfiguration,
+    loadGrammar: loadHaskellTextMateGrammar,
+    mapTokenScopes: mapHaskellTokenScopes
+  })
+}

src/renderer/src/lib/monaco-languages/textmate-language-registration.ts

@@ -4,7 +4,7 @@ import type {
   TextMateGrammarLoader
 } from './textmate-token-provider'
 
-type MonacoModule = typeof Monaco
+type MonacoModule = Pick<typeof Monaco, 'languages'>
 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<TextMateTokenProviderModule>
 }
 
@@ -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
     }

src/renderer/src/lib/monaco-languages/textmate-token-provider.ts

@@ -14,6 +14,7 @@ export type TextMateGrammarLoader = () => Promise<LanguageRegistration>
 
 export type TextMateTokensProviderOptions = {
   loadGrammar: TextMateGrammarLoader
+  mapTokenScopes?: (scopes: readonly string[]) => string
 }
 
 let editorCorePromise: Promise<TextMateCore> | 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
   )
 }

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)],

src/shared/editor-language/editor-language-detect.ts

@@ -99,6 +99,8 @@ const EXT_TO_LANGUAGE: Record<string, string> = {
   '.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',

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<Record<string, string | null>> {
+  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<void> {
+  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') })
+})