@@ -13,7 +13,7 @@ module Development.IDE.State.Rules(
13 IdeState, GetDependencies(..), GetParsedModule(..), TransitiveDependencies(..),
13 IdeState, GetDependencies(..), GetParsedModule(..), TransitiveDependencies(..),
14 Priority(..),
14 Priority(..),
15 runAction, runActions, useE, usesE,
15 runAction, runActions, useE, usesE,
16− toIdeResultNew, defineNoFile,
16+ toIdeResult, defineNoFile,
18 getGhcCore,
18 getGhcCore,
19 getAtPoint,
19 getAtPoint,
@@ -25,7 +25,7 @@ module Development.IDE.State.Rules(
27import Control.Monad.Except
27import Control.Monad.Except
28−import Control.Monad.Extra (whenJust)
28+import Control.Monad.Trans.Maybe
29import qualified Development.IDE.Functions.Compile as Compile
29import qualified Development.IDE.Functions.Compile as Compile
30import qualified Development.IDE.Types.Options as Compile
30import qualified Development.IDE.Types.Options as Compile
31import Development.IDE.Functions.DependencyInformation
31import Development.IDE.Functions.DependencyInformation
@@ -57,15 +57,19 @@ import qualified Development.IDE.Functions.AtPoint as AtPoint
57import Development.IDE.State.Service
57import Development.IDE.State.Service
58import Development.IDE.State.Shake
58import Development.IDE.State.Shake
60−-- LEGACY STUFF ON THE OLD STYLE
60+-- | This is useful for rules to convert rules that can only produce errors or
61+-- a result into the more general IdeResult type that supports producing
62+-- warnings while also producing a result.
63+toIdeResult :: Either [FileDiagnostic] v -> IdeResult v
64+toIdeResult = either (, Nothing) (([],) . Just)
62−toIdeResultNew :: Either [FileDiagnostic] v -> IdeResult v
66+-- | useE is useful to implement functions that aren’t rules but need shortcircuiting
63−toIdeResultNew = either (, Nothing) (([],) . Just)
67+-- e.g. getDefinition.
64−
68+useE :: IdeRule k v => k -> NormalizedFilePath -> MaybeT Action v
65−-- Convert to a legacy Ide result but dropping dependencies
69+useE k = MaybeT . use k
66−toIdeResultSilent :: Maybe v -> Either [FileDiagnostic] v
67−toIdeResultSilent val = maybe (Left []) Right val
71+usesE :: IdeRule k v => k -> [NormalizedFilePath] -> MaybeT Action [v]
72+usesE k = MaybeT . fmap sequence . uses k
70defineNoFile :: IdeRule k v => (k -> Action v) -> Rules ()
74defineNoFile :: IdeRule k v => (k -> Action v) -> Rules ()
71defineNoFile f = define $ \k file -> do
75defineNoFile f = define $ \k file -> do
@@ -85,13 +89,9 @@ getFilesOfInterestRule = do
85 pure (Just $ BS.fromString $ show filesOfInterest, ([], Just filesOfInterest))
89 pure (Just $ BS.fromString $ show filesOfInterest, ([], Just filesOfInterest))
88−-- | Get GHC Core for the supplied file.
89−getGhcCore :: NormalizedFilePath -> Action (Maybe [CoreModule])
90−getGhcCore file = eitherToMaybe <$> runExceptT (coresForFile file)
92-- | Generate the GHC Core for the supplied file and its dependencies.
92-- | Generate the GHC Core for the supplied file and its dependencies.
93−coresForFile :: NormalizedFilePath -> ExceptT [FileDiagnostic] Action [CoreModule]
93+getGhcCore :: NormalizedFilePath -> Action (Maybe [CoreModule])
94−coresForFile file = do
94+getGhcCore file = runMaybeT $ do
95 files <- transitiveModuleDeps <$> useE GetDependencies file
95 files <- transitiveModuleDeps <$> useE GetDependencies file
96 pms <- usesE GetParsedModule $ files ++ [file]
96 pms <- usesE GetParsedModule $ files ++ [file]
97 cores <- usesE GenerateCore $ map fileFromParsedModule pms
97 cores <- usesE GenerateCore $ map fileFromParsedModule pms
@@ -102,62 +102,31 @@ coresForFile file = do
102-- | Get all transitive file dependencies of a given module.
102-- | Get all transitive file dependencies of a given module.
103-- Does not include the file itself.
103-- Does not include the file itself.
104getDependencies :: NormalizedFilePath -> Action (Maybe [NormalizedFilePath])
104getDependencies :: NormalizedFilePath -> Action (Maybe [NormalizedFilePath])
105−getDependencies file =
107− (runExceptT $ transitiveModuleDeps <$> useE GetDependencies file)
105+getDependencies file = fmap transitiveModuleDeps <$> use GetDependencies file
109getDalfDependencies :: NormalizedFilePath -> Action (Maybe [InstalledUnitId])
107getDalfDependencies :: NormalizedFilePath -> Action (Maybe [InstalledUnitId])
110−getDalfDependencies file =
112− (runExceptT $ transitivePkgDeps <$> useE GetDependencies file)
108+getDalfDependencies file = fmap transitivePkgDeps <$> use GetDependencies file
114−-- | Documentation at point.
110+-- | -- | Try to get hover text for the name under point.
115getAtPoint :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [HoverText]))
111getAtPoint :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [HoverText]))
116−getAtPoint file pos = do
112+getAtPoint file pos = fmap join $ runMaybeT $ do
117− fmap (either (const Nothing) id) . runExceptT $ getAtPointForFile file pos
119−-- | Goto Definition.
120−getDefinition :: NormalizedFilePath -> Position -> Action (Maybe Location)
121−getDefinition file pos = do
122− fmap (either (const Nothing) id) . runExceptT $ getDefinitionForFile file pos
124−-- | Parse the contents of a daml file.
125−getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)
126−getParsedModule file =
127− eitherToMaybe <$> (runExceptT $ useE GetParsedModule file)
129−------------------------------------------------------------
134− => k -> NormalizedFilePath -> ExceptT [FileDiagnostic] Action v
135−useE k = ExceptT . fmap toIdeResultSilent . use k
137−-- picks the first error
140− => k -> [NormalizedFilePath] -> ExceptT [FileDiagnostic] Action [v]
141−usesE k = ExceptT . fmap (mapM toIdeResultSilent) . uses k
143−-- | Try to get hover text for the name under point.
145− :: NormalizedFilePath
147− -> ExceptT [FileDiagnostic] Action (Maybe (Maybe Range, [HoverText]))
148−getAtPointForFile file pos = do
149 files <- transitiveModuleDeps <$> useE GetDependencies file
113 files <- transitiveModuleDeps <$> useE GetDependencies file
150 tms <- usesE TypeCheck (file : files)
114 tms <- usesE TypeCheck (file : files)
151− spans <- useE GetSpanInfo file
115+ spans <- useE GetSpanInfo file
152 return $ AtPoint.atPoint (map Compile.tmrModule tms) spans pos
116 return $ AtPoint.atPoint (map Compile.tmrModule tms) spans pos
118+-- | Goto Definition.
154−getDefinitionForFile :: NormalizedFilePath -> Position -> ExceptT [FileDiagnostic] Action (Maybe Location)
119+getDefinition :: NormalizedFilePath -> Position -> Action (Maybe Location)
155−getDefinitionForFile file pos = do
120+getDefinition file pos = fmap join $ runMaybeT $ do
156 spans <- useE GetSpanInfo file
121 spans <- useE GetSpanInfo file
157 pkgState <- useE GhcSession ""
122 pkgState <- useE GhcSession ""
158 opts <- lift getOpts
123 opts <- lift getOpts
159 lift $ AtPoint.gotoDefinition opts pkgState spans pos
124 lift $ AtPoint.gotoDefinition opts pkgState spans pos
126+-- | Parse the contents of a daml file.
127+getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)
128+getParsedModule file = use GetParsedModule file
161getOpts :: Action Compile.IdeOptions
130getOpts :: Action Compile.IdeOptions
162getOpts = envOptions <$> getServiceEnv
131getOpts = envOptions <$> getServiceEnv
@@ -227,22 +196,22 @@ rawDependencyInformation f = go (Set.singleton f) Map.empty Map.empty
228getDependencyInformationRule :: Rules ()
197getDependencyInformationRule :: Rules ()
229getDependencyInformationRule =
198getDependencyInformationRule =
230− define $ \GetDependencyInformation file -> fmap toIdeResultNew $ runExceptT $ do
199+ define $ \GetDependencyInformation file -> fmap toIdeResult $ runExceptT $ do
231 rawDepInfo <- rawDependencyInformation file
200 rawDepInfo <- rawDependencyInformation file
232 pure $ processDependencyInformation rawDepInfo
201 pure $ processDependencyInformation rawDepInfo
234reportImportCyclesRule :: Rules ()
203reportImportCyclesRule :: Rules ()
235reportImportCyclesRule =
204reportImportCyclesRule =
236− define $ \ReportImportCycles file -> fmap toIdeResultNew $ runExceptT $ do
205+ define $ \ReportImportCycles file -> fmap (\errs -> if null errs then ([], Just ()) else (errs, Nothing)) $ do
237− DependencyInformation{..} <- useE GetDependencyInformation file
206+ DependencyInformation{..} <- use_ GetDependencyInformation file
238− whenJust (Map.lookup file depErrorNodes) $ \errs -> do
207+ case Map.lookup file depErrorNodes of
239− let cycles = mapMaybe (cycleErrorInFile file) (toList errs)
210+ let cycles = mapMaybe (cycleErrorInFile file) (toList errs)
240− when (not $ null cycles) $ do
241− -- Convert cycles of files into cycles of module names
211+ -- Convert cycles of files into cycles of module names
242− diags <- forM cycles $ \(imp, files) -> do
212+ forM cycles $ \(imp, files) -> do
243− modNames <- mapM getModuleName files
213+ modNames <- mapM getModuleName files
244− pure $ toDiag imp modNames
214+ pure $ toDiag imp modNames
246 where cycleErrorInFile f (PartOfCycle imp fs)
215 where cycleErrorInFile f (PartOfCycle imp fs)
247 | f `elem` fs = Just (imp, fs)
216 | f `elem` fs = Just (imp, fs)
248 cycleErrorInFile _ _ = Nothing
217 cycleErrorInFile _ _ = Nothing
@@ -257,7 +226,7 @@ reportImportCyclesRule =
257 where loc = srcSpanToLocation (getLoc imp)
226 where loc = srcSpanToLocation (getLoc imp)
258 fp = toNormalizedFilePath $ srcSpanToFilename (getLoc imp)
227 fp = toNormalizedFilePath $ srcSpanToFilename (getLoc imp)
259 getModuleName file = do
228 getModuleName file = do
260− pm <- useE GetParsedModule file
229+ pm <- use_ GetParsedModule file
261 pure (moduleNameString . moduleName . ms_mod $ pm_mod_summary pm)
230 pure (moduleNameString . moduleName . ms_mod $ pm_mod_summary pm)
262 showCycle mods = T.intercalate ", " (map T.pack mods)
231 showCycle mods = T.intercalate ", " (map T.pack mods)