Skip to content

Commit 32f9de1

Browse files
committed
Development.IDE.Spans.Documentation: getDocumentationsTryGhc: structure
Make code easier to reason about & functionally enhancable.
1 parent 480aa51 commit 32f9de1

File tree

1 file changed

+28
-23
lines changed

1 file changed

+28
-23
lines changed

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

Lines changed: 28 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -73,32 +73,37 @@ getDocumentationsTryGhc env mod names = do
7373
res <- fun
7474
case res of
7575
Left _ -> return mempty
76-
Right res -> fmap Map.fromList $ sequenceA $ unwrap <$> Map.toList res
76+
Right res -> fmap Map.fromList $ sequenceA $ uncurry unwrap <$> Map.toList res
7777
where
7878
fun :: IO (Either [FileDiagnostic] (Map.Map Name (Either String (Maybe HsDocString, Map.Map Int HsDocString))))
7979
fun = catchSrcErrors (hsc_dflags env) "docs" $ getDocsBatch env mod names
8080

81-
unwrap :: (Name, Either a (Maybe HsDocString, b)) -> IO (Name, SpanDoc)
82-
unwrap (name, Right (Just docs, _)) = (name,) . SpanDocString docs <$> getUris name
83-
unwrap (name, _) = (name,) . SpanDocText mempty <$> getUris name
84-
85-
-- Get the uris to the documentation and source html pages if they exist
86-
getUris name = do
87-
(docFu, srcFu) <-
88-
case nameModule_maybe name of
89-
Just mod -> liftIO $ do
90-
doc <- toFileUriText $ lookupDocHtmlForModule env mod
91-
src <- toFileUriText $ lookupSrcHtmlForModule env mod
92-
return (doc, src)
93-
Nothing -> pure (Nothing, Nothing)
94-
let docUri = (<> "#" <> selector <> showNameWithoutUniques name) <$> docFu
95-
srcUri = (<> "#" <> showNameWithoutUniques name) <$> srcFu
96-
selector
97-
| isValName name = "v:"
98-
| otherwise = "t:"
99-
return $ SpanDocUris docUri srcUri
100-
101-
toFileUriText = (fmap . fmap) (getUri . filePathToUri)
81+
unwrap :: Name -> Either a (Maybe HsDocString, b) -> IO (Name, SpanDoc)
82+
unwrap name a = (name,) . extractDocString a <$> getSpanDocUris name
83+
where
84+
extractDocString :: Either b1 (Maybe HsDocString, b2) -> SpanDocUris -> SpanDoc
85+
extractDocString (Right (Just docs, _)) = SpanDocString docs
86+
extractDocString _ = SpanDocText mempty
87+
88+
-- | Get the uris to the documentation and source html pages if they exist
89+
getSpanDocUris :: Name -> IO SpanDocUris
90+
getSpanDocUris name = do
91+
(docFu, srcFu) <-
92+
case nameModule_maybe name of
93+
Just mod -> liftIO $ do
94+
doc <- toFileUriText $ lookupDocHtmlForModule env mod
95+
src <- toFileUriText $ lookupSrcHtmlForModule env mod
96+
return (doc, src)
97+
Nothing -> pure mempty
98+
let docUri = (<> "#" <> selector <> showNameWithoutUniques name) <$> docFu
99+
srcUri = (<> "#" <> showNameWithoutUniques name) <$> srcFu
100+
selector
101+
| isValName name = "v:"
102+
| otherwise = "t:"
103+
return $ SpanDocUris docUri srcUri
104+
where
105+
toFileUriText :: IO (Maybe FilePath) -> IO (Maybe T.Text)
106+
toFileUriText = (fmap . fmap) (getUri . filePathToUri)
102107

103108
getDocumentation
104109
:: HasSrcSpan name
@@ -165,7 +170,7 @@ getDocumentation sources targetName = fromMaybe [] $ do
165170
docHeaders :: [RealLocated AnnotationComment]
166171
-> [T.Text]
167172
docHeaders = mapMaybe (\(L _ x) -> wrk x)
168-
where
173+
where
169174
wrk = \case
170175
-- When `Opt_Haddock` is enabled.
171176
AnnDocCommentNext s -> Just $ T.pack s

0 commit comments

Comments
 (0)