Merge remote-tracking branch 'oa/lazy-state-result-#4545'

Author: purefunctor

CHANGELOG.d/fix_issue-4545.md

@@ -0,0 +1 @@
+* Speed up IDE performance on large projects

CONTRIBUTORS.md

@@ -167,6 +167,7 @@ If you would prefer to use different terms, please use the section below instead
 | [@woody88](https://github.com/woody88) | Woodson Delhia | [MIT license] |
 | [@xgrommx](https://github.com/xgrommx) | Denis Stoyanov | [MIT license] |
 | [@zudov](https://github.com/zudov) | Konstantin Zudov | [MIT license] |
+| [@roryc89](https://github.com/roryc89) | Rory Campbell | [MIT license] |
 
 
 ### Contributors using Modified Terms

src/Language/PureScript/Ide/Reexports.hs

@@ -35,9 +35,8 @@ data ReexportResult a
   = ReexportResult
   { reResolved :: a
   , reFailed   :: [(P.ModuleName, P.DeclarationRef)]
-  } deriving (Show, Eq, Functor, Generic)
+  } deriving (Show, Eq, Functor)
 
-instance NFData a => NFData (ReexportResult a)
 
 -- | Uses the passed formatter to format the resolved module, and adds possible
 -- failures

src/Language/PureScript/Ide/State.hs

@@ -58,7 +58,7 @@ import Language.PureScript.Ide.Externs (convertExterns)
 import Language.PureScript.Ide.Reexports (ReexportResult(..), prettyPrintReexportResult, reexportHasFailures, resolveReexports)
 import Language.PureScript.Ide.SourceFile (extractAstInformation)
 import Language.PureScript.Ide.Types
-import Language.PureScript.Ide.Util (discardAnn, displayTimeSpec, logPerf, opNameT, properNameT, runLogger)
+import Language.PureScript.Ide.Util (discardAnn, opNameT, properNameT, runLogger)
 import System.Directory (getModificationTime)
 
 -- | Resets all State inside psc-ide
@@ -221,10 +221,7 @@ cachedRebuild = vsCachedRebuild <$> getVolatileState
 populateVolatileStateSync :: (Ide m, MonadLogger m) => m ()
 populateVolatileStateSync = do
   st <- ideStateVar <$> ask
-  let message duration = "Finished populating volatile state in: " <> displayTimeSpec duration
-  results <- logPerf message $ do
-    !r <- liftIO (atomically (populateVolatileStateSTM st))
-    pure r
+  results <- liftIO (atomically (populateVolatileStateSTM st))
   void $ Map.traverseWithKey
     (\mn -> logWarnN . prettyPrintReexportResult (const (P.runModuleName mn)))
     (Map.filter reexportHasFailures results)
@@ -257,7 +254,7 @@ populateVolatileStateSTM ref = do
         & resolveOperators
         & resolveReexports reexportRefs
   setVolatileStateSTM ref (IdeVolatileState (AstData asts) (map reResolved results) rebuildCache)
-  pure (force results)
+  pure results
 
 resolveLocations
   :: ModuleMap (DefinitionSites P.SourceSpan, TypeAnnotations)

src/Language/PureScript/Ide/Types.hs

@@ -32,59 +32,59 @@ data IdeDeclaration
   | IdeDeclValueOperator IdeValueOperator
   | IdeDeclTypeOperator IdeTypeOperator
   | IdeDeclModule P.ModuleName
-  deriving (Show, Eq, Ord, Generic, NFData)
+  deriving (Show, Eq, Ord)
 
 data IdeValue = IdeValue
   { _ideValueIdent :: P.Ident
   , _ideValueType :: P.SourceType
-  } deriving (Show, Eq, Ord, Generic, NFData)
+  } deriving (Show, Eq, Ord)
 
 data IdeType = IdeType
  { _ideTypeName :: P.ProperName 'P.TypeName
  , _ideTypeKind :: P.SourceType
  , _ideTypeDtors :: [(P.ProperName 'P.ConstructorName, P.SourceType)]
- } deriving (Show, Eq, Ord, Generic, NFData)
+ } deriving (Show, Eq, Ord)
 
 data IdeTypeSynonym = IdeTypeSynonym
   { _ideSynonymName :: P.ProperName 'P.TypeName
   , _ideSynonymType :: P.SourceType
   , _ideSynonymKind :: P.SourceType
-  } deriving (Show, Eq, Ord, Generic, NFData)
+  } deriving (Show, Eq, Ord)
 
 data IdeDataConstructor = IdeDataConstructor
   { _ideDtorName :: P.ProperName 'P.ConstructorName
   , _ideDtorTypeName :: P.ProperName 'P.TypeName
   , _ideDtorType :: P.SourceType
-  } deriving (Show, Eq, Ord, Generic, NFData)
+  } deriving (Show, Eq, Ord)
 
 data IdeTypeClass = IdeTypeClass
   { _ideTCName :: P.ProperName 'P.ClassName
   , _ideTCKind :: P.SourceType
   , _ideTCInstances :: [IdeInstance]
-  } deriving (Show, Eq, Ord, Generic, NFData)
+  } deriving (Show, Eq, Ord)
 
 data IdeInstance = IdeInstance
   { _ideInstanceModule :: P.ModuleName
   , _ideInstanceName :: P.Ident
   , _ideInstanceTypes :: [P.SourceType]
   , _ideInstanceConstraints :: Maybe [P.SourceConstraint]
-  } deriving (Show, Eq, Ord, Generic, NFData)
+  } deriving (Show, Eq, Ord)
 
 data IdeValueOperator = IdeValueOperator
   { _ideValueOpName :: P.OpName 'P.ValueOpName
   , _ideValueOpAlias :: P.Qualified (Either P.Ident (P.ProperName 'P.ConstructorName))
   , _ideValueOpPrecedence :: P.Precedence
   , _ideValueOpAssociativity :: P.Associativity
   , _ideValueOpType :: Maybe P.SourceType
-  } deriving (Show, Eq, Ord, Generic, NFData)
+  } deriving (Show, Eq, Ord)
 
 data IdeTypeOperator = IdeTypeOperator
   { _ideTypeOpName :: P.OpName 'P.TypeOpName
   , _ideTypeOpAlias :: P.Qualified (P.ProperName 'P.TypeName)
   , _ideTypeOpPrecedence :: P.Precedence
   , _ideTypeOpAssociativity :: P.Associativity
   , _ideTypeOpKind :: Maybe P.SourceType
-  } deriving (Show, Eq, Ord, Generic, NFData)
+  } deriving (Show, Eq, Ord)
 
 _IdeDeclValue :: Traversal' IdeDeclaration IdeValue
 _IdeDeclValue f (IdeDeclValue x) = map IdeDeclValue (f x)
@@ -132,15 +132,15 @@ makeLenses ''IdeTypeOperator
 data IdeDeclarationAnn = IdeDeclarationAnn
   { _idaAnnotation :: Annotation
   , _idaDeclaration :: IdeDeclaration
-  } deriving (Show, Eq, Ord, Generic, NFData)
+  } deriving (Show, Eq, Ord)
 
 data Annotation
   = Annotation
   { _annLocation :: Maybe P.SourceSpan
   , _annExportedFrom :: Maybe P.ModuleName
   , _annTypeAnnotation :: Maybe P.SourceType
   , _annDocumentation :: Maybe Text
-  } deriving (Show, Eq, Ord, Generic, NFData)
+  } deriving (Show, Eq, Ord)
 
 makeLenses ''Annotation
 makeLenses ''IdeDeclarationAnn
