diff --git a/.claude/skills/agent-eval/corpus.json b/.claude/skills/agent-eval/corpus.json index 150b4a601..ee70356cf 100644 --- a/.claude/skills/agent-eval/corpus.json +++ b/.claude/skills/agent-eval/corpus.json @@ -607,5 +607,28 @@ "files": "~3390", "question": "How does programs.git.enable produce the final git config file in the user's home directory? Trace the flow from the git program module to the home-files machinery that links generated files into place." } + ], + "Haskell": [ + { + "name": "xmonad", + "repo": "https://github.com/xmonad/xmonad", + "size": "Small", + "files": "~31", + "question": "How does a user's key binding reach the window management action it triggers? Trace from the X event loop to the key press handler to the window action." + }, + { + "name": "postgrest", + "repo": "https://github.com/PostgREST/postgrest", + "size": "Medium", + "files": "~123", + "question": "How does an incoming HTTP request reach the database query executor? Trace from the request router to the SQL query builder and database call." + }, + { + "name": "pandoc", + "repo": "https://github.com/jgm/pandoc", + "size": "Large", + "files": "~366", + "question": "How does a Markdown document get converted to HTML? Trace from the reader that parses Markdown to the writer that emits HTML." + } ] } diff --git a/CHANGELOG.md b/CHANGELOG.md index 8d8ab6f79..e3de5d8f2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,8 @@ and adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). ### New Features +- CodeGraph now indexes **Haskell** (`.hs`, `.lhs`) — functions (including multi-clause definitions with type signatures and Haddock docs), type classes and their instances, algebraic data types and their constructors, record fields, type synonyms, newtypes, and module imports. The call graph follows both local and qualified calls (`Mod.fn`), data-constructor use, and user-defined infix operators, and `where`-clause helpers are tracked as their own symbols. + - Anonymous usage telemetry is now stored entirely on CodeGraph's own first-party infrastructure — no third-party analytics vendor receives any of it, and the endpoint that receives it makes no outbound requests at all. Individual events are deleted after 90 days, leaving only anonymous daily totals. Nothing about what is collected changed, your IP address is still never read or stored, and every off-switch works exactly as before (`codegraph telemetry off`, `CODEGRAPH_TELEMETRY=0`, `DO_NOT_TRACK=1`). `TELEMETRY.md` remains the complete field-by-field list. - `codegraph_explore` no longer re-sends source it already returned earlier in the same conversation. A file it has already shown you comes back as a short pointer — the path, the symbols and the exact line range, with confirmation that the file hasn't changed since — and the space that frees is spent on code you haven't seen yet, so a follow-up call covers new ground instead of repeating the last one. If a file was edited in between, its source is always shown again in full. Set `CODEGRAPH_EXPLORE_DEDUP=0` to turn this off. diff --git a/README.md b/README.md index f8bb60bbc..bd8fc2234 100644 --- a/README.md +++ b/README.md @@ -278,7 +278,7 @@ CodeGraph's parsing engine is a **native Rust kernel**: 20 languages — TypeScr | **Full-Text Search** | Find code by name instantly across your entire codebase, powered by FTS5 | | **Impact Analysis** | Trace callers, callees, and the full impact radius of any symbol before making changes | | **Always Fresh** | File watcher uses native OS events (FSEvents/inotify/ReadDirectoryChangesW) with debounced auto-sync — the graph stays current as you code, zero config | -| **20+ Languages** | TypeScript, JavaScript, ArkTS, Python, Go, Rust, Java, C#, VB.NET, PHP, Ruby, C, C++, CUDA, Objective-C, Metal, Swift, Kotlin, Scala, Dart, Lua, Luau, R, Nix, Erlang, CFML, COBOL, Solidity, Terraform/OpenTofu, Svelte, Vue, Astro, Liquid, Pascal/Delphi | +| **20+ Languages** | TypeScript, JavaScript, ArkTS, Python, Go, Rust, Java, C#, VB.NET, PHP, Ruby, C, C++, CUDA, Objective-C, Metal, Swift, Kotlin, Scala, Dart, Lua, Luau, R, Nix, Erlang, Haskell, CFML, COBOL, Solidity, Terraform/OpenTofu, Svelte, Vue, Astro, Liquid, Pascal/Delphi | | **Framework-aware Routes** | Recognizes web-framework routing files and links URL patterns to their handlers across 17 frameworks | | **Mixed iOS / React Native / Expo** | Closes cross-language flows that static parsing misses: Swift ↔ ObjC bridging, React Native legacy bridge + TurboModules + Fabric view components, native → JS event emitters, Expo Modules | | **100% Local** | No data leaves your machine. No API keys. No external services. SQLite database only | @@ -803,6 +803,7 @@ is written): | Solidity | `.sol` | Full support (contracts, libraries, interfaces, structs, enums, modifiers, events, errors, state variables, `import`/`using` directives, `emit`/`revert` calls) | | Terraform / OpenTofu | `.tf`, `.tfvars`, `.tofu` | Full support (resources, data sources, modules, variables, outputs, providers incl. aliases, `locals`; `var.`/`local.`/`module.`/resource references with Terraform's per-directory scoping enforced; module calls bridged across the boundary — inputs to the child module's variables, `module.M.out` to the child's output, `source` to the module's files; cloudposse/atmos `remote-state` cross-component wiring when the component is statically named; `provider = aws.east` selections resolved up the module tree; `moved`/`import`/`removed`/`check` block references; `.tfvars` assignments linked to the variables they set) | | Nix | `.nix` | Full support (functions with simple/destructured/curried params, `let`/attrset bindings, `inherit`, `import ./path` file edges — `./dir` resolving through `default.nix` — plus NixOS module `imports = [ ./x.nix ]` lists and `callPackage ./pkg.nix` file edges; call edges; module-system option wiring — a config write like `launchd.user.agents.x = { ... }` links to the module declaring `options.launchd.user.agents`, so option flows trace across modules) | +| Haskell | `.hs`, `.lhs` | Full support (functions with multi-clause grouping, type signatures with Haddock docs, type classes as traits, instances with `implements` edges, algebraic data types as structs with constructors as enum members, record fields, type synonyms, newtypes, module imports, local and qualified `Mod.fn` call edges, data constructor instantiations, `where`-clause helper extraction) | ## Measured cross-file coverage diff --git a/__tests__/extraction.test.ts b/__tests__/extraction.test.ts index 292658822..4413ac58a 100644 --- a/__tests__/extraction.test.ts +++ b/__tests__/extraction.test.ts @@ -150,6 +150,15 @@ describe('Language Detection', () => { expect(isSourceFile('default.nix')).toBe(true); }); + it('should detect Haskell files', () => { + expect(detectLanguage('src/Main.hs')).toBe('haskell'); + expect(detectLanguage('app/Lib.lhs')).toBe('haskell'); + expect(detectLanguage('src/Data/Map.hs')).toBe('haskell'); + expect(isSourceFile('app/Main.hs')).toBe(true); + expect(isSourceFile('app/Main.lhs')).toBe(true); + expect(isSourceFile('README.md')).toBe(false); + }); + it('should detect a .h whose only C++ signal is an export-macro class as cpp', () => { // Lean Unreal-Engine style header: the class is annotated with an export // macro and carries no explicit `public:`/`virtual`/`namespace`/`template`, @@ -11589,3 +11598,294 @@ describe('C/C++ kernel-port preParse blanks (R7a)', () => { expect(result.nodes.some((n) => n.kind === 'method' && n.name === 'size')).toBe(true); }); }); + +describe('Haskell Extraction', () => { + describe('Language detection', () => { + it('should report Haskell as supported', () => { + expect(isLanguageSupported('haskell')).toBe(true); + expect(getSupportedLanguages()).toContain('haskell'); + expect(isSourceFile('app/Main.hs')).toBe(true); + expect(isSourceFile('app/Main.lhs')).toBe(true); + }); + }); + + describe('Function extraction', () => { + it('should extract simple functions', () => { + const code = `module M where + +double :: Int -> Int +double x = x * 2 + +identity x = x +`; + const result = extractFromSource('src/M.hs', code); + const double = result.nodes.find((n) => n.kind === 'function' && n.name === 'double'); + expect(double).toBeDefined(); + expect(double?.signature).toBe('double :: Int -> Int'); + expect(double?.language).toBe('haskell'); + const identity = result.nodes.find((n) => n.kind === 'function' && n.name === 'identity'); + expect(identity).toBeDefined(); + }); + + it('should merge multi-clause functions into one node spanning all clauses', () => { + const code = `module M where + +factorial :: Int -> Int +factorial 0 = 1 +factorial n = n * factorial (n - 1) +`; + const result = extractFromSource('src/M.hs', code); + const fns = result.nodes.filter((n) => n.kind === 'function' && n.name === 'factorial'); + expect(fns).toHaveLength(1); + expect(fns[0]!.startLine).toBe(4); + expect(fns[0]!.endLine).toBe(5); + }); + + it('should extract functions with guards', () => { + const code = `module M where + +bar :: Int -> Int +bar x + | x > 0 = x + | otherwise = 0 +`; + const result = extractFromSource('src/M.hs', code); + const bar = result.nodes.find((n) => n.kind === 'function' && n.name === 'bar'); + expect(bar).toBeDefined(); + expect(bar?.startLine).toBe(4); + expect(bar?.endLine).toBe(6); + }); + + it('should use the preceding signature as the function signature', () => { + const code = `module M where + +-- | Computes the area. +area :: Double -> Double +area r = pi * r * r +`; + const result = extractFromSource('src/M.hs', code); + const area = result.nodes.find((n) => n.kind === 'function' && n.name === 'area'); + expect(area?.signature).toBe('area :: Double -> Double'); + expect(area?.docstring).toBe('Computes the area.'); + }); + + it('should qualify functions with the module namespace', () => { + const code = `module MyModule where + +start :: IO () +start = pure () +`; + const result = extractFromSource('src/MyModule.hs', code); + const ns = result.nodes.find((n) => n.kind === 'namespace'); + expect(ns?.name).toBe('MyModule'); + const start = result.nodes.find((n) => n.kind === 'function' && n.name === 'start'); + expect(start?.qualifiedName).toBe('MyModule::start'); + }); + }); + + describe('Data type extraction', () => { + it('should extract simple ADTs as structs with constructors as enum_members', () => { + const code = `module M where + +data Color = Red | Green | Blue +`; + const result = extractFromSource('src/M.hs', code); + const color = result.nodes.find((n) => n.kind === 'struct' && n.name === 'Color'); + expect(color).toBeDefined(); + const ctors = result.nodes.filter((n) => n.kind === 'enum_member').map((n) => n.name); + expect(ctors).toContain('Red'); + expect(ctors).toContain('Green'); + expect(ctors).toContain('Blue'); + }); + + it('should extract record ADTs with fields', () => { + const code = `module M where + +data Point = Point { x :: Double, y :: Double } +`; + const result = extractFromSource('src/M.hs', code); + const point = result.nodes.find((n) => n.kind === 'struct' && n.name === 'Point'); + expect(point).toBeDefined(); + const ctor = result.nodes.find((n) => n.kind === 'enum_member' && n.name === 'Point'); + expect(ctor).toBeDefined(); + const fields = result.nodes.filter((n) => n.kind === 'field').map((n) => n.name); + expect(fields).toContain('x'); + expect(fields).toContain('y'); + }); + + it('should extract parameterized ADTs', () => { + const code = `module M where + +data Tree a = Leaf | Node a (Tree a) (Tree a) +`; + const result = extractFromSource('src/M.hs', code); + const tree = result.nodes.find((n) => n.kind === 'struct' && n.name === 'Tree'); + expect(tree).toBeDefined(); + const ctors = result.nodes.filter((n) => n.kind === 'enum_member').map((n) => n.name); + expect(ctors).toContain('Leaf'); + expect(ctors).toContain('Node'); + }); + }); + + describe('Type class and instance extraction', () => { + it('should extract type classes as traits', () => { + const code = `module M where + +class Shape s where + area :: s -> Double + perimeter :: s -> Double +`; + const result = extractFromSource('src/M.hs', code); + const shape = result.nodes.find((n) => n.kind === 'trait' && n.name === 'Shape'); + expect(shape).toBeDefined(); + }); + + it('should extract instances with implements reference', () => { + const code = `module M where + +data Circle = Circle { radius :: Double } + +class Shape s where + area :: s -> Double + +instance Shape Circle where + area (Circle r) = pi * r * r +`; + const result = extractFromSource('src/M.hs', code); + const inst = result.nodes.find((n) => n.kind === 'class' && n.name === 'Shape.Circle'); + expect(inst).toBeDefined(); + const implRefs = result.unresolvedReferences.filter((r) => r.referenceKind === 'implements'); + expect(implRefs.some((r) => r.referenceName === 'Shape')).toBe(true); + }); + + it('should not merge same-named methods across different instances', () => { + const code = `module M where + +data Circle = Circle { radius :: Double } +data Square = Square { side :: Double } + +class Shape s where + area :: s -> Double + +instance Shape Circle where + area (Circle r) = pi * r * r + +instance Shape Square where + area (Square s) = s * s +`; + const result = extractFromSource('src/M.hs', code); + const areas = result.nodes.filter((n) => n.kind === 'function' && n.name === 'area'); + expect(areas).toHaveLength(2); + const circleInst = result.nodes.find((n) => n.kind === 'class' && n.name === 'Shape.Circle'); + const squareInst = result.nodes.find((n) => n.kind === 'class' && n.name === 'Shape.Square'); + expect(circleInst).toBeDefined(); + expect(squareInst).toBeDefined(); + // Each area method must be contained by its own instance, not both + // collapsed onto one. + const containsArea = (instId: string | undefined) => + result.edges.some( + (e) => + e.kind === 'contains' && + e.source === instId && + areas.some((a) => a.id === e.target), + ); + expect(containsArea(circleInst!.id)).toBe(true); + expect(containsArea(squareInst!.id)).toBe(true); + // The two area nodes must be distinct (not the same id merged). + expect(areas[0]!.id).not.toBe(areas[1]!.id); + }); + }); + + describe('Type synonym and newtype extraction', () => { + it('should extract type synonyms as type aliases', () => { + const code = `module M where + +type Point2D = (Double, Double) +type Synonym = [Int] +`; + const result = extractFromSource('src/M.hs', code); + const p2d = result.nodes.find((n) => n.kind === 'type_alias' && n.name === 'Point2D'); + expect(p2d).toBeDefined(); + const syn = result.nodes.find((n) => n.kind === 'type_alias' && n.name === 'Synonym'); + expect(syn).toBeDefined(); + }); + + it('should extract newtypes as structs', () => { + const code = `module M where + +newtype Score = Score Int +`; + const result = extractFromSource('src/M.hs', code); + const score = result.nodes.find((n) => n.kind === 'struct' && n.name === 'Score'); + expect(score).toBeDefined(); + }); + }); + + describe('Import extraction', () => { + it('should extract simple imports', () => { + const code = `module M where + +import Data.List (sort) +`; + const result = extractFromSource('src/M.hs', code); + const imp = result.nodes.find((n) => n.kind === 'import' && n.name === 'Data.List'); + expect(imp).toBeDefined(); + }); + + it('should extract qualified imports with alias', () => { + const code = `module M where + +import qualified Data.Map as Map +`; + const result = extractFromSource('src/M.hs', code); + const imp = result.nodes.find((n) => n.kind === 'import' && n.name === 'Data.Map'); + expect(imp).toBeDefined(); + }); + }); + + describe('Call edges', () => { + it('should extract local function calls', () => { + const code = `module M where + +factorial :: Int -> Int +factorial 0 = 1 +factorial n = n * factorial (n - 1) +`; + const result = extractFromSource('src/M.hs', code); + const refs = result.unresolvedReferences.filter( + (r) => r.referenceName === 'factorial' && r.referenceKind === 'calls', + ); + expect(refs.length).toBeGreaterThan(0); + }); + + it('should extract qualified calls', () => { + const code = `module M where + +import qualified Data.Text as T + +main :: IO () +main = T.putStrLn "hello" +`; + const result = extractFromSource('src/M.hs', code); + const refs = result.unresolvedReferences.filter( + (r) => r.referenceName === 'T.putStrLn' && r.referenceKind === 'calls', + ); + expect(refs.length).toBeGreaterThan(0); + }); + + it('should extract data constructor applications as instantiates', () => { + const code = `module M where + +data Maybe a = Nothing | Just a + +main :: IO () +main = print (Just 42) +`; + const result = extractFromSource('src/M.hs', code); + const refs = result.unresolvedReferences.filter( + (r) => r.referenceName === 'Just' && r.referenceKind === 'instantiates', + ); + expect(refs.length).toBeGreaterThan(0); + }); + }); +}); diff --git a/src/extraction/grammars.ts b/src/extraction/grammars.ts index d4127631d..13efaa147 100644 --- a/src/extraction/grammars.ts +++ b/src/extraction/grammars.ts @@ -50,6 +50,7 @@ const WASM_GRAMMAR_FILES: Record = { terraform: 'tree-sitter-terraform.wasm', arkts: 'tree-sitter-arkts.wasm', nix: 'tree-sitter-nix.wasm', + haskell: 'tree-sitter-haskell.wasm', }; /** @@ -170,6 +171,9 @@ export const EXTENSION_MAP: Record = { '.tf': 'terraform', '.tfvars': 'terraform', '.tofu': 'terraform', + // Haskell — vendored grammar from tree-sitter-haskell 0.23.1 (ABI 14). + '.hs': 'haskell', + '.lhs': 'haskell', }; /** @@ -291,6 +295,10 @@ export async function initGrammars(): Promise { const VENDORED_WASM_LANGS: ReadonlySet = new Set([ 'pascal', 'scala', 'lua', 'luau', 'csharp', 'r', 'cfml', 'cfscript', 'cfquery', 'cobol', 'vbnet', 'erlang', 'terraform', 'arkts', 'nix', + // Haskell: tree-sitter-wasms doesn't ship it; we vendor the prebuilt + // tree-sitter-haskell.wasm from the tree-sitter-haskell 0.23.1 npm package + // (MIT, ABI 14) — byte-identical to the npm tarball's artifact. + 'haskell', 'typescript', 'tsx', 'javascript', 'jsx', 'java', 'python', 'go', // R7a (C/C++ kernel port prep): tree-sitter-c v0.24.2 (b780e47) + // tree-sitter-cpp v0.23.4 (f41e1a0), parser.c/scanner.c sha-matched against @@ -655,6 +663,7 @@ export function getLanguageDisplayName(language: Language): string { erlang: 'Erlang', terraform: 'Terraform', arkts: 'ArkTS', + haskell: 'Haskell', unknown: 'Unknown', }; return names[language] || language; diff --git a/src/extraction/languages/haskell.ts b/src/extraction/languages/haskell.ts new file mode 100644 index 000000000..4d234b3b2 --- /dev/null +++ b/src/extraction/languages/haskell.ts @@ -0,0 +1,373 @@ +import type { Node as SyntaxNode } from 'web-tree-sitter'; +import { getNodeText, getChildByField } from '../tree-sitter-helpers'; +import type { LanguageExtractor, ExtractorContext } from '../tree-sitter-types'; + +// Node names follow the tree-sitter-haskell grammar 0.23.1 (vendored, ABI 14). +// +// Haskell's AST shapes don't map to the generic extractor's bodyField-based +// dispatch — different node kinds use different field names for their body +// (`match` for functions, `declarations` for class/instance bodies, no field +// for data-type constructors). Every symbol-bearing top-level declaration is +// dispatched through the visitNode hook below, mirroring the Erlang +// extractor's approach. +// +// Calls are handled partly here (data constructor applications and infix +// operators via the haskell branch in extractCall) and partly by the generic +// call-extraction fallback (which reads the `function` field of `apply` +// nodes — covering bare `fn x` and qualified `Mod.fn x` calls). + +/** Collapse runs of whitespace for one-line signatures. */ +function collapseWs(text: string): string { + return text.replace(/\s+/g, ' ').trim(); +} + +/** Read the text of a `module` node as a dotted module name (`Data.List`). */ +function moduleDottedName(node: SyntaxNode, source: string): string { + const parts: string[] = []; + for (let i = 0; i < node.namedChildCount; i++) { + const child = node.namedChild(i); + if (child?.type === 'module_id') { + parts.push(getNodeText(child, source)); + } + } + return parts.join('.'); +} + +/** Extract a Haddock comment (`-- | ...` / `{- | ... -}`) preceding a node. + * Haddocks sit as siblings of the `declarations` container (not as siblings + * of the declaration itself), so climb out of `declarations` to find them. */ +function precedingHaddock(node: SyntaxNode, source: string): string | undefined { + // Climb out of `declarations` so we see top-level siblings (haddocks sit + // alongside `declarations`, not inside it). + let anchor: SyntaxNode = node; + while (anchor.parent && anchor.parent.type === 'declarations') anchor = anchor.parent; + let sibling = anchor.previousNamedSibling; + while (sibling?.type === 'haddock' || sibling?.type === 'comment') { + if (sibling.type === 'haddock') { + const text = getNodeText(sibling, source) + .replace(/^--\s*\|?\s*/, '') + .replace(/^\{-\s*\|?\s*/, '') + .replace(/-}$/, '') + .trim(); + return text || undefined; + } + sibling = sibling.previousNamedSibling; + } + return undefined; +} + +/** The preceding `signature` sibling (comments/haddocks may sit between), if it names this function. */ +function precedingSignature(node: SyntaxNode, name: string, source: string): SyntaxNode | null { + let prev = node.previousNamedSibling; + while (prev && (prev.type === 'comment' || prev.type === 'haddock')) prev = prev.previousNamedSibling; + if (prev?.type === 'signature') { + const sigName = getChildByField(prev, 'name'); + if (sigName && getNodeText(sigName, source) === name) return prev; + } + return null; +} + +// --- Per-file memos. Extraction is file-sequential within a worker, so a +// single-entry memo keyed by filePath is safe (and resets naturally). --- + +/** Clause-merge state: consecutive same-name function/bind nodes *in the same + * enclosing scope* merge into one. The scope key is the top of the node stack + * (the instance/class/top-level container) so two `instance` blocks each + * defining `show` don't collapse into one node. */ +let lastFnFile = ''; +let lastFnName = ''; +let lastFnScope = ''; +let lastFnId = ''; + +function resetFnMemo(filePath: string): void { + if (lastFnFile !== filePath) { + lastFnFile = filePath; + lastFnName = ''; + lastFnScope = ''; + lastFnId = ''; + } +} + +/** Walk a `match` node's expression subtree (and where-clause locals) for calls. */ +function visitMatch(matchNode: SyntaxNode, fnId: string, ctx: ExtractorContext): void { + ctx.pushScope(fnId); + // The match node itself holds the expression (field `expression`) and + // optional guards. Walk all named children so guards, the body expression, + // and any local-binds are all covered. + for (let i = 0; i < matchNode.namedChildCount; i++) { + const child = matchNode.namedChild(i); + if (child) ctx.visitNode(child); + } + ctx.popScope(); +} + +/** Handle a `function` or `bind` node (both are function definitions). */ +function handleFunctionLike(node: SyntaxNode, ctx: ExtractorContext): boolean { + const nameNode = getChildByField(node, 'name'); + if (!nameNode) return true; + const name = getNodeText(nameNode, ctx.source); + if (!name) return true; + + resetFnMemo(ctx.filePath); + + // Continuation clause: same-name consecutive function *in the same enclosing + // scope* — extend the existing node and attribute this clause's calls to it. + // The scope key (top of nodeStack) distinguishes methods of different + // type-class instances that happen to share a name (e.g. two `show` impls). + const currentScope = ctx.nodeStack[ctx.nodeStack.length - 1] ?? ''; + if (name === lastFnName && lastFnId && currentScope === lastFnScope) { + for (let i = ctx.nodes.length - 1; i >= 0; i--) { + const n = ctx.nodes[i]; + if (n && n.id === lastFnId) { + if (node.endPosition.row + 1 > n.endLine) n.endLine = node.endPosition.row + 1; + break; + } + } + const match = getChildByField(node, 'match'); + if (match) visitMatch(match, lastFnId, ctx); + // where-clause local binds (sibling `binds` field on the function node) + const binds = getChildByField(node, 'binds'); + if (binds) { + ctx.pushScope(lastFnId); + for (let i = 0; i < binds.namedChildCount; i++) { + const child = binds.namedChild(i); + if (child) ctx.visitNode(child); + } + ctx.popScope(); + } + return true; + } + + const sig = precedingSignature(node, name, ctx.source); + const doc = precedingHaddock(sig ?? node, ctx.source); + const fn = ctx.createNode('function', name, node, { + docstring: doc, + signature: sig ? collapseWs(getNodeText(sig, ctx.source)).slice(0, 300) : undefined, + }); + if (!fn) return true; + lastFnName = name; + lastFnScope = currentScope; + lastFnId = fn.id; + + const match = getChildByField(node, 'match'); + if (match) visitMatch(match, fn.id, ctx); + // where-clause local binds + const binds = getChildByField(node, 'binds'); + if (binds) { + ctx.pushScope(fn.id); + for (let i = 0; i < binds.namedChildCount; i++) { + const child = binds.namedChild(i); + if (child) ctx.visitNode(child); + } + ctx.popScope(); + } + return true; +} + +/** Handle a `data_type` node — struct + constructors (enum_members) + record fields. */ +function handleDataType(node: SyntaxNode, ctx: ExtractorContext): boolean { + const nameNode = getChildByField(node, 'name'); + if (!nameNode) return true; + const doc = precedingHaddock(node, ctx.source); + const struct = ctx.createNode('struct', getNodeText(nameNode, ctx.source), node, { + docstring: doc, + signature: collapseWs(getNodeText(node, ctx.source)).slice(0, 300), + }); + if (!struct) return true; + + ctx.pushScope(struct.id); + const ctors = getChildByField(node, 'constructors'); + if (ctors) { + for (let i = 0; i < ctors.namedChildCount; i++) { + const dc = ctors.namedChild(i); + if (!dc || dc.type !== 'data_constructor') continue; + // The constructor shape is under a `prefix`, `record`, or `infix` child + // (field `constructor`). + const shape = getChildByField(dc, 'constructor'); + if (!shape) continue; + const ctorNameNode = getChildByField(shape, 'name') || getChildByField(shape, 'constructor'); + const ctorName = ctorNameNode ? getNodeText(ctorNameNode, ctx.source) : null; + if (ctorName) { + ctx.createNode('enum_member', ctorName, dc); + } + // Record fields + if (shape.type === 'record') { + const fields = getChildByField(shape, 'fields'); + if (fields) { + for (let j = 0; j < fields.namedChildCount; j++) { + const field = fields.namedChild(j); + if (!field || field.type !== 'field') continue; + const fNameNode = getChildByField(field, 'name'); + if (fNameNode) ctx.createNode('field', getNodeText(fNameNode, ctx.source), field); + } + } + } + } + } + ctx.popScope(); + return true; // don't descend into type-position expressions +} + +/** Handle a `newtype` node — struct + single constructor + field. */ +function handleNewtype(node: SyntaxNode, ctx: ExtractorContext): boolean { + const nameNode = getChildByField(node, 'name'); + if (!nameNode) return true; + const struct = ctx.createNode('struct', getNodeText(nameNode, ctx.source), node, { + docstring: precedingHaddock(node, ctx.source), + signature: collapseWs(getNodeText(node, ctx.source)).slice(0, 300), + }); + if (!struct) return true; + + ctx.pushScope(struct.id); + const ctor = getChildByField(node, 'constructor'); + if (ctor) { + const ctorNameNode = getChildByField(ctor, 'name') || getChildByField(ctor, 'constructor'); + if (ctorNameNode) ctx.createNode('enum_member', getNodeText(ctorNameNode, ctx.source), ctor); + const field = getChildByField(ctor, 'field'); + if (field) { + const fNameNode = getChildByField(field, 'name'); + if (fNameNode) ctx.createNode('field', getNodeText(fNameNode, ctx.source), field); + } + } + ctx.popScope(); + return true; +} + +/** Handle a `type_synomym` node (note: grammar typo is intentional) — type_alias. */ +function handleTypeSynonym(node: SyntaxNode, ctx: ExtractorContext): boolean { + const nameNode = getChildByField(node, 'name'); + if (!nameNode) return true; + ctx.createNode('type_alias', getNodeText(nameNode, ctx.source), node, { + signature: collapseWs(getNodeText(node, ctx.source)).slice(0, 200), + }); + return true; // the type body is type-position — don't descend +} + +/** Handle a `class` node — trait + default method implementations. */ +function handleClass(node: SyntaxNode, ctx: ExtractorContext): boolean { + const nameNode = getChildByField(node, 'name'); + if (!nameNode) return true; + const trait = ctx.createNode('trait', getNodeText(nameNode, ctx.source), node, { + docstring: precedingHaddock(node, ctx.source), + signature: collapseWs(getNodeText(node, ctx.source)).slice(0, 300), + }); + if (!trait) return true; + + ctx.pushScope(trait.id); + const decls = getChildByField(node, 'declarations'); + if (decls) { + for (let i = 0; i < decls.namedChildCount; i++) { + const child = decls.namedChild(i); + if (child) ctx.visitNode(child); + } + } + ctx.popScope(); + return true; +} + +/** Handle an `instance` node — class node + implements reference + methods. */ +function handleInstance(node: SyntaxNode, ctx: ExtractorContext): boolean { + const nameNode = getChildByField(node, 'name'); + if (!nameNode) return true; + const className = getNodeText(nameNode, ctx.source); + // Derive the instance type from `patterns: type_patterns` + const typePatterns = getChildByField(node, 'patterns'); + let instanceType = ''; + if (typePatterns) { + const firstChild = typePatterns.namedChild(0); + if (firstChild) instanceType = getNodeText(firstChild, ctx.source); + } + const instanceName = instanceType ? `${className}.${instanceType}` : className; + const parentId = ctx.nodeStack[ctx.nodeStack.length - 1]; + + const instNode = ctx.createNode('class', instanceName, node, { + signature: collapseWs(getNodeText(node, ctx.source)).slice(0, 300), + }); + + // Emit an `implements` reference to the class so the resolver links it. + if (parentId) { + ctx.addUnresolvedReference({ + fromNodeId: instNode?.id ?? parentId, + referenceName: className, + referenceKind: 'implements', + line: node.startPosition.row + 1, + column: node.startPosition.column, + }); + } + + if (!instNode) return true; + + ctx.pushScope(instNode.id); + const decls = getChildByField(node, 'declarations'); + if (decls) { + for (let i = 0; i < decls.namedChildCount; i++) { + const child = decls.namedChild(i); + if (child) ctx.visitNode(child); + } + } + ctx.popScope(); + return true; +} + +export const haskellExtractor: LanguageExtractor = { + functionTypes: [], // dispatched via visitNode (name lives on a `variable` child of the `function`/`bind` node) + classTypes: [], + methodTypes: [], + interfaceTypes: [], + structTypes: [], // dispatched via visitNode + enumTypes: [], + typeAliasTypes: [], // dispatched via visitNode + importTypes: ['import'], + callTypes: ['apply', 'infix'], + variableTypes: [], + nameField: 'name', + bodyField: 'match', + paramsField: 'patterns', + interfaceKind: 'trait', + + // `header` wraps `module: module` → wraps the file's declarations in a + // namespace so qualified calls (`Data.Map.fromList`) resolve via + // matchByQualifiedName — mirrors Erlang's -module(m). + packageTypes: ['header'], + extractPackage: (node, source) => { + const mod = getChildByField(node, 'module'); + if (!mod) return null; + return moduleDottedName(mod, source); + }, + + extractImport: (node, source) => { + const modNode = getChildByField(node, 'module'); + if (!modNode) return null; + const moduleName = moduleDottedName(modNode, source); + if (!moduleName) return null; + return { + moduleName, + signature: collapseWs(getNodeText(node, source)).slice(0, 200), + }; + }, + + visitNode: (node, ctx) => { + switch (node.type) { + case 'function': + case 'bind': + return handleFunctionLike(node, ctx); + case 'signature': + return true; // metadata for the following function — skip as a node + case 'data_type': + return handleDataType(node, ctx); + case 'newtype': + return handleNewtype(node, ctx); + case 'type_synomym': + return handleTypeSynonym(node, ctx); + case 'class': + return handleClass(node, ctx); + case 'instance': + return handleInstance(node, ctx); + case 'haddock': + case 'comment': + return true; + default: + return false; + } + }, +}; \ No newline at end of file diff --git a/src/extraction/languages/index.ts b/src/extraction/languages/index.ts index 6b760b01d..63f12f6fa 100644 --- a/src/extraction/languages/index.ts +++ b/src/extraction/languages/index.ts @@ -36,6 +36,7 @@ import { solidityExtractor } from './solidity'; import { terraformExtractor } from './terraform'; import { arktsExtractor } from './arkts'; import { nixExtractor } from './nix'; +import { haskellExtractor } from './haskell'; export const EXTRACTORS: Partial> = { typescript: typescriptExtractor, @@ -69,4 +70,5 @@ export const EXTRACTORS: Partial> = { terraform: terraformExtractor, arkts: arktsExtractor, nix: nixExtractor, + haskell: haskellExtractor, }; diff --git a/src/extraction/tree-sitter.ts b/src/extraction/tree-sitter.ts index 8d71d7f18..9d9272199 100644 --- a/src/extraction/tree-sitter.ts +++ b/src/extraction/tree-sitter.ts @@ -387,6 +387,21 @@ const LITERAL_RECEIVER_TYPES = new Set([ 'dictionary', 'dict_literal', 'object', 'tuple', 'set', ]); +/** + * Haskell infix operators that are always built-in (never a user-defined + * function), so a call edge would never resolve. User-defined operators + * (declared via `prefix_id` in `signature` nodes, e.g. `(<) :: a -> a -> Bool`) + * are NOT in this set and DO get a call edge. + */ +const HASKELL_BUILTIN_OPS = new Set([ + '+', '-', '*', '/', '^', '^^', '**', + '==', '/=', '<', '>', '<=', '>=', + '&&', '||', 'not', + '>>', '>>=', '<<', '<$>', '<*>', '<|', '|$', '$', '$!', + '.', '..', '++', '!!', ':', '++', + '<>', '<$', +]); + export class TreeSitterExtractor { private filePath: string; private language: Language; @@ -3927,6 +3942,60 @@ export class TreeSitterExtractor { return; } + // Haskell: three call shapes the generic fallback doesn't handle correctly: + // - `infix` — `a + b`, `n * factorial (n-1)`, `f <$> g <*> h`. The operator + // is the callee; built-in operators (`+`, `-`, `*`, `/`, `==`, `/=`, `<`, + // `>`, `<=`, `>=`, `&&`, `||`, `>>`, `>>=`, `<<`, `<$>`, `<*>`, `<|`, `|$`, + // `$`, `.`, `++`, `:`) have no project definition, so emit a call edge + // only for operators NOT in the builtin set (user-defined operators via + // `prefix_id` in signatures, e.g. `(<) :: ...`). + // - `apply` with a `constructor` function — `Circle 5.0`, `Node val l r`. + // Data constructor usage; emit an `instantiates` reference so usage + // links to the `enum_member` node. + // - `apply` with a `variable` or `qualified` function — the generic + // fallback (`getNodeText(func)`) already handles these, so the Haskell + // branch only intercepts `infix` and constructor `apply`. + if (this.language === 'haskell') { + const line = node.startPosition.row + 1; + const column = node.startPosition.column; + + if (node.type === 'infix') { + const opNode = getChildByField(node, 'operator'); + if (opNode && opNode.type === 'operator') { + const opText = getNodeText(opNode, this.source); + if (opText && !HASKELL_BUILTIN_OPS.has(opText)) { + this.unresolvedReferences.push({ + fromNodeId: callerId, + referenceName: opText, + referenceKind: 'calls', + line, + column, + }); + } + } + return; + } + + if (node.type === 'apply') { + const func = getChildByField(node, 'function'); + if (func?.type === 'constructor') { + // Data constructor application — `Circle 5.0`, `Just x`. + const ctorName = getNodeText(func, this.source); + if (ctorName) { + this.unresolvedReferences.push({ + fromNodeId: callerId, + referenceName: ctorName, + referenceKind: 'instantiates', + line, + column, + }); + } + return; + } + // `variable` / `qualified` callees fall through to the generic path. + } + } + // Ruby `call` nodes use `receiver` + `method` fields (tree-sitter-ruby), not // the `object`/`name`/`function` fields the branches below expect — so // without this they fell through to the generic path, which took the diff --git a/src/extraction/wasm/tree-sitter-haskell.wasm b/src/extraction/wasm/tree-sitter-haskell.wasm new file mode 100644 index 000000000..1a5fb3263 Binary files /dev/null and b/src/extraction/wasm/tree-sitter-haskell.wasm differ diff --git a/src/types.ts b/src/types.ts index b0ebfe433..a7d131903 100644 --- a/src/types.ts +++ b/src/types.ts @@ -117,6 +117,7 @@ export const LANGUAGES = [ 'vbnet', 'erlang', 'terraform', + 'haskell', 'unknown', ] as const;