@@ -14,6 +14,7 @@
1414
1515{-# LANGUAGE OverloadedStrings #-}
1616{-# LANGUAGE ScopedTypeVariables #-}
17+{-# LANGUAGE NoImplicitPrelude #-}
1718module Language.PureScript.Ide.Integration
1819 (
1920 -- managing the server process
@@ -44,19 +45,15 @@ module Language.PureScript.Ide.Integration
4445 , parseTextResult
4546 ) where
4647
47−import Control.Concurrent (threadDelay)
48−import Control.Exception
49−import Control.Monad (join, when)
48+import Protolude
49+import Unsafe (fromJust)
50+
5051import Data.Aeson
5152import Data.Aeson.Types
52−import qualified Data.ByteString.Lazy.UTF8 as BSL
53−import Data.Either (isRight)
54−import Data.Maybe (fromJust, isNothing, fromMaybe)
5553import qualified Data.Text as T
5654import qualified Data.Vector as V
5755import Language.PureScript.Ide.Util
5856import System.Directory
59−import System.Exit
6057import System.FilePath
6158import System.IO.Error (mkIOError, userErrorType)
6259import System.Process
@@ -81,26 +78,23 @@ stopServer = terminateProcess
8178withServer :: IO a -> IO a
8279withServer s = do
8380 _ <- startServer
84− started <- tryNTimes 5 (shush <$> (try getCwd :: IO (Either SomeException String)))
81+ started <- tryNTimes 5 (rightToMaybe <$> (try getCwd :: IO (Either SomeException Text)))
8582 when (isNothing started) $
8683 throwIO (mkIOError userErrorType "psc-ide-server didn't start in time" Nothing Nothing)
8784 r <- s
8885 quitServer
8986 pure r
9087
91−shush :: Either a b -> Maybe b
92−shush = either (const Nothing) Just
93−
9488-- project management utils
9589
9690compileTestProject :: IO Bool
9791compileTestProject = do
9892 pdir <- projectDirectory
9993 (_, _, _, procHandle) <- createProcess $
100− (shell $ "psc " ++ fileGlob) { cwd = Just pdir
101− , std_out = CreatePipe
102− , std_err = CreatePipe
103− }
94+ (shell . toS $ "psc " <> fileGlob) { cwd = Just pdir
95+ , std_out = CreatePipe
96+ , std_err = CreatePipe
97+ }
10498 r <- tryNTimes 5 (getProcessExitCode procHandle)
10599 pure (fromMaybe False (isSuccess <$> r))
106100
@@ -122,24 +116,17 @@ deleteOutputFolder = do
122116deleteFileIfExists :: FilePath -> IO ()
123117deleteFileIfExists fp = whenM (doesFileExist fp) (removeFile fp)
124118
125−whenM :: Monad m => m Bool -> m () -> m ()
126−whenM p f = do
127− x <- p
128− when x f
129−
130119isSuccess :: ExitCode -> Bool
131120isSuccess ExitSuccess = True
132121isSuccess (ExitFailure _) = False
133122
134−fileGlob :: String
135−fileGlob = unwords
136− [ "\"src/**/*.purs\""
137− ]
123+fileGlob :: Text
124+fileGlob = "\"src/**/*.purs\""
138125
139126-- Integration Testing API
140127
141−sendCommand :: Value -> IO String
142−sendCommand v = readCreateProcess
128+sendCommand :: Value -> IO Text
129+sendCommand v = toS <$> readCreateProcess
143130 ((shell "psc-ide-client") { std_out=CreatePipe
144131 , std_err=CreatePipe
145132 })
@@ -147,68 +134,68 @@ sendCommand v = readCreateProcess
147134
148135quitServer :: IO ()
149136quitServer = do
150− let quitCommand = object ["command" .= ("quit" :: String)]
151− _ <- try $ sendCommand quitCommand :: IO (Either SomeException String)
137+ let quitCommand = object ["command" .= ("quit" :: Text)]
138+ _ <- try $ sendCommand quitCommand :: IO (Either SomeException Text)
152139 return ()
153140
154141reset :: IO ()
155142reset = do
156− let resetCommand = object ["command" .= ("reset" :: String)]
157− _ <- try $ sendCommand resetCommand :: IO (Either SomeException String)
143+ let resetCommand = object ["command" .= ("reset" :: Text)]
144+ _ <- try $ sendCommand resetCommand :: IO (Either SomeException Text)
158145 return ()
159146
160−getCwd :: IO String
147+getCwd :: IO Text
161148getCwd = do
162− let cwdCommand = object ["command" .= ("cwd" :: String)]
149+ let cwdCommand = object ["command" .= ("cwd" :: Text)]
163150 sendCommand cwdCommand
164151
165−loadModule :: String -> IO String
152+loadModule :: Text -> IO Text
166153loadModule m = loadModules [m]
167154
168−loadModules :: [String] -> IO String
155+loadModules :: [Text] -> IO Text
169156loadModules = sendCommand . load
170157
171−loadAll :: IO String
158+loadAll :: IO Text
172159loadAll = sendCommand (load [])
173160
174−getFlexCompletions :: String -> IO [(String, String, String)]
161+getFlexCompletions :: Text -> IO [(Text, Text, Text)]
175162getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) Nothing)
176163
177−getFlexCompletionsInModule :: String -> String -> IO [(String, String, String)]
164+getFlexCompletionsInModule :: Text -> Text -> IO [(Text, Text, Text)]
178165getFlexCompletionsInModule q m = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) (Just m))
179166
180−getType :: String -> IO [(String, String, String)]
167+getType :: Text -> IO [(Text, Text, Text)]
181168getType q = parseCompletions <$> sendCommand (typeC q [])
182169
183−addImport :: String -> FilePath -> FilePath -> IO String
170+addImport :: Text -> FilePath -> FilePath -> IO Text
184171addImport identifier fp outfp = sendCommand (addImportC identifier fp outfp)
185172
186−addImplicitImport :: String -> FilePath -> FilePath -> IO String
173+addImplicitImport :: Text -> FilePath -> FilePath -> IO Text
187174addImplicitImport mn fp outfp = sendCommand (addImplicitImportC mn fp outfp)
188175
189−rebuildModule :: FilePath -> IO String
176+rebuildModule :: FilePath -> IO Text
190177rebuildModule m = sendCommand (rebuildC m Nothing)
191178
192179-- Command Encoding
193180
194−commandWrapper :: String -> Value -> Value
181+commandWrapper :: Text -> Value -> Value
195182commandWrapper c p = object ["command" .= c, "params" .= p]
196183
197−load :: [String] -> Value
184+load :: [Text] -> Value
198185load ms = commandWrapper "load" (object ["modules" .= ms])
199186
200−typeC :: String -> [Value] -> Value
187+typeC :: Text -> [Value] -> Value
201188typeC q filters = commandWrapper "type" (object ["search" .= q, "filters" .= filters])
202189
203−addImportC :: String -> FilePath -> FilePath -> Value
190+addImportC :: Text -> FilePath -> FilePath -> Value
204191addImportC identifier = addImportW $
205− object [ "importCommand" .= ("addImport" :: String)
192+ object [ "importCommand" .= ("addImport" :: Text)
206193 , "identifier" .= identifier
207194 ]
208195
209−addImplicitImportC :: String -> FilePath -> FilePath -> Value
196+addImplicitImportC :: Text -> FilePath -> FilePath -> Value
210197addImplicitImportC mn = addImportW $
211− object [ "importCommand" .= ("addImplicitImport" :: String)
198+ object [ "importCommand" .= ("addImplicitImport" :: Text)
212199 , "module" .= mn
213200 ]
214201
@@ -226,7 +213,7 @@ addImportW importCommand fp outfp =
226213 ])
227214
228215
229−completion :: [Value] -> Maybe Value -> Maybe String -> Value
216+completion :: [Value] -> Maybe Value -> Maybe Text -> Value
230217completion filters matcher currentModule =
231218 let
232219 matcher' = case matcher of
@@ -238,16 +225,16 @@ completion filters matcher currentModule =
238225 in
239226 commandWrapper "complete" (object $ "filters" .= filters : matcher' ++ currentModule' )
240227
241−flexMatcher :: String -> Value
242−flexMatcher q = object [ "matcher" .= ("flex" :: String)
228+flexMatcher :: Text -> Value
229+flexMatcher q = object [ "matcher" .= ("flex" :: Text)
243230 , "params" .= object ["search" .= q]
244231 ]
245232
246233-- Result parsing
247234
248−unwrapResult :: Value -> Parser (Either String Value)
235+unwrapResult :: Value -> Parser (Either Text Value)
249236unwrapResult = withObject "result" $ \o -> do
250− (rt :: String) <- o .: "resultType"
237+ (rt :: Text) <- o .: "resultType"
251238 case rt of
252239 "error" -> do
253240 res <- o .: "result"
@@ -255,16 +242,16 @@ unwrapResult = withObject "result" $ \o -> do
255242 "success" -> do
256243 res <- o .: "result"
257244 pure (Right res)
258− _ -> fail "lol"
245+ _ -> mzero
259246
260−withResult :: (Value -> Parser a) -> Value -> Parser (Either String a)
247+withResult :: (Value -> Parser a) -> Value -> Parser (Either Text a)
261248withResult p v = do
262249 r <- unwrapResult v
263250 case r of
264251 Left err -> pure (Left err)
265252 Right res -> Right <$> p res
266253
267−completionParser :: Value -> Parser [(String, String, String)]
254+completionParser :: Value -> Parser [(Text, Text, Text)]
268255completionParser = withArray "res" $ \cs ->
269256 mapM (withObject "completion" $ \o -> do
270257 ident <- o .: "identifier"
@@ -272,22 +259,16 @@ completionParser = withArray "res" $ \cs ->
272259 ty <- o .: "type"
273260 pure (module', ident, ty)) (V.toList cs)
274261
275−valueFromString :: String -> Value
276−valueFromString = fromJust . decode . BSL.fromString
262+valueFromText :: Text -> Value
263+valueFromText = fromJust . decode . toS
277264
278−resultIsSuccess :: String -> Bool
279−resultIsSuccess = isRight . join . parseEither unwrapResult . valueFromString
265+resultIsSuccess :: Text -> Bool
266+resultIsSuccess = isRight . join . first toS . parseEither unwrapResult . valueFromText
280267
281−parseCompletions :: String -> [(String, String, String)]
282−parseCompletions s = fromJust $ do
283− cs <- parseMaybe (withResult completionParser) (valueFromString s)
284− case cs of
285− Left _ -> error "Failed to parse completions"
286− Right cs' -> pure cs'
268+parseCompletions :: Text -> [(Text, Text, Text)]
269+parseCompletions s =
270+ fromJust $ join (rightToMaybe <$> parseMaybe (withResult completionParser) (valueFromText s))
287271
288−parseTextResult :: String -> String
289−parseTextResult s = fromJust $ do
290− r <- parseMaybe (withResult (withText "tr" pure)) (valueFromString s)
291− case r of
292− Left _ -> error "Failed to parse textResult"
293− Right r' -> pure (T.unpack r')
272+parseTextResult :: Text -> Text
273+parseTextResult s =
274+ fromJust $ join (rightToMaybe <$> parseMaybe (withResult (withText "tr" pure)) (valueFromText s))