purescript · kritzcreek · Jul 30, 2017 · Jul 30, 2017 · Jul 30, 2017 · Jul 30, 2017
diff --git a/app/Command/Ide.hs b/app/Command/Ide.hs
@@ -69,6 +69,7 @@ data ServerOptions = ServerOptions
   , _serverNoWatch    :: Bool
   , _serverPolling    :: Bool
   , _serverLoglevel   :: IdeLogLevel
+  , _serverEditorMode :: Bool
   } deriving (Show)
 
 data ClientOptions = ClientOptions
@@ -106,7 +107,7 @@ command = Opts.helper <*> subcommands where
     Opts.option Opts.auto (Opts.long "port" <> Opts.short 'p' <> Opts.value (4242 :: Integer))
 
   server :: ServerOptions -> IO ()
-  server opts'@(ServerOptions dir globs outputPath port noWatch polling logLevel) = do
+  server opts'@(ServerOptions dir globs outputPath port noWatch polling logLevel editorMode) = do
     when (logLevel == LogDebug || logLevel == LogAll)
       (putText "Parsed Options:" *> print opts')
     maybe (pure ()) setCurrentDirectory dir
@@ -118,10 +119,16 @@ command = Opts.helper <*> subcommands where
       putText "Your output directory didn't exist. This usually means you didn't compile your project yet."
       putText "psc-ide needs you to compile your project (for example by running pulp build)"
 
-    unless noWatch $
+    unless (noWatch || editorMode) $
       void (forkFinally (watcher polling logLevel ideState fullOutputPath) print)
-    let conf = IdeConfiguration {confLogLevel = logLevel, confOutputPath = outputPath, confGlobs = globs}
-        env = IdeEnvironment {ideStateVar = ideState, ideConfiguration = conf}
+    let
+      conf = IdeConfiguration
+        { confLogLevel = logLevel
+        , confOutputPath = outputPath
+        , confGlobs = globs
+        , confEditorMode = editorMode
+        }
+    let env = IdeEnvironment {ideStateVar = ideState, ideConfiguration = conf}
     startServer port env
 
   serverOptions :: Opts.Parser ServerOptions
@@ -138,6 +145,7 @@ command = Opts.helper <*> subcommands where
            (Opts.long "log-level"
             `mappend` Opts.value ""
             `mappend` Opts.help "One of \"debug\", \"perf\", \"all\" or \"none\""))
+      <*> Opts.switch (Opts.long "editor-mode")
 
   parseLogLevel s = case s of
     "debug" -> LogDebug

diff --git a/psc-ide/README.md b/psc-ide/README.md
@@ -1,17 +1,18 @@
-psc-ide
+purs ide
 ===
 
-A tool which provides editor support for the PureScript programming language.
+Editor and tooling support for the PureScript programming language.
 
