Multi-ide doc gen

sdk/compiler/daml-extension/src/doc-webview.js

@@ -0,0 +1,17 @@
+// Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
+// SPDX-License-Identifier: Apache-2.0
+
+function scrollToDef(name) {
+  let elem = document.getElementsByName(name)[0];
+  if (!elem) return;
+  window.scroll(0, elem.getBoundingClientRect().top + document.documentElement.scrollTop);
+}
+
+window.onload = function() {
+  document.querySelectorAll('a[href^="#"]').forEach(a => a.onclick = function() {
+    scrollToDef(a.getAttribute('href').substring(1))
+  });
+};
+
+window.addEventListener('message', event => scrollToDef(event.data));
+

sdk/compiler/daml-extension/src/extension.ts

@@ -144,7 +144,14 @@ export async function activate(context: vscode.ExtensionContext) {
     showRecommendedDirenvPage,
   );
 
-  context.subscriptions.push(d1, d2, d3, d4, d5);
+  let d6 = vscode.commands.registerCommand(
+    "daml.getDocDefinition",
+    (locationDef: { anchor: string; unitid: string }) => {
+      console.log(locationDef);
+    },
+  );
+
+  context.subscriptions.push(d1, d2, d3, d4, d5, d6);
 }
 
 interface IdeManifest {

sdk/compiler/daml-extension/src/language_client.ts

@@ -11,6 +11,8 @@ import {
   LanguageClient,
   LanguageClientOptions,
   RequestType,
+  CancellationToken,
+  ProvideDefinitionSignature,
 } from "vscode-languageclient/node";
 import * as which from "which";
 import {
@@ -28,6 +30,7 @@ import {
 import * as semver from "semver";
 import * as util from "util";
 import * as child_process from "child_process";
+import { URLSearchParams } from "url";
 
 namespace DamlKeepAliveRequest {
   export let type = new RequestType<void, void, void>("daml/keepAlive");
@@ -80,12 +83,16 @@ export class DamlLanguageClient {
     identifier: string | undefined = undefined,
   ): Promise<DamlLanguageClient | null> {
     try {
+      const docWebviewScript = vscode.Uri.file(
+        path.join(_context.extensionPath, "src", "doc-webview.js"),
+      );
       const [languageClient, multiIdeSupport] =
         await DamlLanguageClient.createLanguageClient(
           rootPath,
           envVars,
           config,
           telemetryConsent,
+          docWebviewScript,
           identifier,
         );
       return new DamlLanguageClient(
@@ -299,11 +306,40 @@ export class DamlLanguageClient {
       }
     }
   }
+
+  private static panels: { [packageName: string]: vscode.WebviewPanel } = {};
+
+  private static getOrCreateDocWindow(
+    packageName: string,
+  ): vscode.WebviewPanel {
+    let panels = DamlLanguageClient.panels;
+    let panel = panels[packageName];
+    if (panel) {
+      panel.reveal();
+      return panel;
+    }
+    panel = vscode.window.createWebviewPanel(
+      `docs-${packageName}`,
+      `Generated documentation for ${packageName}`,
+      vscode.ViewColumn.One,
+      {
+        enableCommandUris: true,
+        enableScripts: true,
+      },
+    );
+    panel.onDidDispose(function () {
+      delete panels[packageName];
+    });
+    panels[packageName] = panel;
+    return panel;
+  }
+
   private static async createLanguageClient(
     rootPath: string,
     envVars: { [envVarName: string]: string },
     config: vscode.WorkspaceConfiguration,
     telemetryConsent: boolean | undefined,
+    docWebviewScript: vscode.Uri,
     identifier: string | undefined,
   ): Promise<[LanguageClient, boolean]> {
     // Options to control the language client
@@ -312,6 +348,48 @@ export class DamlLanguageClient {
       documentSelector: [
         { language: "daml", pattern: rootPath + "/**/*.daml" },
       ],
+      middleware: {
+        provideDefinition: async (
+          document: vscode.TextDocument,
+          position: vscode.Position,
+          token: CancellationToken,
+          next: ProvideDefinitionSignature,
+        ) => {
+          const result = await next(document, position, token);
+          if (!result) return;
+
+          let locations: Array<vscode.Location> | Array<vscode.LocationLink>;
+          if (result instanceof vscode.Location)
+            locations = new Array(result as vscode.Location);
+          else if (Array.isArray(result)) locations = result;
+          else throw "Provide definition result was wrongly typed";
+
+          if (locations.length == 0) return;
+
+          // Currently ghc-ide only ever gives 1 or 0 results, so we operate only on the first element
+          let location = locations[0];
+
+          // this should reuse existing page
+          if (
+            location instanceof vscode.Location &&
+            location.uri.scheme == "daml" &&
+            location.uri.path == "open-docs"
+          ) {
+            const params = new URLSearchParams(location.uri.query);
+            const path = params.get("path");
+            const unitId = params.get("unitid");
+            const anchor = params.get("anchor");
+            if (!path || !unitId) throw "Invalid open-docs data";
+            const content = fs.readFileSync(path).toString();
+            const panel = DamlLanguageClient.getOrCreateDocWindow(unitId);
+            const docWebviewScriptPath =
+              panel.webview.asWebviewUri(docWebviewScript);
+            panel.webview.html =
+              `<script src="${docWebviewScriptPath}"></script>\n` + content;
+            panel.webview.postMessage(anchor);
+          } else return locations;
+        },
+      },
     };
 
     const command = DamlLanguageClient.findDamlCommand();

sdk/compiler/damlc/daml-doc/src/DA/Daml/Doc/Anchor.hs

@@ -14,6 +14,7 @@ module DA.Daml.Doc.Anchor
     , typeAnchor
     , constrAnchor
     , functionAnchor
+    , defaultAnchorGenerators
     ) where
 
 import DA.Daml.Doc.Types
@@ -78,3 +79,12 @@ anchor k m n v = Anchor $ T.intercalate "-" [k, convertModulename m, expandOps n
 
 hashText :: Hashable v => v -> T.Text
 hashText = T.pack . show . (`mod` 100000) . hash
+
+defaultAnchorGenerators :: AnchorGenerators
+defaultAnchorGenerators = AnchorGenerators
+  { ag_moduleAnchor = moduleAnchor
+  , ag_classAnchor = classAnchor
+  , ag_typeAnchor = typeAnchor
+  , ag_constrAnchor = constrAnchor
+  , ag_functionAnchor = functionAnchor
+  }

sdk/compiler/damlc/daml-doc/src/DA/Daml/Doc/Driver.hs

@@ -8,6 +8,7 @@ module DA.Daml.Doc.Driver
     , RenderFormat(..)
     , TransformOptions(..)
     , ExternalAnchorPath(..)
+    , ExternalAnchorBehaviour(..)
     , runDamlDoc
     , loadExternalAnchors
     ) where
@@ -39,9 +40,9 @@ import qualified Data.Aeson as AE
 import qualified Data.Aeson.Encode.Pretty as AP
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
-import qualified Data.HashMap.Strict as HMS
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.Extended as T
+import qualified Network.URI as URI
 
 import SdkVersion.Class (SdkVersioned)
 
@@ -62,7 +63,7 @@ data DamldocOptions = DamldocOptions
     , do_baseURL :: Maybe T.Text -- ^ base URL for generated documentation
     , do_hooglePath :: Maybe FilePath -- ^ hoogle database output path
     , do_anchorPath :: Maybe FilePath -- ^ anchor table output path
-    , do_externalAnchorPath :: ExternalAnchorPath -- ^ external anchor table input path
+    , do_externalAnchorBehaviour :: ExternalAnchorBehaviour -- ^ Behaviour for linking external anchors
     , do_globalInternalExt :: String -- ^ File extension for internal links
     }
 
@@ -82,11 +83,15 @@ data ExternalAnchorPath
       -- ^ Read the AnchorMap from the given file
   deriving (Eq, Show, Read)
 
+data ExternalAnchorBehaviour
+  = ExternalAnchorMapPath ExternalAnchorPath
+  | ExternalAnchorFun (Maybe Packagename -> Anchor -> Maybe URI.URI)
+
 -- | Run damldocs!
 runDamlDoc :: SdkVersioned => DamldocOptions -> IO ()
 runDamlDoc options@DamldocOptions{..} = do
     docData <- inputDocData options
-    renderDocData options (applyTransform do_transformOptions docData)
+    renderDocData options (applyTransform do_transformOptions (eo_anchorGenerators do_extractOptions) docData)
 
 -- | Load doc data, either via the Daml typechecker or via JSON files.
 inputDocData :: SdkVersioned => DamldocOptions -> IO [ModuleDoc]
@@ -121,7 +126,7 @@ loadExternalAnchors eapath = do
             hPutStr stderr err
             exitFailure
     anchors <- case eapath of
-        NoExternalAnchorPath -> pure . Right $ AnchorMap HMS.empty
+        NoExternalAnchorPath -> pure . Right $ AnchorMap $ \_ _ -> Nothing
         DefaultExternalAnchorPath -> getDamlBaseAnchorsPath >>= tryLoadAnchors
         ExplicitExternalAnchorPath path -> tryLoadAnchors path
     either printAndExit pure anchors
@@ -158,7 +163,9 @@ renderDocData DamldocOptions{..} docData = do
             OutputJson ->
                 write do_outputPath $ T.decodeUtf8 . LBS.toStrict $ AP.encodePretty' jsonConf docData
             OutputDocs format -> do
-                externalAnchors <- loadExternalAnchors do_externalAnchorPath
+                externalAnchors <- case do_externalAnchorBehaviour of
+                  ExternalAnchorMapPath path -> loadExternalAnchors path
+                  ExternalAnchorFun f -> pure $ AnchorMap f
                 let renderOptions = RenderOptions
                         { ro_mode =
                           if do_combine
@@ -174,5 +181,6 @@ renderDocData DamldocOptions{..} docData = do
                         , ro_anchorPath = do_anchorPath
                         , ro_externalAnchors = externalAnchors
                         , ro_globalInternalExt = do_globalInternalExt
+                        , ro_anchorGenerators = eo_anchorGenerators do_extractOptions
                         }
                 renderDocs renderOptions docData

sdk/compiler/damlc/daml-doc/src/DA/Daml/Doc/Extract.hs

@@ -13,7 +13,6 @@ module DA.Daml.Doc.Extract
     ) where
 
 import DA.Daml.Doc.Types as DDoc
-import DA.Daml.Doc.Anchor as DDoc
 
 import DA.Daml.Doc.Extract.Types
 import DA.Daml.Doc.Extract.Util
@@ -87,7 +86,7 @@ extractDocs extractOpts diagsLogger ideOpts fp = do
             templateMaps = getTemplateMaps ctx
 
             md_name = dc_modname
-            md_anchor = Just (moduleAnchor md_name)
+            md_anchor = Just (ag_moduleAnchor (eo_anchorGenerators extractOpts) md_name)
             md_descr = modDoc tcmod
             md_templates = getTemplateDocs ctx typeMap interfaceInstanceMap templateMaps
             md_interfaces = getInterfaceDocs ctx typeMap interfaceInstanceMap templateMaps
@@ -242,7 +241,7 @@ getFctDocs ctx@DocCtx{..} (DeclData decl docs) = do
     let ty = idType id
         fct_context = typeToContext ctx ty
         fct_type = typeToType ctx ty
-        fct_anchor = Just $ functionAnchor dc_modname fct_name
+        fct_anchor = Just $ ag_functionAnchor (eo_anchorGenerators dc_extractOptions) dc_modname fct_name
         fct_descr = docs
 
     guard (exportsFunction dc_exports fct_name)
@@ -254,7 +253,7 @@ getClsDocs ctx@DocCtx{..} (DeclData (L _ (TyClD _ ClassDecl{..})) tcdocs) = do
     let cl_name = Typename . packRdrName $ unLoc tcdLName
     tycon <- MS.lookup cl_name dc_tycons
     tycls <- tyConClass_maybe tycon
-    let cl_anchor = Just $ classAnchor dc_modname cl_name
+    let cl_anchor = Just $ ag_classAnchor (eo_anchorGenerators dc_extractOptions) dc_modname cl_name
         cl_descr = tcdocs
         cl_args = map (tyVarText . unLoc) $ hsq_explicit tcdTyVars
         opMap = MS.fromList
@@ -301,7 +300,7 @@ getClsDocs ctx@DocCtx{..} (DeclData (L _ (TyClD _ ClassDecl{..})) tcdocs) = do
             flip mapMaybe rdrNamesL $ \rdrNameL -> do
                 let cm_name = Fieldname . packRdrName . unLoc $ rdrNameL
                     cm_anchor = guard (not cm_isDefault) >>
-                        Just (functionAnchor dc_modname cm_name)
+                        Just (ag_functionAnchor (eo_anchorGenerators dc_extractOptions) dc_modname cm_name)
                 (id, dmInfoM) <- MS.lookup cm_name opMap
 
                 let ghcType
@@ -354,7 +353,7 @@ getTypeDocs ctx@DocCtx{..} (DeclData (L _ (TyClD _ decl)) doc)
         let ad_name = Typename . packRdrName $ unLoc tcdLName
             ad_descr = doc
             ad_args = map (tyVarText . unLoc) $ hsq_explicit tcdTyVars
-            ad_anchor = Just $ typeAnchor dc_modname ad_name
+            ad_anchor = Just $ ag_typeAnchor (eo_anchorGenerators dc_extractOptions) dc_modname ad_name
             ad_rhs = fromMaybe unknownType $ do
                 tycon <- MS.lookup ad_name dc_tycons
                 rhs <- synTyConRhs_maybe tycon
@@ -366,15 +365,15 @@ getTypeDocs ctx@DocCtx{..} (DeclData (L _ (TyClD _ decl)) doc)
         let ad_name = Typename . packRdrName $ unLoc tcdLName
             ad_descr = doc
             ad_args = map (tyVarText . unLoc) $ hsq_explicit tcdTyVars
-            ad_anchor = Just $ typeAnchor dc_modname ad_name
+            ad_anchor = Just $ ag_typeAnchor (eo_anchorGenerators dc_extractOptions) dc_modname ad_name
             ad_constrs = map constrDoc . dd_cons $ tcdDataDefn
             ad_instances = Nothing -- filled out later in 'distributeInstanceDocs'
         Just (ad_name, ADTDoc {..})
   where
     constrDoc :: LConDecl GhcPs -> ADTConstr
     constrDoc (L _ con) =
         let ac_name = Typename . packRdrName . unLoc $ con_name con
-            ac_anchor = Just $ constrAnchor dc_modname ac_name
+            ac_anchor = Just $ ag_constrAnchor (eo_anchorGenerators dc_extractOptions) dc_modname ac_name
             ac_descr = fmap (docToText . unLoc) $ con_doc con
             ac_args =
                 case MS.lookup ac_name dc_datacons of
@@ -395,7 +394,7 @@ getTypeDocs ctx@DocCtx{..} (DeclData (L _ (TyClD _ decl)) doc)
     fieldDoc :: (DDoc.Type, LConDeclField GhcPs) -> Maybe FieldDoc
     fieldDoc (fd_type, L _ ConDeclField{..}) = do
         let fd_name = Fieldname . T.concat . map (packFieldOcc . unLoc) $ cd_fld_names
-            fd_anchor = Just $ functionAnchor dc_modname fd_name
+            fd_anchor = Just $ ag_functionAnchor (eo_anchorGenerators dc_extractOptions) dc_modname fd_name
             fd_descr = fmap (docToText . unLoc) cd_fld_doc
         Just FieldDoc{..}
     fieldDoc (_, L _ XConDeclField{}) = Nothing

sdk/compiler/damlc/daml-doc/src/DA/Daml/Doc/Extract/Types.hs

@@ -12,6 +12,7 @@ module DA.Daml.Doc.Extract.Types
     ) where
 
 import DA.Daml.Doc.Types
+import DA.Daml.Doc.Anchor
 
 import qualified Data.Map.Strict as MS
 import qualified Data.Set as Set
@@ -23,7 +24,9 @@ data ExtractOptions = ExtractOptions
         -- ^ qualify non-local types
     , eo_simplifyQualifiedTypes :: Bool
         -- ^ drop common module prefix when qualifying types
-    } deriving (Eq, Show, Read)
+    , eo_anchorGenerators :: AnchorGenerators
+        -- ^ Generation of anchors, needed for multi-ide doc generation
+    } deriving (Eq, Show)
 
 data QualifyTypes
     = QualifyTypesAlways
