@@ -13,7 +13,7 @@ module Development.IDE.State.Rules(
1313 IdeState, GetDependencies(..), GetParsedModule(..), TransitiveDependencies(..),
1414 Priority(..),
1515 runAction, runActions, useE, usesE,
16− toIdeResultNew, defineNoFile,
16+ toIdeResult, defineNoFile,
1717 mainRule,
1818 getGhcCore,
1919 getAtPoint,
@@ -25,7 +25,7 @@ module Development.IDE.State.Rules(
2525 ) where
2626
2727import Control.Monad.Except
28−import Control.Monad.Extra (whenJust)
28+import Control.Monad.Trans.Maybe
2929import qualified Development.IDE.Functions.Compile as Compile
3030import qualified Development.IDE.Types.Options as Compile
3131import Development.IDE.Functions.DependencyInformation
@@ -57,15 +57,19 @@ import qualified Development.IDE.Functions.AtPoint as AtPoint
5757import Development.IDE.State.Service
5858import Development.IDE.State.Shake
5959
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)
6165
62−toIdeResultNew :: Either [FileDiagnostic] v -> IdeResult v
63−toIdeResultNew = either (, Nothing) (([],) . Just)
64−
65−-- Convert to a legacy Ide result but dropping dependencies
66−toIdeResultSilent :: Maybe v -> Either [FileDiagnostic] v
67−toIdeResultSilent val = maybe (Left []) Right val
66+-- | useE is useful to implement functions that aren’t rules but need shortcircuiting
67+-- e.g. getDefinition.
68+useE :: IdeRule k v => k -> NormalizedFilePath -> MaybeT Action v
69+useE k = MaybeT . use k
6870
71+usesE :: IdeRule k v => k -> [NormalizedFilePath] -> MaybeT Action [v]
72+usesE k = MaybeT . fmap sequence . uses k
6973
7074defineNoFile :: IdeRule k v => (k -> Action v) -> Rules ()
7175defineNoFile f = define $ \k file -> do
@@ -85,13 +89,9 @@ getFilesOfInterestRule = do
8589 pure (Just $ BS.fromString $ show filesOfInterest, ([], Just filesOfInterest))
8690
8791
88−-- | Get GHC Core for the supplied file.
89−getGhcCore :: NormalizedFilePath -> Action (Maybe [CoreModule])
90−getGhcCore file = eitherToMaybe <$> runExceptT (coresForFile file)
91−
9292-- | Generate the GHC Core for the supplied file and its dependencies.
93−coresForFile :: NormalizedFilePath -> ExceptT [FileDiagnostic] Action [CoreModule]
94−coresForFile file = do
93+getGhcCore :: NormalizedFilePath -> Action (Maybe [CoreModule])
94+getGhcCore file = runMaybeT $ do
9595 files <- transitiveModuleDeps <$> useE GetDependencies file
9696 pms <- usesE GetParsedModule $ files ++ [file]
9797 cores <- usesE GenerateCore $ map fileFromParsedModule pms
@@ -102,62 +102,31 @@ coresForFile file = do
102102-- | Get all transitive file dependencies of a given module.
103103-- Does not include the file itself.
104104getDependencies :: NormalizedFilePath -> Action (Maybe [NormalizedFilePath])
105−getDependencies file =
106− eitherToMaybe <$>
107− (runExceptT $ transitiveModuleDeps <$> useE GetDependencies file)
105+getDependencies file = fmap transitiveModuleDeps <$> use GetDependencies file
108106
109107getDalfDependencies :: NormalizedFilePath -> Action (Maybe [InstalledUnitId])
110−getDalfDependencies file =
111− eitherToMaybe <$>
112− (runExceptT $ transitivePkgDeps <$> useE GetDependencies file)
108+getDalfDependencies file = fmap transitivePkgDeps <$> use GetDependencies file
113109
114−-- | Documentation at point.
110+-- | -- | Try to get hover text for the name under point.
115111getAtPoint :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [HoverText]))
116−getAtPoint file pos = do
117− fmap (either (const Nothing) id) . runExceptT $ getAtPointForFile file pos
118−
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
123−
124−-- | Parse the contents of a daml file.
125−getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)
126−getParsedModule file =
127− eitherToMaybe <$> (runExceptT $ useE GetParsedModule file)
128−
129−------------------------------------------------------------
130−-- Internal Actions
131−
132−useE
133− :: IdeRule k v
134− => k -> NormalizedFilePath -> ExceptT [FileDiagnostic] Action v
135−useE k = ExceptT . fmap toIdeResultSilent . use k
136−
137−-- picks the first error
138−usesE
139− :: IdeRule k v
140− => k -> [NormalizedFilePath] -> ExceptT [FileDiagnostic] Action [v]
141−usesE k = ExceptT . fmap (mapM toIdeResultSilent) . uses k
142−
143−-- | Try to get hover text for the name under point.
144−getAtPointForFile
145− :: NormalizedFilePath
146− -> Position
147− -> ExceptT [FileDiagnostic] Action (Maybe (Maybe Range, [HoverText]))
148−getAtPointForFile file pos = do
112+getAtPoint file pos = fmap join $ runMaybeT $ do
149113 files <- transitiveModuleDeps <$> useE GetDependencies file
150114 tms <- usesE TypeCheck (file : files)
151− spans <- useE GetSpanInfo file
115+ spans <- useE GetSpanInfo file
152116 return $ AtPoint.atPoint (map Compile.tmrModule tms) spans pos
153117
154−getDefinitionForFile :: NormalizedFilePath -> Position -> ExceptT [FileDiagnostic] Action (Maybe Location)
155−getDefinitionForFile file pos = do
118+-- | Goto Definition.
119+getDefinition :: NormalizedFilePath -> Position -> Action (Maybe Location)
120+getDefinition file pos = fmap join $ runMaybeT $ do
156121 spans <- useE GetSpanInfo file
157122 pkgState <- useE GhcSession ""
158123 opts <- lift getOpts
159124 lift $ AtPoint.gotoDefinition opts pkgState spans pos
160125
126+-- | Parse the contents of a daml file.
127+getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)
128+getParsedModule file = use GetParsedModule file
129+
161130getOpts :: Action Compile.IdeOptions
162131getOpts = envOptions <$> getServiceEnv
163132
@@ -227,22 +196,22 @@ rawDependencyInformation f = go (Set.singleton f) Map.empty Map.empty
227196
228197getDependencyInformationRule :: Rules ()
229198getDependencyInformationRule =
230− define $ \GetDependencyInformation file -> fmap toIdeResultNew $ runExceptT $ do
199+ define $ \GetDependencyInformation file -> fmap toIdeResult $ runExceptT $ do
231200 rawDepInfo <- rawDependencyInformation file
232201 pure $ processDependencyInformation rawDepInfo
233202
234203reportImportCyclesRule :: Rules ()
235204reportImportCyclesRule =
236− define $ \ReportImportCycles file -> fmap toIdeResultNew $ runExceptT $ do
237− DependencyInformation{..} <- useE GetDependencyInformation file
238− whenJust (Map.lookup file depErrorNodes) $ \errs -> do
239− let cycles = mapMaybe (cycleErrorInFile file) (toList errs)
240− when (not $ null cycles) $ do
241− -- Convert cycles of files into cycles of module names
242− diags <- forM cycles $ \(imp, files) -> do
243− modNames <- mapM getModuleName files
244− pure $ toDiag imp modNames
245− throwError diags
205+ define $ \ReportImportCycles file -> fmap (\errs -> if null errs then ([], Just ()) else (errs, Nothing)) $ do
206+ DependencyInformation{..} <- use_ GetDependencyInformation file
207+ case Map.lookup file depErrorNodes of
208+ Nothing -> pure []
209+ Just errs -> do
210+ let cycles = mapMaybe (cycleErrorInFile file) (toList errs)
211+ -- Convert cycles of files into cycles of module names
212+ forM cycles $ \(imp, files) -> do
213+ modNames <- mapM getModuleName files
214+ pure $ toDiag imp modNames
246215 where cycleErrorInFile f (PartOfCycle imp fs)
247216 | f `elem` fs = Just (imp, fs)
248217 cycleErrorInFile _ _ = Nothing
@@ -257,7 +226,7 @@ reportImportCyclesRule =
257226 where loc = srcSpanToLocation (getLoc imp)
258227 fp = toNormalizedFilePath $ srcSpanToFilename (getLoc imp)
259228 getModuleName file = do
260− pm <- useE GetParsedModule file
229+ pm <- use_ GetParsedModule file
261230 pure (moduleNameString . moduleName . ms_mod $ pm_mod_summary pm)
262231 showCycle mods = T.intercalate ", " (map T.pack mods)
263232