@@ -19,8 +19,9 @@ import qualified Data.Aeson as A
19
19
import Data.Aeson ((.=) )
20
20
import Data.Bifunctor (first , second , bimap )
21
21
import qualified Data.ByteString as BS
22
+ import qualified Data.ByteString.Char8 as BS.Char8
22
23
import 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
24
25
import Data.Default (def )
25
26
import Data.Function (on , fix )
26
27
import qualified Data.IORef as IORef
@@ -51,6 +52,7 @@ import System.Environment (getArgs)
51
52
import System.Exit (exitFailure )
52
53
import System.FilePath.Glob (glob )
53
54
import qualified System.IO as IO
55
+ import System.IO (BufferMode (NoBuffering ))
54
56
import qualified System.Process as Process
55
57
import Web.Scotty
56
58
import qualified Web.Scotty as Scotty
@@ -118,27 +120,9 @@ buildMakeActions codegenRef =
118
120
outputPrimDocs :: Make. Make ()
119
121
outputPrimDocs = pure ()
120
122
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
- -- \"
138
123
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
142
126
codegenRef <- IORef. newIORef Nothing
143
127
let makeActions = buildMakeActions codegenRef
144
128
let compile :: Text -> IO (Either Error ([P. JSONError ], JS ))
@@ -182,33 +166,20 @@ server externs initNamesEnv initEnv port = do
182
166
Right (warnings, comp) ->
183
167
Scotty. json $ A. object [ " js" .= comp, " warnings" .= warnings ]
184
168
185
- get " /complete" $ do
186
- query <- param " q"
169
+ post " /complete" $ do
187
170
Scotty. setHeader " Access-Control-Allow-Origin" " *"
188
171
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)
212
183
Scotty. text (TL. fromStrict (T. decodeUtf8 result))
213
184
214
185
get " /search" $ do
@@ -283,7 +254,7 @@ main :: IO ()
283
254
main = do
284
255
-- Stop mangled "Compiling ModuleName" text
285
256
IO. hSetBuffering IO. stderr IO. LineBuffering
286
- (portString : inputGlobs) <- getArgs
257
+ (portString : pursIDEPortString : inputGlobs) <- getArgs
287
258
let port = read portString
288
259
inputFiles <- concat <$> traverse glob inputGlobs
289
260
e <- runExceptT $ do
@@ -294,6 +265,6 @@ main = do
294
265
case e of
295
266
Left err -> print err >> exitFailure
296
267
Right (exts, namesEnv, env) -> do
297
- let ideServer = Process. proc " purs" [ " ide" , " server" ]
268
+ let ideServer = Process. proc " purs" ( " ide" : " server" : " -p " : pursIDEPortString : inputGlobs)
298
269
Process. withCreateProcess ideServer $
299
- \ _ _ _ _ -> server exts namesEnv env port
270
+ \ _ _ _ _ -> server exts namesEnv env port pursIDEPortString
0 commit comments