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