Skip to content

Commit f568fa2

Browse files
committed
ghcide: Core.Compile: getDocsBatch: give explicit GetDocsFailure
Showing error should be explicit, & conversion of error type should be a separate handling. This would also allow to establish proper processing for all these exception types.
1 parent a5ae696 commit f568fa2

File tree

2 files changed

+6
-18
lines changed

2 files changed

+6
-18
lines changed

ghcide/src/Development/IDE/Core/Compile.hs

Lines changed: 5 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,6 @@ import Development.IDE.GHC.Error
3939
import Development.IDE.GHC.Orphans ()
4040
import Development.IDE.GHC.Util
4141
import Development.IDE.GHC.Warnings
42-
import Development.IDE.Spans.Common
4342
import Development.IDE.Types.Diagnostics
4443
import Development.IDE.Types.Location
4544
import Development.IDE.Types.Options
@@ -75,7 +74,7 @@ import Control.Lens hiding (List)
7574
import Control.Monad.Except
7675
import Control.Monad.Extra
7776
import Control.Monad.Trans.Except
78-
import Data.Bifunctor (first, second)
77+
import Data.Bifunctor (second)
7978
import qualified Data.ByteString as BS
8079
import qualified Data.DList as DL
8180
import Data.IORef
@@ -104,6 +103,7 @@ import Data.Functor
104103
import qualified Data.HashMap.Strict as HashMap
105104
import Data.Map (Map)
106105
import Data.Tuple.Extra (dupe)
106+
import Data.Either.Extra (maybeToEither)
107107
import Data.Unique as Unique
108108
import Development.IDE.Core.Tracing (withTrace)
109109
import Development.IDE.GHC.Compat.Util (emptyUDFM, plusUDFM)
@@ -994,20 +994,11 @@ getDocsBatch
994994
:: HscEnv
995995
-> Module -- ^ a moudle where the names are in scope
996996
-> [Name]
997-
-> IO (Either ErrorMessages (Map.Map Name (Either T.Text (Maybe HsDocString, Maybe (Map.Map Int HsDocString)))))
997+
-> IO (Either ErrorMessages (Map.Map Name (Either GetDocsFailure (Maybe HsDocString, Maybe (Map.Map Int HsDocString)))))
998998
getDocsBatch hsc_env _mod _names = do
999999
((_warns,errs), res) <- initTc hsc_env HsSrcFile False _mod fakeSpan $ Map.fromList <$> traverse findNameInfo _names
1000-
pure $ case res of
1001-
Just x -> pure $ fun x
1002-
Nothing -> Left errs
1003-
where
1004-
fun :: Map.Map Name (Either GetDocsFailure c) -> Map.Map Name (Either T.Text c)
1005-
fun =
1006-
Map.map fun1
1007-
where
1008-
fun1 :: Either GetDocsFailure c -> Either T.Text c
1009-
fun1 = first showGhc
1010-
1000+
pure $ maybeToEither errs res
1001+
where
10111002
findNameInfo :: Name -> IOEnv (Env TcGblEnv TcLclEnv) (Name, Either GetDocsFailure (Maybe HsDocString, Maybe (Map.Map Int HsDocString)))
10121003
findNameInfo name =
10131004
case nameModule_maybe name of

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

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -69,14 +69,11 @@ getDocumentationTryGhc env mod n = fromJust . Map.lookup n <$> getDocumentations
6969

7070
getDocumentationsTryGhc :: HscEnv -> Module -> [Name] -> IO (Map.Map Name SpanDoc)
7171
getDocumentationsTryGhc env mod names = do
72-
res <- fun
72+
res <- getDocsBatch env mod names
7373
case res of
7474
Left _ -> return mempty -- catchSrcErrors (hsc_dflags env) "docs"
7575
Right res -> sequenceA $ Map.mapWithKey unwrap res
7676
where
77-
fun :: IO (Either ErrorMessages (Map.Map Name (Either T.Text (Maybe HsDocString, Maybe (Map.Map Int HsDocString)))))
78-
fun = getDocsBatch env mod names
79-
8077
unwrap :: Name -> Either a (Maybe HsDocString, b) -> IO SpanDoc
8178
unwrap name a = extractDocString a <$> getSpanDocUris name
8279
where

0 commit comments

Comments
 (0)