@@ -36,6 +39,7 @@ defaultExtractOptions :: ExtractOptions
 defaultExtractOptions = ExtractOptions
     { eo_qualifyTypes = QualifyTypesNever
     , eo_simplifyQualifiedTypes = False
+    , eo_anchorGenerators = defaultAnchorGenerators
     }
 
 -- | Context in which to extract a module's docs. This is created from

sdk/compiler/damlc/daml-doc/src/DA/Daml/Doc/Extract/Util.hs

@@ -6,7 +6,6 @@ module DA.Daml.Doc.Extract.Util
     ) where
 
 import DA.Daml.Doc.Types
-import DA.Daml.Doc.Anchor
 import DA.Daml.Doc.Extract.Types
 
 import Control.Monad (guard)
@@ -115,8 +114,8 @@ tyConAnchor DocCtx{..} tycon = do
         name = Typename . packName $ ghcName
         mod = maybe dc_modname getModulename (nameModule_maybe ghcName)
         anchorFn
-            | isClassTyCon tycon = classAnchor
-            | otherwise = typeAnchor
+            | isClassTyCon tycon = ag_classAnchor (eo_anchorGenerators dc_extractOptions)
+            | otherwise = ag_typeAnchor (eo_anchorGenerators dc_extractOptions)
     Just (anchorFn mod name)
 
 -- | Create a (possibly external) reference from a TyCon.

sdk/compiler/damlc/daml-doc/src/DA/Daml/Doc/Render.hs

@@ -64,11 +64,11 @@ renderDocs ro@RenderOptions{..} mods = do
                 . T.encodeUtf8
                 . renderTemplate ro template
                 . postProcessing
-                . renderPage formatter externalAnchors
+                . renderPage formatter externalAnchors ro_anchorGenerators
                 $ fold renderMap
 
         RenderToFolder path -> do
-            let (outputIndex, outputMap) = renderFolder formatter externalAnchors ro_globalInternalExt renderMap
+            let (outputIndex, outputMap) = renderFolder formatter externalAnchors ro_anchorGenerators ro_globalInternalExt renderMap
                 extension =
                     case ro_format of
                         Markdown -> "md"

sdk/compiler/damlc/daml-doc/src/DA/Daml/Doc/Render/Markdown.hs

@@ -27,7 +27,7 @@ renderMd env = \case
     RenderAnchor anchor -> [anchorTag anchor]
     RenderIndex moduleNames ->
         [ "*" <-> renderMdLink env
-                (Reference Nothing (moduleAnchor moduleName))
+                (Reference Nothing (ag_moduleAnchor (re_anchorGenerators env) moduleName))
                 (unModulename moduleName)
         | moduleName <- moduleNames
         ]