[test] for coreNLP: allow to use the already started corenlp

Thing is: I sometimes have corenlp/postgres running for my dev
env. When I start tests, they fail because they try to start corenlp
again on the same port. So what I added was checking for that "address
already in use" condition and going on with the tests. CoreNLP is
stateless so it shouldn't matter which one we use for tests.
parent e63bddf7
Pipeline #7645 canceled with stages
......@@ -2,45 +2,56 @@
module Main where
import Control.Monad
import Control.Monad ( MonadFail(fail) )
import Data.Text (isInfixOf)
import Data.Text qualified as T
import Gargantext.Prelude hiding (isInfixOf)
import System.IO
import System.IO ( BufferMode(NoBuffering), hSetBuffering )
import System.Process
import System.Posix.Process
import System.Posix.Signals
import System.Posix.Process ( getProcessGroupIDOf )
import System.Posix.Signals ( keyboardSignal, signalProcessGroup )
import Test.API qualified as API
import Test.Database.Operations qualified as DB
import Test.Database.Transactions qualified as DBT
import Test.Hspec
import Test.Hspec ( hspec, sequential, runIO )
import Test.Server.ReverseProxy qualified as ReverseProxy
startCoreNLPServer :: IO ProcessHandle
startCoreNLPServer :: IO (Maybe ProcessHandle)
startCoreNLPServer = do
putText "calling start core nlp"
devNull <- openFile "/dev/null" WriteMode
let p = proc "startCoreNLPServer.sh" []
(_, _, _, 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
-- delegate it exclusively to the process here, which means that our CoreNLP
-- server will shut down correctly, but the test running will stop responding
-- to Ctrl^C requests.
, delegate_ctlc = False
, create_group = True
, std_out = UseHandle devNull
, std_err = UseHandle devNull
}) `catch` \e -> case e of
_ | True <- "does not exist" `isInfixOf` (T.pack . show @SomeException $ e)
-> fail $ "Cannot execute the 'startCoreNLPServer.sh' script. Make sure you are in a nix environment."
| otherwise -> throwIO e
pure hdl
let connect = do
(_, _, _, 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
-- delegate it exclusively to the process here, which means that our CoreNLP
-- server will shut down correctly, but the test running will stop responding
-- to Ctrl^C requests.
, delegate_ctlc = False
, create_group = True
, std_out = UseHandle devNull
, std_err = UseHandle devNull
}
pure $ Just hdl
killProcessTree :: ProcessHandle -> IO ()
killProcessTree ph = do
connect `catch` \e -> do
putText $ T.pack $ show @SomeException e
case e of
_ | True <- "does not exist" `isInfixOf` (T.pack . show @SomeException $ e)
-> fail $ "Cannot execute the 'startCoreNLPServer.sh' script. Make sure you are in a nix environment."
| True <- "Address already in use" `isInfixOf` (T.pack . show @SomeException $ e)
-> do
putText "Address already in use, but we hope for the best!"
pure Nothing
| otherwise -> throwIO e
killProcessTree :: Maybe ProcessHandle -> IO ()
killProcessTree Nothing = pure ()
killProcessTree (Just ph) = do
pid <- getPid ph
case pid of
Nothing -> putText "Process already terminated"
......
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