@@ -19,8 +19,9 @@ import qualified Data.Aeson as A
1919import Data.Aeson ((.=) )
2020import Data.Bifunctor (first , second , bimap )
2121import qualified Data.ByteString as BS
22+ import qualified Data.ByteString.Char8 as BS.Char8
2223import qualified Data.ByteString.Lazy as BL
23- import qualified Data.ByteString.Lazy.Char8 as Char8
24+ import qualified Data.ByteString.Lazy.Char8 as BL. Char8
2425import Data.Default (def )
2526import Data.Function (on , fix )
2627import qualified Data.IORef as IORef
@@ -51,6 +52,7 @@ import System.Environment (getArgs)
5152import System.Exit (exitFailure )
5253import System.FilePath.Glob (glob )
5354import qualified System.IO as IO
55+ import System.IO (BufferMode (NoBuffering ))
5456import qualified System.Process as Process
5557import Web.Scotty
5658import qualified Web.Scotty as Scotty
@@ -118,27 +120,9 @@ buildMakeActions codegenRef =
118120 outputPrimDocs :: Make. Make ()
119121 outputPrimDocs = pure ()
120122
121- -- mkCommand :: String -> String
122- -- mkCommand str = "\
123- -- \{ \"command\": \"complete\",\
124- -- \\"params\": {\
125- -- \\"filters\": [{\
126- -- \\"filter\": \"prefix\",\
127- -- \\"params\": {\
128- -- \\"search\": \"" <> str <> "\"\
129- -- \}\
130- -- \}],\
131- -- \\"options\": {\
132- -- \\"maxResults\": 20,\
133- -- \\"groupReexports\": true\
134- -- \}\
135- -- \}\
136- -- \}\
137- -- \"
138123
139-
140- server :: [P. ExternsFile ] -> P. Env -> P. Environment -> Int -> IO ()
141- server externs initNamesEnv initEnv port = do
124+ server :: [P. ExternsFile ] -> P. Env -> P. Environment -> Int -> String -> IO ()
125+ server externs initNamesEnv initEnv port pursIDEPortString = do
142126 codegenRef <- IORef. newIORef Nothing
143127 let makeActions = buildMakeActions codegenRef
144128 let compile :: Text -> IO (Either Error ([P. JSONError ], JS ))
@@ -182,33 +166,20 @@ server externs initNamesEnv initEnv port = do
182166 Right (warnings, comp) ->
183167 Scotty. json $ A. object [ " js" .= comp, " warnings" .= warnings ]
184168
185- get " /complete" $ do
186- query <- param " q"
169+ post " /complete" $ do
187170 Scotty. setHeader " Access-Control-Allow-Origin" " *"
188171 Scotty. setHeader " Content-Type" " application/json"
189- let ideClient =
190- Process. createProcess_ " purs-ide-client"
191- (Process. proc " purs" [" ide" , " client" ])
192- { Process. std_in = Process. CreatePipe
193- , Process. std_out = Process. CreatePipe
194- }
195- mkCommand q = A. encode $ A. object
196- [ " command" .= (" complete" :: Text )
197- , " params" .= A. object
198- [ " filters" .= A. Array
199- ( V. fromList
200- [ A. object
201- [ " filter" .= (" prefix" :: Text )
202- , " params" .= A. object
203- [ " search" .= q ]
204- ]
205- ]
206- )
207- ]
208- ]
209- (Just handleIn, Just handleOut, _, _) <- liftIO ideClient
210- liftIO $ Char8. hPutStrLn handleIn (mkCommand (query :: Text ))
211- result <- liftIO $ BS. hGetContents handleOut
172+ (Just handleIn, Just handleOut, _, _) <- liftIO $
173+ Process. createProcess_
174+ " purs-ide-client"
175+ (Process. proc " purs" [" ide" , " client" , " -p" , pursIDEPortString])
176+ { Process. std_in = Process. CreatePipe
177+ , Process. std_out = Process. CreatePipe
178+ }
179+ liftIO (IO. hSetBuffering handleIn NoBuffering )
180+ command <- BL.Char8. toStrict <$> body
181+ liftIO (BS.Char8. hPutStrLn handleIn command)
182+ result <- liftIO (BS. hGetContents handleOut)
212183 Scotty. text (TL. fromStrict (T. decodeUtf8 result))
213184
214185 get " /search" $ do
@@ -283,7 +254,7 @@ main :: IO ()
283254main = do
284255 -- Stop mangled "Compiling ModuleName" text
285256 IO. hSetBuffering IO. stderr IO. LineBuffering
286- (portString : inputGlobs) <- getArgs
257+ (portString : pursIDEPortString : inputGlobs) <- getArgs
287258 let port = read portString
288259 inputFiles <- concat <$> traverse glob inputGlobs
289260 e <- runExceptT $ do
@@ -294,6 +265,6 @@ main = do
294265 case e of
295266 Left err -> print err >> exitFailure
296267 Right (exts, namesEnv, env) -> do
297- let ideServer = Process. proc " purs" [ " ide" , " server" ]
268+ let ideServer = Process. proc " purs" ( " ide" : " server" : " -p " : pursIDEPortString : inputGlobs)
298269 Process. withCreateProcess ideServer $
299- \ _ _ _ _ -> server exts namesEnv env port
270+ \ _ _ _ _ -> server exts namesEnv env port pursIDEPortString
0 commit comments