[tests] better startup of corenlp

Take into account the async nature of createProcess. Add proper watch
so that we monitor that coreNLP is running.
parent bde033f9
Pipeline #7738 canceled with stages
in 7 minutes and 46 seconds
......@@ -7,6 +7,7 @@ import Control.Monad
import Data.Text qualified as T
import Gargantext.Prelude hiding (isInfixOf)
import System.IO
import System.IO.Error (userError)
import System.Process
import System.Posix.Process
import System.Posix.Signals
......@@ -17,13 +18,13 @@ import Test.Hspec
import Test.Server.ReverseProxy qualified as ReverseProxy
startCoreNLPServer :: IO ProcessHandle
startCoreNLPServer :: IO (Handle, Handle, ProcessHandle)
startCoreNLPServer = do
putText "calling start core nlp"
devNull <- openFile "/dev/null" WriteMode
-- devNull <- openFile "/dev/null" WriteMode
let p = proc "nix" [ "run"
, "git+https://gitlab.iscpif.fr/gargantext/corenlp-nix.git" ]
(_, _, _, hdl) <- (createProcess $ p { cwd = Nothing
(_, m_stdout_hdl, m_stderr_hdl, hdl) <- (createProcess $ p { cwd = Nothing
-- NOTE(adn) Issue #451, this one has to stay disabled, because if we
-- turn it on, despite the confusing documentation on the `process` library
-- it will cause the Haskell RTS to completely ignore the Ctrl^c and instead
......@@ -32,17 +33,23 @@ startCoreNLPServer = do
-- to Ctrl^C requests.
, delegate_ctlc = False
, create_group = True
, std_out = UseHandle devNull
, std_err = UseHandle devNull
, std_out = CreatePipe
, std_err = CreatePipe
-- , std_out = UseHandle devNull
-- , std_err = UseHandle devNull
}) `catch` \(e :: SomeException) ->
case e of
_ | True <- "does not exist" `T.isInfixOf` (T.pack . show @SomeException $ e)
-> fail $ "Cannot execute the 'corenlp' via nix flakes. Make sure you are in a nix environment."
-> fail $ "Cannot execute the 'corenlp' via nix flakes. Make sure you have 'nix' installed."
| otherwise -> throwIO e
pure hdl
killProcessTree :: ProcessHandle -> IO ()
killProcessTree ph = do
let stdout_hdl = fromMaybe (errorTrace "Can't get stdout handle!") m_stdout_hdl
let stderr_hdl = fromMaybe (errorTrace "Can't get stderr handle!") m_stderr_hdl
pure (stdout_hdl, stderr_hdl, hdl)
killProcessTree :: (Handle, Handle, ProcessHandle) -> IO ()
killProcessTree (_, _, ph) = do
pid <- getPid ph
case pid of
Nothing -> putText "Process already terminated"
......@@ -50,6 +57,23 @@ killProcessTree ph = do
pgid <- getProcessGroupIDOf p
signalProcessGroup keyboardSignal pgid
-- NOTE(seeg) createProcess is nonblocking, and so its exception
-- handling is incomplete:
-- λ> createProcess $ proc "l" []
-- *** Exception: l: createProcess: posix_spawnp: does not exist (No such file or directory)
-- λ> createProcess $ proc "ls" ["haha"]
-- ls: cannot access 'haha': No such file or directory
-- Credit for this construct goes to @adn
waitOrDie :: (Handle, Handle, ProcessHandle) -> IO ()
waitOrDie (stdout_h, stderr_h, h) = do
ec <- waitForProcess h
when (ec /= ExitSuccess) $ do
out <- hGetContents stdout_h
err <- hGetContents stderr_h
throwIO $ userError ("Async process quit!\nStdout:\n" <> out <> "\nStderr:\n" <> err)
-- It's especially important to use Hspec for DB tests, because,
-- unlike 'tasty', 'Hspec' has explicit control over parallelism,
-- and it's important that DB tests are run according to a very
......@@ -60,7 +84,7 @@ killProcessTree ph = do
main :: IO ()
main = do
hSetBuffering stdout NoBuffering
bracket startCoreNLPServer killProcessTree (const run_tests)
bracket startCoreNLPServer killProcessTree (\h -> race (waitOrDie h) run_tests *> pure())
where
run_tests = hspec $ sequential $ do
API.tests
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment