ghcide: Documentation: getDocumentationTryGhc: implement for 1 elem

Author: Anton-Latukha

ghcide/src/Development/IDE/Spans/Documentation.hs

@@ -12,7 +12,6 @@ module Development.IDE.Spans.Documentation (
   , mkDocMap
   ) where
 
-import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Extra            (findM)
 import           Data.Bool                      (bool)
@@ -70,7 +69,44 @@ lookupKind env mod =
 
 getDocumentationTryGhc :: HscEnv -> Module -> Name -> IO SpanDoc
 --  2021-11-17: FIXME: Code uses batch search for singleton & assumes that search always succeeds.
-getDocumentationTryGhc env mod n = fromJust . M.lookup n <$> getDocumentationsTryGhc env mod [n]
+getDocumentationTryGhc env mod = fun
+ where
+  fun :: Name -> IO SpanDoc
+  fun name = do
+    res <- getDocsNonInteractive env mod name
+    case res of
+        Left _    -> pure emptySpanDoc -- catchSrcErrors (hsc_dflags env) "docs"
+        Right res -> uncurry unwrap res
+      where
+        unwrap :: Name -> Either a (Maybe HsDocString, b) -> IO SpanDoc
+        unwrap name a = extractDocString a <$> getSpanDocUris name
+          where
+            extractDocString :: Either b1 (Maybe HsDocString, b2) -> SpanDocUris -> SpanDoc
+            --  2021-11-17: FIXME: ArgDocs get dropped here - instead propagate them.
+            extractDocString (Right (Just docs, _)) = SpanDocString docs
+            extractDocString _ = SpanDocText mempty
+
+            -- | Get the uris to the documentation and source html pages if they exist
+            getSpanDocUris :: Name -> IO SpanDocUris
+            getSpanDocUris name = do
+                (docFu, srcFu) <-
+                    case nameModule_maybe name of
+                    Just mod -> liftIO $ do
+                        let
+                            toUriFileText :: (HscEnv -> Module -> IO (Maybe FilePath)) -> IO (Maybe T.Text)
+                            toUriFileText f = (fmap . fmap) (getUri . filePathToUri) $ f env mod
+                        doc <- toUriFileText lookupDocHtmlForModule
+                        src <- toUriFileText lookupSrcHtmlForModule
+                        return (doc, src)
+                    Nothing -> pure mempty
+                let
+                    embelishUri :: Functor f => T.Text -> f T.Text -> f T.Text
+                    embelishUri f = fmap (<> "#" <> f <> showNameWithoutUniques name)
+
+                    docUri = embelishUri (bool "t:" "v:" $ isValName name) docFu
+                    srcUri = embelishUri mempty srcFu
+
+                return $ SpanDocUris docUri srcUri
 
 getDocumentationsTryGhc :: HscEnv -> Module -> [Name] -> IO (M.Map Name SpanDoc)
 getDocumentationsTryGhc env mod names = do