From 309d3c0f267f9e1ad7f77085fda300f7e5e06fbe Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 30 Oct 2012 17:02:17 +0200 Subject: [PATCH] yesod devel displays "app not loaded" message In order to achieve this, yesod devel listens on port 3000 and reverse proxies to port 3001. An environment variable is set to tell the app to listen on port 3001. --- yesod-default/Yesod/Default/Main.hs | 9 ++++++-- yesod-default/yesod-default.cabal | 3 ++- yesod/Devel.hs | 33 +++++++++++++++++++++++++++-- yesod/scaffold/project.cabal.cg | 2 +- yesod/yesod.cabal | 3 +++ 5 files changed, 44 insertions(+), 6 deletions(-) diff --git a/yesod-default/Yesod/Default/Main.hs b/yesod-default/Yesod/Default/Main.hs index 5de22ba1..c664de11 100644 --- a/yesod-default/Yesod/Default/Main.hs +++ b/yesod-default/Yesod/Default/Main.hs @@ -15,6 +15,9 @@ import Network.Wai.Middleware.Gzip (gzip, GzipFiles (GzipCacheFolder), gzipFiles import Network.Wai.Middleware.Autohead (autohead) import Network.Wai.Middleware.Jsonp (jsonp) import Control.Monad (when) +import System.Environment (getEnvironment) +import Data.Maybe (fromMaybe) +import Safe (readMay) #ifndef WINDOWS import qualified System.Posix.Signals as Signal @@ -81,7 +84,9 @@ defaultDevelApp -> IO (Int, Application) defaultDevelApp load getApp = do conf <- load - let p = appPort conf - putStrLn $ "Devel application launched: http://localhost:" ++ show p + env <- getEnvironment + let p = fromMaybe (appPort conf) $ lookup "PORT" env >>= readMay + pdisplay = fromMaybe p $ lookup "DISPLAY_PORT" env >>= readMay + putStrLn $ "Devel application launched: http://localhost:" ++ show pdisplay app <- getApp conf return (p, app) diff --git a/yesod-default/yesod-default.cabal b/yesod-default/yesod-default.cabal index 9dd2cbe1..7c464b5e 100644 --- a/yesod-default/yesod-default.cabal +++ b/yesod-default/yesod-default.cabal @@ -1,5 +1,5 @@ name: yesod-default -version: 1.1.0.2 +version: 1.1.1 license: MIT license-file: LICENSE author: Patrick Brisbin @@ -34,6 +34,7 @@ library , unordered-containers , hamlet >= 1.1 && < 1.2 , data-default + , safe if !os(windows) build-depends: unix diff --git a/yesod/Devel.hs b/yesod/Devel.hs index b022f546..7c7352e6 100644 --- a/yesod/Devel.hs +++ b/yesod/Devel.hs @@ -41,6 +41,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Set as Set import System.Directory +import System.Environment (getEnvironment) import System.Exit (ExitCode (..), exitFailure, exitSuccess) @@ -62,7 +63,8 @@ import System.Process (ProcessHandle, readProcess, runInteractiveProcess, system, - terminateProcess) + terminateProcess, + env) import System.Timeout (timeout) import Build (getDeps, isNewerThan, @@ -72,6 +74,12 @@ import GhcBuild (buildPackage, import qualified Config as GHC import SrcLoc (Located) +import Network.HTTP.ReverseProxy (waiProxyTo, ProxyDest (ProxyDest)) +import Network (withSocketsDo) +import Network.Wai (responseLBS) +import Network.HTTP.Types (status200) +import Network.Wai.Handler.Warp (run) +import Network.HTTP.Conduit (newManager, def) lockFile :: DevelOpts -> FilePath lockFile _opts = "yesod-devel/devel-terminate" @@ -108,8 +116,26 @@ cabalCommand opts | isCabalDev opts = "cabal-dev" defaultDevelOpts :: DevelOpts defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing +-- | Run a reverse proxy from port 3000 to 3001. If there is no response on +-- 3001, give an appropriate message to the user. +reverseProxy :: IO () +reverseProxy = withSocketsDo $ do + manager <- newManager def + run 3000 $ waiProxyTo + (const $ return $ Right $ ProxyDest "localhost" 3001) + onExc + manager + where + onExc _ _ = return $ responseLBS + status200 + [ ("content-type", "text/html") + , ("Refresh", "1") + ] + "

App not ready, please refresh

" + devel :: DevelOpts -> [String] -> IO () devel opts passThroughArgs = withManager $ \manager -> do + _ <- forkIO reverseProxy checkDevelFile writeLock opts @@ -162,7 +188,10 @@ devel opts passThroughArgs = withManager $ \manager -> do liftIO $ putStrLn $ if verbose opts then "Starting development server: runghc " ++ L.unwords devArgs else "Starting development server..." - (_,_,_,ph) <- liftIO $ createProcess $ proc "runghc" devArgs + env0 <- liftIO getEnvironment + (_,_,_,ph) <- liftIO $ createProcess (proc "runghc" devArgs) + { env = Just $ ("PORT", "3001") : ("DISPLAY_PORT", "3000") : env0 + } derefMap <- get watchTid <- liftIO . forkIO . try_ $ flip evalStateT derefMap $ do loop list diff --git a/yesod/scaffold/project.cabal.cg b/yesod/scaffold/project.cabal.cg index 106cc654..a9615051 100644 --- a/yesod/scaffold/project.cabal.cg +++ b/yesod/scaffold/project.cabal.cg @@ -55,7 +55,7 @@ library , yesod-core >= 1.1.2 && < 1.2 , yesod-auth >= 1.1 && < 1.2 , yesod-static >= 1.1 && < 1.2 - , yesod-default >= 1.1 && < 1.2 + , yesod-default >= 1.1.1 && < 1.2 , yesod-form >= 1.1 && < 1.2 , yesod-test >= 0.3 && < 0.4 , clientsession >= 0.8 && < 0.9 diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index fad0a6a4..fa967532 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -138,6 +138,9 @@ executable yesod , fsnotify >= 0.0 && < 0.1 , split >= 0.2 && < 0.3 , lifted-base + , http-reverse-proxy >= 0.1.0.4 + , network + , http-conduit ghc-options: -Wall -threaded main-is: main.hs