| Setting | What it does |
|---|---|
| **Editor** | Picks a URL scheme — VS Code, VS Code Insiders, Cursor, IntelliJ family, TextMate (`txmt://`), or plain `file://`. Set it to *off* to keep `Defined at` as plain text. |
-| **Source root** | Absolute prefix prepended to relative paths. The plugin records source paths as GHC saw them (usually relative to each package's source dir), so this needs to be set for `vscode://` etc. to resolve them. |
+| **Source root override** | Absolute prefix prepended to relative paths when no per-package root is known. Usually leave blank — `classgraph-view` infers roots from `--input` (see below). |
-Once both are set, every `Defined at` line in the panel becomes a
-clickable link that opens the file at the right line in your editor.
-Schemes that take a column ( `vscode`, `cursor`, `txmt`) get one;
+Once an editor is chosen, every `Defined at` line in the panel becomes
+a clickable link that opens the file at the right line in your editor.
+Schemes that take a column (`vscode`, `cursor`, `txmt`) get one;
`idea` and `file` ignore it.
+**Source roots are inferred automatically.** The plugin records source
+paths as GHC saw them (usually relative to each package's source dir),
+so the viewer needs an absolute prefix to make `vscode://` /
+`cursor://` /etc URLs resolvable. `classgraph-view` does this for you:
+
+- For each `--input DIR`, the *parent* of `DIR` is used as the source
+ root for every package whose dumps live there. So
+ `--input ~/code/my-app/.classgraph/` means `~/code/my-app/` is the
+ root for the `my-app` package.
+- Repeat `--input` for multi-package merges; each package gets the
+ root inferred from its own input dir.
+- Override per-package with `--source-root PKG=PATH` (repeatable):
+
+ ```bash
+ cabal run classgraph-view -- \
+ --input ~/code/foo/.classgraph \
+ --input ~/code/bar/sub/.classgraph \
+ --source-root bar=~/code/bar \
+ --output combined.html
+ ```
+
+The "Source root override" field in the panel is a global fallback
+applied only when no inferred root exists for the file's package —
+useful when you've been handed an HTML file built elsewhere.
+
## Schema, data flow, design notes
For a deeper walkthrough of where every piece of information comes
module Main (main) where
import qualified Data.ByteString.Lazy as BL
+import qualified Data.Map.Strict as Map
+import Data.Maybe (mapMaybe)
+import qualified Data.Text as T
import Options.Applicative
+import System.Directory (canonicalizePath, doesDirectoryExist)
+import System.FilePath (dropTrailingPathSeparator, takeDirectory)
-import Classgraph.Merge (mergeDirs)
-import Classgraph.Render (renderProgram)
+import Classgraph.Merge (mergeDirs, normalisePackageId, readDumpsInDir)
+import Classgraph.Render (renderProgramWith)
+import Classgraph.Schema (ModuleDump (..))
data Opts = Opts
- { optInputs :: ![FilePath]
- , optOutput :: !FilePath
+ { optInputs :: ![FilePath]
+ , optOutput :: !FilePath
+ , optSourceRoots :: ![(T.Text, FilePath)]
+ -- ^ Explicit @--source-root pkg=PATH@ overrides. Take precedence over
+ -- the per-input-dir default inferred below.
}
opts :: Parser Opts
<> value "classgraph.html"
<> showDefault
<> help "Path to write the self-contained HTML viewer." )
+ <*> many
+ (option (eitherReader parseSourceRoot)
+ ( long "source-root"
+ <> metavar "PKG=PATH"
+ <> help "Override the source-root prefix used by the viewer's \
+ \\"open in editor\" links for a single package. PKG is \
+ \the (normalised) package id (no -version-hash suffix); \
+ \PATH is an absolute filesystem path. May be repeated. \
+ \When omitted, the viewer infers each package's root \
+ \from its --input directory's parent." ))
+ where
+ parseSourceRoot s = case break (== '=') s of
+ (pkg, '=' : path) | not (null pkg), not (null path) ->
+ Right (T.pack pkg, path)
+ _ -> Left "expected --source-root PKG=PATH"
main :: IO ()
main = do
let inputs = case optInputs o of
[] -> [".classgraph"]
xs -> xs
- pd <- mergeDirs inputs
- BL.writeFile (optOutput o) (renderProgram pd)
+ pd <- mergeDirs inputs
+ sourceRoots <- discoverSourceRoots inputs (optSourceRoots o)
+ BL.writeFile (optOutput o) (renderProgramWith pd sourceRoots)
putStrLn $ "Wrote " <> optOutput o <>
" (merged " <> show (length inputs) <> " input dir" <>
(if length inputs == 1 then ")" else "s)")
+ putStrLn $ " source roots: " <> show (Map.size sourceRoots) <>
+ " package(s) with editor-link prefixes"
+
+-- | Build the per-package source-root map. For each input directory, we
+-- read its dumps, see which (normalised) packages they belong to, and
+-- assign that input dir's parent as the default source root for those
+-- packages. Explicit @--source-root@ overrides win.
+--
+-- /First-wins/ at each layer: if multiple input dirs report the same
+-- package, the first one's parent is kept. CLI overrides win over any
+-- inferred value.
+discoverSourceRoots
+ :: [FilePath] -- ^ input dirs
+ -> [(T.Text, FilePath)] -- ^ explicit --source-root overrides
+ -> IO (Map.Map T.Text FilePath)
+discoverSourceRoots inputs overrides = do
+ inferred <- inferFromInputs inputs
+ overrideAbs <- mapM canonicaliseEntry overrides
+ -- Map.union is left-biased — overrides take precedence.
+ pure (Map.union (Map.fromList overrideAbs) inferred)
+ where
+ canonicaliseEntry (pkg, path) = do
+ ok <- doesDirectoryExist path
+ abs' <- if ok then canonicalizePath path else pure path
+ pure (pkg, abs')
+
+inferFromInputs :: [FilePath] -> IO (Map.Map T.Text FilePath)
+inferFromInputs [] = pure Map.empty
+inferFromInputs (dir:rest) = do
+ -- Default root = the input directory's parent (cabal projects keep
+ -- their @.classgraph/@ directly under the package source dir).
+ exists <- doesDirectoryExist dir
+ rootAbs <- if exists
+ then canonicalizePath (takeDirectory (dropTrailingPathSeparator dir))
+ else pure (takeDirectory (dropTrailingPathSeparator dir))
+ pkgs <- packagesIn dir
+ let here = Map.fromList [ (p, rootAbs) | p <- pkgs ]
+ later <- inferFromInputs rest
+ -- Map.union is left-biased: first occurrence wins, matching the
+ -- "first --input that mentions a package decides its root" rule.
+ pure (Map.union here later)
+
+packagesIn :: FilePath -> IO [T.Text]
+packagesIn dir = do
+ exists <- doesDirectoryExist dir
+ if not exists
+ then pure []
+ else do
+ dumps <- readDumpsInDir dir
+ pure (uniq (mapMaybe pkgOf dumps))
+ where
+ pkgOf d = let p = normalisePackageId (mdPackage d)
+ in if T.null p then Nothing else Just p
+ uniq = Map.keys . Map.fromList . map (\x -> (x, ()))
build-depends: base
, classgraph
, bytestring
+ , containers
+ , directory
+ , filepath
, optparse-applicative ^>=0.19
, text
</select>
</div>
<div class="editor-row">
- <label for="editor-root">Source root</label>
- <input id="editor-root" type="text" placeholder="/abs/path/to/your/checkout" autocomplete="off" spellcheck="false" />
+ <label for="editor-root">Source root override</label>
+ <input id="editor-root" type="text" placeholder="(usually leave empty — inferred from --input)" autocomplete="off" spellcheck="false" />
</div>
- <p class="mute-hint">Most schemes (<code>vscode</code>, <code>cursor</code>, <code>idea</code>, …) need <strong>absolute</strong> paths. The plugin records source paths as GHC saw them — usually relative to the package's source dir; prefix that here.</p>
+ <p class="mute-hint">Most schemes (<code>vscode</code>, <code>cursor</code>, <code>idea</code>, …) need <strong>absolute</strong> paths. <code>classgraph-view</code> infers a per-package source root from each <code>--input</code> directory's parent (and any explicit <code>--source-root pkg=PATH</code> arg). Use this field only when the inferred root is wrong or missing.</p>
</details>
<details id="mute-filter">
<summary><span id="mute-summary">Muted classes (0)</span></summary>
const raw = document.getElementById('graph-data').textContent;
const graph = JSON.parse(raw);
+ // Per-package source-root prefixes inferred at render time from the
+ // CLI's --input arguments (and any explicit --source-root overrides).
+ // The viewer prefers these over the localStorage override; they're
+ // baked into the HTML so a freshly-built page already has working
+ // editor links without any client-side configuration.
+ const inferredSourceRoots = (graph && graph.sourceRoots) || {};
// ---------------------------------------------------------------------------
// Indexes over the program data
};
}
+ // Pick the source root to use for a relative file path: per-package
+ // root (inferred from --input at render time) wins; the localStorage
+ // override only applies when no per-package root is known. The
+ // override is global, so it's a poor fit for multi-package merges —
+ // we keep it strictly as a fallback.
+ function pickSourceRoot(pkg, fallbackRoot) {
+ if (pkg && Object.prototype.hasOwnProperty.call(inferredSourceRoots, pkg)) {
+ return inferredSourceRoots[pkg];
+ }
+ return fallbackRoot;
+ }
+
// Build the editor URL for the given file:line:col. Returns null when
- // no scheme is configured (caller falls back to plain text).
- function buildEditorUrl(file, line, col) {
- const { scheme, root } = readEditorSettings();
+ // no scheme is configured (caller falls back to plain text). @pkg@ is
+ // the (normalised) package id whose source root should be applied to
+ // any relative @file@; pass @null@ to use only the localStorage
+ // override.
+ function buildEditorUrl(file, line, col, pkg) {
+ const { scheme, root: overrideRoot } = readEditorSettings();
if (!scheme || !file) return null;
let abs = file;
- if (!/^([a-zA-Z]:)?\//.test(file) && root) {
- // Relative path — prepend the configured root.
- abs = root.replace(/\/+$/, '') + '/' + file.replace(/^\/+/, '');
+ if (!/^([a-zA-Z]:)?\//.test(file)) {
+ // Relative path — prepend whichever root applies.
+ const root = pickSourceRoot(pkg, overrideRoot);
+ if (root) {
+ abs = root.replace(/\/+$/, '') + '/' + file.replace(/^\/+/, '');
+ }
}
const enc = encodeURI(abs);
switch (scheme) {
}
// Render a SrcSpanInfo as a `<dd>` cell — clickable when an editor
- // scheme is configured, plain text otherwise.
- function renderDefinedAt(src) {
+ // scheme is configured, plain text otherwise. @pkg@ should be the
+ // (normalised) defining-package id of the entity whose source span
+ // this is, so per-package source-root inference works.
+ function renderDefinedAt(src, pkg) {
if (!src) return '<dd><em>unknown</em></dd>';
const text = `${src.ssFile}:${src.ssStartLine}:${src.ssStartCol}`;
- const url = buildEditorUrl(src.ssFile, src.ssStartLine, src.ssStartCol);
+ const url = buildEditorUrl(src.ssFile, src.ssStartLine, src.ssStartCol, pkg);
if (!url) return `<dd>${escape(text)}</dd>`;
return `<dd><a class="src-link" href="${escapeAttr(url)}" title="Open in your editor">${escape(text)}</a></dd>`;
}
c.ciAssocTypes.map(a => `<dd>${escape(a.qnName)}</dd>`).join('');
const meths = c.ciMethods.length === 0 ? '<dd><em>none</em></dd>' :
`<dd>${c.ciMethods.map(escape).join(', ')}</dd>`;
- const src = renderDefinedAt(c.ciSrc);
+ const src = renderDefinedAt(c.ciSrc, c.ciName.qnPackage);
const numInsts = (instancesByClass.get(cid) || []).length;
return `
<h2>${escape(c.ciName.qnName)}</h2>
.join('');
const flav = (typeof f.tfFlavor === 'string')
? f.tfFlavor : (f.tfFlavor.tag || JSON.stringify(f.tfFlavor));
- const src = renderDefinedAt(f.tfSrc);
+ const src = renderDefinedAt(f.tfSrc, f.tfName.qnPackage);
return `
<h2>${escape(f.tfName.qnName)}</h2>
<p class="pkgmod">${escape(f.tfName.qnPackage)} · ${escape(f.tfName.qnModule)}</p>
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>`;
- const src = renderDefinedAt(inst.iiSrc);
+ // For the instance, prefer iiDefinedIn (the *defining* package) over
+ // the class's package — for orphan instances those differ, and the
+ // source path is recorded relative to the defining package.
+ const src = renderDefinedAt(inst.iiSrc, inst.iiDefinedIn || inst.iiClass.qnPackage);
return `
<h2>${head}</h2>
<p class="pkgmod">${escape(inst.iiClass.qnPackage)} · ${escape(inst.iiClass.qnModule)}</p>
const tvs = fi.fiTyVars.length === 0 ? '<dd><em>none</em></dd>' :
`<dd><ul>${fi.fiTyVars.map(v =>
`<li>${escape(v.tvName)}<span style="color:#888"> :: ${escape(v.tvKind)}</span></li>`).join('')}</ul></dd>`;
- const src = renderDefinedAt(fi.fiSrc);
+ const src = renderDefinedAt(fi.fiSrc, fi.fiDefinedIn || fi.fiFamily.qnPackage);
return `
<h2>${head}</h2>
<p class="pkgmod">${escape(fi.fiFamily.qnPackage)} · ${escape(fi.fiFamily.qnModule)}</p>
-- UnhelpfulSpan, hence "unknown" in the side panel.
, iiSrc = srcSpanInfo (nameSrcSpan dfunName)
, iiDoc = lookupDoc mDocs dfunName
+ , iiDefinedIn = Nothing
+ -- ^ Filled in by 'Classgraph.Merge' from the enclosing
+ -- 'ModuleDump's package id (after normalisation). The plugin
+ -- itself doesn't bother — at extraction time the package id is
+ -- already known via 'currentModuleNames' / 'mdPackage'.
}
orphanFlag :: IsOrphan -> Bool
-- Closed-family branches don't have their own Haddock-targeted Name;
-- documentation on the family declaration itself ends up on tfDoc
-- of the enclosing TypeFamilyInfo.
+ , fiDefinedIn = Nothing -- filled in by Classgraph.Merge
}
extractFamInst :: Maybe Docs -> FamInst -> FamInstInfo
-- TyCon's Name. If multiple instances of the same family carry
-- separate Haddocks, all of them surface here on every instance —
-- a known limitation of the GHC docs map's structure.
+ , fiDefinedIn = Nothing -- filled in by Classgraph.Merge
}
------------------------------------------------------------------------------
( mergeDir
, mergeDirs
, mergeDumps
+ , readDumpsInDir
+ , normalisePackageId
) where
import Control.Monad (filterM)
mergeDumps :: [ModuleDump] -> ProgramData
mergeDumps dumps =
let normalised = map (mapDumpQNs normalisePackageInQN) dumps
+ -- For instances and family instances we additionally tag each item
+ -- with the (normalised) package id of its defining 'ModuleDump'.
+ -- 'iiClass'/'fiFamily' record the class/family's *defining*
+ -- package, which for orphans is unrelated to the instance's source
+ -- file — so we can't recover this information after the merge.
+ tagged = map tagDefinedIn normalised
in ProgramData
- { pdClasses = dedupOn ciName (concatMap (pdClasses . mdData) normalised)
- , pdInstances = concatMap (pdInstances . mdData) normalised
+ { pdClasses = dedupOn ciName (concatMap (pdClasses . mdData) tagged)
+ , pdInstances = concatMap (pdInstances . mdData) tagged
-- Instances aren't deduplicated: each is uniquely identified by class
-- + arg types, but its serialised form already contains everything we
-- need; collisions are unlikely except for re-extracted modules.
- , pdTypeFamilies = dedupOn tfName (concatMap (pdTypeFamilies . mdData) normalised)
- , pdFamInstances = concatMap (pdFamInstances . mdData) normalised
+ , pdTypeFamilies = dedupOn tfName (concatMap (pdTypeFamilies . mdData) tagged)
+ , pdFamInstances = concatMap (pdFamInstances . mdData) tagged
+ }
+
+tagDefinedIn :: ModuleDump -> ModuleDump
+tagDefinedIn d =
+ let pkg = normalisePackageId (mdPackage d)
+ pd = mdData d
+ in d { mdData = pd
+ { pdInstances = [ i { iiDefinedIn = Just pkg } | i <- pdInstances pd ]
+ , pdFamInstances = [ fi { fiDefinedIn = Just pkg } | fi <- pdFamInstances pd ]
+ }
}
dedupOn :: Ord k => (a -> k) -> [a] -> [a]
-- emitted HTML page works fully offline as a single file.
module Classgraph.Render
( renderProgram
+ , renderProgramWith
) where
import qualified Data.Aeson as Aeson
-- | Produce a self-contained HTML document visualising the superclass DAG
-- and associated-type-family relationships in the given 'ProgramData'.
renderProgram :: ProgramData -> BL.ByteString
-renderProgram pd =
- let graph = buildGraph pd
+renderProgram pd = renderProgramWith pd Map.empty
+
+-- | Like 'renderProgram', but additionally records a per-package
+-- /source root/ map. The viewer uses these absolute paths to turn the
+-- relative file paths in @ssFile@ entries into clickable links that
+-- open in the user's editor. Keys are normalised package ids
+-- (matching 'iiDefinedIn' and 'qnPackage' after 'normalisePackageInQN');
+-- values are absolute filesystem paths.
+renderProgramWith :: ProgramData -> Map.Map Text FilePath -> BL.ByteString
+renderProgramWith pd sourceRoots =
+ let graph = buildGraph pd sourceRoots
jsonBs = Aeson.encode graph
page = TE.decodeUtf8 viewerHtml
pageBuilder = substitutePlaceholders
-- | The element list shape expected by Cytoscape.js.
data CyGraph = CyGraph
- { cyElements :: ![CyElement]
- , cyMeta :: !Aeson.Value -- raw program data (used by side panel)
+ { cyElements :: ![CyElement]
+ , cyMeta :: !Aeson.Value -- raw program data (used by side panel)
+ , cySourceRoots :: !(Map.Map Text FilePath)
}
instance Aeson.ToJSON CyGraph where
toJSON g = Aeson.object
- [ "elements" Aeson..= cyElements g
- , "meta" Aeson..= cyMeta g
+ [ "elements" Aeson..= cyElements g
+ , "meta" Aeson..= cyMeta g
+ , "sourceRoots" Aeson..= cySourceRoots g
]
data CyElement
toJSON (CyNode v) = Aeson.object ["group" Aeson..= ("nodes" :: Text), "data" Aeson..= v]
toJSON (CyEdge v) = Aeson.object ["group" Aeson..= ("edges" :: Text), "data" Aeson..= v]
-buildGraph :: ProgramData -> CyGraph
-buildGraph pd = CyGraph
- { cyElements = classNodes <> familyNodes <> externalNodes
- <> superEdges <> assocEdges
- , cyMeta = Aeson.toJSON pd
+buildGraph :: ProgramData -> Map.Map Text FilePath -> CyGraph
+buildGraph pd sourceRoots = CyGraph
+ { cyElements = classNodes <> familyNodes <> externalNodes
+ <> superEdges <> assocEdges
+ , cyMeta = Aeson.toJSON pd
+ , cySourceRoots = sourceRoots
}
where
-- "Leaf" = no other class has this class as a (direct) superclass.
-- ^ Haddock attached to the @instance ...@ declaration, if the
-- target was compiled with @-haddock@. Looked up via the dfun's
-- 'Name'.
+ , iiDefinedIn :: !(Maybe Text)
+ -- ^ The package id of the module that /defined/ this instance,
+ -- after package-id normalisation (so @demo-0.1.0.0-inplace@ becomes
+ -- @demo@). Set by the merge step from the enclosing 'ModuleDump';
+ -- distinct from 'qnPackage' on 'iiClass' for orphan instances. Used
+ -- by the viewer to look up the right source-root prefix when
+ -- building \"open in editor\" links.
}
deriving stock (Generic, Show, Eq)
instance ToJSON InstanceInfo where
toJSON i = object
- [ "iiClass" .= iiClass i
- , "iiArgs" .= iiArgs i
- , "iiContext" .= iiContext i
- , "iiTyVars" .= iiTyVars i
- , "iiOrphan" .= iiOrphan i
- , "iiOverlap" .= iiOverlap i
- , "iiSrc" .= iiSrc i
- , "iiDoc" .= iiDoc i
+ [ "iiClass" .= iiClass i
+ , "iiArgs" .= iiArgs i
+ , "iiContext" .= iiContext i
+ , "iiTyVars" .= iiTyVars i
+ , "iiOrphan" .= iiOrphan i
+ , "iiOverlap" .= iiOverlap i
+ , "iiSrc" .= iiSrc i
+ , "iiDoc" .= iiDoc i
+ , "iiDefinedIn" .= iiDefinedIn i
]
instance FromJSON InstanceInfo where
<*> o .: "iiOverlap"
<*> o .: "iiSrc"
<*> o .:? "iiDoc"
+ <*> o .:? "iiDefinedIn"
data PredInfo = PredInfo
{ piClass :: !QualName
-- hides the RHS for data-family rows.
, fiDoc :: !(Maybe Text)
-- ^ Haddock for this family instance, when @-haddock@ is on.
+ , fiDefinedIn :: !(Maybe Text)
+ -- ^ Defining-package id (normalised), set at merge time. Used the
+ -- same way as 'iiDefinedIn' for editor-link source-root lookup.
}
deriving stock (Generic, Show, Eq)
instance ToJSON FamInstInfo where
toJSON fi = object
- [ "fiFamily" .= fiFamily fi
- , "fiTyVars" .= fiTyVars fi
- , "fiArgs" .= fiArgs fi
- , "fiRhs" .= fiRhs fi
- , "fiSrc" .= fiSrc fi
- , "fiIsData" .= fiIsData fi
- , "fiDoc" .= fiDoc fi
+ [ "fiFamily" .= fiFamily fi
+ , "fiTyVars" .= fiTyVars fi
+ , "fiArgs" .= fiArgs fi
+ , "fiRhs" .= fiRhs fi
+ , "fiSrc" .= fiSrc fi
+ , "fiIsData" .= fiIsData fi
+ , "fiDoc" .= fiDoc fi
+ , "fiDefinedIn" .= fiDefinedIn fi
]
instance FromJSON FamInstInfo where
<*> o .: "fiSrc"
<*> o .:? "fiIsData" .!= False
<*> o .:? "fiDoc"
+ <*> o .:? "fiDefinedIn"
data SrcSpanInfo = SrcSpanInfo
{ ssFile :: !Text
projects / classgraph.git / commitdiff