@@ -290,10 +290,27 @@ main = do
290290 void $ errExit False $ runOb ["thunk", "update", toTextIgnore dir, "--branch", "dumble-palooza"]
291291 checkDir dir >>= liftIO . assertEqual "" startingContents
292292
293+ describe "ob hoogle" $ {- NOT parallel -} do
294+ it "starts a hoogle server on the given port" $ inTmpObInit $ \_ -> do
295+ [p0] <- liftIO $ getFreePorts 1
296+ maskExitSuccess $ runHandle "ob" ["hoogle", "--port", T.pack (show p0)] $ \stdout -> fix $ \loop -> do
297+ ln <- liftIO $ T.hGetLine stdout
298+ echo ln
299+ let search = "Server starting on port " <> T.pack (show p0)
300+ case search `T.isInfixOf` ln of
301+ False -> loop -- keep waiting
302+ True -> do
303+ let req uri = liftIO $ HTTP.parseRequest uri >>= flip HTTP.httpLbs httpManager
304+ req ("http://127.0.0.1:" <> show p0) >>= \r -> case HTTP.responseStatus r == HTTP.ok200 of
305+ False -> errorExit $ "Request to hoogle server failed: " <> T.pack (show r)
306+ True -> exit 0
307+
308+maskExitSuccess :: Sh () -> Sh ()
309+maskExitSuccess = handle_sh (\case ExitSuccess -> pure (); e -> throw e)
293310
294311-- | Run `ob run` in the given directory (maximum of one level deep)
295312testObRunInDir :: String -> [Text] -> Maybe FilePath -> HTTP.Manager -> Sh ()
296−testObRunInDir executable extraArgs mdir httpManager = handle_sh (\case ExitSuccess -> pure (); e -> throw e) $ do
313+testObRunInDir executable extraArgs mdir httpManager = maskExitSuccess $ do
297314 [p0, p1] <- liftIO $ getFreePorts 2
298315 let uri p = "http://localhost:" <> T.pack (show p) <> "/" -- trailing slash required for comparison
299316 writefile "config/common/route" $ uri p0