8bab509 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

#1712, fast recompilation in psc-ide-server (#2013)

* Initial work on #1712, Fast recompilation by keeping externs files in memory, in psc-ide-server * moves rebuild into its own module * adds a parameter to specify a path for the js Also uses the configured output directory over "output" * sort externfiles before creating the initial Environment * return JSON errors in case of a build failure * fix merge conflicts with master * initial RebuildTests * return warnings in case of a successful rebuild * Refactor to reuse code from Make module * Add TODO item * report errors back in case rebuilding fails * adds the Prim import back in before rebuilding * first stab at gather transitive dependencies * recurse when finding transitive dependencies * use the graph result from sorting the modules Crazy speedups O.o * looks up foreign files adds testfiles to cabal adds tests * silence progress messages

commit8bab5090ce3559d89c10c34e240356a5b371a489 authorChristoph Hegemann <kRITZCREEK@users.noreply.github.com> dateSun 17 Apr 2016, 00:13 (11 years ago) parent419d90e

21 files changed+191−36

compare with golang

unifiedsplit

psc-ide-server/Main.hs+1−1

@@ -125,7 +125,7 @@ startServer port env = withSocketsDo $ do

125125 case decodeT cmd of

126126 Just cmd' -> do

127127 result <- runExceptT (handleCommand cmd')

128− $(logDebug) ("Answer was: " <> T.pack (show result))

128+ -- $(logDebug) ("Answer was: " <> T.pack (show result))

129129 liftIO (hFlush stdout)

130130 case result of

131131 -- What function can I use to clean this up?

psc-ide-server/PROTOCOL.md+24

@@ -240,6 +240,30 @@ Example:

240240}

241241```

242242

243+### Rebuild

244+

245+The `rebuild` command provides a fast rebuild for a single module. It doesn't

246+recompile the entire project though. All the modules dependencies need to be

247+loaded.

248+

249+Arguments:

250+- `file :: String` the path to the module to rebuild

251+

252+```json

253+{

254+ "command": "rebuild",

255+ "params": {

256+ "file": "/path/to/file.purs"

257+ }

258+}