-## Editor Integration
-* [@epost](https://github.com/epost) wrote a plugin to integrate psc-ide with Emacs at https://github.com/epost/psc-ide-emacs.
-* Atom integration is available with https://github.com/nwolverson/atom-ide-purescript.
-* Visual Studio Code integration is available with https://github.com/nwolverson/vscode-ide-purescript.
-* Vim integration is available here: https://github.com/FrigoEU/psc-ide-vim.
+## Setting up your editor
+
+This document will describe how to run `purs ide` as an editor plugin creator.
+If you're looking to set up your PureScript development environment consult
+the
+[documentation repository](https://github.com/purescript/documentation/blob/master/ecosystem/Editor-and-tool-support.md) instead.
 
 ## Running the Server
 
-Start the server by running the `psc-ide-server [SOURCEGLOBS]` executable, where
+Start the server by running the `purs ide server [SOURCEGLOBS]` executable, where
 `SOURCEGLOBS` are (optional) globs that match your PureScript sourcefiles.
 
 It supports the following options:
@@ -26,21 +27,22 @@ It supports the following options:
   files. This flag is reversed on Windows and polling is the default.
 - `--log-level`: Can be set to one of "all", "none", "debug" and "perf"
 - `--no-watch`: Disables the filewatcher
+- `--editor-mode`: Only reload on source file changes reported by the editor
 - `--version`: Output psc-ide version
 
 ## Issuing queries
 
 After you started the server you can start issuing requests using
-`psc-ide-client`. Make sure you start by loading the modules before you try to
+`purs ide client`. Make sure you start by loading the modules before you try to
 query them.
 
-`psc-ide-server` expects the build externs.purs inside the `output/` folder of
-your project after running `pulp build` or `psc-make` respectively.
+`purs ide` expects the built externs.json inside the output folder of your
+project after running `pulp build` or `purs compile` respectively.
 
 (If you changed the port of the server you can change the port for
-`psc-ide-client` by using the -p option accordingly)
+`purs ide client` by using the -p option accordingly)
 
 ## Protocol
 
-For documentation about the protocol have a look at:
-[PROTOCOL.md](PROTOCOL.md)
+If you want to know how to send commands/queries to `purs ide` take a look
+at [PROTOCOL.md](PROTOCOL.md)
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
@@ -1,6 +1,8 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DeriveAnyClass #-}
 
 -- |
 -- Data types for modules and declarations
@@ -9,12 +11,14 @@ module Language.PureScript.AST.Declarations where
 
 import Prelude.Compat
 
+import Control.DeepSeq (NFData)
 import Control.Monad.Identity
 
 import Data.Aeson.TH
 import qualified Data.Map as M
 import Data.Text (Text)
 import qualified Data.List.NonEmpty as NEL
+import GHC.Generics (Generic)
 
 import Language.PureScript.AST.Binders
 import Language.PureScript.AST.Literals
@@ -288,7 +292,7 @@ data DeclarationRef
   -- elaboration in name desugaring.
   --
   | ReExportRef SourceSpan ModuleName DeclarationRef
-  deriving (Show)
+  deriving (Show, Generic, NFData)
 
 instance Eq DeclarationRef where
   (TypeRef _ name dctors) == (TypeRef _ name' dctors') = name == name' && dctors == dctors'

diff --git a/src/Language/PureScript/Ide.hs b/src/Language/PureScript/Ide.hs
@@ -187,14 +187,7 @@ loadModulesAsync
   -> m Success
 loadModulesAsync moduleNames = do
   tr <- loadModules moduleNames
-
-  -- Finally we kick off the worker with @async@ and return the number of
-  -- successfully parsed modules.
-  env <- ask
-  let ll = confLogLevel (ideConfiguration env)
-  -- populateVolatileState return Unit for now, so it's fine to discard this
-  -- result. We might want to block on this in a benchmarking situation.
-  _ <- liftIO (async (runLogger ll (runReaderT populateVolatileState env)))
+  _ <- populateVolatileState
   pure tr
 
 loadModulesSync
@@ -203,7 +196,7 @@ loadModulesSync
   -> m Success
 loadModulesSync moduleNames = do
   tr <- loadModules moduleNames
-  populateVolatileState
+  populateVolatileStateSync
   pure tr
 
 loadModules

diff --git a/src/Language/PureScript/Ide/Rebuild.hs b/src/Language/PureScript/Ide/Rebuild.hs
@@ -72,10 +72,17 @@ rebuildFile path runOpenBuild = do
                         >>= shushProgress $ makeEnv) externs $ m
   case result of
     Left errors -> throwError (RebuildError errors)
-    Right _ -> do
+    Right newExterns -> do
+      whenM isEditorMode $ do
+        insertModule (path, m)
+        insertExterns newExterns
+        void populateVolatileState
       runOpenBuild (rebuildModuleOpen makeEnv externs m)
       pure (RebuildSuccess warnings)
 
+isEditorMode :: Ide m => m Bool
+isEditorMode = asks (confEditorMode . ideConfiguration)
+
 rebuildFileAsync
   :: forall m. (Ide m, MonadLogger m, MonadError IdeError m)
   => FilePath -> m Success

diff --git a/src/Language/PureScript/Ide/Reexports.hs b/src/Language/PureScript/Ide/Reexports.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 -----------------------------------------------------------------------------
 --
 -- Module      : Language.PureScript.Ide.Reexports
@@ -35,7 +36,9 @@ data ReexportResult a
   = ReexportResult
   { reResolved :: a
   , reFailed   :: [(P.ModuleName, P.DeclarationRef)]
-  } deriving (Show, Eq, Functor)
+  } deriving (Show, Eq, Functor, Generic)
+
+instance NFData a => NFData (ReexportResult a)
 
 -- | Uses the passed formatter to format the resolved module, and adds possible
 -- failures

