@@ -60,9 +60,8 @@ runWidget conf w = do
6060 beforeMainLoop = do
6161 putStrLn $ "Frontend running on " <> T.unpack (URI.render uri)
6262 settings = setBeforeMainLoop beforeMainLoop (setPort port (setTimeout 3600 defaultSettings))
63− logErr p = putStrLn $ unwords [ "Port", show p, "is in use."]
6463 bracket
65− (bindPortTCPRetry settings (logErr port) (_runConfig_retryTimeout conf))
64+ (bindPortTCPRetry settings (logPortBindErr port) (_runConfig_retryTimeout conf))
6665 close
6766 (\skt -> do
6867 man <- newManager defaultManagerSettings
@@ -71,19 +70,18 @@ runWidget conf w = do
7170
7271-- | like 'bindPortTCP' but reconnects on exception
7372bindPortTCPRetry :: Settings
74− -> IO () -- ^ Action to run the first time an exception is caught
73+ -> (IOError -> IO ()) -- ^ Action to run the first time an exception is caught
7574 -> Int
7675 -> IO Socket
77−bindPortTCPRetry settings m n = catch (bindPortTCP (settingsPort settings) (settingsHost settings)) $ \(_ :: IOError) -> do
78− m
76+bindPortTCPRetry settings m n = catch (bindPortTCP (settingsPort settings) (settingsHost settings)) $ \(e :: IOError) -> do
77+ m e
7978 threadDelay $ 1000000 * n
80− bindPortTCPRetry settings (return ()) n
79+ bindPortTCPRetry settings (\_ -> pure ()) n
8180
82−-- TODO
83−logPortBindErr :: Int -> IO ()
84−logPortBindErr p = getProcessIdForPort p >>= \case
85− Nothing -> return ()
86− Just _ -> return ()
81+logPortBindErr :: Int -> IOError -> IO ()
82+logPortBindErr p e = getProcessIdForPort p >>= \case
83+ Nothing -> putStrLn $ "runWidget: " <> show e
84+ Just pid -> putStrLn $ unwords [ "Port", show p, "is being used by process ID", show pid <> ".", "Please kill that process or change the port in config/common/route."]
8785
8886getProcessIdForPort :: Int -> IO (Maybe Int)
8987getProcessIdForPort port = do