git.iko.soy/typeable/wai
on master help sign in
Merge pull request #334 from yesodweb/pb-run-env
841b2ecGreg Weber
warp/Network/Wai/Handler/Warp.hs+1
compare with master
unifiedsplit
@@ -20,6 +20,7 @@
20module Network.Wai.Handler.Warp (
20module Network.Wai.Handler.Warp (
21 -- * Run a Warp server
21 -- * Run a Warp server
22 run
22 run
23+ , runEnv
23 , runSettings
24 , runSettings
24 , runSettingsSocket
25 , runSettingsSocket
25 , runSettingsConnection
26 , runSettingsConnection
warp/Network/Wai/Handler/Warp/Run.hs+18
@@ -35,6 +35,7 @@ import Network.Wai.Handler.Warp.Settings
35import qualified Network.Wai.Handler.Warp.Timeout as T
35import qualified Network.Wai.Handler.Warp.Timeout as T
36import Network.Wai.Handler.Warp.Types
36import Network.Wai.Handler.Warp.Types
37import Network.Wai.Internal (ResponseReceived (ResponseReceived))
37import Network.Wai.Internal (ResponseReceived (ResponseReceived))
38+import System.Environment (getEnvironment)
38import System.IO.Error (isFullErrorType, ioeGetErrorType)
39import System.IO.Error (isFullErrorType, ioeGetErrorType)
39
40
40#if WINDOWS
41#if WINDOWS
@@ -71,6 +72,23 @@ allowInterrupt = unblock $ return ()
71run :: Port -> Application -> IO ()
72run :: Port -> Application -> IO ()
72run p = runSettings defaultSettings { settingsPort = p }
73run p = runSettings defaultSettings { settingsPort = p }
73
74
75+-- | Run an 'Application' on the port present in the @PORT@ environment variable
76+--
77+-- Uses the 'Port' given when the variable is unset.
78+--
79+-- Since X.Y.Z
80+runEnv :: Port -> Application -> IO ()
81+runEnv p app = do
82+ mp <- fmap (lookup "PORT") getEnvironment
83+
84+ maybe (run p app) runReadPort mp
85+
86+ where
87+ runReadPort :: String -> IO ()
88+ runReadPort sp = case reads sp of
89+ ((p', _):_) -> run p' app
90+ _ -> fail $ "Invalid value in $PORT: " ++ sp
91+
74-- | Run an 'Application' with the given 'Settings'.
92-- | Run an 'Application' with the given 'Settings'.
75runSettings :: Settings -> Application -> IO ()
93runSettings :: Settings -> Application -> IO ()
76runSettings set app = withSocketsDo $
94runSettings set app = withSocketsDo $