259+```

260+

261+**Result**

262+

263+In the Success case you get a list of warnings in the compilers json format.

264+

265+In the Error case you get the errors in the compilers json format

266+

243267### Pursuit

244268The `pursuit` command looks up the packages/completions for a given identifier from Pursuit.

245269

psc/Main.hs+1−2

@@ -28,8 +28,7 @@ import qualified Language.PureScript as P

2828import qualified Paths_purescript as Paths

2929

3030import Language.PureScript.Make

31−

32−import JSON

31+import Language.PureScript.Errors.JSON

3332

3433data PSCMakeOptions = PSCMakeOptions

3534 { pscmInput :: [FilePath]

purescript.cabal+6−1

@@ -37,6 +37,8 @@ extra-source-files: examples/passing/*.purs

3737 , tests/support/flattened/*.js

3838 , tests/support/psci/*.purs

3939 , tests/support/pscide/src/*.purs

40+ , tests/support/pscide/src/*.js

41+ , tests/support/pscide/src/*.fail

4042 , stack.yaml

4143 , stack-lts-5.yaml

4244 , stack-nightly.yaml

@@ -127,6 +129,7 @@ library

127129 Language.PureScript.Comments

128130 Language.PureScript.Environment

129131 Language.PureScript.Errors

132+ Language.PureScript.Errors.JSON

130133 Language.PureScript.Kinds

131134 Language.PureScript.Linter

132135 Language.PureScript.Linter.Exhaustive

@@ -215,6 +218,7 @@ library

215218 Language.PureScript.Ide.Reexports

216219 Language.PureScript.Ide.Imports

217220 Language.PureScript.Ide.Util

221+ Language.PureScript.Ide.Rebuild

218222

219223 Control.Monad.Logger

220224 Control.Monad.Supply

@@ -238,7 +242,7 @@ executable psc

238242 main-is: Main.hs

239243 buildable: True

240244 hs-source-dirs: psc

241− other-modules: JSON, Paths_purescript

245+ other-modules: Paths_purescript

242246 ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts "-with-rtsopts=-N"

243247

244248executable psci

@@ -370,6 +374,7 @@ test-suite tests

370374 Language.PureScript.Ide.Imports.IntegrationSpec

371375 Language.PureScript.Ide.Integration

372376 Language.PureScript.Ide.MatcherSpec

377+ Language.PureScript.Ide.RebuildSpec

373378 Language.PureScript.Ide.ReexportsSpec

374379 Language.PureScript.IdeSpec

375380 PSCi.Completion

psc/JSON.hs → src/Language/PureScript/Errors/JSON.hsrenamed+7−7

@@ -1,6 +1,6 @@

11-----------------------------------------------------------------------------

22--

3−-- Module : Main

3+-- Module : Language.PureScript.Errors.JSON

55-- License : MIT (http://opensource.org/licenses/MIT)

66--

@@ -14,7 +14,7 @@

1414

1515{-# LANGUAGE TemplateHaskell #-}

1616

17−module JSON where

17+module Language.PureScript.Errors.JSON where

1818

1919import Prelude ()

2020import Prelude.Compat

@@ -28,9 +28,9 @@ data ErrorPosition = ErrorPosition

2828 , startColumn :: Int

2929 , endLine :: Int

3030 , endColumn :: Int

31− }

31+ } deriving (Show, Eq, Ord)

3232

33−data ErrorSuggestion = ErrorSuggestion { replacement :: String }

33+data ErrorSuggestion = ErrorSuggestion { replacement :: String } deriving (Show, Eq)

3434

3535data JSONError = JSONError

3636 { position :: Maybe ErrorPosition

@@ -40,12 +40,12 @@ data JSONError = JSONError

4040 , filename :: Maybe String

4141 , moduleName :: Maybe String

4242 , suggestion :: Maybe ErrorSuggestion

43− }

43+ } deriving (Show, Eq)

4444

4545data JSONResult = JSONResult

4646 { warnings :: [JSONError]

4747 , errors :: [JSONError]

48− }

48+ } deriving (Show, Eq)

4949

5050$(A.deriveJSON A.defaultOptions ''ErrorPosition)

5151$(A.deriveJSON A.defaultOptions ''JSONError)

@@ -64,7 +64,7 @@ toJSONError verbose level e =

6464 (P.wikiUri e)

6565 (P.spanName <$> sspan)

6666 (P.runModuleName <$> P.errorModule e)

67− (toSuggestion <$> (P.errorSuggestion $ P.unwrapErrorMessage e))

67+ (toSuggestion <$> P.errorSuggestion (P.unwrapErrorMessage e))

6868 where

6969 sspan :: Maybe P.SourceSpan

7070 sspan = P.errorSpan e

src/Language/PureScript/Ide.hs+3−2

@@ -53,11 +53,11 @@ import Language.PureScript.Ide.SourceFile

5353import Language.PureScript.Ide.State

5454import Language.PureScript.Ide.Types

5555import Language.PureScript.Ide.Util

56+import Language.PureScript.Ide.Rebuild

5657import System.Directory

5758import System.FilePath

5859import System.Exit

5960

60−

6161handleCommand :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

6262 Command -> m Success

6363handleCommand (Load [] []) = loadAllModules

@@ -89,6 +89,8 @@ handleCommand (Import fp outfp filters (AddImportForIdentifier ident)) = do

8989 case rs of

9090 Right rs' -> answerRequest outfp rs'

9191 Left question -> pure $ CompletionResult (mapMaybe completionFromMatch question)

92+handleCommand (Rebuild file) =

93+ rebuildFile file

9294handleCommand Cwd =

9395 TextResult . T.pack <$> liftIO getCurrentDirectory

9496handleCommand Quit = liftIO exitSuccess

@@ -238,4 +240,3 @@ filePathFromModule moduleName = do

238240 if ex

239241 then pure path

240242 else throwError (ModuleFileNotFound moduleName)

241−

src/Language/PureScript/Ide/Command.hs+5−1

@@ -63,6 +63,7 @@ data Command

6363 -- Import InputFile OutputFile

6464 | Import FilePath (Maybe FilePath) [Filter] ImportCommand

6565 | List { listType :: ListType }

66+ | Rebuild FilePath -- ^ Rebuild the specified file using the loaded externs

6667 | Cwd

6768 | Quit

6869

@@ -149,5 +150,8 @@ instance FromJSON Command where

149150 filters <- params .:? "filters"

150151 importCommand <- params .: "importCommand"

151152 pure $ Import fp out (fromMaybe [] filters) importCommand

153+ "rebuild" -> do

154+ params <- o .: "params"

155+ filePath <- params .: "file"

156+ return $ Rebuild filePath

152157 _ -> mzero

153−

src/Language/PureScript/Ide/Error.hs+12−6

@@ -20,6 +20,7 @@ module Language.PureScript.Ide.Error

2020import Data.Aeson

2121import Data.Monoid

2222import Data.Text (Text, pack)

23+import Language.PureScript.Errors.JSON

2324import Language.PureScript.Ide.Types (ModuleIdent)

2425import qualified Text.Parsec.Error as P

2526

@@ -31,9 +32,13 @@ data PscIdeError

3132 | ModuleNotFound ModuleIdent

3233 | ModuleFileNotFound ModuleIdent

3334 | ParseError P.ParseError ErrorMsg

34− deriving (Show, Eq)

35+ | RebuildError [JSONError]

3536

3637instance ToJSON PscIdeError where

38+ toJSON (RebuildError errs) = object

39+ [ "resultType" .= ("error" :: Text)

40+ , "result" .= errs

41+ ]

3742 toJSON err = object

3843 [ "resultType" .= ("error" :: Text)

3944 , "result" .= textError err

@@ -44,8 +49,9 @@ textError (GeneralError msg) = pack msg

4449textError (NotFound ident) = "Symbol '" <> ident <> "' not found."

4550textError (ModuleNotFound ident) = "Module '" <> ident <> "' not found."

4651textError (ModuleFileNotFound ident) = "Extern file for module " <> ident <>" could not be found"

47−textError (ParseError parseError msg) = pack $ msg <> ": " <> show (escape parseError)

48− where

49− -- escape newlines and other special chars so we can send the error over the socket as a single line

50− escape :: P.ParseError -> String

51− escape = show

52+textError (ParseError parseError msg) = let escape = show

53+ -- escape newlines and other special

54+ -- chars so we can send the error

55+ -- over the socket as a single line

56+ in pack $ msg <> ": " <> show (escape parseError)

57+textError (RebuildError err) = pack (show err)

src/Language/PureScript/Ide/Rebuild.hsnew file

Binary file not shown.

src/Language/PureScript/Ide/State.hs+4

@@ -51,6 +51,10 @@ getExternFiles = do

5151 stateVar <- envStateVar <$> ask

5252 liftIO (externsFiles <$> readTVarIO stateVar)

5353

54+getExternFile :: (PscIde m) =>

55+ ModuleName -> m (Maybe ExternsFile)

56+getExternFile mn = M.lookup mn <$> getExternFiles

57+

5458getAllDecls :: (PscIde m) => m [ExternDecl]

5559getAllDecls = concat <$> getPscIdeState

5660

src/Language/PureScript/Ide/Types.hs+3

@@ -33,6 +33,7 @@ import Data.Maybe (maybeToList)

3333import Data.Text (Text (), pack, unpack)

3434import qualified Language.PureScript.AST.Declarations as D

3535import Language.PureScript.Externs

36+import qualified Language.PureScript.Errors.JSON as P

3637import qualified Language.PureScript.Names as N

3738import qualified Language.PureScript as P

3839

@@ -144,6 +145,7 @@ data Success =

144145 | PursuitResult [PursuitResponse]

145146 | ImportList [ModuleImport]

146147 | ModuleList [ModuleIdent]

148+ | RebuildSuccess [P.JSONError]

147149 deriving(Show, Eq)

148150

149151encodeSuccess :: (ToJSON a) => a -> Value

@@ -157,6 +159,7 @@ instance ToJSON Success where

157159 toJSON (PursuitResult resp) = encodeSuccess resp

158160 toJSON (ImportList decls) = encodeSuccess decls

159161 toJSON (ModuleList modules) = encodeSuccess modules

162+ toJSON (RebuildSuccess modules) = encodeSuccess modules

160163

161164newtype PursuitQuery = PursuitQuery Text

162165 deriving (Show, Eq)

src/Language/PureScript/Make.hs+25−16

@@ -14,6 +14,7 @@ module Language.PureScript.Make

1414 , ProgressMessage(..), renderProgressMessage

1515 , MakeActions(..)

1616 , Externs()

17+ , rebuildModule

1718 , make

1819

1920 -- * Implementation of Make API using files on disk

@@ -147,6 +148,28 @@ data RebuildPolicy

147148 -- | Always rebuild this module

148149 | RebuildAlways deriving (Show, Read, Eq, Ord)

149150

151+-- | Rebuild a single module

152+rebuildModule :: forall m. (Monad m, MonadBaseControl IO m, MonadReader Options m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

153+ => MakeActions m

154+ -> [ExternsFile]

155+ -> Module

156+ -> m ExternsFile

157+rebuildModule MakeActions{..} externs m@(Module _ _ moduleName _ _) = do

158+ progress $ CompilingModule moduleName

159+ let env = foldl' (flip applyExternsFileToEnvironment) initEnvironment externs

160+ lint m

161+ ((checked@(Module ss coms _ elaborated exps), env'), nextVar) <- runSupplyT 0 $ do

162+ [desugared] <- desugar externs [m]

163+ runCheck' env $ typeCheckModule desugared

164+ checkExhaustiveModule env' checked

165+ regrouped <- createBindingGroups moduleName . collapseBindingGroups $ elaborated

166+ let mod' = Module ss coms moduleName regrouped exps

167+ corefn = CF.moduleToCoreFn env' mod'

168+ [renamed] = renameInModules [corefn]

169+ exts = moduleToExternsFile mod' env'

170+ evalSupplyT nextVar . codegen renamed env' . BU8.toString . B.toStrict . encode $ exts

171+ return exts

172+

150173-- |

151174-- Compiles in "make" mode, compiling each module separately to a js files and an externs file

152175--

@@ -157,7 +180,7 @@ make :: forall m. (Monad m, MonadBaseControl IO m, MonadReader Options m, MonadE

157180 => MakeActions m

158181 -> [Module]

159182 -> m Environment

160−make MakeActions{..} ms = do

183+make ma@MakeActions{..} ms = do

161184 requirePath <- asks optionsRequirePath

162185 when (isJust requirePath) $ tell $ errorMessage DeprecatedRequirePath

163186

@@ -221,21 +244,7 @@ make MakeActions{..} ms = do

221244 _ -> True

222245

223246 let rebuild = do

224− (exts, warnings) <- listen $ do

225− progress $ CompilingModule moduleName

226− let env = foldl' (flip applyExternsFileToEnvironment) initEnvironment externs

227− lint m

228− ((checked@(Module ss coms _ elaborated exps), env'), nextVar) <- runSupplyT 0 $ do

229− [desugared] <- desugar externs [m]

230− runCheck' env $ typeCheckModule desugared

231− checkExhaustiveModule env' checked

232− regrouped <- createBindingGroups moduleName . collapseBindingGroups $ elaborated

233− let mod' = Module ss coms moduleName regrouped exps

234− corefn = CF.moduleToCoreFn env' mod'

235− [renamed] = renameInModules [corefn]

236− exts = moduleToExternsFile mod' env'

237− evalSupplyT nextVar . codegen renamed env' . BU8.toString . B.toStrict . encode $ exts

238− return exts

247+ (exts, warnings) <- listen $ rebuildModule ma externs m

239248 markComplete (Just (warnings, exts)) Nothing

240249

241250 if shouldRebuild

tests/Language/PureScript/Ide/Integration.hs+14

@@ -27,11 +27,13 @@ module Language.PureScript.Ide.Integration

2727 , projectDirectory

2828 , deleteFileIfExists

2929 -- sending commands

30+ , loadModule

3031 , loadModuleWithDeps

3132 , getFlexCompletions

3233 , getType

3334 , addImport

3435 , addImplicitImport

36+ , rebuildModule

3537 -- checking results

3638 , resultIsSuccess

3739 , parseCompletions

@@ -131,6 +133,9 @@ quitServer = do

131133loadModuleWithDeps :: String -> IO String

132134loadModuleWithDeps m = sendCommand $ load [] [m]

133135

136+loadModule :: String -> IO String

137+loadModule m = sendCommand $ load [m] []

138+

134139getFlexCompletions :: String -> IO [(String, String, String)]

135140getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)))

136141

@@ -143,6 +148,9 @@ addImport identifier fp outfp = sendCommand (addImportC identifier fp outfp)

143148addImplicitImport :: String -> FilePath -> FilePath -> IO String

144149addImplicitImport mn fp outfp = sendCommand (addImplicitImportC mn fp outfp)

145150

151+rebuildModule :: FilePath -> IO String

152+rebuildModule m = sendCommand (rebuildC m Nothing)

153+

146154-- Command Encoding

147155

148156commandWrapper :: String -> Value -> Value

@@ -166,6 +174,12 @@ addImplicitImportC mn = addImportW $

166174 , "module" .= mn

167175 ]

168176

177+rebuildC :: FilePath -> Maybe FilePath -> Value

178+rebuildC file outFile =

179+ commandWrapper "rebuild" (object [ "file" .= file

180+ , "outfile" .= outFile

181+ ])

182+

169183addImportW :: Value -> FilePath -> FilePath -> Value

170184addImportW importCommand fp outfp =

171185 commandWrapper "import" (object [ "file" .= fp

tests/Language/PureScript/Ide/RebuildSpec.hsnew file+62

@@ -0,0 +1,62 @@

1+module Language.PureScript.Ide.RebuildSpec where

3+import Control.Monad

4+import qualified Language.PureScript.Ide.Integration as Integration

5+import Test.Hspec

7+import System.FilePath

9+compile :: IO ()

10+compile = do

11+ Integration.deleteOutputFolder

12+ s <- Integration.compileTestProject

13+ unless s $ fail "Failed to compile .purs sources"

14+

15+teardown :: IO ()

16+teardown = Integration.quitServer

17+

18+restart :: IO ()

19+restart = Integration.quitServer *> (void Integration.startServer)

20+

21+shouldBeSuccess :: String -> IO ()

22+shouldBeSuccess = shouldBe True . Integration.resultIsSuccess

23+

24+shouldBeFailure :: String -> IO ()

25+shouldBeFailure = shouldBe False . Integration.resultIsSuccess

26+

27+spec :: Spec

28+spec = beforeAll_ compile $ afterAll_ teardown $ before_ restart $ do

29+ describe "Rebuilding single modules" $ do

30+ it "rebuilds a correct module without dependencies successfully" $ do

31+ _ <- Integration.loadModuleWithDeps "RebuildSpecSingleModule"

32+ pdir <- Integration.projectDirectory

33+ let file = pdir </> "src" </> "RebuildSpecSingleModule.purs"

34+ Integration.rebuildModule file >>= shouldBeSuccess

35+ it "fails to rebuild an incorrect module without dependencies and returns the errors" $ do

36+ pdir <- Integration.projectDirectory

37+ let file = pdir </> "src" </> "RebuildSpecSingleModule.fail"

38+ Integration.rebuildModule file >>= shouldBeFailure

39+ it "rebuilds a correct module with its dependencies successfully" $ do

40+ _ <- Integration.loadModuleWithDeps "RebuildSpecWithDeps"

41+ pdir <- Integration.projectDirectory

42+ let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"

43+ Integration.rebuildModule file >>= shouldBeSuccess

44+ it "rebuilds a correct module that has reverse dependencies" $ do

45+ _ <- Integration.loadModuleWithDeps "RebuildSpecWithDeps"

46+ pdir <- Integration.projectDirectory

47+ let file = pdir </> "src" </> "RebuildSpecDep.purs"

48+ Integration.rebuildModule file >>= shouldBeSuccess

49+ it "fails to rebuild a module if its dependencies are not loaded" $ do

50+ _ <- Integration.loadModule "RebuildSpecWithDeps"

51+ pdir <- Integration.projectDirectory

52+ let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"

53+ Integration.rebuildModule file >>= shouldBeFailure

54+ it "rebuilds a correct module with a foreign file" $ do

55+ _ <- Integration.loadModuleWithDeps "RebuildSpecWithForeign"

56+ pdir <- Integration.projectDirectory

57+ let file = pdir </> "src" </> "RebuildSpecWithForeign.purs"

58+ Integration.rebuildModule file >>= shouldBeSuccess

59+ it "fails to rebuild a module with a foreign import but no file" $ do

60+ pdir <- Integration.projectDirectory

61+ let file = pdir </> "src" </> "RebuildSpecWithMissingForeign.fail"

62+ Integration.rebuildModule file >>= shouldBeFailure

tests/support/pscide/src/RebuildSpecDep.pursnew file+3

@@ -0,0 +1,3 @@

1+module RebuildSpecDep where

3+dep = 42

tests/support/pscide/src/RebuildSpecSingleModule.failnew file+3

@@ -0,0 +1,3 @@

1+module RebuildSpecSingleModule where

3+let anerror

tests/support/pscide/src/RebuildSpecSingleModule.pursnew file+4

@@ -0,0 +1,4 @@

1+module RebuildSpecSingleModule where

3+id x = x

4+const x y = x

tests/support/pscide/src/RebuildSpecWithDeps.pursnew file+5

@@ -0,0 +1,5 @@

1+module RebuildSpecWithDeps where

3+import RebuildSpecDep (dep)

5+x = dep

tests/support/pscide/src/RebuildSpecWithForeign.jsnew file+3

@@ -0,0 +1,3 @@

1+// module RebuildSpecWithForeign

3+exports.f = 5;

tests/support/pscide/src/RebuildSpecWithForeign.pursnew file+3

@@ -0,0 +1,3 @@

1+module RebuildSpecWithForeign where

3+foreign import f :: Int

tests/support/pscide/src/RebuildSpecWithMissingForeign.failnew file+3

@@ -0,0 +1,3 @@

1+module RebuildSpecWithMissingForeign where

3+foreign import f :: Int