@@ -19,20 +19,15 @@
1919module Language.PureScript.Ide.State
2020 ( getLoadedModulenames
2121 , getExternFiles
22− , insertModuleOld
2322 , resetIdeState
2423 , cacheRebuild
2524 , insertExterns
2625 , insertModule
27− , insertModuleSTM
2826 , insertExternsSTM
29− , getAllModules2
30− , getStage1
31− , setStage1
32− , getStage2
33− , setStage2
27+ , getAllModules
3428 , populateStage2
35− , populateStage2STM
29+ , populateStage3
30+ , populateStage3STM
3631 ) where
3732
3833import Protolude
@@ -44,6 +39,7 @@ import qualified Data.Map.Lazy as M
4439import Language.PureScript.Externs
4540import Language.PureScript.Ide.Externs
4641import Language.PureScript.Ide.Reexports
42+import Language.PureScript.Ide.SourceFile
4743import Language.PureScript.Ide.Types
4844import Language.PureScript.Ide.Util
4945import qualified Language.PureScript as P
@@ -53,12 +49,10 @@ import System.FilePath
5349-- | Resets all State inside psc-ide
5450resetIdeState :: Ide m => m ()
5551resetIdeState = do
56− stateVar <- envStateVar <$> ask
5752 ideVar <- ideStateVar <$> ask
5853 liftIO . atomically $ do
59− writeTVar stateVar emptyPscIdeState
6054 writeTVar ideVar emptyIdeState
61− setStage2STM ideVar emptyStage2
55+ setStage3STM ideVar emptyStage3
6256
6357-- | Gets the loaded Modulenames
6458getLoadedModulenames :: Ide m => m [P.ModuleName]
@@ -68,26 +62,6 @@ getLoadedModulenames = M.keys <$> getExternFiles
6862getExternFiles :: Ide m => m (M.Map P.ModuleName ExternsFile)
6963getExternFiles = s1Externs <$> getStage1
7064
71−-- | Inserts an @ExternsFile@ into the PscIdeState. Also converts the
72−-- ExternsFile into psc-ide's internal Declaration format
73−-- TODO: should be removed when the "old" Declaration format gets removed
74−insertModuleOld :: Ide m => ExternsFile -> m ()
75−insertModuleOld externsFile = do
76− stateVar <- envStateVar <$> ask
77− liftIO . atomically $ insertModuleOldSTM stateVar externsFile
78−
79−-- | STM version of insertModuleOld
80−insertModuleOldSTM :: TVar PscIdeState -> ExternsFile -> STM ()
81−insertModuleOldSTM st ef = modifyTVar st (insertModule' ef)
82−
83−-- | Pure version of insertModuleOld
84−insertModule' :: ExternsFile -> PscIdeState -> PscIdeState
85−insertModule' ef state =
86− state
87− { pscIdeStateModules = let (mn, decls) = convertExterns ef
88− in M.insert mn decls (pscIdeStateModules state)
89− }
90−
9165-- | Insert a Module into Stage1 of the State
9266insertModule :: Ide m => (FilePath, P.Module) -> m ()
9367insertModule module' = do
@@ -106,7 +80,6 @@ insertModuleSTM ref (fp, module') =
10680
10781-- | Retrieves Stage1 from the State.
10882-- This includes loaded Externfiles
109−-- (TODO: as soon as we actually parse the modules) aswell as the parsed modules
11083getStage1 :: Ide m => m Stage1
11184getStage1 = do
11285 st <- ideStateVar <$> ask
@@ -116,27 +89,14 @@ getStage1 = do
11689getStage1STM :: TVar IdeState -> STM Stage1
11790getStage1STM ref = ideStage1 <$> readTVar ref
11891
119−-- | Sets Stage1 inside the compiler
120−setStage1 :: Ide m => Stage1 -> m ()
121−setStage1 s1 = do
122− st <- ideStateVar <$> ask
123− liftIO . atomically . modifyTVar st $ \x ->
124− x {ideStage1 = s1}
125− pure ()
126−
127−-- TODO: Soon to be Stage3
12892-- | Retrieves Stage2 from the State.
129−-- This includes the denormalized Declarations and cached rebuilds
13093getStage2 :: Ide m => m Stage2
13194getStage2 = do
13295 st <- ideStateVar <$> ask
133− fmap ideStage2 . liftIO . readTVarIO $ st
96+ liftIO (atomically (getStage2STM st))
13497
135−-- | Sets Stage2 inside the compiler
136−setStage2 :: Ide m => Stage2 -> m ()
137−setStage2 s2 = do
138− st <- ideStateVar <$> ask
139− liftIO . atomically $ setStage2STM st s2
98+getStage2STM :: TVar IdeState -> STM Stage2
99+getStage2STM ref = ideStage2 <$> readTVar ref
140100
141101-- | STM version of setStage2
142102setStage2STM :: TVar IdeState -> Stage2 -> STM ()
@@ -145,21 +105,38 @@ setStage2STM ref s2 = do
145105 x {ideStage2 = s2}
146106 pure ()
147107
108+-- | Retrieves Stage3 from the State.
109+-- This includes the denormalized Declarations and cached rebuilds
110+getStage3 :: Ide m => m Stage3
111+getStage3 = do
112+ st <- ideStateVar <$> ask
113+ fmap ideStage3 . liftIO . readTVarIO $ st
114+
115+-- | Sets Stage3 inside the compiler
116+setStage3STM :: TVar IdeState -> Stage3 -> STM ()
117+setStage3STM ref s3 = do
118+ modifyTVar ref $ \x ->
119+ x {ideStage3 = s3}
120+ pure ()
121+
148122-- | Checks if the given ModuleName matches the last rebuild cache and if it
149123-- does returns all loaded definitions + the definitions inside the rebuild
150124-- cache
151−getAllModules2 :: Ide m => Maybe P.ModuleName -> m [(P.ModuleName, [IdeDeclaration])]
152−getAllModules2 mmoduleName = do
153− declarations <- s2Declarations <$> getStage2
125+getAllModules :: Ide m => Maybe P.ModuleName -> m [Module]
126+getAllModules mmoduleName = do
127+ declarations <- s3Declarations <$> getStage3
154128 rebuild <- cachedRebuild
155129 case mmoduleName of
156130 Nothing -> pure (M.toList declarations)
157131 Just moduleName ->
158132 case rebuild of
159133 Just (cachedModulename, ef)
160− | cachedModulename == moduleName ->
161− pure . M.toList $
162− M.insert moduleName (snd . convertModule . convertExterns $ ef) declarations
134+ | cachedModulename == moduleName -> do
135+ (AstData asts) <- s2AstData <$> getStage2
136+ let ast = fromMaybe M.empty (M.lookup moduleName asts)
137+ pure . M.toList $
138+ M.insert moduleName
139+ (snd . annotateLocations ast . fst . convertExterns $ ef) declarations
163140 _ -> pure (M.toList declarations)
164141
165142-- | Adds an ExternsFile into psc-ide's State Stage1. This does not populate the
@@ -182,14 +159,14 @@ cacheRebuild :: Ide m => ExternsFile -> m ()
182159cacheRebuild ef = do
183160 st <- ideStateVar <$> ask
184161 liftIO . atomically . modifyTVar st $ \x ->
185− x { ideStage2 = (ideStage2 x) {
186− s2CachedRebuild = Just (efModuleName ef, ef)}}
162+ x { ideStage3 = (ideStage3 x) {
163+ s3CachedRebuild = Just (efModuleName ef, ef)}}
187164
188165-- | Retrieves the rebuild cache
189166cachedRebuild :: Ide m => m (Maybe (P.ModuleName, ExternsFile))
190−cachedRebuild = s2CachedRebuild <$> getStage2
167+cachedRebuild = s3CachedRebuild <$> getStage3
191168
192−-- | Resolves reexports and populates Stage2 with data to be used in queries.
169+-- | Extracts source spans from the parsed ASTs
193170populateStage2 :: (Ide m, MonadLogger m) => m ()
194171populateStage2 = do
195172 st <- ideStateVar <$> ask
@@ -203,9 +180,35 @@ populateStage2 = do
203180-- | STM version of populateStage2
204181populateStage2STM :: TVar IdeState -> STM ()
205182populateStage2STM ref = do
183+ modules <- s1Modules <$> getStage1STM ref
184+ let spans = map (\((P.Module ss _ _ decls _), _) -> M.fromList (concatMap (extractSpans ss) decls)) modules
185+ setStage2STM ref (Stage2 (AstData spans))
186+
187+-- | Resolves reexports and populates Stage3 with data to be used in queries.
188+populateStage3 :: (Ide m, MonadLogger m) => m ()
189+populateStage3 = do
190+ st <- ideStateVar <$> ask
191+ (duration, results) <- liftIO $ do
192+ start <- getTime Monotonic
193+ results <- atomically (populateStage3STM st)
194+ end <- getTime Monotonic
195+ pure (Prelude.show (diffTimeSpec start end), results)
196+ traverse_
197+ (logWarnN . prettyPrintReexportResult (runModuleNameT . fst))
198+ (filter reexportHasFailures results)
199+ $(logDebug) $ "Finished populating Stage3 in " <> toS duration
200+
201+-- | STM version of populateStage3
202+populateStage3STM :: TVar IdeState -> STM [ReexportResult Module]
203+populateStage3STM ref = do
206204 externs <- s1Externs <$> getStage1STM ref
207− -- Build the "old" ExternDecl format
208− let modules = M.mapKeys runModuleNameT (M.map (snd . convertExterns) externs)
209− -- Convert ExternDecl into IdeDeclaration
210− declarations = resolveReexports2 modules <$> M.toList modules
211− setStage2STM ref (Stage2 (M.fromList declarations) Nothing)
205+ (AstData asts) <- s2AstData <$> getStage2STM ref
206+ let modules = M.map convertExterns externs
207+ nModules :: Map P.ModuleName (Module, [(P.ModuleName, P.DeclarationRef)])
208+ nModules = M.mapWithKey
209+ (\moduleName (m, refs) ->
210+ (fromMaybe m $ annotateLocations <$> M.lookup moduleName asts <*> pure m, refs)) modules
211+ -- resolves reexports and discards load failures for now
212+ result = resolveReexports (M.map (snd . fst) nModules) <$> M.elems nModules
213+ setStage3STM ref (Stage3 (M.fromList (map reResolved result)) Nothing)
214+ pure result