yesod 1.1.6 → 1.1.7
raw patch · 4 files changed
+50/−24 lines, 4 filesdep +network-conduitdep ~yesod-default
Dependencies added: network-conduit
Dependency ranges changed: yesod-default
Files
- Devel.hs +41/−19
- GhcBuild.hs +2/−2
- main.hs +4/−1
- yesod.cabal +3/−2
Devel.hs view
@@ -67,11 +67,14 @@ getBuildFlags) import qualified Config as GHC+import Data.Conduit.Network (HostPreference (HostIPv4),+ bindPort) import Network (withSocketsDo) import Network.HTTP.Conduit (def, newManager) import Network.HTTP.ReverseProxy (ProxyDest (ProxyDest), waiProxyTo) import Network.HTTP.Types (status200)+import Network.Socket (sClose) import Network.Wai (responseLBS) import Network.Wai.Handler.Warp (run) import SrcLoc (Located)@@ -99,27 +102,29 @@ , successHook :: Maybe String , failHook :: Maybe String , buildDir :: Maybe String+ , develPort :: Int } deriving (Show, Eq) getBuildDir :: DevelOpts -> String getBuildDir opts = fromMaybe "dist" (buildDir opts) defaultDevelOpts :: DevelOpts-defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing+defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 -- | 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+reverseProxy :: DevelOpts -> Int -> IO ()+reverseProxy opts appPort = do manager <- newManager def- forever $ do- run 3000 $ waiProxyTo- (const $ return $ Right $ ProxyDest "127.0.0.1" 3001)- onExc- manager- putStrLn "Reverse proxy stopped, but it shouldn't"- threadDelay 1000000- putStrLn "Restarting reverse proxy"+ let loop = forever $ do+ run (develPort opts) $ waiProxyTo+ (const $ return $ Right $ ProxyDest "127.0.0.1" appPort)+ onExc+ manager+ putStrLn "Reverse proxy stopped, but it shouldn't"+ threadDelay 1000000+ putStrLn "Restarting reverse proxy"+ loop `Ex.onException` exitFailure where onExc _ _ = return $ responseLBS status200@@ -128,9 +133,26 @@ ] "<h1>App not ready, please refresh</h1>" +checkPort :: Int -> IO Bool+checkPort p = do+ es <- Ex.try $ bindPort p HostIPv4+ case es of+ Left (_ :: Ex.IOException) -> return False+ Right s -> do+ sClose s+ return True++getPort :: Int -> IO Int+getPort p = do+ avail <- checkPort p+ if avail then return p else getPort (succ p)+ devel :: DevelOpts -> [String] -> IO ()-devel opts passThroughArgs = withManager $ \manager -> do- _ <- forkIO reverseProxy+devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do+ avail <- checkPort $ develPort opts+ unless avail $ error "devel port unavailable"+ appPort <- getPort 17834+ _ <- forkIO $ reverseProxy opts appPort checkDevelFile writeLock opts @@ -138,7 +160,7 @@ _ <- forkIO $ do filesModified <- newEmptyMVar watchTree manager "." (const True) (\_ -> void (tryPutMVar filesModified ()))- evalStateT (mainOuterLoop filesModified) Map.empty+ evalStateT (mainOuterLoop appPort filesModified) Map.empty _ <- getLine writeLock opts exitSuccess@@ -146,7 +168,7 @@ bd = getBuildDir opts -- outer loop re-reads the cabal file- mainOuterLoop filesModified = do+ mainOuterLoop appPort filesModified = do ghcVer <- liftIO ghcVersion cabal <- liftIO $ D.findPackageDesc "." gpd <- liftIO $ D.readPackageDescription D.normal cabal@@ -158,10 +180,10 @@ liftIO $ removeFileIfExists "yesod-devel/arargs.txt" -- the configure step, remove them to force liftIO $ removeFileIfExists "yesod-devel/ldargs.txt" -- a cabal build first rebuild <- liftIO $ mkRebuild gpd ghcVer cabal opts ldar- mainInnerLoop hsSourceDirs filesModified cabal gpd lib ghcVer rebuild+ mainInnerLoop appPort hsSourceDirs filesModified cabal gpd lib ghcVer rebuild -- inner loop rebuilds after files change- mainInnerLoop hsSourceDirs filesModified cabal gpd lib ghcVer rebuild = go+ mainInnerLoop appPort hsSourceDirs filesModified cabal gpd lib ghcVer rebuild = go where go = do _ <- recompDeps hsSourceDirs@@ -185,7 +207,7 @@ else "Starting development server..." env0 <- liftIO getEnvironment (_,_,_,ph) <- liftIO $ createProcess (proc "runghc" devArgs)- { env = Just $ ("PORT", "3001") : ("DISPLAY_PORT", "3000") : env0+ { env = Just $ ("PORT", show appPort) : ("DISPLAY_PORT", show $ develPort opts) : env0 } derefMap <- get watchTid <- liftIO . forkIO . try_ $ flip evalStateT derefMap $ do@@ -201,7 +223,7 @@ liftIO $ Ex.throwTo watchTid (userError "process finished") loop list n <- liftIO $ cabal `isNewerThan` (bd </> "setup-config")- if n then mainOuterLoop filesModified else go+ if n then mainOuterLoop appPort filesModified else go runBuildHook :: Maybe String -> IO () runBuildHook (Just s) = do
GhcBuild.hs view
@@ -62,8 +62,8 @@ return argv2 buildPackage :: [Located String] -> FilePath -> FilePath -> IO Bool-buildPackage a ld ar = buildPackage' a ld ar `Ex.catch` \(e::Ex.SomeException) -> do- putStrLn ("exception building package: " ++ show e)+buildPackage a ld ar = buildPackage' a ld ar `Ex.catch` \e -> do+ putStrLn ("exception building package: " ++ show (e :: Ex.SomeException)) return False buildPackage' :: [Located String] -> FilePath -> FilePath -> IO Bool
main.hs view
@@ -53,6 +53,7 @@ , _develBuildDir :: Maybe String , develIgnore :: [String] , develExtraArgs :: [String]+ , _develPort :: Int } | Test | AddHandler@@ -90,7 +91,7 @@ Configure -> cabal ["configure"] Build es -> touch' >> cabal ("build":es) Touch -> touch'- Devel da s f r b _ig es -> devel (DevelOpts (optCabalPgm o == CabalDev) da (optVerbose o) r s f b) es+ Devel da s f r b _ig es p -> devel (DevelOpts (optCabalPgm o == CabalDev) da (optVerbose o) r s f b p) es Keter noRebuild -> keter (cabalCommand o) noRebuild Version -> do putStrLn ("yesod-core version:" ++ yesodVersion) putStrLn ("yesod version:" ++ showVersion Paths_yesod.version)@@ -145,6 +146,8 @@ <> help "ignore file changes in DIR" ) ) <*> extraCabalArgs+ <*> option ( long "port" <> short 'p' <> value 3000 <> metavar "N"+ <> help "Devel server listening port" ) extraCabalArgs :: Parser [String] extraCabalArgs = many (strOption ( long "extra-cabal-arg" <> short 'e' <> metavar "ARG"
yesod.cabal view
@@ -1,5 +1,5 @@ name: yesod-version: 1.1.6+version: 1.1.7 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -32,7 +32,7 @@ , yesod-json >= 1.1 && < 1.2 , yesod-persistent >= 1.1 && < 1.2 , yesod-form >= 1.1 && < 1.3- , yesod-default >= 1.1.1 && < 1.2+ , yesod-default >= 1.1.3 && < 1.2 , monad-control >= 0.3 && < 0.4 , transformers >= 0.2.2 && < 0.4 , wai >= 1.3 && < 1.4@@ -108,6 +108,7 @@ , http-reverse-proxy >= 0.1.0.4 , network , http-conduit+ , network-conduit , project-template >= 0.1.1 ghc-options: -Wall -threaded