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 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..77a925ac1c 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 @@ -61,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 @@ -141,6 +146,23 @@ setVolatileStateSTM ref vs = do x {ideVolatileState = vs} pure () +-- | Retrieves the DurableState from the State. +getDurableState :: Ide m => m IdeDurableState +getDurableState = do + st <- ideStateVar <$> ask + liftIO (atomically (getDurableStateSTM st)) + +-- | STM version of getDurableState +getDurableStateSTM :: TVar IdeState -> STM IdeDurableState +getDurableStateSTM ref = ideDurableState <$> readTVar ref + +-- | Sets the DurableState inside Ide's state +setDurableStateSTM :: TVar IdeState -> IdeDurableState -> STM () +setDurableStateSTM ref md = do + modifyTVar ref $ \x -> + x {ideDurableState = 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 +472,17 @@ 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 + IdeDurableState{drFocusedModules = focusedModules} <- getDurableState + 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 + setDurableStateSTM ref (IdeDurableState (Set.fromList modulesToFocus)) diff --git a/src/Language/PureScript/Ide/Types.hs b/src/Language/PureScript/Ide/Types.hs index 5fa304166b..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,10 +179,11 @@ type Ide m = (MonadIO m, MonadReader IdeEnvironment m) data IdeState = IdeState { ideFileState :: IdeFileState , ideVolatileState :: IdeVolatileState + , ideDurableState :: IdeDurableState } deriving (Show) emptyIdeState :: IdeState -emptyIdeState = IdeState emptyFileState emptyVolatileState +emptyIdeState = IdeState emptyFileState emptyVolatileState emptyDurableState emptyFileState :: IdeFileState emptyFileState = IdeFileState M.empty M.empty @@ -189,6 +191,8 @@ emptyFileState = IdeFileState M.empty M.empty emptyVolatileState :: IdeVolatileState emptyVolatileState = IdeVolatileState (AstData M.empty) M.empty Nothing +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 @@ -213,6 +217,15 @@ data IdeVolatileState = IdeVolatileState , vsCachedRebuild :: Maybe (P.ModuleName, P.ExternsFile) } deriving (Show) +-- | @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) deriving (Show, Eq, Functor)