git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Evaluate PSCi expressions in the browser (#2199)

* Initial work on evaluating PSCi expressions in the browser using websockets * Use Warp, add shutdown handler * Bundle all JS resources on startup * Refactoring before supporting multiple backends * Tidy up JavaScript component. Return output/exception stack to PSCi. * Refactor to allow different backends * Remove comments * Add port option, fork ping thread * Only allow one client * Support multiple clients, handle reloads * extra-deps * stack.yaml * Implement suggestions: use file-embed, save console.log, use case * Add static files to bundle

commit54526889709db2c02128de506bb0a50621e8ebc3 authorPhil Freeman <paf31@cantab.net> dateSun 10 Jul 2016, 13:43 (10 years ago) parent293c345
9 files changed+383−66
compare with golang
unifiedsplit
psc-bundle/Main.hs+1−9 psci/Main.hs+259−27 psci/static/index.html+10 psci/static/index.js+63 purescript.cabal+12−1 src/Language/PureScript/Bundle.hs+11 src/Language/PureScript/Interactive.hs+25−28 src/Language/PureScript/Interactive/Types.hs−1 stack-ghc-8.0.yaml+2
psc-bundle/Main.hs+1−9
@@ -15,7 +15,7 @@ import Control.Monad.Error.Class
1515import Control.Monad.Trans.Except
1616import Control.Monad.IO.Class
1717
18−import System.FilePath (takeFileName, takeDirectory)
18+import System.FilePath (takeDirectory)
1919import System.FilePath.Glob (glob)
2020import System.Exit (exitFailure)
2121import System.IO (stderr, stdout, hPutStrLn, hSetEncoding, utf8)
@@ -37,14 +37,6 @@ data Options = Options
3737 , optionsNamespace :: String
3838 } deriving Show
3939
40−-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.
41−guessModuleIdentifier :: (MonadError ErrorMessage m) => FilePath -> m ModuleIdentifier
42−guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> guessModuleType (takeFileName filename)
43− where
44− guessModuleType "index.js" = pure Regular
45− guessModuleType "foreign.js" = pure Foreign
46− guessModuleType name = throwError $ UnsupportedModulePath name
47−
4840-- | The main application function.
4941-- This function parses the input files, performs dead code elimination, filters empty modules
5042-- and generates and prints the final Javascript bundle.
psci/Main.hs+259−27
@@ -1,9 +1,13 @@
11{-# LANGUAGE DataKinds #-}
22{-# LANGUAGE DoAndIfThenElse #-}
3+{-# LANGUAGE GADTs #-}
34{-# LANGUAGE GeneralizedNewtypeDeriving #-}
45{-# LANGUAGE MultiParamTypeClasses #-}
6+{-# LANGUAGE OverloadedStrings #-}
7+{-# LANGUAGE PatternGuards #-}
58{-# LANGUAGE RecordWildCards #-}
69{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE TemplateHaskell #-}
711{-# LANGUAGE TupleSections #-}
812
913module Main (main) where
@@ -11,10 +15,22 @@ module Main (main) where
1115import Prelude ()
1216import Prelude.Compat
1317
18+import Data.FileEmbed (embedStringFile)
1419import Data.Monoid ((<>))
20+import Data.String (IsString(..))
21+import Data.Text (Text, unpack)
22+import Data.Traversable (for)
1523import Data.Version (showVersion)
1624
17−import Control.Applicative (many)
25+import Control.Applicative (many, (<|>))
26+import Control.Concurrent (forkIO)
27+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar,
28+ tryPutMVar)
29+import Control.Concurrent.STM (TVar, atomically, newTVarIO, writeTVar,
30+ readTVarIO,
31+ TChan, newBroadcastTChanIO, dupTChan,
32+ readTChan, writeTChan)
33+import Control.Exception (fromException)
1834import Control.Monad
1935import Control.Monad.IO.Class (liftIO)
2036import Control.Monad.Trans.Class
@@ -23,21 +39,33 @@ import Control.Monad.Trans.State.Strict (StateT, evalStateT)
2339import Control.Monad.Trans.Reader (ReaderT, runReaderT)
2440
2541import qualified Language.PureScript as P
42+import qualified Language.PureScript.Bundle as Bundle
2643import Language.PureScript.Interactive
2744
45+import Network.HTTP.Types.Header (hContentType, hCacheControl,
46+ hPragma, hExpires)
47+import Network.HTTP.Types.Status (status200, status404, status503)
48+import qualified Network.Wai as Wai
49+import qualified Network.Wai.Handler.Warp as Warp
50+import qualified Network.Wai.Handler.WebSockets as WS
51+import qualified Network.WebSockets as WS
52+
2853import qualified Options.Applicative as Opts
2954
3055import qualified Paths_purescript as Paths
3156
3257import System.Console.Haskeline
58+import System.IO.UTF8 (readUTF8File)
3359import System.Exit
60+import System.FilePath ((</>))
3461import System.FilePath.Glob (glob)
62+import System.Process (readProcessWithExitCode)
3563
3664-- | Command line options
3765data PSCiOptions = PSCiOptions
3866 { psciMultiLineMode :: Bool
3967 , psciInputFile :: [FilePath]
40− , psciInputNodeFlags :: [String]
68+ , psciBackend :: Backend
4169 }
4270
4371multiLineMode :: Opts.Parser Bool
@@ -60,10 +88,21 @@ nodeFlagsFlag = Opts.option parser $
6088 where
6189 parser = words <$> Opts.str
6290
91+port :: Opts.Parser Int
92+port = Opts.option Opts.auto $
93+ Opts.long "port"
94+ <> Opts.short 'p'
95+ <> Opts.help "The web server port"
96+
97+backend :: Opts.Parser Backend
98+backend =
99+ (browserBackend <$> port)
100+ <|> (nodeBackend <$> nodeFlagsFlag)
101+
63102psciOptions :: Opts.Parser PSCiOptions
64103psciOptions = PSCiOptions <$> multiLineMode
65104 <*> many inputFile
66− <*> nodeFlagsFlag
105+ <*> backend
67106
68107version :: Opts.Parser (a -> a)
69108version = Opts.abortOption (Opts.InfoMsg (showVersion Paths.version)) $
@@ -92,6 +131,195 @@ getCommand singleLineMode = handleInterrupt (return (Right Nothing)) $ do
92131 go :: [String] -> InputT m String
93132 go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
94133
134+-- | Make a JavaScript bundle for the browser.
135+bundle :: IO (Either Bundle.ErrorMessage String)
136+bundle = runExceptT $ do
137+ inputFiles <- liftIO (glob (".psci_modules" </> "node_modules" </> "*" </> "*.js"))
138+ input <- for inputFiles $ \filename -> do
139+ js <- liftIO (readUTF8File filename)
140+ mid <- Bundle.guessModuleIdentifier filename
141+ length js `seq` return (mid, js)
142+ Bundle.bundle input [] Nothing "PSCI"
143+
144+indexJS :: IsString string => string
145+indexJS = $(embedStringFile "psci/static/index.js")
146+
147+indexPage :: IsString string => string
148+indexPage = $(embedStringFile "psci/static/index.html")
149+
150+-- | All of the functions required to implement a PSCi backend
151+data Backend = forall state. Backend
152+ { _backendSetup :: IO state
153+ -- ^ Initialize, and call the continuation when the backend is ready
154+ , _backendEval :: state -> String -> IO ()
155+ -- ^ Evaluate JavaScript code
156+ , _backendReload :: state -> IO ()
157+ -- ^ Reload the compiled code
158+ , _backendShutdown :: state -> IO ()
159+ -- ^ Shut down the backend
160+ }
161+
162+-- | Commands which can be sent to the browser
163+data BrowserCommand
164+ = Eval (MVar String)
165+ -- ^ Evaluate the latest JS
166+ | Reload
167+ -- ^ Reload the page
168+
169+-- | State for the browser backend
170+data BrowserState = BrowserState
171+ { browserCommands :: TChan BrowserCommand
172+ -- ^ A channel which receives data when the compiled JS has
173+ -- been updated
174+ , browserShutdownNotice :: MVar ()
175+ -- ^ An MVar which becomes full when the server should shut down
176+ , browserIndexJS :: TVar (Maybe String)
177+ -- ^ A TVar holding the latest compiled JS
178+ , browserBundleJS :: TVar (Maybe String)
179+ -- ^ A TVar holding the latest bundled JS
180+ }
181+
182+browserBackend :: Int -> Backend
183+browserBackend serverPort = Backend setup evaluate reload shutdown
184+ where
185+ setup :: IO BrowserState
186+ setup = do
187+ shutdownVar <- newEmptyMVar
188+ cmdChan <- newBroadcastTChanIO
189+ indexJs <- newTVarIO Nothing
190+ bundleJs <- newTVarIO Nothing
191+
192+ let
193+ handleWebsocket :: WS.PendingConnection -> IO ()
194+ handleWebsocket pending = do
195+ conn <- WS.acceptRequest pending
196+ -- Fork a thread to keep the connection alive
197+ WS.forkPingThread conn 10
198+ -- Clone the command channel
199+ cmdChanCopy <- atomically $ dupTChan cmdChan
200+ -- Listen for commands
201+ forever $ do
202+ cmd <- atomically $ readTChan cmdChanCopy
203+ case cmd of
204+ Eval resultVar -> void $ do
205+ WS.sendTextData conn ("eval" :: Text)
206+ result <- WS.receiveData conn
207+ -- With many connected clients, all but one of
208+ -- these attempts will fail.
209+ tryPutMVar resultVar (unpack result)
210+ Reload -> do
211+ WS.sendTextData conn ("reload" :: Text)
212+
213+ shutdownHandler :: IO () -> IO ()
214+ shutdownHandler stopServer = void . forkIO $ do
215+ () <- takeMVar shutdownVar
216+ stopServer
217+
218+ onException :: Maybe Wai.Request -> SomeException -> IO ()
219+ onException req ex
220+ | Just (_ :: WS.ConnectionException) <- fromException ex
221+ = return () -- ignore websocket disconnects
222+ | otherwise = Warp.defaultOnException req ex
223+
224+ staticServer :: Wai.Application
225+ staticServer req respond =
226+ case Wai.pathInfo req of
227+ [] ->
228+ respond $ Wai.responseLBS status200
229+ [(hContentType, "text/html")]
230+ indexPage
231+ ["js", "index.js"] ->
232+ respond $ Wai.responseLBS status200
233+ [(hContentType, "application/javascript")]
234+ indexJS
235+ ["js", "latest.js"] -> do
236+ may <- readTVarIO indexJs
237+ case may of
238+ Nothing ->
239+ respond $ Wai.responseLBS status503 [] "Service not available"
240+ Just js ->
241+ respond $ Wai.responseLBS status200
242+ [ (hContentType, "application/javascript")
243+ , (hCacheControl, "no-cache, no-store, must-revalidate")
244+ , (hPragma, "no-cache")
245+ , (hExpires, "0")
246+ ]
247+ (fromString js)
248+ ["js", "bundle.js"] -> do
249+ may <- readTVarIO bundleJs
250+ case may of
251+ Nothing ->
252+ respond $ Wai.responseLBS status503 [] "Service not available"
253+ Just js ->
254+ respond $ Wai.responseLBS status200
255+ [ (hContentType, "application/javascript")]
256+ (fromString js)
257+ _ -> respond $ Wai.responseLBS status404 [] "Not found"
258+
259+ let browserState = BrowserState cmdChan shutdownVar indexJs bundleJs
260+ createBundle browserState
261+
262+ putStrLn $ "Serving http://localhost:" <> show serverPort <> "/. Waiting for connections..."
263+ _ <- forkIO $ Warp.runSettings ( Warp.setInstallShutdownHandler shutdownHandler
264+ . Warp.setPort serverPort
265+ . Warp.setOnException onException
266+ $ Warp.defaultSettings
267+ ) $
268+ WS.websocketsOr WS.defaultConnectionOptions
269+ handleWebsocket
270+ staticServer
271+ return browserState
272+
273+ createBundle :: BrowserState -> IO ()
274+ createBundle state = do
275+ putStrLn "Bundling Javascript..."
276+ ejs <- bundle
277+ case ejs of
278+ Left err -> do
279+ putStrLn (unlines (Bundle.printErrorMessage err))
280+ exitFailure
281+ Right js -> do
282+ atomically $ writeTVar (browserBundleJS state) (Just js)
283+
284+ reload :: BrowserState -> IO ()
285+ reload state = do
286+ createBundle state
287+ atomically $ writeTChan (browserCommands state) Reload
288+
289+ shutdown :: BrowserState -> IO ()
290+ shutdown state = putMVar (browserShutdownNotice state) ()
291+
292+ evaluate :: BrowserState -> String -> IO ()
293+ evaluate state js = liftIO $ do
294+ resultVar <- newEmptyMVar
295+ atomically $ do
296+ writeTVar (browserIndexJS state) (Just js)
297+ writeTChan (browserCommands state) (Eval resultVar)
298+ result <- takeMVar resultVar
299+ putStrLn result
300+
301+nodeBackend :: [String] -> Backend
302+nodeBackend nodeArgs = Backend setup eval reload shutdown
303+ where
304+ setup :: IO ()
305+ setup = return ()
306+
307+ eval :: () -> String -> IO ()
308+ eval _ _ = do
309+ writeFile indexFile "require('$PSCI')['$main']();"
310+ process <- findNodeProcess
311+ result <- traverse (\node -> readProcessWithExitCode node (nodeArgs ++ [indexFile]) "") process
312+ case result of
313+ Just (ExitSuccess, out, _) -> putStrLn out
314+ Just (ExitFailure _, _, err) -> putStrLn err
315+ Nothing -> putStrLn "Couldn't find node.js"
316+
317+ reload :: () -> IO ()
318+ reload _ = return ()
319+
320+ shutdown :: () -> IO ()
321+ shutdown _ = return ()
322+
95323-- | Get command line options and drop into the REPL
96324main :: IO ()
97325main = getOpt >>= loop
@@ -106,27 +334,31 @@ main = getOpt >>= loop
106334 exitFailure
107335 (externs, env) <- ExceptT . runMake . make $ modules
108336 return (modules, externs, env)
109− case e of
110− Left errs -> putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure
111− Right (modules, externs, env) -> do
112− historyFilename <- getHistoryFilename
113− let settings = defaultSettings { historyFile = Just historyFilename }
114− initialState = PSCiState [] [] (zip (map snd modules) externs)
115− config = PSCiConfig inputFiles psciInputNodeFlags env
116− runner = flip runReaderT config
117− . flip evalStateT initialState
118− . runInputT (setComplete completion settings)
119− putStrLn prologueMessage
120− runner go
121− where
122− go :: InputT (StateT PSCiState (ReaderT PSCiConfig IO)) ()
123− go = do
124− c <- getCommand (not psciMultiLineMode)
125− case c of
126− Left err -> outputStrLn err >> go
127− Right Nothing -> go
128− Right (Just QuitPSCi) -> outputStrLn quitMessage
129− Right (Just c') -> do
130− handleInterrupt (outputStrLn "Interrupted.")
131− (withInterrupt (lift (handleCommand c')))
132− go
337+ case psciBackend of
338+ Backend setup eval reload (shutdown :: state -> IO ()) -> do
339+ case e of
340+ Left errs -> putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure
341+ Right (modules, externs, env) -> do
342+ historyFilename <- getHistoryFilename
343+ let settings = defaultSettings { historyFile = Just historyFilename }
344+ initialState = PSCiState [] [] (zip (map snd modules) externs)
345+ config = PSCiConfig inputFiles env
346+ runner = flip runReaderT config
347+ . flip evalStateT initialState
348+ . runInputT (setComplete completion settings)
349+
350+ go :: state -> InputT (StateT PSCiState (ReaderT PSCiConfig IO)) ()
351+ go state = do
352+ c <- getCommand (not psciMultiLineMode)
353+ case c of
354+ Left err -> outputStrLn err >> go state
355+ Right Nothing -> go state
356+ Right (Just QuitPSCi) -> do
357+ outputStrLn quitMessage
358+ liftIO $ shutdown state
359+ Right (Just c') -> do
360+ handleInterrupt (outputStrLn "Interrupted.")
361+ (withInterrupt (lift (handleCommand (liftIO . eval state) (liftIO (reload state)) c')))
362+ go state
363+ putStrLn prologueMessage
364+ setup >>= runner . go
psci/static/index.htmlnew file+10
@@ -0,0 +1,10 @@
1+<!DOCTYPE html>
2+<html>
3+<head>
4+ <title>PureScript Interactive</title>
5+ <script src='js/bundle.js'></script>
6+ <script src='js/index.js'></script>
7+</head>
8+<body>
9+</body>
10+</html>
psci/static/index.jsnew file+63
@@ -0,0 +1,63 @@
1+var get = function get(uri, callback, onError) {
2+ var request = new XMLHttpRequest();
3+ request.addEventListener('load', function() {
4+ callback(request.responseText);
5+ });
6+ request.addEventListener('error', onError);
7+ request.open('GET', uri);
8+ request.send();
9+};
10+var evaluate = function evaluate(js) {
11+ var buffer = [];
12+ // Save the old console.log function
13+ var oldLog = console.log;
14+ console.log = function(s) {
15+ // Push log output into a temporary buffer
16+ // which will be returned to PSCi.
17+ buffer.push(s);
18+ };
19+ // Replace any require(...) statements with lookups on the PSCI object.
20+ var replaced = js.replace(/require\("[^"]*"\)/g, function(s) {
21+ return "PSCI['" + s.substring(12, s.length - 2) + "']";
22+ });
23+ // Wrap the module and evaluate it.
24+ var wrapped =
25+ [ 'var module = {};'
26+ , '(function(module) {'
27+ , replaced
28+ , '})(module);'
29+ , 'return module.exports["$main"] && module.exports["$main"]();'
30+ ].join('\n');
31+ new Function(wrapped)();
32+ // Restore console.log
33+ console.log = oldLog;
34+ return buffer.join('\n');
35+};
36+window.onload = function() {
37+ var socket = new WebSocket('ws://0.0.0.0:' + location.port);
38+ var evalNext = function reload() {
39+ get('js/latest.js', function(response) {
40+ try {
41+ var result = evaluate(response);
42+ socket.send(result);
43+ } catch (ex) {
44+ socket.send(ex.stack);
45+ }
46+ }, function(err) {
47+ socket.send('Error sending JavaScript');
48+ });
49+ };
50+ socket.onopen = function() {
51+ console.log('Connected');
52+ socket.onmessage = function(event) {
53+ switch (event.data) {
54+ case 'eval':
55+ evalNext();
56+ break;
57+ case 'reload':
58+ location.reload();
59+ break;
60+ }
61+ };
62+ };
63+};
purescript.cabal+12−1
@@ -79,6 +79,8 @@ extra-source-files: examples/passing/*.purs
7979 , examples/docs/bower_components/purescript-prelude/src/*.purs
8080 , examples/docs/bower.json
8181 , examples/docs/src/*.purs
82+ , psci/static/index.html
83+ , psci/static/index.js
8284 , tests/support/package.json
8385 , tests/support/bower.json
8486 , tests/support/setup-win.cmd
@@ -338,18 +340,27 @@ executable psci
338340 purescript -any,
339341 base-compat >=0.6.0,
340342 boxes >= 0.1.4 && < 0.2.0,
343+ bytestring -any,
341344 containers -any,
342345 directory -any,
343346 filepath -any,
347+ file-embed -any,
344348 Glob -any,
345349 haskeline >= 0.7.0.0,
350+ http-types == 0.9.*,
346351 mtl -any,
347352 optparse-applicative >= 0.12.1,
348353 parsec -any,
349354 process -any,
355+ stm >= 0.2.4.0,
356+ text -any,
350357 time -any,
351358 transformers -any,
352− transformers-compat -any
359+ transformers-compat -any,
360+ wai == 3.*,
361+ wai-websockets == 3.*,
362+ warp == 3.*,
363+ websockets >= 0.9 && <0.10
353364 main-is: Main.hs
354365 buildable: True
355366 hs-source-dirs: psci
src/Language/PureScript/Bundle.hs+11
@@ -6,6 +6,7 @@
66-- and generates the final Javascript bundle.
77module Language.PureScript.Bundle
88 ( bundle
9+ , guessModuleIdentifier
910 , ModuleIdentifier(..)
1011 , moduleName
1112 , ModuleType(..)
@@ -32,6 +33,8 @@ import Language.JavaScript.Parser.AST
3233
3334import qualified Paths_purescript as Paths
3435
36+import System.FilePath (takeFileName, takeDirectory)
37+
3538-- | The type of error messages. We separate generation and rendering of errors using a data
3639-- type, in case we need to match on error types later.
3740data ErrorMessage
@@ -58,6 +61,14 @@ data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Read,
5861moduleName :: ModuleIdentifier -> String
5962moduleName (ModuleIdentifier name _) = name
6063
64+-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.
65+guessModuleIdentifier :: MonadError ErrorMessage m => FilePath -> m ModuleIdentifier
66+guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> guessModuleType (takeFileName filename)
67+ where
68+ guessModuleType "index.js" = pure Regular
69+ guessModuleType "foreign.js" = pure Foreign
70+ guessModuleType name = throwError $ UnsupportedModulePath name
71+
6172-- | A piece of code is identified by its module and its name. These keys are used to label vertices
6273-- in the dependency graph.
6374type Key = (ModuleIdentifier, String)
src/Language/PureScript/Interactive.hs+25−28
@@ -38,8 +38,7 @@ import Language.PureScript.Interactive.Parser as Interactive
3838import Language.PureScript.Interactive.Printer as Interactive
3939import Language.PureScript.Interactive.Types as Interactive
4040
41−import System.Exit
42−import System.Process (readProcessWithExitCode)
41+import System.FilePath ((</>))
4342
4443-- | Pretty-print errors
4544printErrors :: MonadIO m => P.MultipleErrors -> m ()
@@ -91,25 +90,28 @@ make ms = do
9190-- | Performs a PSCi command
9291handleCommand
9392 :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
94− => Command
93+ => (String -> m ())
9594 -> m ()
96−handleCommand ShowHelp = liftIO $ putStrLn helpMessage
97−handleCommand ResetState = handleResetState
98−handleCommand (Expression val) = handleExpression val
99−handleCommand (Import im) = handleImport im
100−handleCommand (Decls l) = handleDecls l
101−handleCommand (TypeOf val) = handleTypeOf val
102−handleCommand (KindOf typ) = handleKindOf typ
103−handleCommand (BrowseModule moduleName) = handleBrowse moduleName
104−handleCommand (ShowInfo QueryLoaded) = handleShowLoadedModules
105−handleCommand (ShowInfo QueryImport) = handleShowImportedModules
106−handleCommand QuitPSCi = P.internalError "`handleCommand QuitPSCi` was called. This is a bug."
95+ -> Command
96+ -> m ()
97+handleCommand _ _ ShowHelp = liftIO $ putStrLn helpMessage
98+handleCommand _ r ResetState = handleResetState r
99+handleCommand c _ (Expression val) = handleExpression c val
100+handleCommand _ _ (Import im) = handleImport im
101+handleCommand _ _ (Decls l) = handleDecls l
102+handleCommand _ _ (TypeOf val) = handleTypeOf val
103+handleCommand _ _ (KindOf typ) = handleKindOf typ
104+handleCommand _ _ (BrowseModule moduleName) = handleBrowse moduleName
105+handleCommand _ _ (ShowInfo QueryLoaded) = handleShowLoadedModules
106+handleCommand _ _ (ShowInfo QueryImport) = handleShowImportedModules
107+handleCommand _ _ QuitPSCi = P.internalError "`handleCommand QuitPSCi` was called. This is a bug."
107108
108109-- | Reset the application state
109110handleResetState
110111 :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
111112 => m ()
112−handleResetState = do
113+ -> m ()
114+handleResetState reload = do
113115 modify $ updateImportedModules (const [])
114116 . updateLets (const [])
115117 files <- asks psciLoadedFiles
@@ -119,30 +121,25 @@ handleResetState = do
119121 return (map snd modules, externs)
120122 case e of
121123 Left errs -> printErrors errs
122− Right (modules, externs) -> modify (updateLoadedExterns (const (zip modules externs)))
124+ Right (modules, externs) -> do
125+ modify (updateLoadedExterns (const (zip modules externs)))
126+ reload
123127
124128-- | Takes a value expression and evaluates it with the current state.
125−--
126−-- TODO: factor out the Node process runner, so that we can use PSCi in other settings.
127129handleExpression
128130 :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
129− => P.Expr
131+ => (String -> m ())
132+ -> P.Expr
130133 -> m ()
131−handleExpression val = do
134+handleExpression evaluate val = do
132135 st <- get
133136 let m = createTemporaryModule True st val
134− nodeArgs <- asks ((++ [indexFile]) . psciNodeFlags)
135137 e <- liftIO . runMake $ rebuild (map snd (psciLoadedExterns st)) m
136138 case e of
137139 Left errs -> printErrors errs
138140 Right _ -> do
139− liftIO $ writeFile indexFile "require('$PSCI')['$main']();"
140− process <- liftIO findNodeProcess
141− result <- liftIO $ traverse (\node -> readProcessWithExitCode node nodeArgs "") process
142− case result of
143− Just (ExitSuccess, out, _) -> liftIO $ putStrLn out
144− Just (ExitFailure _, _, err) -> liftIO $ putStrLn err
145− Nothing -> liftIO $ putStrLn "Couldn't find node.js"
141+ js <- liftIO $ readFile (modulesDir </> "$PSCI" </> "index.js")
142+ evaluate js
146143
147144-- |
148145-- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,
src/Language/PureScript/Interactive/Types.hs−1
@@ -13,7 +13,6 @@ import qualified Language.PureScript as P
1313--
1414data PSCiConfig = PSCiConfig
1515 { psciLoadedFiles :: [FilePath]
16− , psciNodeFlags :: [String]
1716 , psciEnvironment :: P.Environment
1817 } deriving Show
1918
stack-ghc-8.0.yaml+2
@@ -3,3 +3,5 @@ packages:
33- '.'
44extra-deps:
55- pipes-http-1.0.2
6+- wai-websockets-3.0.0.9
7+- websockets-0.9.6.2