diff --git a/src/Language/PureScript/Ide/State.hs b/src/Language/PureScript/Ide/State.hs
@@ -12,9 +12,10 @@
 -- Functions to access psc-ide's state
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE PackageImports        #-}
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE NamedFieldPuns        #-}
+{-# LANGUAGE PackageImports  #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NamedFieldPuns  #-}
+{-# LANGUAGE BangPatterns    #-}
 
 module Language.PureScript.Ide.State
   ( getLoadedModulenames
@@ -27,6 +28,7 @@ module Language.PureScript.Ide.State
   , insertExternsSTM
   , getAllModules
   , populateVolatileState
+  , populateVolatileStateSync
   , populateVolatileStateSTM
   -- for tests
   , resolveOperatorsForModule
@@ -163,21 +165,33 @@ cachedRebuild :: Ide m => m (Maybe (P.ModuleName, ExternsFile))
 cachedRebuild = vsCachedRebuild <$> getVolatileState
 
 -- | Resolves reexports and populates VolatileState with data to be used in queries.
-populateVolatileState :: (Ide m, MonadLogger m) => m ()
-populateVolatileState = do
+populateVolatileStateSync :: (Ide m, MonadLogger m) => m ()
+populateVolatileStateSync = do
   st <- ideStateVar <$> ask
-  let message duration = "Finished populating Stage3 in " <> displayTimeSpec duration
-  results <- logPerf message (liftIO (atomically (populateVolatileStateSTM st)))
+  let message duration = "Finished populating volatile state in: " <> displayTimeSpec duration
+  results <- logPerf message $ do
+    !r <- liftIO (atomically (populateVolatileStateSTM st))
+    pure r
   void $ Map.traverseWithKey
     (\mn -> logWarnN . prettyPrintReexportResult (const (P.runModuleName mn)))
     (Map.filter reexportHasFailures results)
 
+populateVolatileState :: (Ide m, MonadLogger m) => m (Async ())
+populateVolatileState = do
+  env <- ask
+  let ll = confLogLevel (ideConfiguration env)
+  -- populateVolatileState return Unit for now, so it's fine to discard this
+  -- result. We might want to block on this in a benchmarking situation.
+  liftIO (async (runLogger ll (runReaderT populateVolatileStateSync env)))
+
 -- | STM version of populateVolatileState
 populateVolatileStateSTM
   :: TVar IdeState
   -> STM (ModuleMap (ReexportResult [IdeDeclarationAnn]))
 populateVolatileStateSTM ref = do
   IdeFileState{fsExterns = externs, fsModules = modules} <- getFileStateSTM ref
+  -- We're not using the cached rebuild for anything other than preserving it
+  -- through the repopulation
   rebuildCache <- vsCachedRebuild <$> getVolatileStateSTM ref
   let asts = map (extractAstInformation . fst) modules
   let (moduleDeclarations, reexportRefs) = (map fst &&& map snd) (Map.map convertExterns externs)
@@ -189,7 +203,7 @@ populateVolatileStateSTM ref = do
         & resolveOperators
         & resolveReexports reexportRefs
   setVolatileStateSTM ref (IdeVolatileState (AstData asts) (map reResolved results) rebuildCache)
-  pure results
+  pure (force results)
 
 resolveLocations
   :: ModuleMap (DefinitionSites P.SourceSpan, TypeAnnotations)

diff --git a/src/Language/PureScript/Ide/Types.hs b/src/Language/PureScript/Ide/Types.hs
@@ -12,6 +12,8 @@
 -- Type definitions for psc-ide
 -----------------------------------------------------------------------------
 
+{-# LANGUAGE DeriveGeneric   #-}
+{-# LANGUAGE DeriveAnyClass  #-}
 {-# LANGUAGE DeriveFoldable  #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -38,59 +40,59 @@ data IdeDeclaration
   | IdeDeclValueOperator IdeValueOperator
   | IdeDeclTypeOperator IdeTypeOperator
   | IdeDeclKind (P.ProperName 'P.KindName)
-  deriving (Show, Eq, Ord)
+  deriving (Show, Eq, Ord, Generic, NFData)
 
 data IdeValue = IdeValue
   { _ideValueIdent :: P.Ident
   , _ideValueType  :: P.Type
-  } deriving (Show, Eq, Ord)
+  } deriving (Show, Eq, Ord, Generic, NFData)
 
 data IdeType = IdeType
  { _ideTypeName :: P.ProperName 'P.TypeName
  , _ideTypeKind :: P.Kind
  , _ideTypeDtors :: [(P.ProperName 'P.ConstructorName, P.Type)]
- } deriving (Show, Eq, Ord)
+ } deriving (Show, Eq, Ord, Generic, NFData)
 
 data IdeTypeSynonym = IdeTypeSynonym
   { _ideSynonymName :: P.ProperName 'P.TypeName
   , _ideSynonymType :: P.Type
   , _ideSynonymKind :: P.Kind
-  } deriving (Show, Eq, Ord)
+  } deriving (Show, Eq, Ord, Generic, NFData)
 
 data IdeDataConstructor = IdeDataConstructor
   { _ideDtorName     :: P.ProperName 'P.ConstructorName
   , _ideDtorTypeName :: P.ProperName 'P.TypeName
   , _ideDtorType     :: P.Type
-  } deriving (Show, Eq, Ord)
+  } deriving (Show, Eq, Ord, Generic, NFData)
 
 data IdeTypeClass = IdeTypeClass
   { _ideTCName :: P.ProperName 'P.ClassName
   , _ideTCKind :: P.Kind
   , _ideTCInstances :: [IdeInstance]
-  } deriving (Show, Eq, Ord)
+  } deriving (Show, Eq, Ord, Generic, NFData)
 
 data IdeInstance = IdeInstance
   { _ideInstanceModule      :: P.ModuleName
   , _ideInstanceName        :: P.Ident
   , _ideInstanceTypes       :: [P.Type]
   , _ideInstanceConstraints :: Maybe [P.Constraint]
-  } deriving (Show, Eq, Ord)
+  } deriving (Show, Eq, Ord, Generic, NFData)
 
 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.Type
-  } deriving (Show, Eq, Ord)
+  } deriving (Show, Eq, Ord, Generic, NFData)
 
 data IdeTypeOperator = IdeTypeOperator
   { _ideTypeOpName          :: P.OpName 'P.TypeOpName
   , _ideTypeOpAlias         :: P.Qualified (P.ProperName 'P.TypeName)
   , _ideTypeOpPrecedence    :: P.Precedence
   , _ideTypeOpAssociativity :: P.Associativity
   , _ideTypeOpKind          :: Maybe P.Kind
-  } deriving (Show, Eq, Ord)
+  } deriving (Show, Eq, Ord, Generic, NFData)
 
 makePrisms ''IdeDeclaration
 makeLenses ''IdeValue
@@ -105,14 +107,14 @@ makeLenses ''IdeTypeOperator
 data IdeDeclarationAnn = IdeDeclarationAnn
   { _idaAnnotation  :: Annotation
   , _idaDeclaration :: IdeDeclaration
-  } deriving (Show, Eq, Ord)
+  } deriving (Show, Eq, Ord, Generic, NFData)
 
 data Annotation
   = Annotation
   { _annLocation       :: Maybe P.SourceSpan
   , _annExportedFrom   :: Maybe P.ModuleName
   , _annTypeAnnotation :: Maybe P.Type
-  } deriving (Show, Eq, Ord)
+  } deriving (Show, Eq, Ord, Generic, NFData)
 
 makeLenses ''Annotation
 makeLenses ''IdeDeclarationAnn
