Say "Still Alive" during checking for Travis

This commit is contained in:
Michael Snoyman 2015-01-05 17:08:23 +02:00
parent 5cb4f0532d
commit cb9526b2fd

View File

@ -8,6 +8,9 @@ module Stackage.CompleteBuild
, completeBuild , completeBuild
, justCheck , justCheck
) where ) where
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (withAsync)
import Data.Default.Class (def) import Data.Default.Class (def)
import Data.Semigroup (Max (..), Option (..)) import Data.Semigroup (Max (..), Option (..))
import Data.Text.Read (decimal) import Data.Text.Read (decimal)
@ -145,11 +148,20 @@ renderLTSVer lts = fpFromText $ concat
, ".yaml" , ".yaml"
] ]
-- | Just print a message saying "still alive" every second, to appease Travis.
stillAlive :: IO () -> IO ()
stillAlive inner =
withAsync printer $ const inner
where
printer = forever $ do
threadDelay 1000000
putStrLn "Still alive"
-- | Generate and check a new build plan, but do not execute it. -- | Generate and check a new build plan, but do not execute it.
-- --
-- Since 0.3.1 -- Since 0.3.1
justCheck :: IO () justCheck :: IO ()
justCheck = withManager tlsManagerSettings $ \man -> do justCheck = stillAlive $ withManager tlsManagerSettings $ \man -> do
putStrLn "Loading build constraints" putStrLn "Loading build constraints"
bc <- defaultBuildConstraints man bc <- defaultBuildConstraints man