Generate doc file URL via LSP (to fix it for Windows) (#721)

* use three slashes in doc file URLs to fix it for Windows

* generate normalized doc file URL using LSP
This commit is contained in:
Nick Dunets 2020-09-03 06:06:28 +12:00 committed by GitHub
parent 0350c7f97e
commit cf5df3c467
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 9 additions and 7 deletions

View File

@ -31,6 +31,7 @@ import SrcLoc (RealLocated)
import GhcMonad import GhcMonad
import Packages import Packages
import Name import Name
import Language.Haskell.LSP.Types (getUri, filePathToUri)
getDocumentationTryGhc :: GhcMonad m => Module -> [ParsedModule] -> Name -> m SpanDoc getDocumentationTryGhc :: GhcMonad m => Module -> [ParsedModule] -> Name -> m SpanDoc
getDocumentationTryGhc mod deps n = head <$> getDocumentationsTryGhc mod deps [n] getDocumentationTryGhc mod deps n = head <$> getDocumentationsTryGhc mod deps [n]
@ -55,24 +56,25 @@ getDocumentationsTryGhc _ sources names = mapM mkSpanDocText names
#endif #endif
mkSpanDocText name = mkSpanDocText name =
pure (SpanDocText (getDocumentation sources name)) <*> getUris name pure (SpanDocText (getDocumentation sources name)) <*> getUris name
-- Get the uris to the documentation and source html pages if they exist -- Get the uris to the documentation and source html pages if they exist
getUris name = do getUris name = do
df <- getSessionDynFlags df <- getSessionDynFlags
(docFp, srcFp) <- (docFu, srcFu) <-
case nameModule_maybe name of case nameModule_maybe name of
Just mod -> liftIO $ do Just mod -> liftIO $ do
doc <- fmap (fmap T.pack) $ lookupDocHtmlForModule df mod doc <- toFileUriText $ lookupDocHtmlForModule df mod
src <- fmap (fmap T.pack) $ lookupSrcHtmlForModule df mod src <- toFileUriText $ lookupSrcHtmlForModule df mod
return (doc, src) return (doc, src)
Nothing -> pure (Nothing, Nothing) Nothing -> pure (Nothing, Nothing)
let docUri = docFp >>= \fp -> pure $ "file://" <> fp <> "#" <> selector <> showName name let docUri = (<> "#" <> selector <> showName name) <$> docFu
srcUri = srcFp >>= \fp -> pure $ "file://" <> fp <> "#" <> showName name srcUri = (<> "#" <> showName name) <$> srcFu
selector selector
| isValName name = "v:" | isValName name = "v:"
| otherwise = "t:" | otherwise = "t:"
return $ SpanDocUris docUri srcUri return $ SpanDocUris docUri srcUri
toFileUriText = (fmap . fmap) (getUri . filePathToUri)
getDocumentation getDocumentation
:: HasSrcSpan name :: HasSrcSpan name

View File

@ -2033,7 +2033,7 @@ findDefinitionAndHoverTests = let
lstL43 = Position 47 12 ; litL = [ExpectHoverText ["[8391 :: Int, 6268]"]] lstL43 = Position 47 12 ; litL = [ExpectHoverText ["[8391 :: Int, 6268]"]]
outL45 = Position 49 3 ; outSig = [ExpectHoverText ["outer", "Bool"], mkR 46 0 46 5] outL45 = Position 49 3 ; outSig = [ExpectHoverText ["outer", "Bool"], mkR 46 0 46 5]
innL48 = Position 52 5 ; innSig = [ExpectHoverText ["inner", "Char"], mkR 49 2 49 7] innL48 = Position 52 5 ; innSig = [ExpectHoverText ["inner", "Char"], mkR 49 2 49 7]
cccL17 = Position 17 11 ; docLink = [ExpectHoverText ["[Documentation](file://"]] cccL17 = Position 17 11 ; docLink = [ExpectHoverText ["[Documentation](file:///"]]
#if MIN_GHC_API_VERSION(8,6,0) #if MIN_GHC_API_VERSION(8,6,0)
imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3] imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3]
reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 0 3 14] reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 0 3 14]