@@ -73,32 +73,37 @@ getDocumentationsTryGhc env mod names = do
73
73
res <- fun
74
74
case res of
75
75
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
77
77
where
78
78
fun :: IO (Either [FileDiagnostic ] (Map. Map Name (Either String (Maybe HsDocString , Map. Map Int HsDocString ))))
79
79
fun = catchSrcErrors (hsc_dflags env) " docs" $ getDocsBatch env mod names
80
80
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)
102
107
103
108
getDocumentation
104
109
:: HasSrcSpan name
@@ -165,7 +170,7 @@ getDocumentation sources targetName = fromMaybe [] $ do
165
170
docHeaders :: [RealLocated AnnotationComment ]
166
171
-> [T. Text ]
167
172
docHeaders = mapMaybe (\ (L _ x) -> wrk x)
168
- where
173
+ where
169
174
wrk = \ case
170
175
-- When `Opt_Haddock` is enabled.
171
176
AnnDocCommentNext s -> Just $ T. pack s
0 commit comments