@@ -28,6 +28,8 @@ module Language.PureScript.Ide.State
2828 , populateStage2
2929 , populateStage3
3030 , populateStage3STM
31+ -- for tests
32+ , resolveOperatorsForModule
3133 ) where
3234
3335import Protolude
@@ -35,7 +37,8 @@ import qualified Prelude
3537
3638import Control.Concurrent.STM
3739import "monad-logger" Control.Monad.Logger
38−import qualified Data.Map.Lazy as M
40+import qualified Data.Map.Lazy as Map
41+import qualified Data.List as List
3942import Language.PureScript.Externs
4043import Language.PureScript.Ide.Externs
4144import Language.PureScript.Ide.Reexports
@@ -55,10 +58,10 @@ resetIdeState = do
5558
5659-- | Gets the loaded Modulenames
5760getLoadedModulenames :: Ide m => m [P.ModuleName]
58−getLoadedModulenames = M.keys <$> getExternFiles
61+getLoadedModulenames = Map.keys <$> getExternFiles
5962
6063-- | Gets all loaded ExternFiles
61−getExternFiles :: Ide m => m (M.Map P.ModuleName ExternsFile)
64+getExternFiles :: Ide m => m (Map P.ModuleName ExternsFile)
6265getExternFiles = s1Externs <$> getStage1
6366
6467-- | Insert a Module into Stage1 of the State
@@ -72,7 +75,7 @@ insertModuleSTM :: TVar IdeState -> (FilePath, P.Module) -> STM ()
7275insertModuleSTM ref (fp, module') =
7376 modifyTVar ref $ \x ->
7477 x { ideStage1 = (ideStage1 x) {
75− s1Modules = M.insert
78+ s1Modules = Map.insert
7679 (P.getModuleName module')
7780 (module', fp)
7881 (s1Modules (ideStage1 x))}}
@@ -126,17 +129,24 @@ getAllModules mmoduleName = do
126129 declarations <- s3Declarations <$> getStage3
127130 rebuild <- cachedRebuild
128131 case mmoduleName of
129− Nothing -> pure (M.toList declarations)
132+ Nothing -> pure (Map.toList declarations)
130133 Just moduleName ->
131134 case rebuild of
132135 Just (cachedModulename, ef)
133136 | cachedModulename == moduleName -> do
134137 (AstData asts) <- s2AstData <$> getStage2
135− let ast = fromMaybe (M.empty, M.empty) (M.lookup moduleName asts)
136− pure . M.toList $
137− M.insert moduleName
138− (snd . annotateModule ast . fst . convertExterns $ ef) declarations
139− _ -> pure (M.toList declarations)
138+ let
139+ ast =
140+ fromMaybe (Map.empty, Map.empty) (Map.lookup moduleName asts)
141+ cachedModule =
142+ snd . annotateModule ast . fst . convertExterns $ ef
143+ tmp =
144+ Map.insert moduleName cachedModule declarations
145+ resolved =
146+ Map.adjust (resolveOperatorsForModule tmp) moduleName tmp
147+
148+ pure (Map.toList resolved)
149+ _ -> pure (Map.toList declarations)
140150
141151-- | Adds an ExternsFile into psc-ide's State Stage1. This does not populate the
142152-- following Stages, which needs to be done after all the necessary Exterms have
@@ -151,7 +161,7 @@ insertExternsSTM :: TVar IdeState -> ExternsFile -> STM ()
151161insertExternsSTM ref ef =
152162 modifyTVar ref $ \x ->
153163 x { ideStage1 = (ideStage1 x) {
154− s1Externs = M.insert (efModuleName ef) ef (s1Externs (ideStage1 x))}}
164+ s1Externs = Map.insert (efModuleName ef) ef (s1Externs (ideStage1 x))}}
155165
156166-- | Sets rebuild cache to the given ExternsFile
157167cacheRebuild :: Ide m => ExternsFile -> m ()
@@ -202,12 +212,70 @@ populateStage3STM :: TVar IdeState -> STM [ReexportResult Module]
202212populateStage3STM ref = do
203213 externs <- s1Externs <$> getStage1STM ref
204214 (AstData asts) <- s2AstData <$> getStage2STM ref
205− let modules = M.map convertExterns externs
215+ let modules = Map.map convertExterns externs
206216 nModules :: Map P.ModuleName (Module, [(P.ModuleName, P.DeclarationRef)])
207− nModules = M.mapWithKey
217+ nModules = Map.mapWithKey
208218 (\moduleName (m, refs) ->
209− (fromMaybe m $ annotateModule <$> M.lookup moduleName asts <*> pure m, refs)) modules
219+ (fromMaybe m $ annotateModule <$> Map.lookup moduleName asts <*> pure m, refs)) modules
210220 -- resolves reexports and discards load failures for now
211− result = resolveReexports (M.map (snd . fst) nModules) <$> M.elems nModules
212− setStage3STM ref (Stage3 (M.fromList (map reResolved result)) Nothing)
221+ result = resolveReexports (map (snd . fst) nModules) <$> Map.elems nModules
222+ resultP = resolveOperators (Map.fromList (reResolved <$> result))
223+ setStage3STM ref (Stage3 resultP Nothing)
213224 pure result
225+
226+resolveOperators
227+ :: Map P.ModuleName [IdeDeclarationAnn]
228+ -> Map P.ModuleName [IdeDeclarationAnn]
229+resolveOperators modules =
230+ map (resolveOperatorsForModule modules) modules
231+
232+-- | Looks up the types and kinds for operators and assigns them to their
233+-- declarations
234+resolveOperatorsForModule
235+ :: Map P.ModuleName [IdeDeclarationAnn]
236+ -> [IdeDeclarationAnn]
237+ -> [IdeDeclarationAnn]
238+resolveOperatorsForModule modules = map (mapIdeDeclaration resolveOperator)
239+ where
240+ resolveOperator (IdeValueOperator
241+ opName
242+ i@(P.Qualified (Just moduleName)
243+ (Left ident)) precedence assoc _) =
244+ let t = do
245+ sourceModule <- Map.lookup moduleName modules
246+ IdeValue _ tP <-
247+ List.find (\case
248+ IdeValue iP _ -> iP == ident
249+ _ -> False) (discardAnn <$> sourceModule)
250+ pure tP
251+
252+ in IdeValueOperator opName i precedence assoc t
253+ resolveOperator (IdeValueOperator
254+ opName
255+ i@(P.Qualified (Just moduleName)
256+ (Right ctor)) precedence assoc _) =
257+ let t = do
258+ sourceModule <- Map.lookup moduleName modules
259+ IdeDataConstructor _ _ tP <-
260+ List.find (\case
261+ IdeDataConstructor cname _ _ -> ctor == cname
262+ _ -> False) (discardAnn <$> sourceModule)
263+ pure tP
264+
265+ in IdeValueOperator opName i precedence assoc t
266+ resolveOperator (IdeTypeOperator
267+ opName
268+ i@(P.Qualified (Just moduleName) properName) precedence assoc _) =
269+ let k = do
270+ sourceModule <- Map.lookup moduleName modules
271+ IdeType _ kP <-
272+ List.find (\case
273+ IdeType name _ -> name == properName
274+ _ -> False) (discardAnn <$> sourceModule)
275+ pure kP
276+
277+ in IdeTypeOperator opName i precedence assoc k
278+ resolveOperator x = x
279+
280+mapIdeDeclaration :: (IdeDeclaration -> IdeDeclaration) -> IdeDeclarationAnn -> IdeDeclarationAnn
281+mapIdeDeclaration f (IdeDeclarationAnn ann decl) = IdeDeclarationAnn ann (f decl)