Skip to content

Commit 54afb31

Browse files
pepeiborramergify[bot]berberman
authored
ghcide - enable ApplicativeDo everywhere (#1667)
* ghcide - enable ApplicativeDo everywhere ApplicativeDo created type errors in some modules, disabled locally with NoApplicativeDo * replace par with applicative parallelism * missing file * redundant import * export list * fix build Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> Co-authored-by: Potato Hatsue <[email protected]>
1 parent c67b233 commit 54afb31

File tree

9 files changed

+206
-181
lines changed

9 files changed

+206
-181
lines changed

‎ghcide/ghcide.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -111,6 +111,7 @@ library
111111
cbits/getmodtime.c
112112

113113
default-extensions:
114+
ApplicativeDo
114115
BangPatterns
115116
DeriveFunctor
116117
DeriveGeneric
@@ -140,6 +141,7 @@ library
140141
Control.Concurrent.Strict
141142
Development.IDE
142143
Development.IDE.Main
144+
Development.IDE.Core.Actions
143145
Development.IDE.Core.Debouncer
144146
Development.IDE.Core.FileStore
145147
Development.IDE.Core.IdeConfiguration

‎ghcide/src/Development/IDE.hs

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -6,18 +6,20 @@ module Development.IDE
66

77
) where
88

9+
import Development.IDE.Core.Actions as X (getAtPoint,
10+
getDefinition,
11+
getTypeDefinition,
12+
useE, useNoFileE,
13+
usesE)
914
import Development.IDE.Core.FileExists as X (getFileExists)
1015
import Development.IDE.Core.FileStore as X (getFileContents)
1116
import Development.IDE.Core.IdeConfiguration as X (IdeConfiguration (..),
1217
isWorkspaceFile)
1318
import Development.IDE.Core.OfInterest as X (getFilesOfInterest)
1419
import Development.IDE.Core.RuleTypes as X
1520
import Development.IDE.Core.Rules as X (IsHiFileStable (..),
16-
getAtPoint,
1721
getClientConfigAction,
18-
getDefinition,
19-
getParsedModule,
20-
getTypeDefinition)
22+
getParsedModule)
2123
import Development.IDE.Core.Service as X (runAction)
2224
import Development.IDE.Core.Shake as X (FastResult (..),
2325
IdeAction (..),

‎ghcide/src/Development/IDE/Core/Actions.hs

Lines changed: 127 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,127 @@
1+
{-# LANGUAGE NoApplicativeDo #-}
2+
{-# LANGUAGE TypeFamilies #-}
3+
module Development.IDE.Core.Actions
4+
( getAtPoint
5+
, getDefinition
6+
, getTypeDefinition
7+
, highlightAtPoint
8+
, refsAtPoint
9+
, useE
10+
, useNoFileE
11+
, usesE
12+
, workspaceSymbols
13+
) where
14+
15+
import Control.Monad.Reader
16+
import Control.Monad.Trans.Maybe
17+
import qualified Data.HashMap.Strict as HM
18+
import Data.Maybe
19+
import qualified Data.Text as T
20+
import Data.Tuple.Extra
21+
import Development.IDE.Core.OfInterest
22+
import Development.IDE.Core.PositionMapping
23+
import Development.IDE.Core.RuleTypes
24+
import Development.IDE.Core.Service
25+
import Development.IDE.Core.Shake
26+
import Development.IDE.GHC.Compat hiding (TargetFile,
27+
TargetModule,
28+
parseModule,
29+
typecheckModule,
30+
writeHieFile)
31+
import qualified Development.IDE.Spans.AtPoint as AtPoint
32+
import Development.IDE.Types.Location
33+
import Development.Shake hiding (Diagnostic)
34+
import qualified HieDb
35+
import Language.LSP.Types (DocumentHighlight (..),
36+
SymbolInformation (..))
37+
38+
39+
-- | Eventually this will lookup/generate URIs for files in dependencies, but not in the
40+
-- project. Right now, this is just a stub.
41+
lookupMod
42+
:: HieDbWriter -- ^ access the database
43+
-> FilePath -- ^ The `.hie` file we got from the database
44+
-> ModuleName
45+
-> UnitId
46+
-> Bool -- ^ Is this file a boot file?
47+
-> MaybeT IdeAction Uri
48+
lookupMod _dbchan _hie_f _mod _uid _boot = MaybeT $ pure Nothing
49+
50+
51+
-- IMPORTANT NOTE : make sure all rules `useE`d by these have a "Persistent Stale" rule defined,
52+
-- so we can quickly answer as soon as the IDE is opened
53+
-- Even if we don't have persistent information on disk for these rules, the persistent rule
54+
-- should just return an empty result
55+
-- It is imperative that the result of the persistent rule succeed in such a case, or we will
56+
-- block waiting for the rule to be properly computed.
57+
58+
-- | Try to get hover text for the name under point.
59+
getAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe (Maybe Range, [T.Text]))
60+
getAtPoint file pos = runMaybeT $ do
61+
ide <- ask
62+
opts <- liftIO $ getIdeOptionsIO ide
63+
64+
(hf, mapping) <- useE GetHieAst file
65+
dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> (runMaybeT $ useE GetDocMap file)
66+
67+
!pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
68+
MaybeT $ pure $ fmap (first (toCurrentRange mapping =<<)) $ AtPoint.atPoint opts hf dkMap pos'
69+
70+
toCurrentLocations :: PositionMapping -> [Location] -> [Location]
71+
toCurrentLocations mapping = mapMaybe go
72+
where
73+
go (Location uri range) = Location uri <$> toCurrentRange mapping range
74+
75+
-- | useE is useful to implement functions that aren’t rules but need shortcircuiting
76+
-- e.g. getDefinition.
77+
useE :: IdeRule k v => k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
78+
useE k = MaybeT . useWithStaleFast k
79+
80+
useNoFileE :: IdeRule k v => IdeState -> k -> MaybeT IdeAction v
81+
useNoFileE _ide k = fst <$> useE k emptyFilePath
82+
83+
usesE :: IdeRule k v => k -> [NormalizedFilePath] -> MaybeT IdeAction [(v,PositionMapping)]
84+
usesE k = MaybeT . fmap sequence . mapM (useWithStaleFast k)
85+
86+
-- | Goto Definition.
87+
getDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
88+
getDefinition file pos = runMaybeT $ do
89+
ide <- ask
90+
opts <- liftIO $ getIdeOptionsIO ide
91+
(HAR _ hf _ _ _, mapping) <- useE GetHieAst file
92+
(ImportMap imports, _) <- useE GetImportMap file
93+
!pos' <- MaybeT (pure $ fromCurrentPosition mapping pos)
94+
hiedb <- lift $ asks hiedb
95+
dbWriter <- lift $ asks hiedbWriter
96+
toCurrentLocations mapping <$> AtPoint.gotoDefinition hiedb (lookupMod dbWriter) opts imports hf pos'
97+
98+
getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
99+
getTypeDefinition file pos = runMaybeT $ do
100+
ide <- ask
101+
opts <- liftIO $ getIdeOptionsIO ide
102+
(hf, mapping) <- useE GetHieAst file
103+
!pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
104+
hiedb <- lift $ asks hiedb
105+
dbWriter <- lift $ asks hiedbWriter
106+
toCurrentLocations mapping <$> AtPoint.gotoTypeDefinition hiedb (lookupMod dbWriter) opts hf pos'
107+
108+
highlightAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe [DocumentHighlight])
109+
highlightAtPoint file pos = runMaybeT $ do
110+
(HAR _ hf rf _ _,mapping) <- useE GetHieAst file
111+
!pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
112+
let toCurrentHighlight (DocumentHighlight range t) = flip DocumentHighlight t <$> toCurrentRange mapping range
113+
mapMaybe toCurrentHighlight <$>AtPoint.documentHighlight hf rf pos'
114+
115+
-- Refs are not an IDE action, so it is OK to be slow and (more) accurate
116+
refsAtPoint :: NormalizedFilePath -> Position -> Action [Location]
117+
refsAtPoint file pos = do
118+
ShakeExtras{hiedb} <- getShakeExtras
119+
fs <- HM.keys <$> getFilesOfInterest
120+
asts <- HM.fromList . mapMaybe sequence . zip fs <$> usesWithStale GetHieAst fs
121+
AtPoint.referencesAtPoint hiedb file pos (AtPoint.FOIReferences asts)
122+
123+
workspaceSymbols :: T.Text -> IdeAction (Maybe [SymbolInformation])
124+
workspaceSymbols query = runMaybeT $ do
125+
hiedb <- lift $ asks hiedb
126+
res <- liftIO $ HieDb.searchDef hiedb $ T.unpack query
127+
pure $ mapMaybe AtPoint.defRowToSymbolInfo res

‎ghcide/src/Development/IDE/Core/OfInterest.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -98,7 +98,7 @@ kick = do
9898
liftIO $ progressUpdate KickStarted
9999

100100
-- Update the exports map for FOIs
101-
(results, ()) <- par (uses GenerateCore files) (void $ uses GetHieAst files)
101+
results <- uses GenerateCore files <* uses GetHieAst files
102102

103103
-- Update the exports map for non FOIs
104104
-- We can skip this if checkProject is True, assuming they never change under our feet.

0 commit comments

Comments
 (0)