Implement the focus command for limiting externs

purefunctor · purefunctor · commit b1e4b01901aa · 2024-07-31T01:51:45.000+08:00
diff --git a/src/Language/PureScript/Ide.hs b/src/Language/PureScript/Ide.hs
@@ -22,6 +22,7 @@ import Protolude hiding (moduleName)
 
 import "monad-logger" Control.Monad.Logger (MonadLogger, logWarnN)
 import Data.Map qualified as Map
+import Data.Set qualified as Set
 import Data.Text qualified as T
 import Language.PureScript qualified as P
 import Language.PureScript.Glob (toInputGlobs, PSCGlobs(..))
@@ -37,7 +38,7 @@ import Language.PureScript.Ide.Matcher (Matcher)
 import Language.PureScript.Ide.Prim (idePrimDeclarations)
 import Language.PureScript.Ide.Rebuild (rebuildFileAsync, rebuildFileSync)
 import Language.PureScript.Ide.SourceFile (parseModulesFromFiles)
-import Language.PureScript.Ide.State (getAllModules, getLoadedModulenames, insertExterns, insertModule, populateVolatileState, populateVolatileStateSync, resetIdeState)
+import Language.PureScript.Ide.State (getAllModules, getLoadedModulenames, insertExterns, insertModule, populateVolatileState, populateVolatileStateSync, resetIdeState, setFocusedModules, getFocusedModules)
 import Language.PureScript.Ide.Types (Annotation(..), Ide, IdeConfiguration(..), IdeDeclarationAnn(..), IdeEnvironment(..), Success(..))
 import Language.PureScript.Ide.Util (discardAnn, identifierFromIdeDeclaration, namespaceForDeclaration, withEmptyAnn)
 import Language.PureScript.Ide.Usage (findUsages)
@@ -102,6 +103,8 @@ handleCommand c = case c of
     rebuildFileAsync file actualFile targets
   RebuildSync file actualFile targets ->
     rebuildFileSync file actualFile targets
+  Focus modulesToFocus ->
+    setFocusedModules modulesToFocus $> TextResult "Focused modules have been set."
   Cwd ->
     TextResult . T.pack <$> liftIO getCurrentDirectory
   Reset ->
@@ -215,10 +218,18 @@ loadModules
   => [P.ModuleName]
   -> m Success
 loadModules moduleNames = do
+  focusedModules <- getFocusedModules
   -- We resolve all the modulenames to externs files and load these into memory.
   oDir <- outputDirectory
-  let efPaths =
-        map (\mn -> oDir </> toS (P.runModuleName mn) </> P.externsFileName) moduleNames
+  let
+    -- But we only load the externs files that are in the focusedModules.
+    efModules = 
+        if Set.null focusedModules then 
+          moduleNames
+        else 
+          Set.toList $ Set.fromList moduleNames `Set.intersection` focusedModules
+    efPaths =
+        map (\mn -> oDir </> toS (P.runModuleName mn) </> P.externsFileName) efModules
   efiles <- traverse readExternFile efPaths
   traverse_ insertExterns efiles
 
diff --git a/src/Language/PureScript/Ide/Command.hs b/src/Language/PureScript/Ide/Command.hs
@@ -62,6 +62,7 @@ data Command
     | List { listType :: ListType }
     | Rebuild FilePath (Maybe FilePath) (Set P.CodegenTarget)
     | RebuildSync FilePath (Maybe FilePath) (Set P.CodegenTarget)
+    | Focus [P.ModuleName]
     | Cwd
     | Reset
     | Quit
@@ -79,6 +80,7 @@ commandName c = case c of
   List{} -> "List"
   Rebuild{} -> "Rebuild"
   RebuildSync{} -> "RebuildSync"
+  Focus{} -> "Focus"
   Cwd{} -> "Cwd"
   Reset{} -> "Reset"
   Quit{} -> "Quit"
@@ -176,6 +178,13 @@ instance FromJSON Command where
           <$> params .: "file"
           <*> params .:? "actualFile"
           <*> (parseCodegenTargets =<< params .:? "codegen" .!= [ "js" ])
+      "focus" -> do
+        params' <- o .:? "params"
+        case params' of
+          Nothing -> 
+            pure (Focus [])
+          Just params ->
+            Focus <$> (map P.moduleNameFromString <$> params .:? "modules" .!= [])
       c -> fail ("Unknown command: " <> show c)
     where
       parseCodegenTargets ts =
