const familyById = new Map();
for (const f of graph.meta.pdTypeFamilies) familyById.set(qid(f.tfName), f);
- // Instances grouped by class id (qid).
+ // Instances grouped by class id (qid). Each instance gets a stable global
+ // `_idx` (its position in pdInstances) so the visibility filter and the
+ // matched-superclass-instance lookup can refer to it deterministically.
const instancesByClass = new Map();
- for (const i of graph.meta.pdInstances) {
+ graph.meta.pdInstances.forEach((i, idx) => {
+ i._idx = idx;
const k = qid(i.iiClass);
if (!instancesByClass.has(k)) instancesByClass.set(k, []);
instancesByClass.get(k).push(i);
- }
+ });
// Family instances grouped by family id (qid). Each fam-instance gets a
// stable index so we can mint deterministic Cytoscape node ids. Closed
setTopbar('classgraph', '');
setHint('classes');
setBackVisible(false);
- setCounts(`${classById.size} classes · ${familyById.size} families · ${cy.edges().length} edges`);
+ setCounts(focusCountsLine());
+ document.getElementById('instance-filter').hidden = true;
showSelection(null);
if (!opts || !opts.fromHistory) {
history.pushState({ view: 'classes' }, '', '#classes');
setBackVisible(true);
const insts = instancesByClass.get(classId) || [];
const supers = (cls ? cls.ciSuperclasses : []).length;
- setCounts(`${insts.length} instances · ${supers} superclass requirements`);
+ const hidden = getHidden(classId).size;
+ const visiblePart = hidden > 0 ? `${insts.length - hidden}/${insts.length}` : `${insts.length}`;
+ setCounts(`${visiblePart} instances · ${supers} superclass requirements`);
+ renderInstanceFilter(classId);
showSelection(null);
if (!opts || !opts.fromHistory) {
history.pushState({ view: 'instance', classId }, '', '#instances/' + encodeURIComponent(classId));
}
}
+ // Re-run the instance view with the current visibility set, preserving
+ // the user's pan/zoom.
+ function rebuildInstanceView() {
+ if (state.view !== 'instance' || !state.classId) return;
+ const pan = cy.pan();
+ const zoom = cy.zoom();
+ loadGraph(buildInstanceView(state.classId));
+ cy.layout({ name: 'dagre', rankDir: 'TB', nodeSep: 30, rankSep: 80 }).run();
+ cy.pan(pan);
+ cy.zoom(zoom);
+ const cls = classById.get(state.classId);
+ const insts = instancesByClass.get(state.classId) || [];
+ const hidden = getHidden(state.classId).size;
+ const visiblePart = hidden > 0 ? `${insts.length - hidden}/${insts.length}` : `${insts.length}`;
+ setCounts(`${visiblePart} instances · ${(cls ? cls.ciSuperclasses : []).length} superclass requirements`);
+ renderInstanceFilter(state.classId);
+ }
+
+ // -------------------------------------------------------------------------
+ // Instance filter (right-hand side panel)
+
+ const filterEl = document.getElementById('instance-filter');
+ const filterListEl = document.getElementById('filter-list');
+ const filterSummary = document.getElementById('filter-summary');
+ const filterSearch = document.getElementById('filter-search');
+
+ function renderInstanceFilter(classId) {
+ const insts = instancesByClass.get(classId) || [];
+ if (insts.length === 0) {
+ filterEl.hidden = true;
+ return;
+ }
+ filterEl.hidden = false;
+ const hidden = getHidden(classId);
+ const visible = insts.length - hidden.size;
+ filterSummary.textContent = `Instances (${visible} / ${insts.length})`;
+ filterListEl.innerHTML = insts.map(inst => {
+ const head = renderInstanceHead(inst);
+ const isHidden = hidden.has(inst._idx);
+ return `<li data-idx="${inst._idx}">
+ <label class="${isHidden ? 'unchecked' : ''}">
+ <input type="checkbox" ${isHidden ? '' : 'checked'} />
+ <span class="head" title="${escapeAttr(head)}">${escape(head)}</span>
+ </label>
+ </li>`;
+ }).join('');
+ applyFilterSearch();
+ }
+
+ function applyFilterSearch() {
+ const q = (filterSearch.value || '').toLowerCase().trim();
+ [...filterListEl.children].forEach(li => {
+ if (!q) { li.classList.remove('hidden-row'); return; }
+ const text = li.textContent.toLowerCase();
+ li.classList.toggle('hidden-row', !text.includes(q));
+ });
+ }
+
+ filterListEl.addEventListener('change', evt => {
+ if (state.view !== 'instance' || !state.classId) return;
+ const cb = evt.target.closest('input[type="checkbox"]');
+ if (!cb) return;
+ const li = cb.closest('li[data-idx]');
+ if (!li) return;
+ const idx = parseInt(li.dataset.idx, 10);
+ const hidden = getHidden(state.classId);
+ if (cb.checked) hidden.delete(idx); else hidden.add(idx);
+ rebuildInstanceView();
+ });
+
+ document.getElementById('filter-all').addEventListener('click', () => {
+ if (state.view !== 'instance' || !state.classId) return;
+ getHidden(state.classId).clear();
+ rebuildInstanceView();
+ });
+
+ document.getElementById('filter-none').addEventListener('click', () => {
+ if (state.view !== 'instance' || !state.classId) return;
+ const insts = instancesByClass.get(state.classId) || [];
+ const hidden = getHidden(state.classId);
+ insts.forEach(i => hidden.add(i._idx));
+ rebuildInstanceView();
+ });
+
+ filterSearch.addEventListener('input', applyFilterSearch);
+
function switchToFamily(familyId, opts) {
const els = buildFamilyView(familyId);
if (!els) return;
setBackVisible(true);
const fis = famInstsByFamily.get(familyId) || [];
setCounts(`${fis.length} type instances`);
+ document.getElementById('instance-filter').hidden = true;
showSelection(null);
if (!opts || !opts.fromHistory) {
history.pushState({ view: 'family', familyId }, '', '#families/' + encodeURIComponent(familyId));
}
// ---------------------------------------------------------------------------
- // Classes view
+ // Globally muted classes — qid set hidden across all views. Useful for
+ // taking out noisy "ambient" superclasses (Show, Eq, Ord, Typeable,
+ // NoThunks, …) so the rest of the graph reads cleanly.
+
+ const mutedSet = new Set();
+
+ function muteClass(id) {
+ if (mutedSet.has(id)) return;
+ mutedSet.add(id);
+ renderMuteList();
+ refreshCurrentView();
+ }
+
+ function unmuteClass(id) {
+ if (!mutedSet.delete(id)) return;
+ renderMuteList();
+ refreshCurrentView();
+ }
+
+ function clearMuted() {
+ if (mutedSet.size === 0) return;
+ mutedSet.clear();
+ renderMuteList();
+ refreshCurrentView();
+ }
+
+ function refreshCurrentView() {
+ if (state.view === 'classes') relayoutClassesView();
+ else if (state.view === 'instance') rebuildInstanceView();
+ // Family view shows no class nodes; nothing to refresh.
+ }
+
+ function renderMuteList() {
+ const summary = document.getElementById('mute-summary');
+ const listEl = document.getElementById('mute-list');
+ summary.textContent = `Muted classes (${mutedSet.size})`;
+ if (mutedSet.size === 0) {
+ listEl.innerHTML = '';
+ return;
+ }
+ const parts = [];
+ for (const id of mutedSet) {
+ const cls = classById.get(id);
+ const name = cls ? cls.ciName.qnName : id.split('.').pop();
+ parts.push(
+ `<li><span class="mute-chip" data-id="${escapeAttr(id)}" title="${escapeAttr(id)}">` +
+ `<span class="chip-name">${escape(name)}</span>` +
+ `<button class="mute-x" title="Unmute">×</button>` +
+ `</span></li>`
+ );
+ }
+ listEl.innerHTML = parts.join('');
+ }
+
+ document.getElementById('mute-clear').addEventListener('click', clearMuted);
+ document.getElementById('mute-list').addEventListener('click', evt => {
+ const x = evt.target.closest('.mute-x');
+ if (!x) return;
+ const chip = x.closest('.mute-chip');
+ if (!chip) return;
+ unmuteClass(chip.dataset.id);
+ });
+
+ // ---------------------------------------------------------------------------
+ // Classes view (with optional focus filter)
+ //
+ // When `focusSet` is empty, the full pre-built graph from Render.hs is
+ // shown. When non-empty, the view shrinks to only the pinned classes
+ // plus their immediate superclasses (and any associated type families).
+ // Ghost (one-hop) nodes can be promoted to pinned by clicking them, which
+ // expands the view by one more hop.
+
+ const focusSet = new Set();
function buildClassesView() {
- return graph.elements; // pre-built by Render.hs
+ const focused = focusSet.size > 0;
+ const muted = mutedSet.size > 0;
+ if (!focused && !muted) return graph.elements;
+
+ let visible = null;
+ if (focused) {
+ visible = new Set(focusSet);
+ for (const id of focusSet) {
+ const c = classById.get(id);
+ if (!c) continue;
+ for (const sc of c.ciSuperclasses) visible.add(qid(sc.seSuperclass));
+ for (const at of c.ciAssocTypes) visible.add(qid(at));
+ }
+ }
+
+ const out = [];
+ for (const e of graph.elements) {
+ if (e.group === 'nodes') {
+ if (mutedSet.has(e.data.id)) continue;
+ if (visible && !visible.has(e.data.id)) continue;
+ const ghost = focused && !focusSet.has(e.data.id);
+ out.push({ group: 'nodes', data: Object.assign({}, e.data, { ghost }) });
+ } else {
+ if (mutedSet.has(e.data.source) || mutedSet.has(e.data.target)) continue;
+ if (visible && (!visible.has(e.data.source) || !visible.has(e.data.target))) continue;
+ out.push(e);
+ }
+ }
+ return out;
+ }
+
+ function relayoutClassesView() {
+ if (state.view !== 'classes') return;
+ loadGraph(buildClassesView());
+ cy.layout({ name: 'dagre', rankDir: 'BT', nodeSep: 50, rankSep: 90 }).run();
+ setCounts(focusCountsLine());
+ }
+
+ function focusCountsLine() {
+ if (focusSet.size === 0) {
+ return `${classById.size} classes · ${familyById.size} families · ${cy.edges().length} edges`;
+ }
+ const total = cy.nodes().length;
+ const pinned = focusSet.size;
+ return `Focus: ${pinned} pinned · ${total} visible nodes · ${cy.edges().length} edges`;
+ }
+
+ function pinClass(id) {
+ if (!classById.has(id)) return;
+ if (focusSet.has(id)) return;
+ focusSet.add(id);
+ renderChips();
+ if (state.view === 'classes') {
+ relayoutClassesView();
+ } else {
+ switchToClasses(); // pinning implies you want to look at the focused subgraph
+ }
+ }
+
+ function unpinClass(id) {
+ if (!focusSet.delete(id)) return;
+ renderChips();
+ if (state.view === 'classes') relayoutClassesView();
+ }
+
+ function clearFocus() {
+ if (focusSet.size === 0) return;
+ focusSet.clear();
+ renderChips();
+ if (state.view === 'classes') relayoutClassesView();
+ }
+
+ function renderChips() {
+ const chips = document.getElementById('pin-chips');
+ const list = document.getElementById('pin-list');
+ if (focusSet.size === 0) {
+ chips.hidden = true;
+ list.innerHTML = '';
+ return;
+ }
+ chips.hidden = false;
+ const parts = [];
+ for (const id of focusSet) {
+ const c = classById.get(id);
+ const name = c ? c.ciName.qnName : id;
+ parts.push(
+ `<span class="pin-chip" data-id="${escapeAttr(id)}" title="${escapeAttr(id)}">` +
+ `<span class="chip-name">${escape(name)}</span>` +
+ `<button class="pin-x" title="Remove">×</button>` +
+ `</span>`
+ );
+ }
+ list.innerHTML = parts.join('');
+ }
+
+ function escapeAttr(s) {
+ return String(s).replace(/[&<>"']/g, ch => ({
+ '&':'&','<':'<','>':'>','"':'"',"'":''',
+ }[ch]));
}
// ---------------------------------------------------------------------------
// Instance view
+ // Per-class set of *hidden* instance _idx values. Persists across
+ // navigation so the filter survives a back-and-forth trip. Empty (or
+ // missing) means "show all".
+ const hiddenInstancesByClass = new Map();
+
+ function getHidden(classId) {
+ let s = hiddenInstancesByClass.get(classId);
+ if (!s) { s = new Set(); hiddenInstancesByClass.set(classId, s); }
+ return s;
+ }
+
function buildInstanceView(classId) {
const cls = classById.get(classId);
if (!cls) return null;
- const insts = instancesByClass.get(classId) || [];
+ const all = instancesByClass.get(classId) || [];
+ const hidden = getHidden(classId);
+ const insts = all.filter(i => !hidden.has(i._idx));
const els = [];
const seenNodes = new Set();
return id;
}
+ // For every distinct type family referenced anywhere inside `args`,
+ // ensure a family node exists, draw a "via family" edge from the
+ // origin node, and lift the family's known type-instance rows into
+ // the graph so the user can verify the family is actually defined
+ // for the relevant types.
+ function addFamilyLinksFromArgs(args, originId, edgeTag) {
+ const fams = collectFamilyRefs(args);
+ for (const fa of fams) {
+ const famNodeId = ensureFamilyNode(fa);
+ const linkId = originId + '#viafam#' + edgeTag + '#' + famNodeId;
+ if (seenNodes.has(linkId)) continue;
+ seenNodes.add(linkId);
+ els.push({ group: 'edges', data: {
+ id: linkId,
+ source: originId,
+ target: famNodeId,
+ kind: 'via-family',
+ label: 'via ' + fa.qnName,
+ }});
+ // Also surface the matching type-instance rows so we see where
+ // the family is actually defined for which heads.
+ for (const fi of (famInstsByFamily.get(famNodeId) || [])) {
+ const fiNodeId = ensureFamInstanceNode(fi);
+ const fdId = famNodeId + '=>' + fiNodeId;
+ if (seenNodes.has(fdId)) continue;
+ seenNodes.add(fdId);
+ els.push({ group: 'edges', data: {
+ id: fdId,
+ source: famNodeId,
+ target: fiNodeId,
+ kind: 'fam-defines',
+ }});
+ }
+ }
+ }
+
// Focus class at the top.
const focusedId = ensureClassNode(cls.ciName, { focused: true });
}});
// Context constraints — these are the "new classes the instance
- // declares as needed for the implementation".
+ // declares as needed for the implementation". Skip predicates whose
+ // class is globally muted. Equality predicates (a ~ b) don't point
+ // at a class node, so they aren't drawn as edges; they appear in
+ // the side panel under the instance.
inst.iiContext.forEach((pred, pi) => {
+ if (pred.piIsEq) return;
+ if (mutedSet.has(qid(pred.piClass))) return;
const cid = ensureClassNode(pred.piClass);
els.push({ group: 'edges', data: {
id: instId + '#ctx#' + pi,
kind: 'context',
label: 'ctx: ' + renderArgsCompact(pred.piArgs, inst.iiTyVars),
}});
+ // Surface any type-family applications hiding inside the predicate
+ // (e.g. `Eq (TxOut era)` — `Eq` itself is the class, but `TxOut`
+ // is a type family that must be defined for that era).
+ addFamilyLinksFromArgs(pred.piArgs, instId, 'ctx-fam');
});
// Associated type families: when the focused class declares assoc
// produce the requirement `S substArgs`. We then look in our program
// data for instances of S whose head shape matches.
cls.ciSuperclasses.forEach((sc, si) => {
+ if (mutedSet.has(qid(sc.seSuperclass))) return;
const reqArgs = sc.seArgs.map(a => substTypeArg(a, inst.iiArgs));
+ // Same family-linkage as for context preds: a superclass requirement
+ // like `Eq (TxOut era)` should also flag the `TxOut` family.
+ addFamilyLinksFromArgs(reqArgs, instId, 'sc-fam-' + si);
const matched = findMatchingInstances(sc.seSuperclass, reqArgs);
const scClsId = ensureClassNode(sc.seSuperclass);
const reqLabel = 'needs ' + sc.seSuperclass.qnName + ' ' +
function findMatchingInstances(classQn, reqArgs) {
const target = qid(classQn);
const matches = [];
- for (let i = 0; i < graph.meta.pdInstances.length; i++) {
- const inst = graph.meta.pdInstances[i];
+ for (const inst of graph.meta.pdInstances) {
if (qid(inst.iiClass) !== target) continue;
- if (matchArgs(inst.iiArgs, reqArgs)) {
- // Stash a stable index for id generation.
- if (inst._idx === undefined) inst._idx = i;
- matches.push(inst);
- }
+ if (matchArgs(inst.iiArgs, reqArgs)) matches.push(inst);
}
return matches;
}
}
if (a.tag === 'TyConApp' || a.tag === 'FamilyApp') {
const [q, args] = a.contents;
+ // Infix render for equality/coercibility-like binary operators that
+ // appear as TyCons in argument position. Without this they would
+ // print as e.g. "(~ a b)".
+ const op = infixOpName(q.qnName);
+ if (op && args && args.length === 2) {
+ return '(' + renderArg(args[0], boundTvs) + ' ' + op + ' ' +
+ renderArg(args[1], boundTvs) + ')';
+ }
if (!args || args.length === 0) return q.qnName;
const inner = args.map(x => renderArg(x, boundTvs)).join(' ');
return '(' + q.qnName + ' ' + inner + ')';
return '?';
}
+ // Walk a list of TypeArgs and collect every distinct family QualName
+ // mentioned. Used by the instance view to surface the type families
+ // referenced by a constraint (e.g. `Eq (TxOut era)` mentions `TxOut`).
+ function collectFamilyRefs(args) {
+ const seen = new Map(); // qid → QualName
+ function go(t) {
+ if (!t || !t.tag) return;
+ if (t.tag === 'FamilyApp') {
+ const [q, inner] = t.contents;
+ if (!seen.has(qid(q))) seen.set(qid(q), q);
+ for (const x of (inner || [])) go(x);
+ } else if (t.tag === 'TyConApp') {
+ const [, inner] = t.contents;
+ for (const x of (inner || [])) go(x);
+ }
+ }
+ for (const a of (args || [])) go(a);
+ return [...seen.values()];
+ }
+
+ // Returns the infix operator string for a TyCon name that should render
+ // infix (currently the various equality and coercion-evidence forms).
+ function infixOpName(name) {
+ if (name === '->' || name === '(->)') return '->';
+ if (name === '~' || name === '(~)') return '~';
+ if (name === '~~' || name === '(~~)') return '~~';
+ if (name === '~#' || name === '(~#)') return '~#';
+ if (name === '~R#' || name === '(~R#)') return '~R#';
+ return null;
+ }
+
// ---------------------------------------------------------------------------
// Side panel
const head = escape(inst.iiClass.qnName) + ' ' +
escape(renderArgsCompact(inst.iiArgs, inst.iiTyVars));
const ctx = inst.iiContext.length === 0 ? '<dd><em>none</em></dd>' :
- inst.iiContext.map(p =>
- `<dd>${escape(p.piClass.qnName)} ${escape(renderArgsCompact(p.piArgs, inst.iiTyVars))}</dd>`).join('');
+ inst.iiContext.map(p => {
+ const txt = p.piIsEq
+ ? renderArg(p.piArgs[0], inst.iiTyVars) + ' ' + p.piClass.qnName +
+ ' ' + renderArg(p.piArgs[1], inst.iiTyVars)
+ : p.piClass.qnName + ' ' + renderArgsCompact(p.piArgs, inst.iiTyVars);
+ return `<dd>${escape(txt)}</dd>`;
+ }).join('');
const tvs = inst.iiTyVars.length === 0 ? '<dd><em>none</em></dd>' :
`<dd><ul>${inst.iiTyVars.map(v =>
`<li>${escape(v.tvName)}<span style="color:#888"> :: ${escape(v.tvKind)}</span></li>`).join('')}</ul></dd>`;
'border-style': 'dashed',
},
},
+ // Ghost class node (one-hop neighbour in a focus-filtered classes view)
+ {
+ selector: 'node[kind = "class"][?ghost]',
+ style: {
+ 'background-color': '#dbeafe',
+ color: '#1e3a8a',
+ 'border-color': '#1d4ed8',
+ 'border-style': 'dashed',
+ opacity: 0.85,
+ },
+ },
// Focused class in instance view
{
selector: 'node[?focused]',
width: 1.4,
},
},
+ // Instance view: via-family (instance -> family node, indicating the
+ // constraint mentions a type family that must be defined elsewhere).
+ {
+ selector: 'edge[kind = "via-family"]',
+ style: {
+ 'line-color': '#c084fc',
+ 'target-arrow-color': '#c084fc',
+ 'line-style': 'dashed',
+ width: 1.2,
+ 'font-size': 9,
+ },
+ },
// Family/instance view: fam-defines (family -> fam-instance node)
{
selector: 'edge[kind = "fam-defines"]',
cy.on('tap', 'node', evt => {
const n = evt.target;
const data = n.data();
+
+ // In the classes view, when focus filtering is on:
+ // * clicking a *ghost* node (visible because it's a one-hop superclass
+ // of something pinned) promotes it to pinned, expanding the view.
+ // * clicking a pinned node still drills in to its instance view.
+ if (state.view === 'classes' && focusSet.size > 0
+ && data.kind === 'class' && data.ghost && classById.has(n.id())) {
+ pinClass(n.id());
+ return;
+ }
+
// Class node → drill into its instance view (skip the already-focused
// class in the current instance view).
if (data.kind === 'class' && !data.focused && classById.has(n.id())) {
switchToClasses();
});
+ document.getElementById('pin-clear').addEventListener('click', () => {
+ clearFocus();
+ });
+
+ document.getElementById('pin-list').addEventListener('click', evt => {
+ const x = evt.target.closest('.pin-x');
+ if (!x) return;
+ const chip = x.closest('.pin-chip');
+ if (!chip) return;
+ unpinClass(chip.dataset.id);
+ });
+
window.addEventListener('popstate', evt => {
const s = evt.state;
if (s && s.view === 'instance') {
}
bootstrap();
+ // -------------------------------------------------------------------------
+ // Resizable side panel — drag the splitter to widen/narrow the panel.
+ // The chosen width is persisted to localStorage.
+
+ (function setupSplitter() {
+ const splitter = document.getElementById('splitter');
+ const panel = document.getElementById('panel');
+ if (!splitter || !panel) return;
+ const STORAGE_KEY = 'classgraph.panelWidthPx';
+ const stored = parseInt(localStorage.getItem(STORAGE_KEY) || '0', 10);
+ if (stored && stored > 200 && stored < window.innerWidth - 200) {
+ panel.style.width = stored + 'px';
+ }
+ let dragging = false;
+ splitter.addEventListener('mousedown', evt => {
+ dragging = true;
+ splitter.classList.add('dragging');
+ document.body.style.cursor = 'ew-resize';
+ evt.preventDefault();
+ });
+ document.addEventListener('mousemove', evt => {
+ if (!dragging) return;
+ const w = Math.max(220, Math.min(window.innerWidth - 200,
+ window.innerWidth - evt.clientX));
+ panel.style.width = w + 'px';
+ cy.resize();
+ });
+ document.addEventListener('mouseup', () => {
+ if (!dragging) return;
+ dragging = false;
+ splitter.classList.remove('dragging');
+ document.body.style.cursor = '';
+ const w = parseInt(panel.style.width, 10);
+ if (w) localStorage.setItem(STORAGE_KEY, String(w));
+ });
+ })();
+
// ---------------------------------------------------------------------------
// Search bar
//
const badge = e.kind === 'family'
? '<span class="badge family">family</span>'
: (e.external ? '<span class="badge external">external</span>' : '');
+ const canPin = (e.kind === 'class' && !e.external);
+ const canMute = (e.kind === 'class');
+ const pinned = canPin && focusSet.has(e.id);
+ const muted = canMute && mutedSet.has(e.id);
+ const actions = [];
+ if (canMute) {
+ actions.push(`<button class="mute-add${muted ? ' muted' : ''}" title="${muted ? 'Unmute' : 'Mute (hide everywhere)'}">🙈</button>`);
+ }
+ if (canPin) {
+ actions.push(`<button class="pin-add${pinned ? ' pinned' : ''}" title="${pinned ? 'Unpin' : 'Add to focus'}">📌</button>`);
+ }
return `<li data-index="${i}">
- <span class="name">${escape(e.name)}${badge}</span>
- <span class="qual">${escape(e.package)} · ${escape(e.module)}</span>
+ <span class="row-content">
+ <span class="name">${escape(e.name)}${badge}</span>
+ <span class="qual">${escape(e.package)} · ${escape(e.module)}</span>
+ </span>
+ <span class="row-actions">${actions.join('')}</span>
</li>`;
}).join('');
}
const li = evt.target.closest('li[data-index]');
if (!li) return;
evt.preventDefault();
- selectMatch(parseInt(li.dataset.index, 10));
+ const idx = parseInt(li.dataset.index, 10);
+ const m = currentMatches[idx];
+ if (!m) return;
+ const pinBtn = evt.target.closest('.pin-add');
+ if (pinBtn) {
+ if (focusSet.has(m.id)) unpinClass(m.id); else pinClass(m.id);
+ renderResults(currentMatches);
+ updateActive();
+ searchInput.focus();
+ return;
+ }
+ const muteBtn = evt.target.closest('.mute-add');
+ if (muteBtn) {
+ if (mutedSet.has(m.id)) unmuteClass(m.id); else muteClass(m.id);
+ renderResults(currentMatches);
+ updateActive();
+ searchInput.focus();
+ return;
+ }
+ selectMatch(idx);
});
document.addEventListener('mousedown', evt => {
, fromBranches
)
import GHC.Core.FamInstEnv (FamInst (..))
+import GHC.Core.Predicate
+ ( EqRel (..)
+ , Pred (..)
+ , classifyPredType
+ )
import GHC.Core (IsOrphan, isOrphan)
import GHC.Core.InstEnv
( ClsInst
( FamTyConFlav (..)
, TyCon
, famTyConFlav_maybe
- , isClassTyCon
, isFamilyTyCon
+ , isInvisibleTyConBinder
+ , tyConBinders
, tyConName
, tyConResKind
+ , tyConTuple_maybe
, tyConTyVars
, tyConClass_maybe
)
+import GHC.Core.Class (classTyCon)
+import GHC.Types.Basic (TupleSort (..))
import GHC.Core.Type
( Type
, getTyVar_maybe
, isLitTy
, splitTyConApp_maybe
+ , splitVisibleFunTy_maybe
)
import GHC.Tc.Types (TcGblEnv (..))
import GHC.Types.Name
import GHC.Types.Var (Var, varName, varType)
import GHC.Unit.Module (moduleName, moduleNameString, moduleUnit)
import GHC.Unit.Types (unitString)
-import GHC.Utils.Outputable (showPprUnsafe)
+import GHC.Utils.Outputable
+ ( Outputable
+ , SDocContext (..)
+ , defaultSDocContext
+ , ppr
+ , showSDocOneLine
+ )
import qualified GHC.Data.FastString as FS
import Classgraph.Schema
+-- | A user-style 'SDocContext' that suppresses the noise the default
+-- (debug-leaning) context emits — explicit kinds, RuntimeRep arguments,
+-- linearity multiplicities, foralls, etc. Without these overrides, types
+-- like @* -> *@ and @a -> b@ get printed as @TYPE BoxedRep Lifted@ and
+-- @FUN ManyTy a b@, which is unreadable in the viewer.
+prettyCtx :: SDocContext
+prettyCtx = defaultSDocContext
+ { sdocPrintExplicitKinds = False
+ , sdocPrintExplicitRuntimeReps = False
+ , sdocPrintExplicitForalls = False
+ , sdocPrintExplicitCoercions = False
+ , sdocSuppressVarKinds = True
+ , sdocSuppressUniques = True
+ , sdocLinearTypes = False
+ , sdocPrintTypeAbbreviations = True
+ , sdocSuppressModulePrefixes = True
+ , sdocStarIsType = True
+ , sdocListTuplePuns = True
+ }
+
+pprText :: Outputable a => a -> Text
+pprText = T.pack . showSDocOneLine prettyCtx . ppr
+
-- | Identify which module + package this dump corresponds to.
currentModuleNames :: TcGblEnv -> (Text, Text)
currentModuleNames env =
extractClass cls = Just ClassInfo
{ ciName = qualName (className cls)
, ciTyVars = map tyVarInfo (classTyVars cls)
- , ciSuperclasses = mapMaybe (predToSuperEdge boundTvs) (classSCTheta cls)
+ , ciSuperclasses = concatMap (predToSuperEdges boundTvs) (classSCTheta cls)
, ciAssocTypes = [ qualName (tyConName atTc) | atTc <- classATs cls ]
, ciMethods = map (T.pack . occNameString . nameOccName . varName) (classMethods cls)
, ciSrc = srcSpanInfo (nameSrcSpan (className cls))
where
boundTvs = classTyVars cls
-predToSuperEdge :: [Var] -> Type -> Maybe SuperclassEdge
-predToSuperEdge boundTvs predTy =
- case splitTyConApp_maybe predTy of
- Just (tc, args)
- | isClassTyCon tc ->
- Just SuperclassEdge
- { seSuperclass = qualName (tyConName tc)
+-- | Decompose one PredType into 0..n 'SuperclassEdge's. Class predicates
+-- become a single edge; constraint tuples are flattened recursively;
+-- equality\/quantified\/irreducible predicates produce no edge (they don't
+-- map onto a class node).
+predToSuperEdges :: [Var] -> Type -> [SuperclassEdge]
+predToSuperEdges boundTvs predTy = case classifyPredType predTy of
+ ClassPred cls args
+ | isCTupleClass cls -> concatMap (predToSuperEdges boundTvs) args
+ | otherwise ->
+ [ SuperclassEdge
+ { seSuperclass = qualName (className cls)
, seArgs = map (typeArg boundTvs) args
}
- _ -> Nothing -- equality, implicit-param, etc. — not a class constraint
+ ]
+ EqPred{} -> []
+ IrredPred{} -> []
+ ForAllPred{} -> []
+
+isCTupleClass :: Class -> Bool
+isCTupleClass cls = tyConTuple_maybe (classTyCon cls) == Just ConstraintTuple
------------------------------------------------------------------------------
-- Instances
in InstanceInfo
{ iiClass = qualName (className cls)
, iiArgs = map (typeArg tvs) args
- , iiContext = mapMaybe (predToPredInfo tvs) theta
+ , iiContext = concatMap (predToPredInfos tvs) theta
, iiTyVars = map tyVarInfo tvs
, iiOrphan = orphanFlag (is_orphan inst)
- , iiOverlap = Just (T.pack (showPprUnsafe (is_flag inst)))
+ , iiOverlap = Just (pprText (is_flag inst))
-- The dfun's name span would be more precise; for synthesised
-- dfuns it's often unhelpful, so fall back to the class name.
, iiSrc = srcSpanInfo (nameSrcSpan (className cls))
orphanFlag :: IsOrphan -> Bool
orphanFlag = isOrphan
-predToPredInfo :: [Var] -> Type -> Maybe PredInfo
-predToPredInfo boundTvs predTy =
- case splitTyConApp_maybe predTy of
- Just (tc, args)
- | isClassTyCon tc ->
- Just PredInfo
- { piClass = qualName (tyConName tc)
+-- | Decompose one PredType into 0..n 'PredInfo's:
+-- * ClassPred → one info (or many, if it's a constraint tuple).
+-- * EqPred → one info with @piIsEq = True@ and the two operands.
+-- * IrredPred / ForAllPred → none.
+predToPredInfos :: [Var] -> Type -> [PredInfo]
+predToPredInfos boundTvs predTy = case classifyPredType predTy of
+ ClassPred cls args
+ | isCTupleClass cls -> concatMap (predToPredInfos boundTvs) args
+ | otherwise ->
+ [ PredInfo
+ { piClass = qualName (className cls)
, piArgs = map (typeArg boundTvs) args
+ , piIsEq = False
}
- _ -> Nothing
+ ]
+ EqPred eqRel a b ->
+ [ PredInfo
+ { piClass = QualName "<builtin>" "GHC.Builtin" (eqOpName eqRel)
+ , piArgs = [typeArg boundTvs a, typeArg boundTvs b]
+ , piIsEq = True
+ }
+ ]
+ IrredPred{} -> []
+ ForAllPred{} -> []
+
+eqOpName :: EqRel -> Text
+eqOpName NomEq = "~"
+eqOpName ReprEq = "Coercible" -- shows up as "a ~R b" sometimes; closest readable form
------------------------------------------------------------------------------
-- Type families
{ tfName = qualName (tyConName tc)
, tfTyVars = map tyVarInfo (tyConTyVars tc)
, tfFlavor = flavor
- , tfResultKind = T.pack (showPprUnsafe (tyConResKind tc))
+ , tfResultKind = pprText (tyConResKind tc)
, tfSrc = srcSpanInfo (nameSrcSpan (tyConName tc))
, tfEquations = closedEquations
}
-- returned by 'instanceSig'). Their positional index in this list is
-- what 'TyVarRef' carries — exactly what the viewer needs to render the
-- multi-param positional mapping on edge labels.
+--
+-- We aggressively sugar two structural forms that would otherwise leak the
+-- compiler's explicit-runtime-rep representation into the viewer:
+--
+-- * Function arrows are recognised via 'splitVisibleFunTy_maybe' and
+-- rendered as a synthetic @(->)@ 'TyConApp' with two arguments only —
+-- no multiplicity, no kind args. (Otherwise we'd see @FUN ManyTy
+-- (BoxedRep Lifted) (BoxedRep Lifted) (TYPE …) a b@.)
+--
+-- * For all other 'TyConApp's the invisible (kind / runtime-rep)
+-- argument positions are filtered out using 'tyConBinders' +
+-- 'isInvisibleTyConBinder', so we don't surface @TYPE (BoxedRep
+-- Lifted)@ injections at every kind-polymorphic call site.
typeArg :: [Var] -> Type -> TypeArg
typeArg boundTvs t =
case getTyVar_maybe t of
Just tv | Just i <- elemIndex tv boundTvs -> TyVarRef i
- _ -> case splitTyConApp_maybe t of
- Just (tc, args)
- | isFamilyTyCon tc ->
- FamilyApp (qualName (tyConName tc)) (map (typeArg boundTvs) args)
- | otherwise ->
- TyConApp (qualName (tyConName tc)) (map (typeArg boundTvs) args)
- Nothing -> case isLitTy t of
- Just _ -> LitArg (T.pack (showPprUnsafe t))
- Nothing -> OtherArg (T.pack (showPprUnsafe t))
+ _ -> case splitVisibleFunTy_maybe t of
+ Just (a, b) ->
+ TyConApp arrowQualName [typeArg boundTvs a, typeArg boundTvs b]
+ Nothing -> case splitTyConApp_maybe t of
+ Just (tc, args) ->
+ let visArgs = visibleArgs tc args
+ kids = map (typeArg boundTvs) visArgs
+ in if isFamilyTyCon tc
+ then FamilyApp (qualName (tyConName tc)) kids
+ else TyConApp (qualName (tyConName tc)) kids
+ Nothing -> case isLitTy t of
+ Just _ -> LitArg (pprText t)
+ Nothing -> OtherArg (pprText t)
+
+-- | Drop the elements of @args@ corresponding to invisible 'tyConBinders'.
+-- If @args@ has more entries than the TyCon has binders (over-application,
+-- which can happen for higher-kinded type variables), the trailing extras
+-- are kept as visible.
+visibleArgs :: TyCon -> [Type] -> [Type]
+visibleArgs tc args =
+ let binders = tyConBinders tc
+ in zipFilter binders args
+ where
+ zipFilter (b:bs) (a:as)
+ | isInvisibleTyConBinder b = zipFilter bs as
+ | otherwise = a : zipFilter bs as
+ zipFilter _ leftover = leftover
+
+-- | Synthetic 'QualName' used to flag a function arrow in a 'TypeArg'. The
+-- viewer renders this as the @->@ infix operator.
+arrowQualName :: QualName
+arrowQualName = QualName "<builtin>" "GHC.Builtin" "->"
------------------------------------------------------------------------------
-- Helpers
tyVarInfo :: Var -> TyVarInfo
tyVarInfo v = TyVarInfo
{ tvName = T.pack (occNameString (nameOccName (varName v)))
- , tvKind = T.pack (showPprUnsafe (varType v))
+ , tvKind = pprText (varType v)
-- For TyVars, varType v is the kind (Kind = Type).
}
projects / classgraph.git / commitdiff