--- /dev/null
+// Pure type-argument unification / matching core.
+//
+// Shared between the in-page viewer (viewer.js, where it runs as a browser
+// global) and the Node test-suite (test/typecore.test.js, where it is
+// required as a module). It has NO dependency on the DOM or Cytoscape, so it
+// can be exercised in isolation — see the test-suite for fixtures covering
+// a~b instances, closed-family reduction, multi-param projection, and
+// data-family rewrites.
+//
+// Everything operates on the structured TypeArg shape emitted by the Haskell
+// extractor (Classgraph.Schema):
+//
+// { tag: 'TyVarRef', contents: <int index> } // i-th tyvar of the
+// // enclosing class/inst
+// { tag: 'TyConApp', contents: [qn, [TypeArg…]] }
+// { tag: 'FamilyApp', contents: [qn, [TypeArg…]] }
+// { tag: 'LitArg', contents: <string> }
+// { tag: 'OtherArg', contents: <string> }
+//
+// where qn = { qnPackage, qnModule, qnName }.
+//
+// Functions that need program data (type-family equations, class instances)
+// are produced by makeTypeCore(env); the data-free helpers are pure and are
+// also exported directly for convenience.
+(function (root, factory) {
+ 'use strict';
+ const api = factory();
+ if (typeof module !== 'undefined' && module.exports) {
+ module.exports = api;
+ } else {
+ root.ClassgraphTypeCore = api;
+ }
+})(typeof globalThis !== 'undefined' ? globalThis : this, function () {
+ 'use strict';
+
+ // Stable, human-readable identity of a QualName: "pkg:Mod.Name".
+ function qid(qn) { return qn.qnPackage + ':' + qn.qnModule + '.' + qn.qnName; }
+
+ // Structural equality of two TypeArgs.
+ function deepEqArg(a, b) {
+ if (a === b) return true;
+ if (!a || !b || a.tag !== b.tag) return false;
+ if (a.tag === 'TyVarRef') return a.contents === b.contents;
+ if (a.tag === 'TyConApp' || a.tag === 'FamilyApp') {
+ const [aq, aa] = a.contents;
+ const [bq, ba] = b.contents;
+ if (qid(aq) !== qid(bq) || aa.length !== ba.length) return false;
+ return aa.every((x, i) => deepEqArg(x, ba[i]));
+ }
+ return a.contents === b.contents;
+ }
+
+ // Substitute the i-th instance arg in for each TyVarRef i appearing in t.
+ // (No family reduction — that's reduceTypeArg's job; see substTypeArg.)
+ function substTypeArgRaw(t, instArgs) {
+ if (!t || !t.tag) return t;
+ if (t.tag === 'TyVarRef') {
+ const ix = t.contents;
+ if (ix >= 0 && ix < instArgs.length) return instArgs[ix];
+ return t;
+ }
+ if (t.tag === 'TyConApp' || t.tag === 'FamilyApp') {
+ const [q, args] = t.contents;
+ return { tag: t.tag, contents: [q, args.map(a => substTypeArgRaw(a, instArgs))] };
+ }
+ return t; // LitArg / OtherArg
+ }
+
+ // One-sided unification: bind TyVarRefs occurring in `pat` against `t`.
+ // TyVarRefs in `t` (the requirement side) are not unified — we don't
+ // attempt to invent fresh bindings on the right.
+ function unify(pat, t, subst) {
+ if (!pat || !t) return false;
+ if (pat.tag === 'TyVarRef') {
+ const ix = pat.contents;
+ if (subst[ix] !== undefined) return deepEqArg(subst[ix], t);
+ subst[ix] = t;
+ return true;
+ }
+ if (t.tag === 'TyVarRef') return false;
+ if (pat.tag !== t.tag) return false;
+ if (pat.tag === 'TyConApp' || pat.tag === 'FamilyApp') {
+ const [pq, pargs] = pat.contents;
+ const [tq, targs] = t.contents;
+ if (qid(pq) !== qid(tq)) return false;
+ if (pargs.length !== targs.length) return false;
+ for (let i = 0; i < pargs.length; i++) {
+ if (!unify(pargs[i], targs[i], subst)) return false;
+ }
+ return true;
+ }
+ if (pat.tag === 'LitArg' || pat.tag === 'OtherArg') {
+ return pat.contents === t.contents;
+ }
+ return false;
+ }
+
+ function applySubst(t, subst) {
+ if (!t || !t.tag) return t;
+ if (t.tag === 'TyVarRef') {
+ const ix = t.contents;
+ return subst[ix] !== undefined ? subst[ix] : t;
+ }
+ if (t.tag === 'TyConApp' || t.tag === 'FamilyApp') {
+ const [q, args] = t.contents;
+ return { tag: t.tag, contents: [q, args.map(a => applySubst(a, subst))] };
+ }
+ return t;
+ }
+
+ // For the resolution chain we want to ask: "if the family @fa@ resolves
+ // via this particular fam-instance @fi@, what would the predicate look
+ // like?" That requires *bi-directional* unification — we may need to
+ // bind a tyvar on the pred side to a concrete value from fi (e.g. for
+ // @Pretty (Bag a)@ vs @type instance Bag Int = [Int]@, we hypothetically
+ // bind @a := Int@), and we may also need to bind a tyvar on fi's side
+ // to a value from the pred (e.g. fi's @a@ to pred's @era@).
+ function biUnify(pat, t, substPat, substT) {
+ if (!pat || !t) return false;
+ if (pat.tag === 'TyVarRef') {
+ const ix = pat.contents;
+ if (substPat[ix] !== undefined) return deepEqArg(substPat[ix], t);
+ substPat[ix] = t;
+ return true;
+ }
+ if (t.tag === 'TyVarRef') {
+ const ix = t.contents;
+ if (substT[ix] !== undefined) return deepEqArg(substT[ix], pat);
+ substT[ix] = pat;
+ return true;
+ }
+ if (pat.tag !== t.tag) return false;
+ if (pat.tag === 'TyConApp' || pat.tag === 'FamilyApp') {
+ const [pq, pa] = pat.contents;
+ const [tq, ta] = t.contents;
+ if (qid(pq) !== qid(tq)) return false;
+ if (pa.length !== ta.length) return false;
+ for (let i = 0; i < pa.length; i++) {
+ if (!biUnify(pa[i], ta[i], substPat, substT)) return false;
+ }
+ return true;
+ }
+ return pat.contents === t.contents;
+ }
+
+ // Resolve a predicate-arg expression as if the family @fa@ were to be
+ // realised via the fam-instance @fi@. Walks @t@ for the first
+ // @FamilyApp(fa, _)@, computes a bi-substitution by unifying @fi.fiArgs@
+ // against that @FamilyApp@'s args, then rewrites the entire expression
+ // using that substitution: tyvars of the predicate get pinned to fi's
+ // concrete values and the @FamilyApp@ itself is replaced with @fi.fiRhs@
+ // (substituted with fi's bindings).
+ //
+ // Return value:
+ //
+ // * @t@ unchanged — when the arg contains no @FamilyApp(fa, _)@ at
+ // all. The fi is irrelevant to this particular arg, but other args
+ // of the same predicate may still yield a successful resolution.
+ // * the rewritten arg — on success.
+ // * @null@ — when @t@ DOES contain @FamilyApp(fa, _)@ but the
+ // unification with this fi's LHS fails. This is the signal the
+ // caller uses to skip irrelevant fam-instances entirely (e.g.
+ // @TxIn ByronBlock@ vs a Shelley-flavoured predicate).
+ function replaceFamilyApp(t, fa, fi) {
+ let pivot = null; // first FamilyApp(fa, _) seen
+ function find(x) {
+ if (pivot) return;
+ if (!x || !x.tag) return;
+ if (x.tag === 'FamilyApp' && qid(x.contents[0]) === qid(fa)) {
+ pivot = x; return;
+ }
+ if (x.tag === 'TyConApp' || x.tag === 'FamilyApp') {
+ for (const sub of x.contents[1]) find(sub);
+ }
+ }
+ find(t);
+ if (!pivot) return t;
+ const pivotArgs = pivot.contents[1];
+ if (!fi.fiArgs || fi.fiArgs.length !== pivotArgs.length) return null;
+ const substFi = {}; // fi-side tyvars → pred-side values
+ const substPred = {}; // pred-side tyvars → fi-side values
+ for (let i = 0; i < pivotArgs.length; i++) {
+ if (!biUnify(fi.fiArgs[i], pivotArgs[i], substFi, substPred)) return null;
+ }
+ function go(x) {
+ if (!x || !x.tag) return x;
+ if (x.tag === 'TyVarRef') {
+ const ix = x.contents;
+ return substPred[ix] !== undefined ? substPred[ix] : x;
+ }
+ if (x.tag === 'FamilyApp' && qid(x.contents[0]) === qid(fa)) {
+ return applySubst(fi.fiRhs, substFi);
+ }
+ if (x.tag === 'TyConApp' || x.tag === 'FamilyApp') {
+ const [q, args] = x.contents;
+ return { tag: x.tag, contents: [q, args.map(go)] };
+ }
+ return x;
+ }
+ return go(t);
+ }
+
+ function matchArgs(headArgs, reqArgs) {
+ if (headArgs.length !== reqArgs.length) return false;
+ for (let i = 0; i < headArgs.length; i++) {
+ if (!matchTypeArg(headArgs[i], reqArgs[i])) return false;
+ }
+ return true;
+ }
+
+ function matchTypeArg(h, r) {
+ if (!h || !r) return false;
+ // A variable in the instance head is polymorphic: it matches anything
+ // on the requirement side (concrete or variable).
+ if (h.tag === 'TyVarRef') return true;
+ // A variable that survives on the requirement side is still abstract;
+ // a concrete instance head does not discharge it. (The head-is-variable
+ // case is already handled above, so reaching here means h is concrete.)
+ if (r.tag === 'TyVarRef') return false;
+ if (h.tag !== r.tag) return false;
+ if (h.tag === 'TyConApp' || h.tag === 'FamilyApp') {
+ const [hq, hargs] = h.contents;
+ const [rq, rargs] = r.contents;
+ if (qid(hq) !== qid(rq)) return false;
+ return matchArgs(hargs, rargs);
+ }
+ if (h.tag === 'LitArg' || h.tag === 'OtherArg') {
+ return h.contents === r.contents;
+ }
+ return false;
+ }
+
+ // Build the data-dependent half of the core, closing over a program's
+ // family-instance index and class-instance list.
+ //
+ // env.famInstsByFamily : Map<qid(family), [FamInstInfo]>
+ // (folds open/associated + closed-family equations)
+ // env.pdInstances : [InstanceInfo]
+ function makeTypeCore(env) {
+ const famInstsByFamily = (env && env.famInstsByFamily) || new Map();
+ const pdInstances = (env && env.pdInstances) || [];
+
+ // Recursively reduce type-family applications. Each family instance is
+ // matched by /unifying/ its LHS against the application (so type
+ // variables in the family-instance LHS bind to concrete arguments),
+ // then the RHS is rewritten with that substitution. We bail out if no
+ // family instance applies.
+ function reduceTypeArg(t) {
+ if (!t || !t.tag) return t;
+ if (t.tag === 'TyConApp') {
+ const [q, args] = t.contents;
+ return { tag: 'TyConApp', contents: [q, args.map(reduceTypeArg)] };
+ }
+ if (t.tag === 'FamilyApp') {
+ const [q, args] = t.contents;
+ const reducedArgs = args.map(reduceTypeArg);
+ // The index folds in closed-family `tfEquations` alongside
+ // open/associated `pdFamInstances`. Iterating `pdFamInstances`
+ // directly (as this once did) skipped closed-family equations
+ // entirely, so closed-family applications never reduced and showed
+ // up as spurious "unresolved external family" placeholders.
+ for (const fi of (famInstsByFamily.get(qid(q)) || [])) {
+ // Skip data fam-instances: their fiRhs is opaque (the synthetic
+ // R: TyCon, or after the data-family rewrite the *abstract*
+ // FamilyApp form that's structurally equal to the LHS). Recursing
+ // on either form either loops forever or produces no progress, so
+ // leave the FamilyApp untouched and let the outer flow handle it
+ // as a use site.
+ if (fi.fiIsData) continue;
+ if (fi.fiArgs.length !== reducedArgs.length) continue;
+ const subst = {};
+ let ok = true;
+ for (let i = 0; i < reducedArgs.length; i++) {
+ if (!unify(fi.fiArgs[i], reducedArgs[i], subst)) { ok = false; break; }
+ }
+ if (ok) {
+ return reduceTypeArg(applySubst(fi.fiRhs, subst));
+ }
+ }
+ return { tag: 'FamilyApp', contents: [q, reducedArgs] };
+ }
+ return t;
+ }
+
+ // Substitute the i-th instance arg in for each TyVarRef i appearing in t,
+ // then attempt one round of type-family reduction. The reduction matters
+ // for cases like `class Pretty (Norm a) => Foo a` where without it we'd
+ // never find a `Pretty <reduced>` instance.
+ function substTypeArg(t, instArgs) {
+ return reduceTypeArg(substTypeArgRaw(t, instArgs));
+ }
+
+ // Find instances of `classQn` whose head args structurally match
+ // `reqArgs`. Matching is one-sided (see matchTypeArg): a variable in the
+ // instance *head* is polymorphic and covers any requirement, but a
+ // variable left in the *requirement* is still abstract and is only
+ // satisfied by another variable — a concrete instance does not discharge
+ // it. This avoids matching an unsubstituted (e.g. uncovered multi-param)
+ // requirement variable against every instance of the class.
+ function findMatchingInstances(classQn, reqArgs) {
+ const target = qid(classQn);
+ const matches = [];
+ for (const inst of pdInstances) {
+ if (qid(inst.iiClass) !== target) continue;
+ if (matchArgs(inst.iiArgs, reqArgs)) matches.push(inst);
+ }
+ return matches;
+ }
+
+ return {
+ // pure helpers (re-exported so callers can use one bundle)
+ qid, deepEqArg, substTypeArgRaw, unify, applySubst, biUnify,
+ replaceFamilyApp, matchArgs, matchTypeArg,
+ // data-dependent
+ reduceTypeArg, substTypeArg, findMatchingInstances,
+ };
+ }
+
+ return {
+ makeTypeCore,
+ qid, deepEqArg, substTypeArgRaw, unify, applySubst, biUnify,
+ replaceFamilyApp, matchArgs, matchTypeArg,
+ };
+});
<script>/*__VENDOR_CYTOSCAPE__*/</script>
<script>/*__VENDOR_CYTOSCAPE_DAGRE__*/</script>
<script id="graph-data" type="application/json">/*__GRAPH_DATA__*/</script>
+ <script>/*__VIEWER_TYPECORE__*/</script>
<script>/*__VIEWER_JS__*/</script>
</body>
</html>
if (Array.isArray(f.tfEquations)) f.tfEquations.forEach(indexFamInst);
}
+ // The pure TypeArg unification / matching core (typecore.js), bound to
+ // this program's family index + instance list. The destructured names are
+ // used throughout the file; their definitions and tests live in typecore.js
+ // / test/typecore.test.js.
+ const TC = ClassgraphTypeCore.makeTypeCore({
+ famInstsByFamily,
+ pdInstances: graph.meta.pdInstances,
+ });
+ const {
+ substTypeArgRaw, reduceTypeArg, replaceFamilyApp,
+ findMatchingInstances, matchArgs,
+ } = TC;
+
// ---------------------------------------------------------------------------
// Cytoscape — single instance, swap elements when changing view.
}
});
- // One row of instance nodes, anchored to the focused class.
- insts.forEach((inst, idx) => {
- // Use the instance's stable global _idx for the node id (not the
- // filtered-row position) so the focused representation and any
- // superclass-matched representation of the *same* instance collapse
- // onto one node via seenNodes, and a filtered-out instance can never
- // reappear through the superclass-match path under a different id.
- const instId = ensureInstanceNode(inst, cls.ciName,
- 'inst:' + inst._idx);
- els.push({ group: 'edges', data: {
- id: focusedId + '=>' + instId,
- source: focusedId,
- target: instId,
- kind: 'defines',
- }});
+ // Per-instance phases, factored out of the row loop below for
+ // readability. Each closes over els / seenNodes / cls / the ensure*
+ // node builders and appends to the shared element list.
- // Context constraints — these are the "new classes the instance
- // 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.
+ // Context constraints — the "new classes the instance declares as needed
+ // for the implementation". Equality predicates (a ~ b) don't point at a
+ // class node (they appear in the side panel), and globally muted classes
+ // are skipped.
+ function addInstanceContext(inst, instId) {
inst.iiContext.forEach((pred, pi) => {
if (pred.piIsEq) return;
if (mutedSet.has(qid(pred.piClass))) return;
- // Render the predicate (e.g. `ShelleyBasedEra era`) as its own
- // node, not as a class node with a "ctx: era" arrow. The
- // predicate-node label spells the constraint out in full and
- // is shaped like an instance — which is what it morally is, a
- // place-holder for whichever instance will satisfy this
- // constraint at use time.
+ // Render the predicate (e.g. `ShelleyBasedEra era`) as its own node,
+ // not as a class node with a "ctx: era" arrow — it's morally a
+ // place-holder for whichever instance satisfies it at use time.
const pid = ensurePredicateNode(pred.piClass, pred.piArgs, 'context', inst.iiTyVars);
els.push({ group: 'edges', data: {
id: instId + '#ctx#' + pi,
kind: 'context',
label: 'instance context',
}});
- // 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). For each
- // fam-instance we surface, we also try to resolve `pred.piClass`
- // for the fam-instance's RHS and chain to the matching instance.
+ // Surface type-family applications hiding inside the predicate
+ // (e.g. `Eq (TxOut era)`) and chain each toward the matching instance
+ // of pred.piClass for the fam-instance's RHS.
addFamilyLinksFromArgs(pred.piArgs, instId, 'ctx-fam',
pred.piClass, inst.iiTyVars, pid);
});
+ }
- // Associated type families: when the focused class declares assoc
- // type families (e.g. `class Collection c where type Element c`),
- // each instance of C may also declare a `type instance` for those
- // families. Surface them as fam-instance nodes hanging off the
- // instance node, plus an edge from the family node to the same
- // fam-instance node so the family side is also rooted.
+ // Associated type families: when the focused class declares assoc type
+ // families (`class Collection c where type Element c`), surface each
+ // instance's matching `type instance` as a fam-instance node rooted to
+ // its family node. (No instance → fam-instance edge: it was redundant
+ // with the fam-instance node's own label and visually busy.)
+ function addInstanceAssocFamilies(inst) {
cls.ciAssocTypes.forEach(famQn => {
const candidates = famInstsByFamily.get(qid(famQn)) || [];
for (const fi of candidates) {
if (!matchArgs(fi.fiArgs, inst.iiArgs)) continue;
const famNodeId = ensureFamilyNode(famQn);
const fiNodeId = ensureFamInstanceNode(fi);
- // Family -> fam-instance: this family is defined here. We
- // *don't* draw an instance → fam-instance edge any more
- // (the old "= (Rhs)" purple-dotted line) — it was redundant
- // with the fam-instance node's own label and visually busy.
- // The fam-instance still surfaces in the graph through this
- // family link, so the user can see it's relevant.
const linkId = famNodeId + '=>' + fiNodeId;
if (!seenNodes.has(linkId)) {
seenNodes.add(linkId);
}
}
});
+ }
- // Superclass requirements: for each direct superclass S of the focused
- // class, the head's args are substituted into S's positional refs to
- // produce the requirement `S substArgs`. We then look in our program
- // data for instances of S whose head shape matches.
+ // Superclass requirements: for each direct superclass S, substitute the
+ // instance head's args into S's positional refs to get the requirement
+ // `S substArgs`, then look for instances of S whose head shape matches.
+ function addInstanceSuperclasses(inst, instId) {
cls.ciSuperclasses.forEach((sc, si) => {
if (mutedSet.has(qid(sc.seSuperclass))) return;
- // The chain helper needs the *unreduced* (only substituted) form
- // so collectFamilyRefs still finds the FamilyApp nodes — if we
- // hand it the post-reduction `reqArgs` below, the FamilyApps have
- // already been replaced by some fam-instance's RHS and the chain
- // never gets a chance to enumerate alternative fam-instances.
+ // The chain helper needs the *unreduced* (only substituted) form so
+ // collectFamilyRefs still finds the FamilyApp nodes — the
+ // post-reduction reqArgs would have them already replaced by some
+ // fam-instance's RHS, so the chain couldn't enumerate alternatives.
const subbedArgs = sc.seArgs.map(a => substTypeArgRaw(a, inst.iiArgs));
- // Direct-match path uses the reduced args as before.
const reqArgs = subbedArgs.map(reduceTypeArg);
const matched = findMatchingInstances(sc.seSuperclass, reqArgs);
- // Edge label: just "superclass constraint". The target node
- // (matched instance, or — after task #4 — a predicate node)
- // carries the class + arg shape, so naming the class on the
- // edge would just duplicate it.
+ // The target node (matched instance or predicate) carries the class +
+ // arg shape, so the edge label needn't repeat it.
const reqLabel = 'superclass constraint';
- // chainTarget gets passed to addFamilyLinksFromArgs further
- // down: when we land in the unmatched branch and create a
- // predicate node, the synthetic "Family args = ?" placeholders
- // will chain to it. For the matched branch there's no single
- // chain endpoint (matched instances are heterogeneous), so we
- // leave it null.
+ // chainTarget: the predicate node the synthetic "Family args = ?"
+ // placeholders chain into (set only in the unmatched branch; matched
+ // instances are heterogeneous, so there's no single endpoint).
let chainTarget = null;
if (matched.length === 0) {
- // No instance was found in our data — but the original
- // module typechecked, so the constraint must be discharged
- // somewhere. Two cases:
- //
- // (a) The same predicate (class + arg shape) is also in
- // this instance's context. ensurePredicateNode returns
- // the existing id, and the focused instance gains a
- // *second* incoming edge ("superclass constraint")
- // alongside the "instance context" one already there.
- //
- // (b) Otherwise this is a constraint defined *outside* the
- // project. A fresh predicate node is created with role
- // 'extern' (rendered gray), meaning "an instance must
- // exist somewhere outside this project".
- //
- // In both cases the edge label is just "superclass
- // constraint"; the predicate node carries class + args.
+ // No local instance, but the module typechecked, so the constraint
+ // is discharged somewhere: (a) if the same predicate is also in
+ // this instance's context, ensurePredicateNode returns the existing
+ // node, which gains a second incoming edge; (b) otherwise a fresh
+ // 'extern' predicate node ("must exist outside this project").
const pid = ensurePredicateNode(
sc.seSuperclass, reqArgs, 'extern', inst.iiTyVars
);
}});
chainTarget = pid;
} else {
- // Local match(es) exist. Connect the focused instance directly
- // to each matched instance — we deliberately *don't* also pull
- // the superclass class node into the graph, because the same
- // information ("instance of class Foo") is already implied by
- // the matched instance's own label and is plainly noisy.
+ // Local match(es): connect the focused instance directly to each.
+ // We deliberately don't also pull in the superclass class node —
+ // the matched instance's own label already implies its class.
for (const m of matched) {
- const mId = ensureInstanceNode(
- m, sc.seSuperclass,
- 'inst:' + m._idx
- );
+ const mId = ensureInstanceNode(m, sc.seSuperclass, 'inst:' + m._idx);
els.push({ group: 'edges', data: {
id: instId + '#sc#' + si + '#' + m._idx,
source: instId,
}
}
- // Family-chain work runs *after* the predicate-node decision so
- // we can hand the synthetic "Family args = ?" placeholders the
- // pred-node id to chain into.
+ // Family-chain work runs after the predicate-node decision so the
+ // synthetic placeholders can chain into the pred-node id.
addFamilyLinksFromArgs(subbedArgs, instId, 'sc-fam-' + si,
sc.seSuperclass, inst.iiTyVars, chainTarget);
});
+ }
+
+ // One row of instance nodes, anchored to the focused class. Each instance
+ // uses its stable global _idx for the node id (not the filtered-row
+ // position) so the focused representation and any superclass-matched
+ // representation of the *same* instance collapse onto one node, and a
+ // filtered-out instance can't reappear under a second id.
+ insts.forEach(inst => {
+ const instId = ensureInstanceNode(inst, cls.ciName, 'inst:' + inst._idx);
+ els.push({ group: 'edges', data: {
+ id: focusedId + '=>' + instId,
+ source: focusedId,
+ target: instId,
+ kind: 'defines',
+ }});
+ addInstanceContext(inst, instId);
+ addInstanceAssocFamilies(inst);
+ addInstanceSuperclasses(inst, instId);
});
return els;
// ---------------------------------------------------------------------------
// TypeArg helpers
- // Substitute the i-th instance arg in for each TyVarRef i appearing in t,
- // then attempt one round of type-family reduction using pdFamInstances.
- // The reduction matters for cases like `class Pretty (Norm a) => Foo a`
- // where without it we'd never find a `Pretty <reduced>` instance.
- function substTypeArg(t, instArgs) {
- return reduceTypeArg(substTypeArgRaw(t, instArgs));
- }
-
- function substTypeArgRaw(t, instArgs) {
- if (!t || !t.tag) return t;
- if (t.tag === 'TyVarRef') {
- const ix = t.contents;
- if (ix >= 0 && ix < instArgs.length) return instArgs[ix];
- return t;
- }
- if (t.tag === 'TyConApp' || t.tag === 'FamilyApp') {
- const [q, args] = t.contents;
- return { tag: t.tag, contents: [q, args.map(a => substTypeArgRaw(a, instArgs))] };
- }
- return t; // LitArg / OtherArg
- }
-
- // Recursively reduce type-family applications using pdFamInstances. Each
- // family instance is matched by /unifying/ its LHS against the application
- // (so type variables in the family-instance LHS bind to concrete arguments),
- // then the RHS is rewritten with that substitution. We bail out if no
- // family instance applies.
- function reduceTypeArg(t) {
- if (!t || !t.tag) return t;
- if (t.tag === 'TyConApp') {
- const [q, args] = t.contents;
- return { tag: 'TyConApp', contents: [q, args.map(reduceTypeArg)] };
- }
- if (t.tag === 'FamilyApp') {
- const [q, args] = t.contents;
- const reducedArgs = args.map(reduceTypeArg);
- // Use the family index, which folds in closed-family `tfEquations`
- // alongside open/associated `pdFamInstances`. Iterating
- // `pdFamInstances` directly (as this once did) skipped closed-family
- // equations entirely, so closed-family applications never reduced and
- // showed up as spurious "unresolved external family" placeholders.
- for (const fi of (famInstsByFamily.get(qid(q)) || [])) {
- // Skip data fam-instances: their fiRhs is opaque (the
- // synthetic R: TyCon, or after the data-family rewrite the
- // *abstract* FamilyApp form that's structurally equal to the
- // LHS). Recursing on either form either loops forever or
- // produces no progress, so leave the FamilyApp untouched and
- // let the outer flow handle it as a use site.
- if (fi.fiIsData) continue;
- if (fi.fiArgs.length !== reducedArgs.length) continue;
- const subst = {};
- let ok = true;
- for (let i = 0; i < reducedArgs.length; i++) {
- if (!unify(fi.fiArgs[i], reducedArgs[i], subst)) { ok = false; break; }
- }
- if (ok) {
- return reduceTypeArg(applySubst(fi.fiRhs, subst));
- }
- }
- return { tag: 'FamilyApp', contents: [q, reducedArgs] };
- }
- return t;
- }
-
- // One-sided unification: bind TyVarRefs occurring in `pat` against `t`.
- // TyVarRefs in `t` (the requirement side) are not unified — we don't
- // attempt to invent fresh bindings on the right.
- function unify(pat, t, subst) {
- if (!pat || !t) return false;
- if (pat.tag === 'TyVarRef') {
- const ix = pat.contents;
- if (subst[ix] !== undefined) return deepEqArg(subst[ix], t);
- subst[ix] = t;
- return true;
- }
- if (t.tag === 'TyVarRef') return false;
- if (pat.tag !== t.tag) return false;
- if (pat.tag === 'TyConApp' || pat.tag === 'FamilyApp') {
- const [pq, pargs] = pat.contents;
- const [tq, targs] = t.contents;
- if (qid(pq) !== qid(tq)) return false;
- if (pargs.length !== targs.length) return false;
- for (let i = 0; i < pargs.length; i++) {
- if (!unify(pargs[i], targs[i], subst)) return false;
- }
- return true;
- }
- if (pat.tag === 'LitArg' || pat.tag === 'OtherArg') {
- return pat.contents === t.contents;
- }
- return false;
- }
-
- function applySubst(t, subst) {
- if (!t || !t.tag) return t;
- if (t.tag === 'TyVarRef') {
- const ix = t.contents;
- return subst[ix] !== undefined ? subst[ix] : t;
- }
- if (t.tag === 'TyConApp' || t.tag === 'FamilyApp') {
- const [q, args] = t.contents;
- return { tag: t.tag, contents: [q, args.map(a => applySubst(a, subst))] };
- }
- return t;
- }
-
- // For the resolution chain we want to ask: "if the family @fa@ resolves
- // via this particular fam-instance @fi@, what would the predicate look
- // like?" That requires *bi-directional* unification — we may need to
- // bind a tyvar on the pred side to a concrete value from fi (e.g. for
- // @Pretty (Bag a)@ vs @type instance Bag Int = [Int]@, we hypothetically
- // bind @a := Int@), and we may also need to bind a tyvar on fi's side
- // to a value from the pred (e.g. fi's @a@ to pred's @era@).
- function biUnify(pat, t, substPat, substT) {
- if (!pat || !t) return false;
- if (pat.tag === 'TyVarRef') {
- const ix = pat.contents;
- if (substPat[ix] !== undefined) return deepEqArg(substPat[ix], t);
- substPat[ix] = t;
- return true;
- }
- if (t.tag === 'TyVarRef') {
- const ix = t.contents;
- if (substT[ix] !== undefined) return deepEqArg(substT[ix], pat);
- substT[ix] = pat;
- return true;
- }
- if (pat.tag !== t.tag) return false;
- if (pat.tag === 'TyConApp' || pat.tag === 'FamilyApp') {
- const [pq, pa] = pat.contents;
- const [tq, ta] = t.contents;
- if (qid(pq) !== qid(tq)) return false;
- if (pa.length !== ta.length) return false;
- for (let i = 0; i < pa.length; i++) {
- if (!biUnify(pa[i], ta[i], substPat, substT)) return false;
- }
- return true;
- }
- return pat.contents === t.contents;
- }
-
- // Resolve a predicate-arg expression as if the family @fa@ were to be
- // realised via the fam-instance @fi@. Walks @t@ for the first
- // @FamilyApp(fa, _)@, computes a bi-substitution by unifying @fi.fiArgs@
- // against that @FamilyApp@'s args, then rewrites the entire expression
- // using that substitution: tyvars of the predicate get pinned to fi's
- // concrete values and the @FamilyApp@ itself is replaced with @fi.fiRhs@
- // (substituted with fi's bindings).
- //
- // Return value:
- //
- // * @t@ unchanged — when the arg contains no @FamilyApp(fa, _)@ at
- // all. The fi is irrelevant to this particular arg, but other args
- // of the same predicate may still yield a successful resolution.
- // * the rewritten arg — on success.
- // * @null@ — when @t@ DOES contain @FamilyApp(fa, _)@ but the
- // unification with this fi's LHS fails. This is the signal the
- // caller uses to skip irrelevant fam-instances entirely (e.g.
- // @TxIn ByronBlock@ vs a Shelley-flavoured predicate).
- function replaceFamilyApp(t, fa, fi) {
- let pivot = null; // first FamilyApp(fa, _) seen
- function find(x) {
- if (pivot) return;
- if (!x || !x.tag) return;
- if (x.tag === 'FamilyApp' && qid(x.contents[0]) === qid(fa)) {
- pivot = x; return;
- }
- if (x.tag === 'TyConApp' || x.tag === 'FamilyApp') {
- for (const sub of x.contents[1]) find(sub);
- }
- }
- find(t);
- if (!pivot) return t;
- const pivotArgs = pivot.contents[1];
- if (!fi.fiArgs || fi.fiArgs.length !== pivotArgs.length) return null;
- const substFi = {}; // fi-side tyvars → pred-side values
- const substPred = {}; // pred-side tyvars → fi-side values
- for (let i = 0; i < pivotArgs.length; i++) {
- if (!biUnify(fi.fiArgs[i], pivotArgs[i], substFi, substPred)) return null;
- }
- function go(x) {
- if (!x || !x.tag) return x;
- if (x.tag === 'TyVarRef') {
- const ix = x.contents;
- return substPred[ix] !== undefined ? substPred[ix] : x;
- }
- if (x.tag === 'FamilyApp' && qid(x.contents[0]) === qid(fa)) {
- return applySubst(fi.fiRhs, substFi);
- }
- if (x.tag === 'TyConApp' || x.tag === 'FamilyApp') {
- const [q, args] = x.contents;
- return { tag: x.tag, contents: [q, args.map(go)] };
- }
- return x;
- }
- return go(t);
- }
-
- function deepEqArg(a, b) {
- if (a === b) return true;
- if (!a || !b || a.tag !== b.tag) return false;
- if (a.tag === 'TyVarRef') return a.contents === b.contents;
- if (a.tag === 'TyConApp' || a.tag === 'FamilyApp') {
- const [aq, aa] = a.contents;
- const [bq, ba] = b.contents;
- if (qid(aq) !== qid(bq) || aa.length !== ba.length) return false;
- return aa.every((x, i) => deepEqArg(x, ba[i]));
- }
- return a.contents === b.contents;
- }
-
- // Search graph.meta.pdInstances for an instance of `classQn` whose head
- // args structurally match `reqArgs`. Matching is one-sided (see
- // matchTypeArg): a variable in the instance *head* is polymorphic and
- // covers any requirement, but a variable left in the *requirement* is
- // still abstract and is only satisfied by another variable — a concrete
- // instance does not discharge it. This avoids the old behaviour where an
- // unsubstituted (e.g. uncovered multi-param) requirement variable matched
- // every instance of the class, drawing false "satisfied" edges.
- function findMatchingInstances(classQn, reqArgs) {
- const target = qid(classQn);
- const matches = [];
- for (const inst of graph.meta.pdInstances) {
- if (qid(inst.iiClass) !== target) continue;
- if (matchArgs(inst.iiArgs, reqArgs)) matches.push(inst);
- }
- return matches;
- }
-
- function matchArgs(headArgs, reqArgs) {
- if (headArgs.length !== reqArgs.length) return false;
- for (let i = 0; i < headArgs.length; i++) {
- if (!matchTypeArg(headArgs[i], reqArgs[i])) return false;
- }
- return true;
- }
-
- function matchTypeArg(h, r) {
- if (!h || !r) return false;
- // A variable in the instance head is polymorphic: it matches anything
- // on the requirement side (concrete or variable).
- if (h.tag === 'TyVarRef') return true;
- // A variable that survives on the requirement side is still abstract;
- // a concrete instance head does not discharge it. (The head-is-variable
- // case is already handled above, so reaching here means h is concrete.)
- if (r.tag === 'TyVarRef') return false;
- if (h.tag !== r.tag) return false;
- if (h.tag === 'TyConApp' || h.tag === 'FamilyApp') {
- const [hq, hargs] = h.contents;
- const [rq, rargs] = r.contents;
- if (qid(hq) !== qid(rq)) return false;
- return matchArgs(hargs, rargs);
- }
- if (h.tag === 'LitArg' || h.tag === 'OtherArg') {
- return h.contents === r.contents;
- }
- return false;
- }
+ // The TypeArg unification / matching core lives in typecore.js (loaded as
+ // a global before this script, and unit-tested under test/). It is bound
+ // to the current program's data in `TC` near the top of this IIFE; the
+ // names used throughout this file (substTypeArg, reduceTypeArg, unify,
+ // matchTypeArg, …) are destructured from there.
// ---------------------------------------------------------------------------
// Rendering helpers (textual)
'&': '&', '<': '<', '>': '>', '"': '"', "'": ''',
}[ch]));
}
+
+ // Test hook: under Node (the regression harness in test/) expose the
+ // element builders so their output can be snapshotted. No effect in the
+ // browser, where `module` is undefined.
+ if (typeof module !== 'undefined' && module.exports) {
+ module.exports = { buildClassesView, buildInstanceView, buildFamilyView };
+ }
})();
--- /dev/null
+{
+ "name": "classgraph-viewer",
+ "version": "0.2.0",
+ "private": true,
+ "description": "Tests and dev tooling for the classgraph in-browser viewer (data/typecore.js, data/viewer.js). No runtime dependencies; the viewer is shipped embedded in the generated HTML.",
+ "scripts": {
+ "test": "node --test test/*.test.js"
+ }
+}
-- '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 splitVisibleFunTy_maybe t of
- Just (a, b) ->
- TyConApp arrowQualName [typeArg boundTvs a, typeArg boundTvs b]
- Nothing -> case splitTyConApp_maybe t of
- Just (tc, args)
- -- Synthetic data-family-instance representation TyCon.
- -- GHC creates one of these (`R:FooArgs`) for each
- -- `data instance Foo Args = …` and uses it in the actual
- -- type representation. The user wrote @Foo Args@ at source
- -- level; that's what we want to surface. Crucially,
- -- @parentArgs@ are the abstract family arguments (e.g.
- -- @[Praos c]@ for @data instance ConsensusConfig (Praos
- -- c)@), not the rep TyCon's own type variables, so we get
- -- the right shape back without further work.
- --
- -- We classify the result as a 'FamilyApp' so the viewer's
- -- chain logic ("there should be a fam-instance somewhere
- -- that satisfies this") naturally engages — including
- -- finding the matching @data instance@ row and connecting
- -- it to any class instance of e.g. @NoThunks (Foo Args)@.
- | Just (parent, parentArgs) <- tyConFamInst_maybe tc ->
- -- @parentArgs@ are the abstract data-instance LHS args
- -- (e.g. @[ShelleyBlock <reptv1> <reptv2>]@), referencing
- -- the *rep TyCon's* type variables — NOT the use-site
- -- args. Without substitution those rep tyvars leak into
- -- the rendered form as @OtherArg "<reptv1>"@ because
- -- they're not in the caller's @boundTvs@. Build a
- -- Subst from the rep's tyvars to the actual use-site
- -- args and apply it before recursing.
- let repTvs = tyConTyVars tc
- sub = zipTvSubst repTvs args
- instantiated = substTys sub parentArgs
- in FamilyApp (qualName (tyConName parent))
- (map (typeArg boundTvs) instantiated)
- | otherwise ->
- 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)
+typeArg boundTvs t
+ -- A bound type variable → its positional index.
+ | Just tv <- getTyVar_maybe t
+ , Just i <- elemIndex tv boundTvs
+ = TyVarRef i
+ -- A visible function arrow → synthetic @(->)@ application (no
+ -- multiplicity / kind args).
+ | Just (a, b) <- splitVisibleFunTy_maybe t
+ = TyConApp arrowQualName [typeArg boundTvs a, typeArg boundTvs b]
+ -- A saturated TyCon application.
+ | Just (tc, args) <- splitTyConApp_maybe t
+ = tyConArg boundTvs tc args
+ -- A type-level literal.
+ | Just _ <- isLitTy t
+ = LitArg (pprText t)
+ -- Anything else (including a free/out-of-scope tyvar): print it.
+ | otherwise
+ = OtherArg (pprText t)
+
+-- | Convert a saturated 'TyConApp'. The invisible (kind / runtime-rep)
+-- argument positions are dropped via 'visibleArgs'; a /family/ TyCon yields
+-- a 'FamilyApp', a plain TyCon a 'TyConApp'. The one special case is a
+-- data-family /representation/ TyCon, handled by 'dataFamilyRepArg'.
+tyConArg :: [Var] -> TyCon -> [Type] -> TypeArg
+tyConArg boundTvs tc args
+ | Just (parent, parentArgs) <- tyConFamInst_maybe tc
+ = dataFamilyRepArg boundTvs tc parent parentArgs args
+ | otherwise
+ = let kids = map (typeArg boundTvs) (visibleArgs tc args)
+ in if isFamilyTyCon tc
+ then FamilyApp (qualName (tyConName tc)) kids
+ else TyConApp (qualName (tyConName tc)) kids
+
+-- | Rewrite a synthetic data-family-instance representation TyCon back to
+-- the abstract @Foo Args@ the user wrote.
+--
+-- GHC creates one of these (`R:FooArgs`) for each
+-- @data instance Foo Args = …@ and uses it in the actual type
+-- representation. We classify the result as a 'FamilyApp' so the viewer's
+-- chain logic ("there should be a fam-instance somewhere that satisfies
+-- this") naturally engages — finding the matching @data instance@ row and
+-- connecting it to any class instance of e.g. @NoThunks (Foo Args)@.
+--
+-- @parentArgs@ are the abstract data-instance LHS args (e.g.
+-- @[ShelleyBlock <reptv1> <reptv2>]@), referencing the *rep TyCon's* type
+-- variables — NOT the use-site args. Without substitution those rep tyvars
+-- leak into the rendered form as @OtherArg "<reptv1>"@ because they're not
+-- in the caller's @boundTvs@. We build a Subst from the rep's tyvars to the
+-- actual use-site @args@ and apply it before recursing.
+dataFamilyRepArg :: [Var] -> TyCon -> TyCon -> [Type] -> [Type] -> TypeArg
+dataFamilyRepArg boundTvs repTc parent parentArgs args =
+ let sub = zipTvSubst (tyConTyVars repTc) args
+ instantiated = substTys sub parentArgs
+ in FamilyApp (qualName (tyConName parent))
+ (map (typeArg boundTvs) instantiated)
-- | Drop the elements of @args@ corresponding to invisible 'tyConBinders'.
-- If @args@ has more entries than the TyCon has binders (over-application,
------------------------------------------------------------------------------
-- Embedded assets
-viewerHtml, viewerJs, viewerCss :: BS.ByteString
+viewerHtml, viewerJs, viewerCss, viewerTypecore :: BS.ByteString
vendorCytoscape, vendorDagre, vendorCytoscapeDagre :: BS.ByteString
viewerHtml = $(embedFile "data/viewer.html")
viewerJs = $(embedFile "data/viewer.js")
+viewerTypecore = $(embedFile "data/typecore.js")
viewerCss = $(embedFile "data/viewer.css")
vendorCytoscape = $(embedFile "data/vendor/cytoscape.min.js")
vendorDagre = $(embedFile "data/vendor/dagre.min.js")
, ("/*__VENDOR_DAGRE__*/", BB.byteString vendorDagre)
, ("/*__VENDOR_CYTOSCAPE_DAGRE__*/", BB.byteString vendorCytoscapeDagre)
, ("/*__VIEWER_CSS__*/", BB.byteString viewerCss)
+ , ("/*__VIEWER_TYPECORE__*/", BB.byteString viewerTypecore)
, ("/*__VIEWER_JS__*/", BB.byteString viewerJs)
, ("/*__GRAPH_DATA__*/", BB.lazyByteString jsonBs)
]
-- the whole label — cytoscape can't style only one line, so we
-- accept whole-node italic as the visual cue for "data family".
familyNodeLabel f =
- let head = case tfTyVars f of
+ let hd = case tfTyVars f of
[] -> qnName (tfName f)
tvs -> qnName (tfName f) <> " "
<> T.intercalate " " (map tvName tvs)
- in head <> if isDataFamily f then "\n(data)" else ""
+ in hd <> if isDataFamily f then "\n(data)" else ""
isDataFamily f = case tfFlavor f of
DataFam -> True
--- /dev/null
+'use strict';
+
+// Minimal DOM / Cytoscape / browser stubs that let viewer.js load under
+// Node, so we can call its element builders headlessly. viewer.js touches
+// the DOM and creates a Cytoscape instance at load time; none of that is
+// exercised by buildInstanceView / buildFamilyView / buildClassesView, which
+// just compute and return a plain element array. The stubs only need to be
+// inert enough for the module to finish loading.
+//
+// loadViewer(graphJson) returns { buildClassesView, buildInstanceView,
+// buildFamilyView } bound to that program's data.
+
+const fs = require('node:fs');
+const path = require('node:path');
+const vm = require('node:vm');
+
+function fakeEl() {
+ const el = {
+ textContent: '', innerHTML: '', value: '', hidden: false, checked: false,
+ style: {}, dataset: {},
+ classList: { add() {}, remove() {}, toggle() {}, contains() { return false; } },
+ addEventListener() {}, removeEventListener() {},
+ appendChild() {}, removeChild() {}, prepend() {}, append() {},
+ setAttribute() {}, getAttribute() { return null; }, removeAttribute() {},
+ insertAdjacentHTML() {}, scrollIntoView() {}, focus() {}, blur() {}, click() {},
+ closest() { return null; },
+ querySelector() { return fakeEl(); }, querySelectorAll() { return []; },
+ getBoundingClientRect() { return { top: 0, left: 0, right: 0, bottom: 0, width: 0, height: 0 }; },
+ };
+ return el;
+}
+
+// A Cytoscape instance/collection stand-in: every method is a chainable
+// no-op, and it is an empty iterable so `for (… of cy.nodes())` is safe.
+function makeCy() {
+ const handler = {
+ get(_t, prop) {
+ if (prop === Symbol.iterator) return function* () {};
+ if (prop === 'length') return 0;
+ if (prop === 'then') return undefined; // never treated as a thenable
+ return () => proxy;
+ },
+ apply() { return proxy; },
+ };
+ const proxy = new Proxy(function () {}, handler);
+ return proxy;
+}
+
+function loadViewer(graphJson) {
+ const repoRoot = path.join(__dirname, '..');
+ const typecoreSrc = fs.readFileSync(path.join(repoRoot, 'data', 'typecore.js'), 'utf8');
+ const viewerSrc = fs.readFileSync(path.join(repoRoot, 'data', 'viewer.js'), 'utf8');
+
+ const graphDataEl = fakeEl();
+ graphDataEl.textContent = graphJson;
+ const elements = { 'graph-data': graphDataEl };
+
+ const documentStub = {
+ getElementById(id) { return elements[id] || (elements[id] = fakeEl()); },
+ createElement() { return fakeEl(); },
+ addEventListener() {}, removeEventListener() {},
+ querySelector() { return fakeEl(); }, querySelectorAll() { return []; },
+ body: fakeEl(), documentElement: fakeEl(),
+ };
+
+ const cytoscape = function () { return makeCy(); };
+ cytoscape.use = function () {};
+
+ const sandbox = {
+ document: documentStub,
+ cytoscape,
+ cytoscapeDagre: function () {},
+ dagre: {},
+ localStorage: { getItem() { return null; }, setItem() {}, removeItem() {} },
+ location: { hash: '', href: 'http://localhost/', search: '' },
+ history: { pushState() {}, replaceState() {} },
+ requestAnimationFrame(fn) { return 0; },
+ cancelAnimationFrame() {},
+ getComputedStyle() { return { getPropertyValue() { return ''; } }; },
+ setTimeout() { return 0; }, clearTimeout() {},
+ addEventListener() {}, removeEventListener() {},
+ matchMedia() { return { matches: false, addEventListener() {}, addListener() {} }; },
+ console,
+ };
+ sandbox.window = sandbox;
+ sandbox.globalThis = sandbox;
+
+ const ctx = vm.createContext(sandbox);
+ // typecore first (defines ClassgraphTypeCore on the shared global), then
+ // viewer.js, whose `module.exports` we capture.
+ vm.runInContext(typecoreSrc, ctx, { filename: 'typecore.js' });
+ const mod = { exports: {} };
+ ctx.module = mod;
+ ctx.exports = mod.exports;
+ vm.runInContext(viewerSrc, ctx, { filename: 'viewer.js' });
+ return mod.exports;
+}
+
+module.exports = { loadViewer };
--- /dev/null
+'use strict';
+
+// Headless regression snapshot: load viewer.js over a rendered page's graph
+// data and dump every view-builder's output as stable JSON. Used to prove a
+// refactor of the builders is behaviour-preserving (diff before vs after).
+//
+// node test/snapshot-views.js <rendered.html> > snapshot.json
+
+const fs = require('node:fs');
+const { loadViewer } = require('./harness.js');
+
+const htmlPath = process.argv[2];
+const html = fs.readFileSync(htmlPath, 'utf8');
+const m = html.match(/<script id="graph-data"[^>]*>([\s\S]*?)<\/script>/);
+if (!m) { throw new Error('no graph-data script found in ' + htmlPath); }
+const graphJson = m[1];
+const graph = JSON.parse(graphJson);
+
+const views = loadViewer(graphJson);
+
+const out = {};
+out['__classes__'] = views.buildClassesView();
+for (const c of graph.meta.pdClasses) {
+ const id = c.ciName.qnPackage + ':' + c.ciName.qnModule + '.' + c.ciName.qnName;
+ out['inst:' + id] = views.buildInstanceView(id);
+}
+for (const f of graph.meta.pdTypeFamilies) {
+ const id = f.tfName.qnPackage + ':' + f.tfName.qnModule + '.' + f.tfName.qnName;
+ out['fam:' + id] = views.buildFamilyView(id);
+}
+
+process.stdout.write(JSON.stringify(out, null, 1));
--- /dev/null
+'use strict';
+
+// Unit tests for the pure TypeArg unification / matching core (data/typecore.js).
+// Run with: node --test test/
+//
+// Fixtures cover the four behaviours the visualizer's instance view depends
+// on (and that we want locked down): one-sided instance matching incl.
+// multi-param projection, closed/open type-family reduction, and the
+// data-family / chain rewrite (replaceFamilyApp).
+
+const test = require('node:test');
+const assert = require('node:assert/strict');
+
+const core = require('../data/typecore.js');
+
+// ---- TypeArg builders -------------------------------------------------------
+
+const qn = (name, mod = 'M', pkg = 'p') => ({ qnPackage: pkg, qnModule: mod, qnName: name });
+const con = (name, ...args) => ({ tag: 'TyConApp', contents: [qn(name), args] });
+const fam = (name, ...args) => ({ tag: 'FamilyApp', contents: [qn(name), args] });
+const v = (i) => ({ tag: 'TyVarRef', contents: i });
+const lit = (s) => ({ tag: 'LitArg', contents: s });
+
+const { matchTypeArg, matchArgs, deepEqArg, substTypeArgRaw, replaceFamilyApp } = core;
+
+// A FamInstInfo-shaped record (only the fields the core reads).
+const eqn = (famName, args, rhs, isData = false) =>
+ ({ fiFamily: qn(famName), fiArgs: args, fiRhs: rhs, fiIsData: isData });
+
+// An InstanceInfo-shaped record (only the fields the core reads).
+const inst = (className, args) => ({ iiClass: qn(className), iiArgs: args });
+
+const indexFams = (...eqns) => {
+ const m = new Map();
+ for (const e of eqns) {
+ const k = core.qid(e.fiFamily);
+ if (!m.has(k)) m.set(k, []);
+ m.get(k).push(e);
+ }
+ return m;
+};
+
+// ---- matchTypeArg / matchArgs (instance matching) ---------------------------
+
+test('head variable is polymorphic: matches any concrete requirement', () => {
+ assert.equal(matchTypeArg(v(0), con('Int')), true);
+ assert.equal(matchTypeArg(v(0), con('Maybe', con('Int'))), true);
+});
+
+test('requirement variable is abstract: a concrete head does NOT match it', () => {
+ // This is the one-sided fix — previously this returned true (false edge).
+ assert.equal(matchTypeArg(con('Int'), v(0)), false);
+});
+
+test('variable matches variable', () => {
+ assert.equal(matchTypeArg(v(0), v(1)), true);
+});
+
+test('concrete tycons must agree', () => {
+ assert.equal(matchTypeArg(con('Int'), con('Bool')), false);
+ assert.equal(matchTypeArg(con('Maybe', v(0)), con('Maybe', con('Int'))), true);
+ assert.equal(matchTypeArg(con('Maybe', con('Bool')), con('Maybe', con('Int'))), false);
+});
+
+test('matchArgs requires equal arity', () => {
+ assert.equal(matchArgs([con('Int')], [con('Int'), con('Bool')]), false);
+ assert.equal(matchArgs([v(0), v(1)], [con('Int'), con('Bool')]), true);
+});
+
+// ---- findMatchingInstances --------------------------------------------------
+
+test('findMatchingInstances: concrete requirement hits both the concrete and the polymorphic instance', () => {
+ const tc = core.makeTypeCore({
+ pdInstances: [inst('Eq', [con('Int')]), inst('Eq', [v(0)])],
+ });
+ const hits = tc.findMatchingInstances(qn('Eq'), [con('Int')]);
+ assert.equal(hits.length, 2);
+});
+
+test('findMatchingInstances: a different concrete requirement hits only the polymorphic instance', () => {
+ const tc = core.makeTypeCore({
+ pdInstances: [inst('Eq', [con('Int')]), inst('Eq', [v(0)])],
+ });
+ const hits = tc.findMatchingInstances(qn('Eq'), [con('Bool')]);
+ assert.equal(hits.length, 1);
+ assert.deepEqual(hits[0].iiArgs, [v(0)]);
+});
+
+test('findMatchingInstances: an abstract requirement is NOT discharged by a concrete instance', () => {
+ const tc = core.makeTypeCore({
+ pdInstances: [inst('Eq', [con('Int')]), inst('Eq', [v(0)])],
+ });
+ // Requirement still a bare variable (e.g. an uncovered multi-param tyvar):
+ // only the polymorphic instance head (also a variable) matches.
+ const hits = tc.findMatchingInstances(qn('Eq'), [v(7)]);
+ assert.equal(hits.length, 1);
+ assert.deepEqual(hits[0].iiArgs, [v(0)]);
+});
+
+test('findMatchingInstances: multi-param projection matches positionally', () => {
+ // class C a b; instances: C Int Bool, C a a.
+ const tc = core.makeTypeCore({
+ pdInstances: [inst('C', [con('Int'), con('Bool')]), inst('C', [v(0), v(0)])],
+ });
+ assert.equal(tc.findMatchingInstances(qn('C'), [con('Int'), con('Bool')]).length, 2);
+ assert.equal(tc.findMatchingInstances(qn('C'), [con('Char'), con('Char')]).length, 1);
+ assert.equal(tc.findMatchingInstances(qn('C'), [con('Int'), con('Char')], ).length, 1);
+});
+
+// ---- reduceTypeArg (type-family reduction, incl. closed families) -----------
+
+test('reduceTypeArg: closed/open family equation with concrete LHS rewrites to its RHS', () => {
+ // type instance F Int = Bool (closed-family equations arrive folded into
+ // the same index, which is exactly the bug we fixed).
+ const tc = core.makeTypeCore({ famInstsByFamily: indexFams(eqn('F', [con('Int')], con('Bool'))) });
+ assert.ok(deepEqArg(tc.reduceTypeArg(fam('F', con('Int'))), con('Bool')));
+});
+
+test('reduceTypeArg: equation with a variable LHS instantiates the RHS', () => {
+ // type instance F a = [a]
+ const tc = core.makeTypeCore({ famInstsByFamily: indexFams(eqn('F', [v(0)], con('List', v(0)))) });
+ assert.ok(deepEqArg(tc.reduceTypeArg(fam('F', con('Int'))), con('List', con('Int'))));
+});
+
+test('reduceTypeArg: no applicable equation leaves the FamilyApp untouched', () => {
+ const tc = core.makeTypeCore({ famInstsByFamily: indexFams(eqn('F', [con('Int')], con('Bool'))) });
+ assert.ok(deepEqArg(tc.reduceTypeArg(fam('F', con('Char'))), fam('F', con('Char'))));
+ assert.ok(deepEqArg(tc.reduceTypeArg(fam('G', con('Int'))), fam('G', con('Int'))));
+});
+
+test('reduceTypeArg: reduces nested family applications', () => {
+ const tc = core.makeTypeCore({ famInstsByFamily: indexFams(eqn('F', [con('Int')], con('Bool'))) });
+ assert.ok(deepEqArg(tc.reduceTypeArg(con('Maybe', fam('F', con('Int')))), con('Maybe', con('Bool'))));
+});
+
+test('reduceTypeArg: data-family equations are skipped (opaque RHS)', () => {
+ const tc = core.makeTypeCore({ famInstsByFamily: indexFams(eqn('F', [con('Int')], con('RHS'), true)) });
+ assert.ok(deepEqArg(tc.reduceTypeArg(fam('F', con('Int'))), fam('F', con('Int'))));
+});
+
+// ---- replaceFamilyApp (data-family / resolution-chain rewrite) --------------
+
+test('replaceFamilyApp: rewrites the family app and pins the predicate variable', () => {
+ // Predicate arg `Pair a (F a)`, resolved via `type instance F Int = Bool`.
+ const fi = eqn('F', [con('Int')], con('Bool'));
+ const out = replaceFamilyApp(con('Pair', v(0), fam('F', v(0))), qn('F'), fi);
+ assert.ok(deepEqArg(out, con('Pair', con('Int'), con('Bool'))));
+});
+
+test('replaceFamilyApp: returns null when the family is present but its LHS does not unify', () => {
+ const fi = eqn('F', [con('Int')], con('Bool'));
+ assert.equal(replaceFamilyApp(fam('F', con('Char')), qn('F'), fi), null);
+});
+
+test('replaceFamilyApp: returns the arg unchanged when the family is absent', () => {
+ const fi = eqn('F', [con('Int')], con('Bool'));
+ const t = con('Maybe', v(0));
+ assert.equal(replaceFamilyApp(t, qn('F'), fi), t); // same reference: irrelevant fi
+});
+
+// ---- substTypeArgRaw / deepEqArg -------------------------------------------
+
+test('substTypeArgRaw substitutes positional instance args', () => {
+ assert.ok(deepEqArg(substTypeArgRaw(con('Maybe', v(0)), [con('Int')]), con('Maybe', con('Int'))));
+ // out-of-range index is left as-is
+ assert.ok(deepEqArg(substTypeArgRaw(v(5), [con('Int')]), v(5)));
+});
+
+test('deepEqArg distinguishes structure, names, and literals', () => {
+ assert.equal(deepEqArg(con('Maybe', con('Int')), con('Maybe', con('Int'))), true);
+ assert.equal(deepEqArg(con('Maybe', con('Int')), con('Maybe', con('Bool'))), false);
+ assert.equal(deepEqArg(lit('5'), lit('5')), true);
+ assert.equal(deepEqArg(v(0), v(1)), false);
+});
--- /dev/null
+'use strict';
+
+// Integration test for the element builders in viewer.js, loaded headlessly
+// via the stub harness. Guards the buildInstanceView decomposition: a tiny
+// hand-built program (class C with superclass D, instances C Int / D Int)
+// must still wire the focused class, its instance, and a satisfied
+// "superclass constraint" (needs) edge to the matching D instance.
+
+const test = require('node:test');
+const assert = require('node:assert/strict');
+const { loadViewer } = require('./harness.js');
+
+const qn = (n) => ({ qnPackage: 'p', qnModule: 'M', qnName: n });
+const con = (n) => ({ tag: 'TyConApp', contents: [qn(n), []] });
+const cls = (name, supers = [], assoc = []) => ({
+ ciName: qn(name), ciTyVars: [{ tvName: 'a', tvKind: '*' }],
+ ciSuperclasses: supers, ciAssocTypes: assoc,
+ ciMethods: [], ciSrc: null, ciDoc: null,
+});
+const inst = (name, args) => ({
+ iiClass: qn(name), iiArgs: args, iiContext: [], iiTyVars: [],
+ iiOrphan: false, iiOverlap: null, iiSrc: null, iiDoc: null, iiDefinedIn: null,
+});
+
+function buildProgram() {
+ const meta = {
+ pdClasses: [
+ cls('C', [{ seSuperclass: qn('D'), seArgs: [{ tag: 'TyVarRef', contents: 0 }] }]),
+ cls('D'),
+ ],
+ pdInstances: [inst('C', [con('Int')]), inst('D', [con('Int')])],
+ pdTypeFamilies: [],
+ pdFamInstances: [],
+ };
+ return loadViewer(JSON.stringify({ elements: [], meta, sourceRoots: {} }));
+}
+
+test('buildInstanceView wires focus class, instance node, and defines edge', () => {
+ const els = buildProgram().buildInstanceView('p:M.C');
+ assert.ok(els.some(e => e.data.id === 'p:M.C' && e.data.focused),
+ 'focused class node present');
+ assert.ok(els.some(e => e.data.kind === 'instance' && e.data.classId === 'p:M.C'),
+ 'C-instance node present');
+ assert.ok(els.some(e => e.data.kind === 'defines'),
+ 'class→instance "defines" edge present');
+});
+
+test('buildInstanceView draws a satisfied "needs" edge to the matching superclass instance', () => {
+ const els = buildProgram().buildInstanceView('p:M.C');
+ assert.ok(els.some(e => e.data.kind === 'needs'),
+ 'superclass constraint satisfied by local D instance');
+ assert.ok(els.some(e => e.data.kind === 'instance' && e.data.classId === 'p:M.D'),
+ 'matched D-instance node pulled in');
+ // The abstract superclass should NOT have produced an external predicate
+ // node here, since a concrete D Int instance discharges it.
+ assert.ok(!els.some(e => e.data.kind === 'needs-external'),
+ 'no spurious external predicate when a local instance matches');
+});
+
+test('an unmatched superclass yields an external predicate node', () => {
+ // C's superclass D, but the only D instance is for Bool, not Int.
+ const meta = {
+ pdClasses: [
+ cls('C', [{ seSuperclass: qn('D'), seArgs: [{ tag: 'TyVarRef', contents: 0 }] }]),
+ cls('D'),
+ ],
+ pdInstances: [inst('C', [con('Int')]), inst('D', [con('Bool')])],
+ pdTypeFamilies: [],
+ pdFamInstances: [],
+ };
+ const views = loadViewer(JSON.stringify({ elements: [], meta, sourceRoots: {} }));
+ const els = views.buildInstanceView('p:M.C');
+ assert.ok(els.some(e => e.data.kind === 'needs-external'),
+ 'unmatched superclass becomes an external predicate');
+ assert.ok(!els.some(e => e.data.kind === 'needs'),
+ 'no false local-match edge');
+});