git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
poll to check if the server is running (#2121)
7620ec3Christoph Hegemann
tests/Language/PureScript/Ide/Integration.hs+25−2
@@ -31,6 +31,7 @@ module Language.PureScript.Ide.Integration
31 , addImplicitImport
31 , addImplicitImport
32 , loadModule
32 , loadModule
33 , loadModuleWithDeps
33 , loadModuleWithDeps
34+ , getCwd
34 , getFlexCompletions
35 , getFlexCompletions
35 , getType
36 , getType
36 , rebuildModule
37 , rebuildModule
@@ -48,13 +49,14 @@ import Data.Aeson
48import Data.Aeson.Types
49import Data.Aeson.Types
49import qualified Data.ByteString.Lazy.UTF8 as BSL
50import qualified Data.ByteString.Lazy.UTF8 as BSL
50import Data.Either (isRight)
51import Data.Either (isRight)
51−import Data.Maybe (fromJust)
52+import Data.Maybe (fromJust, isNothing)
52import qualified Data.Text as T
53import qualified Data.Text as T
53import qualified Data.Vector as V
54import qualified Data.Vector as V
54import Language.PureScript.Ide.Util
55import Language.PureScript.Ide.Util
55import System.Directory
56import System.Directory
56import System.Exit
57import System.Exit
57import System.FilePath
58import System.FilePath
59+import System.IO.Error (mkIOError, userErrorType)
58import System.Process
60import System.Process
59
61
60projectDirectory :: IO FilePath
62projectDirectory :: IO FilePath
@@ -77,9 +79,15 @@ stopServer = terminateProcess
77withServer :: IO a -> IO a
79withServer :: IO a -> IO a
78withServer s = do
80withServer s = do
79 _ <- startServer
81 _ <- startServer
82+ started <- tryNTimes 5 (shush <$> (try getCwd :: IO (Either SomeException String)))
83+ when (isNothing started) $
84+ throwIO (mkIOError userErrorType "psc-ide-server didn't start in time" Nothing Nothing)
80 r <- s
85 r <- s
81 quitServer
86 quitServer
82− return r
87+ pure r
88+
89+shush :: Either a b -> Maybe b
90+shush = either (const Nothing) Just
83
91
84-- project management utils
92-- project management utils
85
93
@@ -93,6 +101,16 @@ compileTestProject = do
93 }
101 }
94 isSuccess <$> waitForProcess procHandle
102 isSuccess <$> waitForProcess procHandle
95
103
104+tryNTimes :: Int -> IO (Maybe a) -> IO (Maybe a)
105+tryNTimes 0 _ = pure Nothing
106+tryNTimes n action = do
107+ r <- action
108+ case r of
109+ Nothing -> do
110+ threadDelay 500000
111+ tryNTimes (n - 1) action
112+ Just a -> pure (Just a)
113+
96deleteOutputFolder :: IO ()
114deleteOutputFolder :: IO ()
97deleteOutputFolder = do
115deleteOutputFolder = do
98 odir <- fmap (</> "output") projectDirectory
116 odir <- fmap (</> "output") projectDirectory
@@ -137,6 +155,11 @@ reset = do
137 _ <- try $ sendCommand resetCommand :: IO (Either SomeException String)
155 _ <- try $ sendCommand resetCommand :: IO (Either SomeException String)
138 return ()
156 return ()
139
157
158+getCwd :: IO String
159+getCwd = do
160+ let cwdCommand = object ["command" .= ("cwd" :: String)]
161+ sendCommand cwdCommand
162+
140loadModuleWithDeps :: String -> IO String
163loadModuleWithDeps :: String -> IO String
141loadModuleWithDeps m = sendCommand $ load [] [m]
164loadModuleWithDeps m = sendCommand $ load [] [m]
142
165