@@ -5,10 +5,12 @@
55{-# LANGUAGE PatternGuards #-}
66{-# LANGUAGE ScopedTypeVariables #-}
77{-# LANGUAGE TemplateHaskell #-}
8+{-# LANGUAGE TypeApplications #-}
89{-# LANGUAGE ViewPatterns #-}
910module Obelisk.SelfTest where
1011
11−import Control.Exception (bracket, throw)
12+import Control.Concurrent (threadDelay)
13+import Control.Exception (bracket, throw, try)
1214import Control.Monad
1315import Control.Monad.IO.Class
1416import Data.Bool (bool)
@@ -282,17 +284,20 @@ main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache ->
282284 describe "ob hoogle" $ {- NOT parallel -} do
283285 it "starts a hoogle server on the given port" $ inTmpObInit $ \_ -> do
284286 [p0] <- liftIO $ getFreePorts 1
285− maskExitSuccess $ runHandle "ob" ["hoogle", "--port", T.pack (show p0)] $ \stdout -> fix $ \loop -> do
286− ln <- liftIO $ T.hGetLine stdout
287− echo ln
288− let search = "Server starting on port " <> T.pack (show p0)
289− case search `T.isInfixOf` ln of
290− False -> loop -- keep waiting
291− True -> do
292− let req uri = liftIO $ HTTP.parseRequest uri >>= flip HTTP.httpLbs httpManager
293− req ("http://127.0.0.1:" <> show p0) >>= \r -> case HTTP.responseStatus r == HTTP.ok200 of
294− False -> errorExit $ "Request to hoogle server failed: " <> T.pack (show r)
295− True -> exit 0
287+ maskExitSuccess $ runHandle "ob" ["hoogle", "--port", T.pack (show p0)] $ \stdout -> flip fix Nothing $ \loop -> \case
288+ Nothing -> do -- Still waiting for initial signal that the server has started
289+ ln <- liftIO $ T.hGetLine stdout
290+ let search = "Server starting on port " <> T.pack (show p0)
291+ case search `T.isInfixOf` ln of
292+ False -> loop Nothing -- keep waiting
293+ True -> loop $ Just 10
294+ Just (n :: Int) -> do -- Server has started and we have n attempts left
295+ let req uri = liftIO $ try @HTTP.HttpException $ HTTP.parseRequest uri >>= flip HTTP.httpLbs httpManager
296+ req ("http://127.0.0.1:" <> show p0) >>= \case
297+ Right r | HTTP.responseStatus r == HTTP.ok200 -> exit 0
298+ e -> if n <= 0
299+ then errorExit $ "Request to hoogle server failed: " <> T.pack (show e)
300+ else liftIO (threadDelay (1*10^(6 :: Int))) *> loop (Just $ n - 1)
296301 where
297302 verbosity = bool silently verbosely isVerbose
298303 nixBuild args = run nixBuildPath ("--no-out-link" : args)