@@ -125,7 +127,7 @@ type TypeAnnotations = Map P.Ident P.Type
 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, Functor, Foldable)
+  deriving (Show, Eq, Ord, Generic, NFData, Functor, Foldable)
 
 data IdeLogLevel = LogDebug | LogPerf | LogAll | LogDefault | LogNone
   deriving (Show, Eq)
@@ -135,6 +137,7 @@ data IdeConfiguration =
   { confOutputPath :: FilePath
   , confLogLevel   :: IdeLogLevel
   , confGlobs      :: [FilePath]
+  , confEditorMode :: Bool
   }
 
 data IdeEnvironment =
@@ -316,7 +319,7 @@ instance ToJSON PursuitResponse where
 
 -- | Denotes the different namespaces a name in PureScript can reside in.
 data IdeNamespace = IdeNSValue | IdeNSType | IdeNSKind
-  deriving (Show, Eq, Ord)
+  deriving (Show, Eq, Ord, Generic, NFData)
 
 instance FromJSON IdeNamespace where
   parseJSON (String s) = case s of
@@ -328,4 +331,4 @@ instance FromJSON IdeNamespace where
 
 -- | A name tagged with a namespace
 data IdeNamespaced = IdeNamespaced IdeNamespace Text
-  deriving (Show, Eq, Ord)
+  deriving (Show, Eq, Ord, Generic, NFData)