diff --git a/src/Language/PureScript/Ide/State.hs b/src/Language/PureScript/Ide/State.hs
@@ -31,6 +31,9 @@ module Language.PureScript.Ide.State
   , populateVolatileStateSTM
   , getOutputDirectory
   , updateCacheTimestamp
+  , getFocusedModules
+  , setFocusedModules
+  , setFocusedModulesSTM
   -- for tests
   , resolveOperatorsForModule
   , resolveInstances
@@ -44,6 +47,7 @@ import Control.Lens (Ixed(..), preview, view, (%~), (.~), (^.))
 import "monad-logger" Control.Monad.Logger (MonadLogger, logWarnN)
 import Data.IORef (readIORef, writeIORef)
 import Data.Map.Lazy qualified as Map
+import Data.Set qualified as Set
 import Data.Time.Clock (UTCTime)
 import Data.Zip (unzip)
 import Language.PureScript qualified as P
@@ -141,6 +145,23 @@ setVolatileStateSTM ref vs = do
     x {ideVolatileState = vs}
   pure ()
 
+-- | Retrieves the ModifierState from the State.
+getModifierState :: Ide m => m IdeModifierState
+getModifierState = do
+  st <- ideStateVar <$> ask
+  liftIO (atomically (getModifierStateSTM st))
+
+-- | STM version of getModifierState
+getModifierStateSTM :: TVar IdeState -> STM IdeModifierState
+getModifierStateSTM ref = ideModifierState <$> readTVar ref
+
+-- | Sets the ModifierState inside Ide's state
+setModifierStateSTM :: TVar IdeState -> IdeModifierState -> STM ()
+setModifierStateSTM ref md = do
+  modifyTVar ref $ \x ->
+    x {ideModifierState = md}
+  pure ()
+
 -- | Checks if the given ModuleName matches the last rebuild cache and if it
 -- does returns all loaded definitions + the definitions inside the rebuild
 -- cache
@@ -450,3 +471,18 @@ resolveDataConstructorsForModule decls =
       & mapMaybe (preview (idaDeclaration . _IdeDeclDataConstructor))
       & foldr (\(IdeDataConstructor name typeName type') ->
                   Map.insertWith (<>) typeName [(name, type')]) Map.empty
+
+getFocusedModules :: Ide m => m (Set P.ModuleName)
+getFocusedModules = do
+  IdeModifierState{mdFocusedModules = focusedModules} <- getModifierState
+  pure focusedModules
+
+setFocusedModules :: Ide m => [P.ModuleName] -> m ()
+setFocusedModules modulesToFocus = do
+  st <- ideStateVar <$> ask
+  liftIO (atomically (setFocusedModulesSTM st modulesToFocus)) 
+
+setFocusedModulesSTM :: TVar IdeState -> [P.ModuleName] -> STM ()
+setFocusedModulesSTM ref modulesToFocus = do
+  IdeModifierState{} <- getModifierStateSTM ref
+  setModifierStateSTM ref (IdeModifierState (Set.fromList modulesToFocus))
diff --git a/src/Language/PureScript/Ide/Types.hs b/src/Language/PureScript/Ide/Types.hs
@@ -178,17 +178,20 @@ type Ide m = (MonadIO m, MonadReader IdeEnvironment m)
 data IdeState = IdeState
   { ideFileState :: IdeFileState
   , ideVolatileState :: IdeVolatileState
+  , ideModifierState :: IdeModifierState
   } deriving (Show)
 
 emptyIdeState :: IdeState
-emptyIdeState = IdeState emptyFileState emptyVolatileState
+emptyIdeState = IdeState emptyFileState emptyVolatileState emptyModifierState
 
 emptyFileState :: IdeFileState
 emptyFileState = IdeFileState M.empty M.empty
 
 emptyVolatileState :: IdeVolatileState
 emptyVolatileState = IdeVolatileState (AstData M.empty) M.empty Nothing
 
+emptyModifierState :: IdeModifierState
+emptyModifierState = IdeModifierState mempty
 
 -- | @IdeFileState@ holds data that corresponds 1-to-1 to an entity on the
 -- filesystem. Externs correspond to the ExternsFiles the compiler emits into
@@ -213,6 +216,10 @@ data IdeVolatileState = IdeVolatileState
   , vsCachedRebuild :: Maybe (P.ModuleName, P.ExternsFile)
   } deriving (Show)
 
+data IdeModifierState = IdeModifierState
+  { mdFocusedModules :: Set P.ModuleName
+  } deriving (Show)
+
 newtype Match a = Match (P.ModuleName, a)
            deriving (Show, Eq, Functor)
 
