From 85d2c1d122c45d3054c41e7e10929ad92799d007 Mon Sep 17 00:00:00 2001 From: Peter Murphy Date: Sun, 6 Feb 2022 13:20:42 -0500 Subject: [PATCH 1/4] WIP: Add IDE process --- server/Main.hs | 52 ++++++++++++++++++++++++++++++++++++++++++++- stack.yaml.lock | 14 ++++++------ trypurescript.cabal | 1 + 3 files changed, 59 insertions(+), 8 deletions(-) diff --git a/server/Main.hs b/server/Main.hs index c3beddab..93868807 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -20,7 +20,7 @@ import Data.Aeson ((.=)) import Data.Bifunctor (first, second, bimap) import qualified Data.ByteString.Lazy as BL import Data.Default (def) -import Data.Function (on) +import Data.Function (on, fix) import qualified Data.IORef as IORef import Data.List (nubBy) import qualified Data.List.NonEmpty as NE @@ -43,10 +43,12 @@ import qualified Language.PureScript.Make as Make import qualified Language.PureScript.Make.Cache as Cache import qualified Language.PureScript.TypeChecker.TypeSearch as TS import qualified Network.Wai.Handler.Warp as Warp +import qualified System.Directory as Directory import System.Environment (getArgs) import System.Exit (exitFailure) import System.FilePath.Glob (glob) import qualified System.IO as IO +import qualified System.Process as Process import Web.Scotty import qualified Web.Scotty as Scotty @@ -113,6 +115,54 @@ buildMakeActions codegenRef = outputPrimDocs :: Make.Make () outputPrimDocs = pure () +exampleQuery str = "\ +\{ \"command\": \"complete\",\ + \\"currentModule\": \"Main\",\ + \\"matcher\": {\ + \\"matcher\": \"flex\",\ + \\"params\": {\ + \\"search\": \"" <> str <> "\",\ + \\"maxResults\": 10\ + \}\ + \},\ + \\"params\": {\ + \\"filters\": [{\ + \\"filter\": \"prefix\",\ + \\"params\": {\ + \\"search\": \"" <> str <> "\"\ + \}\ + \}],\ + \\"options\": {\ + \\"maxResults\": 20,\ + \\"groupReexports\": true\ + \}\ + \}\ +\}\ +\" + +ideProcess :: IO () +ideProcess = do + currentDirectory <- Directory.getCurrentDirectory + let ideServer = + (Process.proc "purs" ["ide", "server"]) + { Process.cwd = Just (currentDirectory <> "/staging") + } + ideClient = + Process.createProcess_ "purs-ide-client" + (Process.proc "purs" ["ide", "client"]) + { Process.std_in = Process.CreatePipe + , Process.std_out = Process.CreatePipe + } + Process.withCreateProcess ideServer $ + \_ _ _ _ -> fix $ \loop -> do + getLine >>= \case + "STOP" -> pure () + arg -> do + (Just handleIn, Just handleOut, _, _) <- ideClient + IO.hPutStrLn handleIn (exampleQuery arg) + IO.hGetContents handleOut >>= putStrLn + loop + server :: [P.ExternsFile] -> P.Env -> P.Environment -> Int -> IO () server externs initNamesEnv initEnv port = do codegenRef <- IORef.newIORef Nothing diff --git a/stack.yaml.lock b/stack.yaml.lock index 8088114d..972c9363 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -5,19 +5,19 @@ packages: - completed: - hackage: purescript-0.14.3@sha256:4b75604e86c335711e1b1f1f73ef381108d047c9277df1cdc71922ec7da7c181,18623 + hackage: purescript-0.14.5@sha256:511f50e7f267b65e1f656cdff9f9665073496efdf4375a3a86aa68496dae7281,18623 pantry-tree: - size: 132222 - sha256: e3957c9d2c96434fcf5e8f310b34f4ea696cc8e5f63e60958eae5c6e31aba4c6 + size: 121096 + sha256: 895dfc2fc938d99930f4ad17d1c475baf59efb4ad0c64519dfd09e482db38ff3 original: - hackage: purescript-0.14.3 + hackage: purescript-0.14.5 - completed: - hackage: purescript-cst-0.3.0.0@sha256:369317d52737c4fa8c74a875283ed6cc0ef68e7c64db13d6e5bb7a7f72b76572,3861 + hackage: purescript-cst-0.4.0.0@sha256:bfe7be3962e83b645a4a8cd1805f31de17db3d3456962e1a2d17016fe5d7f96d,3861 pantry-tree: size: 3018 - sha256: 38f94bcc121068215c6082bab39b6c555cadd3b88e786740c394a5c4b98c4100 + sha256: 1681432cc9fa87bc6344e7c604f94a15a016af6e4b7c3519ee035f0f51d90c9c original: - hackage: purescript-cst-0.3.0.0 + hackage: purescript-cst-0.4.0.0 - completed: hackage: language-javascript-0.7.0.0@sha256:3eab0262b8ac5621936a4beab6a0f97d0e00a63455a8b0e3ac1547b4088dae7d,3898 pantry-tree: diff --git a/trypurescript.cabal b/trypurescript.cabal index 9894408a..a8e53b4c 100644 --- a/trypurescript.cabal +++ b/trypurescript.cabal @@ -32,6 +32,7 @@ executable trypurescript http-types -any, transformers -any, mtl -any, + process -any, text -any, time -any, warp -any From 3880d2f1e5ee13cf913c74b205202f1c6d99c627 Mon Sep 17 00:00:00 2001 From: Peter Murphy Date: Sun, 6 Feb 2022 15:45:27 -0500 Subject: [PATCH 2/4] Add /complete endpoint --- server/Main.hs | 102 +++++++++++++++++++++++--------------------- trypurescript.cabal | 1 + 2 files changed, 55 insertions(+), 48 deletions(-) diff --git a/server/Main.hs b/server/Main.hs index 93868807..e7af9d8b 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -18,7 +18,9 @@ import Control.Monad.Writer.Strict (runWriterT) import qualified Data.Aeson as A import Data.Aeson ((.=)) import Data.Bifunctor (first, second, bimap) +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as Char8 import Data.Default (def) import Data.Function (on, fix) import qualified Data.IORef as IORef @@ -28,7 +30,9 @@ import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as TL import Data.Time.Clock (UTCTime) +import qualified Data.Vector as V import GHC.Generics (Generic) import qualified Language.PureScript as P import qualified Language.PureScript.CST as CST @@ -43,7 +47,6 @@ import qualified Language.PureScript.Make as Make import qualified Language.PureScript.Make.Cache as Cache import qualified Language.PureScript.TypeChecker.TypeSearch as TS import qualified Network.Wai.Handler.Warp as Warp -import qualified System.Directory as Directory import System.Environment (getArgs) import System.Exit (exitFailure) import System.FilePath.Glob (glob) @@ -115,53 +118,24 @@ buildMakeActions codegenRef = outputPrimDocs :: Make.Make () outputPrimDocs = pure () -exampleQuery str = "\ -\{ \"command\": \"complete\",\ - \\"currentModule\": \"Main\",\ - \\"matcher\": {\ - \\"matcher\": \"flex\",\ - \\"params\": {\ - \\"search\": \"" <> str <> "\",\ - \\"maxResults\": 10\ - \}\ - \},\ - \\"params\": {\ - \\"filters\": [{\ - \\"filter\": \"prefix\",\ - \\"params\": {\ - \\"search\": \"" <> str <> "\"\ - \}\ - \}],\ - \\"options\": {\ - \\"maxResults\": 20,\ - \\"groupReexports\": true\ - \}\ - \}\ -\}\ -\" +-- mkCommand :: String -> String +-- mkCommand str = "\ +-- \{ \"command\": \"complete\",\ +-- \\"params\": {\ +-- \\"filters\": [{\ +-- \\"filter\": \"prefix\",\ +-- \\"params\": {\ +-- \\"search\": \"" <> str <> "\"\ +-- \}\ +-- \}],\ +-- \\"options\": {\ +-- \\"maxResults\": 20,\ +-- \\"groupReexports\": true\ +-- \}\ +-- \}\ +-- \}\ +-- \" -ideProcess :: IO () -ideProcess = do - currentDirectory <- Directory.getCurrentDirectory - let ideServer = - (Process.proc "purs" ["ide", "server"]) - { Process.cwd = Just (currentDirectory <> "/staging") - } - ideClient = - Process.createProcess_ "purs-ide-client" - (Process.proc "purs" ["ide", "client"]) - { Process.std_in = Process.CreatePipe - , Process.std_out = Process.CreatePipe - } - Process.withCreateProcess ideServer $ - \_ _ _ _ -> fix $ \loop -> do - getLine >>= \case - "STOP" -> pure () - arg -> do - (Just handleIn, Just handleOut, _, _) <- ideClient - IO.hPutStrLn handleIn (exampleQuery arg) - IO.hGetContents handleOut >>= putStrLn - loop server :: [P.ExternsFile] -> P.Env -> P.Environment -> Int -> IO () server externs initNamesEnv initEnv port = do @@ -207,6 +181,35 @@ server externs initNamesEnv initEnv port = do Scotty.json $ A.object [ "error" .= err ] Right (warnings, comp) -> Scotty.json $ A.object [ "js" .= comp, "warnings" .= warnings ] + + get "/complete" $ do + query <- param "q" + Scotty.setHeader "Access-Control-Allow-Origin" "*" + Scotty.setHeader "Content-Type" "application/json" + let ideClient = + Process.createProcess_ "purs-ide-client" + (Process.proc "purs" ["ide", "client"]) + { Process.std_in = Process.CreatePipe + , Process.std_out = Process.CreatePipe + } + mkCommand q = A.encode $ A.object + [ "command" .= ("complete" :: Text) + , "params" .= A.object + [ "filters" .= A.Array + ( V.fromList + [ A.object + [ "filter" .= ("prefix" :: Text) + , "params" .= A.object + [ "search" .= q ] + ] + ] + ) + ] + ] + (Just handleIn, Just handleOut, _, _) <- liftIO ideClient + liftIO $ Char8.hPutStrLn handleIn (mkCommand (query :: Text)) + result <- liftIO $ BS.hGetContents handleOut + Scotty.text (TL.fromStrict (T.decodeUtf8 result)) get "/search" $ do query <- param "q" @@ -290,4 +293,7 @@ main = do pure (exts, namesEnv, env) case e of Left err -> print err >> exitFailure - Right (exts, namesEnv, env) -> server exts namesEnv env port + Right (exts, namesEnv, env) -> do + let ideServer = Process.proc "purs" ["ide", "server"] + Process.withCreateProcess ideServer $ + \_ _ _ _ -> server exts namesEnv env port diff --git a/trypurescript.cabal b/trypurescript.cabal index a8e53b4c..9723e615 100644 --- a/trypurescript.cabal +++ b/trypurescript.cabal @@ -35,6 +35,7 @@ executable trypurescript process -any, text -any, time -any, + vector -any, warp -any hs-source-dirs: server main-is: Main.hs From 749670093a22c5b2abaee654a9e2051be302fee1 Mon Sep 17 00:00:00 2001 From: Peter Murphy Date: Mon, 7 Feb 2022 21:20:46 -0500 Subject: [PATCH 3/4] Configure purs ide port, convert endpoint to POST --- README.md | 7 ++--- deploy/start | 2 +- server/Main.hs | 69 +++++++++++++++----------------------------------- 3 files changed, 25 insertions(+), 53 deletions(-) diff --git a/README.md b/README.md index 0ffda87b..935eff55 100644 --- a/README.md +++ b/README.md @@ -83,7 +83,7 @@ ln -s "$PWD/output" "$PWD/../client/public/js/output" # # We run this in a subshell so that setting noglob only lasts for the duration # of the command and no longer. -(set -o noglob && stack exec trypurescript 8081 $(spago sources)) +(set -o noglob && stack exec trypurescript 8081 8082 $(spago sources)) # Should output that it is compiling the sources (first time) # Then: Setting phasers to stun... (port 8081) (ctrl-c to quit) @@ -178,9 +178,10 @@ If the compiled JavaScript code in the response includes a `require` call such a The server application takes the following arguments on the command line: -- port number +- port number for the server +- port number for the IDE server - a list of input source files #### Example - trypurescript 8081 'bower_components/purescript-*/src/**/*.purs' + trypurescript 8081 8082 'bower_components/purescript-*/src/**/*.purs' diff --git a/deploy/start b/deploy/start index 0b4815d4..f2b8abd8 100755 --- a/deploy/start +++ b/deploy/start @@ -4,4 +4,4 @@ set -ex set -o noglob export XDG_CACHE_HOME="$PWD/.spago-cache" spago install -exec trypurescript +RTS -N2 -A128m -M3G -RTS 8081 $(spago sources) +exec trypurescript +RTS -N2 -A128m -M3G -RTS 8081 8082 $(spago sources) diff --git a/server/Main.hs b/server/Main.hs index e7af9d8b..e2b8300f 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -19,8 +19,9 @@ import qualified Data.Aeson as A import Data.Aeson ((.=)) import Data.Bifunctor (first, second, bimap) import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS.Char8 import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Lazy.Char8 as Char8 +import qualified Data.ByteString.Lazy.Char8 as BL.Char8 import Data.Default (def) import Data.Function (on, fix) import qualified Data.IORef as IORef @@ -51,6 +52,7 @@ import System.Environment (getArgs) import System.Exit (exitFailure) import System.FilePath.Glob (glob) import qualified System.IO as IO +import System.IO (BufferMode(NoBuffering)) import qualified System.Process as Process import Web.Scotty import qualified Web.Scotty as Scotty @@ -118,27 +120,9 @@ buildMakeActions codegenRef = outputPrimDocs :: Make.Make () outputPrimDocs = pure () --- mkCommand :: String -> String --- mkCommand str = "\ --- \{ \"command\": \"complete\",\ --- \\"params\": {\ --- \\"filters\": [{\ --- \\"filter\": \"prefix\",\ --- \\"params\": {\ --- \\"search\": \"" <> str <> "\"\ --- \}\ --- \}],\ --- \\"options\": {\ --- \\"maxResults\": 20,\ --- \\"groupReexports\": true\ --- \}\ --- \}\ --- \}\ --- \" - -server :: [P.ExternsFile] -> P.Env -> P.Environment -> Int -> IO () -server externs initNamesEnv initEnv port = do +server :: [P.ExternsFile] -> P.Env -> P.Environment -> Int -> String -> IO () +server externs initNamesEnv initEnv port pursIDEPortString = do codegenRef <- IORef.newIORef Nothing let makeActions = buildMakeActions codegenRef let compile :: Text -> IO (Either Error ([P.JSONError], JS)) @@ -182,33 +166,20 @@ server externs initNamesEnv initEnv port = do Right (warnings, comp) -> Scotty.json $ A.object [ "js" .= comp, "warnings" .= warnings ] - get "/complete" $ do - query <- param "q" + post "/complete" $ do Scotty.setHeader "Access-Control-Allow-Origin" "*" Scotty.setHeader "Content-Type" "application/json" - let ideClient = - Process.createProcess_ "purs-ide-client" - (Process.proc "purs" ["ide", "client"]) - { Process.std_in = Process.CreatePipe - , Process.std_out = Process.CreatePipe - } - mkCommand q = A.encode $ A.object - [ "command" .= ("complete" :: Text) - , "params" .= A.object - [ "filters" .= A.Array - ( V.fromList - [ A.object - [ "filter" .= ("prefix" :: Text) - , "params" .= A.object - [ "search" .= q ] - ] - ] - ) - ] - ] - (Just handleIn, Just handleOut, _, _) <- liftIO ideClient - liftIO $ Char8.hPutStrLn handleIn (mkCommand (query :: Text)) - result <- liftIO $ BS.hGetContents handleOut + (Just handleIn, Just handleOut, _, _) <- liftIO $ + Process.createProcess_ + "purs-ide-client" + (Process.proc "purs" ["ide", "client", "-p", pursIDEPortString]) + { Process.std_in = Process.CreatePipe + , Process.std_out = Process.CreatePipe + } + liftIO (IO.hSetBuffering handleIn NoBuffering) + command <- BL.Char8.toStrict <$> body + liftIO (BS.Char8.hPutStrLn handleIn command) + result <- liftIO (BS.hGetContents handleOut) Scotty.text (TL.fromStrict (T.decodeUtf8 result)) get "/search" $ do @@ -283,7 +254,7 @@ main :: IO () main = do -- Stop mangled "Compiling ModuleName" text IO.hSetBuffering IO.stderr IO.LineBuffering - (portString : inputGlobs) <- getArgs + (portString : pursIDEPortString : inputGlobs) <- getArgs let port = read portString inputFiles <- concat <$> traverse glob inputGlobs e <- runExceptT $ do @@ -294,6 +265,6 @@ main = do case e of Left err -> print err >> exitFailure Right (exts, namesEnv, env) -> do - let ideServer = Process.proc "purs" ["ide", "server"] + let ideServer = Process.proc "purs" ("ide":"server":"-p":pursIDEPortString:inputGlobs) Process.withCreateProcess ideServer $ - \_ _ _ _ -> server exts namesEnv env port + \_ _ _ _ -> server exts namesEnv env port pursIDEPortString From 0bdd1fd65505807b0f8fd3dabf5048aac5a1bec2 Mon Sep 17 00:00:00 2001 From: Peter Murphy Date: Tue, 8 Feb 2022 19:48:09 -0500 Subject: [PATCH 4/4] Revert to GET with query param --- server/Main.hs | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/server/Main.hs b/server/Main.hs index e2b8300f..9b15d16d 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -19,11 +19,10 @@ import qualified Data.Aeson as A import Data.Aeson ((.=)) import Data.Bifunctor (first, second, bimap) import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BS.Char8 import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL.Char8 import Data.Default (def) -import Data.Function (on, fix) +import Data.Function (on) import qualified Data.IORef as IORef import Data.List (nubBy) import qualified Data.List.NonEmpty as NE @@ -52,7 +51,6 @@ import System.Environment (getArgs) import System.Exit (exitFailure) import System.FilePath.Glob (glob) import qualified System.IO as IO -import System.IO (BufferMode(NoBuffering)) import qualified System.Process as Process import Web.Scotty import qualified Web.Scotty as Scotty @@ -120,7 +118,6 @@ buildMakeActions codegenRef = outputPrimDocs :: Make.Make () outputPrimDocs = pure () - server :: [P.ExternsFile] -> P.Env -> P.Environment -> Int -> String -> IO () server externs initNamesEnv initEnv port pursIDEPortString = do codegenRef <- IORef.newIORef Nothing @@ -166,9 +163,24 @@ server externs initNamesEnv initEnv port pursIDEPortString = do Right (warnings, comp) -> Scotty.json $ A.object [ "js" .= comp, "warnings" .= warnings ] - post "/complete" $ do + get "/complete" $ do + query <- param "q" Scotty.setHeader "Access-Control-Allow-Origin" "*" Scotty.setHeader "Content-Type" "application/json" + let mkCommand q = A.encode $ A.object + [ "command" .= ("complete" :: Text) + , "params" .= A.object + [ "filters" .= A.Array + ( V.fromList + [ A.object + [ "filter" .= ("prefix" :: Text) + , "params" .= A.object + [ "search" .= q ] + ] + ] + ) + ] + ] (Just handleIn, Just handleOut, _, _) <- liftIO $ Process.createProcess_ "purs-ide-client" @@ -176,9 +188,8 @@ server externs initNamesEnv initEnv port pursIDEPortString = do { Process.std_in = Process.CreatePipe , Process.std_out = Process.CreatePipe } - liftIO (IO.hSetBuffering handleIn NoBuffering) - command <- BL.Char8.toStrict <$> body - liftIO (BS.Char8.hPutStrLn handleIn command) + liftIO (IO.hSetBuffering handleIn IO.NoBuffering) + liftIO (BL.Char8.hPutStrLn handleIn (mkCommand (query :: Text))) result <- liftIO (BS.hGetContents handleOut) Scotty.text (TL.fromStrict (T.decodeUtf8 result)) @@ -265,6 +276,6 @@ main = do case e of Left err -> print err >> exitFailure Right (exts, namesEnv, env) -> do - let ideServer = Process.proc "purs" ("ide":"server":"-p":pursIDEPortString:inputGlobs) - Process.withCreateProcess ideServer $ + let pursIDEServer = Process.proc "purs" ("ide":"server":"-p":pursIDEPortString:inputGlobs) + Process.withCreateProcess pursIDEServer $ \_ _ _ _ -> server exts namesEnv env port pursIDEPortString