@@ -153,7 +153,7 @@ type TypeAnnotations = Map P.Ident P.SourceType
 newtype AstData a = AstData (ModuleMap (DefinitionSites a, TypeAnnotations))
   -- ^ SourceSpans for the definition sites of values and types as well as type
   -- annotations found in a module
-  deriving (Show, Eq, Ord, Generic, NFData, Functor, Foldable)
+  deriving (Show, Eq, Ord, Functor, Foldable)
 
 data IdeLogLevel = LogDebug | LogPerf | LogAll | LogDefault | LogNone
   deriving (Show, Eq)
@@ -326,7 +326,7 @@ encodeImport (P.runModuleName -> mn, importType, map P.runModuleName -> qualifie
 
 -- | Denotes the different namespaces a name in PureScript can reside in.
 data IdeNamespace = IdeNSValue | IdeNSType | IdeNSModule
-  deriving (Show, Eq, Ord, Generic, NFData)
+  deriving (Show, Eq, Ord)
 
 instance FromJSON IdeNamespace where
   parseJSON = Aeson.withText "Namespace" $ \case
@@ -337,4 +337,4 @@ instance FromJSON IdeNamespace where
 
 -- | A name tagged with a namespace
 data IdeNamespaced = IdeNamespaced IdeNamespace Text
-  deriving (Show, Eq, Ord, Generic, NFData)
+  deriving (Show, Eq, Ord)