@@ -1,280 +0,0 @@
1−-----------------------------------------------------------------------------
3−-- Module : Language.PureScript.Ide.Integration
4−-- Description : A psc-ide client for use in integration tests
5−-- Copyright : Christoph Hegemann 2016
6−-- License : MIT (http://opensource.org/licenses/MIT)
8−-- Maintainer : Christoph Hegemann <christoph.hegemann1337@gmail.com>
9−-- Stability : experimental
12−-- A psc-ide client for use in integration tests
13−-----------------------------------------------------------------------------
15−{-# LANGUAGE OverloadedStrings #-}
16−{-# LANGUAGE ScopedTypeVariables #-}
17−{-# LANGUAGE NoImplicitPrelude #-}
18−module Language.PureScript.Ide.Integration
20− -- managing the server process
38− , getFlexCompletionsInModule
49−import Data.Maybe (fromJust)
52−import Data.Aeson.Types
53−import qualified Data.Text.Encoding as T
54−import qualified Data.ByteString.Char8 as BS8
55−import qualified Data.ByteString.Lazy.Char8 as BSL8
56−import qualified Data.Vector as V
57−import qualified Language.PureScript as P
58−import System.Directory
59−import System.FilePath
61−import System.IO.Error (mkIOError, userErrorType)
64−projectDirectory :: IO FilePath
66− cd <- getCurrentDirectory
67− return $ cd </> "tests" </> "support" </> "pscide"
69−startServer :: IO ProcessHandle
71− pdir <- projectDirectory
72− -- Turn off filewatching since it creates race condition in a testing environment
73− (_, _, _, procHandle) <- createProcess $
74− (shell "psc-ide-server --no-watch src/*.purs") {cwd = Just pdir}
75− threadDelay 2000000 -- give the server 2s to start up
78−stopServer :: ProcessHandle -> IO ()
79−stopServer = terminateProcess
81−withServer :: IO a -> IO a
84− started <- tryNTimes 5 (rightToMaybe <$> (try getCwd :: IO (Either SomeException Text)))
85− when (isNothing started) $
86− throwIO (mkIOError userErrorType "psc-ide-server didn't start in time" Nothing Nothing)
91−-- project management utils
93−compileTestProject :: IO Bool
94−compileTestProject = do
95− pdir <- projectDirectory
96− (_, _, _, procHandle) <- createProcess $
97− (shell . toS $ "psc " <> fileGlob) { cwd = Just pdir }
98− r <- tryNTimes 10 (getProcessExitCode procHandle)
99− pure (fromMaybe False (isSuccess <$> r))
101−tryNTimes :: Int -> IO (Maybe a) -> IO (Maybe a)
102−tryNTimes 0 _ = pure Nothing
103−tryNTimes n action = do
108− tryNTimes (n - 1) action
109− Just a -> pure (Just a)
111−deleteOutputFolder :: IO ()
112−deleteOutputFolder = do
113− odir <- fmap (</> "output") projectDirectory
114− whenM (doesDirectoryExist odir) (removeDirectoryRecursive odir)
116−deleteFileIfExists :: FilePath -> IO ()
117−deleteFileIfExists fp = whenM (doesFileExist fp) (removeFile fp)
119−isSuccess :: ExitCode -> Bool
120−isSuccess ExitSuccess = True
121−isSuccess (ExitFailure _) = False
124−fileGlob = "\"src/**/*.purs\""
126−-- Integration Testing API
128−sendCommand :: Value -> IO Text
130− (Just hin, Just hout, _, _) <-
131− createProcess ((proc "psc-ide-client" []) {std_in=CreatePipe, std_out=CreatePipe})
133− hSetEncoding hin utf8
134− hSetEncoding hout utf8
136− BS8.hPutStrLn hin (BSL8.toStrict (encode v))
138− T.decodeUtf8 <$> BS8.hGetLine hout
142− let quitCommand = object ["command" .= ("quit" :: Text)]
143− _ <- try $ sendCommand quitCommand :: IO (Either SomeException Text)
148− let resetCommand = object ["command" .= ("reset" :: Text)]
149− _ <- try $ sendCommand resetCommand :: IO (Either SomeException Text)
154− let cwdCommand = object ["command" .= ("cwd" :: Text)]
155− sendCommand cwdCommand
157−loadModule :: Text -> IO Text
158−loadModule m = loadModules [m]
160−loadModules :: [Text] -> IO Text
161−loadModules = sendCommand . load
164−loadAll = sendCommand (load [])
166−getFlexCompletions :: Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)]
167−getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) Nothing)
169−getFlexCompletionsInModule :: Text -> Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)]
170−getFlexCompletionsInModule q m = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) (Just m))
172−getType :: Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)]
173−getType q = parseCompletions <$> sendCommand (typeC q [])
175−addImport :: Text -> FilePath -> FilePath -> IO Text
176−addImport identifier fp outfp = sendCommand (addImportC identifier fp outfp)
178−addImplicitImport :: Text -> FilePath -> FilePath -> IO Text
179−addImplicitImport mn fp outfp = sendCommand (addImplicitImportC mn fp outfp)
181−rebuildModule :: FilePath -> IO Text
182−rebuildModule m = sendCommand (rebuildC m Nothing)
186−commandWrapper :: Text -> Value -> Value
187−commandWrapper c p = object ["command" .= c, "params" .= p]
189−load :: [Text] -> Value
190−load ms = commandWrapper "load" (object ["modules" .= ms])
192−typeC :: Text -> [Value] -> Value
193−typeC q filters = commandWrapper "type" (object ["search" .= q, "filters" .= filters])
195−addImportC :: Text -> FilePath -> FilePath -> Value
196−addImportC identifier = addImportW $
197− object [ "importCommand" .= ("addImport" :: Text)
198− , "identifier" .= identifier
201−addImplicitImportC :: Text -> FilePath -> FilePath -> Value
202−addImplicitImportC mn = addImportW $
203− object [ "importCommand" .= ("addImplicitImport" :: Text)
207−rebuildC :: FilePath -> Maybe FilePath -> Value
208−rebuildC file outFile =
209− commandWrapper "rebuild" (object [ "file" .= file
210− , "outfile" .= outFile
213−addImportW :: Value -> FilePath -> FilePath -> Value
214−addImportW importCommand fp outfp =
215− commandWrapper "import" (object [ "file" .= fp
216− , "outfile" .= outfp
217− , "importCommand" .= importCommand
221−completion :: [Value] -> Maybe Value -> Maybe Text -> Value
222−completion filters matcher currentModule =
224− matcher' = case matcher of
226− Just m -> ["matcher" .= m]
227− currentModule' = case currentModule of
229− Just cm -> ["currentModule" .= cm]
231− commandWrapper "complete" (object $ "filters" .= filters : matcher' ++ currentModule' )
233−flexMatcher :: Text -> Value
234−flexMatcher q = object [ "matcher" .= ("flex" :: Text)
235− , "params" .= object ["search" .= q]
240−unwrapResult :: Value -> Parser (Either Text Value)
241−unwrapResult = withObject "result" $ \o -> do
242− (rt :: Text) <- o .: "resultType"
245− res <- o .: "result"
246− withArray "errors" (fmap (Left . fold) . traverse (withObject "error" (.: "message"))) res
248− res <- o .: "result"
252−withResult :: (Value -> Parser a) -> Value -> Parser (Either Text a)
256− Left err -> pure (Left err)
257− Right res -> Right <$> p res
259−completionParser :: Value -> Parser [(Text, Text, Text, Maybe P.SourceSpan)]
260−completionParser = withArray "res" $ \cs ->
261− mapM (withObject "completion" $ \o -> do
262− ident <- o .: "identifier"
263− module' <- o .: "module"
265− ss <- o .: "definedAt"
266− pure (module', ident, ty, ss)) (V.toList cs)
268−valueFromText :: Text -> Value
269−valueFromText = fromJust . decode . toS
271−resultIsSuccess :: Text -> Bool
272−resultIsSuccess = isRight . join . first toS . parseEither unwrapResult . valueFromText
274−parseCompletions :: Text -> [(Text, Text, Text, Maybe P.SourceSpan)]
276− fromJust $ join (rightToMaybe <$> parseMaybe (withResult completionParser) (valueFromText s))
278−parseTextResult :: Text -> Text
280− fromJust $ join (rightToMaybe <$> parseMaybe (withResult (withText "tr" pure)) (valueFromText s))