From b1e4b01901aab877b0b539c36d3a8ff30b676221 Mon Sep 17 00:00:00 2001 From: Justin Garcia Date: Wed, 31 Jul 2024 01:48:50 +0800 Subject: [PATCH 1/3] Implement the focus command for limiting externs --- src/Language/PureScript/Ide.hs | 17 +++++++++--- src/Language/PureScript/Ide/Command.hs | 9 +++++++ src/Language/PureScript/Ide/State.hs | 36 ++++++++++++++++++++++++++ src/Language/PureScript/Ide/Types.hs | 9 ++++++- 4 files changed, 67 insertions(+), 4 deletions(-) diff --git a/src/Language/PureScript/Ide.hs b/src/Language/PureScript/Ide.hs index 57601c3d45..e0ecc4a8f7 100644 --- 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 index ae4b6c9d8e..49e99a4474 100644 --- 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 index 06eed507e4..95cae598a4 100644 --- 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 index 5fa304166b..600417ca0b 100644 --- a/src/Language/PureScript/Ide/Types.hs +++ b/src/Language/PureScript/Ide/Types.hs @@ -178,10 +178,11 @@ 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 @@ -189,6 +190,8 @@ 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) From b44f32867467e26e677d83884597a37c4d4e4704 Mon Sep 17 00:00:00 2001 From: Justin Garcia Date: Wed, 31 Jul 2024 04:27:53 +0800 Subject: [PATCH 2/3] Rename to IdeDurableState --- src/Language/PureScript/Ide/State.hs | 30 ++++++++++++++-------------- src/Language/PureScript/Ide/Types.hs | 18 +++++++++++------ 2 files changed, 27 insertions(+), 21 deletions(-) diff --git a/src/Language/PureScript/Ide/State.hs b/src/Language/PureScript/Ide/State.hs index 95cae598a4..77a925ac1c 100644 --- a/src/Language/PureScript/Ide/State.hs +++ b/src/Language/PureScript/Ide/State.hs @@ -65,7 +65,8 @@ import System.Directory (getModificationTime) resetIdeState :: Ide m => m () resetIdeState = do ideVar <- ideStateVar <$> ask - liftIO (atomically (writeTVar ideVar emptyIdeState)) + durableState <- getDurableState + liftIO (atomically (writeTVar ideVar (emptyIdeState { ideDurableState = durableState }))) getOutputDirectory :: Ide m => m FilePath getOutputDirectory = do @@ -145,21 +146,21 @@ setVolatileStateSTM ref vs = do x {ideVolatileState = vs} pure () --- | Retrieves the ModifierState from the State. -getModifierState :: Ide m => m IdeModifierState -getModifierState = do +-- | Retrieves the DurableState from the State. +getDurableState :: Ide m => m IdeDurableState +getDurableState = do st <- ideStateVar <$> ask - liftIO (atomically (getModifierStateSTM st)) + liftIO (atomically (getDurableStateSTM st)) --- | STM version of getModifierState -getModifierStateSTM :: TVar IdeState -> STM IdeModifierState -getModifierStateSTM ref = ideModifierState <$> readTVar ref +-- | STM version of getDurableState +getDurableStateSTM :: TVar IdeState -> STM IdeDurableState +getDurableStateSTM ref = ideDurableState <$> readTVar ref --- | Sets the ModifierState inside Ide's state -setModifierStateSTM :: TVar IdeState -> IdeModifierState -> STM () -setModifierStateSTM ref md = do +-- | Sets the DurableState inside Ide's state +setDurableStateSTM :: TVar IdeState -> IdeDurableState -> STM () +setDurableStateSTM ref md = do modifyTVar ref $ \x -> - x {ideModifierState = md} + x {ideDurableState = md} pure () -- | Checks if the given ModuleName matches the last rebuild cache and if it @@ -474,7 +475,7 @@ resolveDataConstructorsForModule decls = getFocusedModules :: Ide m => m (Set P.ModuleName) getFocusedModules = do - IdeModifierState{mdFocusedModules = focusedModules} <- getModifierState + IdeDurableState{drFocusedModules = focusedModules} <- getDurableState pure focusedModules setFocusedModules :: Ide m => [P.ModuleName] -> m () @@ -484,5 +485,4 @@ setFocusedModules modulesToFocus = do setFocusedModulesSTM :: TVar IdeState -> [P.ModuleName] -> STM () setFocusedModulesSTM ref modulesToFocus = do - IdeModifierState{} <- getModifierStateSTM ref - setModifierStateSTM ref (IdeModifierState (Set.fromList modulesToFocus)) + setDurableStateSTM ref (IdeDurableState (Set.fromList modulesToFocus)) diff --git a/src/Language/PureScript/Ide/Types.hs b/src/Language/PureScript/Ide/Types.hs index 600417ca0b..2f2b0b04ab 100644 --- a/src/Language/PureScript/Ide/Types.hs +++ b/src/Language/PureScript/Ide/Types.hs @@ -15,6 +15,7 @@ import Data.Aeson qualified as Aeson import Data.IORef (IORef) import Data.Time.Clock (UTCTime) import Data.Map.Lazy qualified as M +import Data.Set qualified as S import Language.PureScript qualified as P import Language.PureScript.Errors.JSON qualified as P import Language.PureScript.Ide.Filter.Declaration (DeclarationType(..)) @@ -178,11 +179,11 @@ type Ide m = (MonadIO m, MonadReader IdeEnvironment m) data IdeState = IdeState { ideFileState :: IdeFileState , ideVolatileState :: IdeVolatileState - , ideModifierState :: IdeModifierState + , ideDurableState :: IdeDurableState } deriving (Show) emptyIdeState :: IdeState -emptyIdeState = IdeState emptyFileState emptyVolatileState emptyModifierState +emptyIdeState = IdeState emptyFileState emptyVolatileState emptyDurableState emptyFileState :: IdeFileState emptyFileState = IdeFileState M.empty M.empty @@ -190,8 +191,8 @@ emptyFileState = IdeFileState M.empty M.empty emptyVolatileState :: IdeVolatileState emptyVolatileState = IdeVolatileState (AstData M.empty) M.empty Nothing -emptyModifierState :: IdeModifierState -emptyModifierState = IdeModifierState mempty +emptyDurableState :: IdeDurableState +emptyDurableState = IdeDurableState S.empty -- | @IdeFileState@ holds data that corresponds 1-to-1 to an entity on the -- filesystem. Externs correspond to the ExternsFiles the compiler emits into @@ -216,8 +217,13 @@ data IdeVolatileState = IdeVolatileState , vsCachedRebuild :: Maybe (P.ModuleName, P.ExternsFile) } deriving (Show) -data IdeModifierState = IdeModifierState - { mdFocusedModules :: Set P.ModuleName +-- | @IdeDurableState@ holds data that persists across resets of the @IdeState@. +-- This is particularly useful for configuration variables that can be modified +-- during runtime. For instance, the module names for the "focus" feature are +-- stored in the drFocusedModules field, which the client populates using the +-- @Focus@ command to specify only which modules to load. +data IdeDurableState = IdeDurableState + { drFocusedModules :: Set P.ModuleName } deriving (Show) newtype Match a = Match (P.ModuleName, a) From c19d377a734addaf5dfb03b732896de6b70a550c Mon Sep 17 00:00:00 2001 From: Justin Garcia Date: Wed, 31 Jul 2024 04:28:08 +0800 Subject: [PATCH 3/3] Refactor command handling in startServer --- app/Command/Ide.hs | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/app/Command/Ide.hs b/app/Command/Ide.hs index f5a501af75..38fc9c7e36 100644 --- a/app/Command/Ide.hs +++ b/app/Command/Ide.hs @@ -28,7 +28,7 @@ import Data.ByteString.Char8 qualified as BS8 import Data.ByteString.Lazy.Char8 qualified as BSL8 import GHC.IO.Exception (IOErrorType(..), IOException(..)) import Language.PureScript.Ide (handleCommand) -import Language.PureScript.Ide.Command (Command(..), commandName) +import Language.PureScript.Ide.Command (commandName, Command(..)) import Language.PureScript.Ide.Util (decodeT, displayTimeSpec, encodeT, logPerf, runLogger) import Language.PureScript.Ide.Error (IdeError(..)) import Language.PureScript.Ide.State (updateCacheTimestamp) @@ -199,14 +199,22 @@ startServer port env = Network.withSocketsDo $ do logPerf message $ do result <- runExceptT $ do updateCacheTimestamp >>= \case - Nothing -> pure () + Nothing -> + handleCommand cmd' Just (before, after) -> do -- If the cache db file was changed outside of the IDE -- we trigger a reset before processing the command $(logInfo) ("cachedb was changed from: " <> show before <> ", to: " <> show after) - unless (isLoadAll cmd') $ - void (handleCommand Reset *> handleCommand (LoadSync [])) - handleCommand cmd' + let doReload = handleCommand Reset *> handleCommand (LoadSync []) + case cmd' of + -- handleCommand on Load [] already resets the state. + Load [] -> handleCommand cmd' + -- Focus needs to fire before doReload, because we + -- want to set the focused modules first before + -- loading everything with LoadSync []. + Focus _ -> handleCommand cmd' <* doReload + -- Otherwise, just doReload and then handle. + _ -> doReload *> handleCommand cmd' liftIO $ catchGoneHandle $ BSL8.hPutStrLn h $ case result of Right r -> Aeson.encode r Left err -> Aeson.encode err @@ -219,11 +227,6 @@ startServer port env = Network.withSocketsDo $ do hFlush stdout liftIO $ catchGoneHandle (hClose h) -isLoadAll :: Command -> Bool -isLoadAll = \case - Load [] -> True - _ -> False - catchGoneHandle :: IO () -> IO () catchGoneHandle = handle (\e -> case e of