diff --git a/Devel.hs b/Devel.hs --- a/Devel.hs +++ b/Devel.hs @@ -102,13 +102,14 @@ , buildDir :: Maybe String , develPort :: Int , proxyTimeout :: Int + , useReverseProxy :: Bool } deriving (Show, Eq) getBuildDir :: DevelOpts -> String getBuildDir opts = fromMaybe "dist" (buildDir opts) defaultDevelOpts :: DevelOpts -defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 10 +defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 10 True cabalProgram :: DevelOpts -> FilePath cabalProgram opts | isCabalDev opts = "cabal-dev" @@ -159,17 +160,21 @@ sClose s return True -getPort :: Int -> IO Int -getPort p = do - avail <- checkPort p - if avail then return p else getPort (succ p) +getPort :: DevelOpts -> Int -> IO Int +getPort opts _ | not (useReverseProxy opts) = return $ develPort opts +getPort _ p0 = + loop p0 + where + loop p = do + avail <- checkPort p + if avail then return p else loop (succ p) devel :: DevelOpts -> [String] -> IO () devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do avail <- checkPort $ develPort opts unless avail $ error "devel port unavailable" - iappPort <- getPort 17834 >>= I.newIORef - _ <- forkIO $ reverseProxy opts iappPort + iappPort <- getPort opts 17834 >>= I.newIORef + when (useReverseProxy opts) $ void $ forkIO $ reverseProxy opts iappPort checkDevelFile writeLock opts @@ -233,7 +238,7 @@ env0 <- liftIO getEnvironment -- get a new port for the new process to listen on - appPort <- liftIO $ I.readIORef iappPort >>= getPort . (+ 1) + appPort <- liftIO $ I.readIORef iappPort >>= getPort opts . (+ 1) liftIO $ I.writeIORef iappPort appPort (_,_,_,ph) <- liftIO $ createProcess (proc "runghc" devArgs) diff --git a/hsfiles/mongo.hsfiles b/hsfiles/mongo.hsfiles --- a/hsfiles/mongo.hsfiles +++ b/hsfiles/mongo.hsfiles @@ -1,6 +1,6 @@ {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen -:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls +:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} dist* @@ -101,7 +101,6 @@ import qualified Settings import Settings.Development (development) import qualified Database.Persist -import Database.Persist.Sql (SqlPersistT) import Settings.StaticFiles import Database.Persist.MongoDB hiding (master) import Settings (widgetFile, Extra (..)) @@ -176,7 +175,7 @@ , css_bootstrap_css ]) $(widgetFile "default-layout") - hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet") + giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- This is done to provide an optimization for serving static files from -- a separate domain. Please see the staticRoot setting in Settings.hs @@ -263,7 +262,7 @@ -- The majority of the code you will write in Yesod lives in these handler -- functions. You can spread them across multiple files if you are so -- inclined, or create a single monolithic file. -getHomeR :: Handler RepHtml +getHomeR :: Handler Html getHomeR = do (formWidget, formEnctype) <- generateFormPost sampleForm let submission = Nothing :: Maybe (FileInfo, Text) @@ -273,7 +272,7 @@ setTitle "Welcome To Yesod!" $(widgetFile "homepage") -postHomeR :: Handler RepHtml +postHomeR :: Handler Html postHomeR = do ((result, formWidget), formEnctype) <- runFormPost sampleForm let handlerName = "postHomeR" :: Text @@ -5769,7 +5768,7 @@ import TestImport import qualified Data.List as L -homeSpecs :: Specs +homeSpecs :: Spec homeSpecs = ydescribe "These are some example tests" $ do @@ -5808,7 +5807,8 @@ , module Foundation , module Database.Persist , runDB - , Specs + , Spec + , Example ) where import Yesod.Test @@ -5821,7 +5821,8 @@ import Foundation import Model -type Specs = YesodSpec App +type Spec = YesodSpec App +type Example = YesodExample App runDB :: Action (NoLoggingT (ResourceT IO)) a -> YesodExample App a runDB query = do diff --git a/hsfiles/mysql.hsfiles b/hsfiles/mysql.hsfiles --- a/hsfiles/mysql.hsfiles +++ b/hsfiles/mysql.hsfiles @@ -1,6 +1,6 @@ {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen -:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls +:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} dist* @@ -182,7 +182,7 @@ , css_bootstrap_css ]) $(widgetFile "default-layout") - hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet") + giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- This is done to provide an optimization for serving static files from -- a separate domain. Please see the staticRoot setting in Settings.hs @@ -271,7 +271,7 @@ -- The majority of the code you will write in Yesod lives in these handler -- functions. You can spread them across multiple files if you are so -- inclined, or create a single monolithic file. -getHomeR :: Handler RepHtml +getHomeR :: Handler Html getHomeR = do (formWidget, formEnctype) <- generateFormPost sampleForm let submission = Nothing :: Maybe (FileInfo, Text) @@ -281,7 +281,7 @@ setTitle "Welcome To Yesod!" $(widgetFile "homepage") -postHomeR :: Handler RepHtml +postHomeR :: Handler Html postHomeR = do ((result, formWidget), formEnctype) <- runFormPost sampleForm let handlerName = "postHomeR" :: Text @@ -5798,7 +5798,7 @@ import TestImport import qualified Data.List as L -homeSpecs :: Specs +homeSpecs :: Spec homeSpecs = ydescribe "These are some example tests" $ do @@ -5837,25 +5837,25 @@ , module Foundation , module Database.Persist , runDB - , Specs + , Spec + , Example ) where import Yesod.Test import Database.Persist hiding (get) -import Database.Persist.Sql (runSqlPool, SqlPersist, Connection) -import Control.Monad.Trans.Resource (ResourceT, runResourceT) -import Control.Monad.Logger (NoLoggingT, runNoLoggingT) +import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool) import Control.Monad.IO.Class (liftIO) import Foundation import Model -type Specs = YesodSpec App +type Spec = YesodSpec App +type Example = YesodExample App -runDB :: SqlPersist (NoLoggingT (ResourceT IO)) a -> YesodExample App a +runDB :: SqlPersistM a -> Example a runDB query = do pool <- fmap connPool getTestYesod - liftIO $ runResourceT $ runNoLoggingT $ runSqlPool query pool + liftIO $ runSqlPersistMPool query pool {-# START_FILE tests/main.hs #-} {-# LANGUAGE OverloadedStrings #-} diff --git a/hsfiles/postgres-fay.hsfiles b/hsfiles/postgres-fay.hsfiles --- a/hsfiles/postgres-fay.hsfiles +++ b/hsfiles/postgres-fay.hsfiles @@ -1,6 +1,6 @@ {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen -:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls +:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} dist* @@ -186,7 +186,7 @@ , css_bootstrap_css ]) $(widgetFile "default-layout") - hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet") + giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- This is done to provide an optimization for serving static files from -- a separate domain. Please see the staticRoot setting in Settings.hs @@ -301,7 +301,7 @@ -- The majority of the code you will write in Yesod lives in these handler -- functions. You can spread them across multiple files if you are so -- inclined, or create a single monolithic file. -getHomeR :: Handler RepHtml +getHomeR :: Handler Html getHomeR = do (formWidget, formEnctype) <- generateFormPost sampleForm let submission = Nothing :: Maybe (FileInfo, Text) @@ -312,7 +312,7 @@ $(widgetFile "homepage") $(fayFile' (ConE 'StaticR) "Home") -postHomeR :: Handler RepHtml +postHomeR :: Handler Html postHomeR = do ((result, formWidget), formEnctype) <- runFormPost sampleForm let handlerName = "postHomeR" :: Text @@ -881,7 +881,7 @@ #ifdef FAY import FFI #else -import Language.Fay.FFI +--import Language.Fay.FFI #endif data Command = GetFib Int (Returns Int) @@ -5884,7 +5884,7 @@ import TestImport import qualified Data.List as L -homeSpecs :: Specs +homeSpecs :: Spec homeSpecs = ydescribe "These are some example tests" $ do @@ -5923,25 +5923,25 @@ , module Foundation , module Database.Persist , runDB - , Specs + , Spec + , Example ) where import Yesod.Test import Database.Persist hiding (get) -import Database.Persist.Sql (runSqlPool, SqlPersist, Connection) -import Control.Monad.Trans.Resource (ResourceT, runResourceT) -import Control.Monad.Logger (NoLoggingT, runNoLoggingT) +import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool) import Control.Monad.IO.Class (liftIO) import Foundation import Model -type Specs = YesodSpec App +type Spec = YesodSpec App +type Example = YesodExample App -runDB :: SqlPersist (NoLoggingT (ResourceT IO)) a -> YesodExample App a +runDB :: SqlPersistM a -> Example a runDB query = do pool <- fmap connPool getTestYesod - liftIO $ runResourceT $ runNoLoggingT $ runSqlPool query pool + liftIO $ runSqlPersistMPool query pool {-# START_FILE tests/main.hs #-} {-# LANGUAGE OverloadedStrings #-} diff --git a/hsfiles/postgres.hsfiles b/hsfiles/postgres.hsfiles --- a/hsfiles/postgres.hsfiles +++ b/hsfiles/postgres.hsfiles @@ -1,6 +1,6 @@ {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen -:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls +:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} dist* @@ -182,7 +182,7 @@ , css_bootstrap_css ]) $(widgetFile "default-layout") - hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet") + giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- This is done to provide an optimization for serving static files from -- a separate domain. Please see the staticRoot setting in Settings.hs @@ -271,7 +271,7 @@ -- The majority of the code you will write in Yesod lives in these handler -- functions. You can spread them across multiple files if you are so -- inclined, or create a single monolithic file. -getHomeR :: Handler RepHtml +getHomeR :: Handler Html getHomeR = do (formWidget, formEnctype) <- generateFormPost sampleForm let submission = Nothing :: Maybe (FileInfo, Text) @@ -281,7 +281,7 @@ setTitle "Welcome To Yesod!" $(widgetFile "homepage") -postHomeR :: Handler RepHtml +postHomeR :: Handler Html postHomeR = do ((result, formWidget), formEnctype) <- runFormPost sampleForm let handlerName = "postHomeR" :: Text @@ -5772,7 +5772,7 @@ import TestImport import qualified Data.List as L -homeSpecs :: Specs +homeSpecs :: Spec homeSpecs = ydescribe "These are some example tests" $ do @@ -5811,25 +5811,25 @@ , module Foundation , module Database.Persist , runDB - , Specs + , Spec + , Example ) where import Yesod.Test import Database.Persist hiding (get) -import Database.Persist.Sql (runSqlPool, SqlPersist, Connection) -import Control.Monad.Trans.Resource (ResourceT, runResourceT) -import Control.Monad.Logger (NoLoggingT, runNoLoggingT) +import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool) import Control.Monad.IO.Class (liftIO) import Foundation import Model -type Specs = YesodSpec App +type Spec = YesodSpec App +type Example = YesodExample App -runDB :: SqlPersist (NoLoggingT (ResourceT IO)) a -> YesodExample App a +runDB :: SqlPersistM a -> Example a runDB query = do pool <- fmap connPool getTestYesod - liftIO $ runResourceT $ runNoLoggingT $ runSqlPool query pool + liftIO $ runSqlPersistMPool query pool {-# START_FILE tests/main.hs #-} {-# LANGUAGE OverloadedStrings #-} diff --git a/hsfiles/simple.hsfiles b/hsfiles/simple.hsfiles --- a/hsfiles/simple.hsfiles +++ b/hsfiles/simple.hsfiles @@ -1,6 +1,6 @@ {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen -:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls +:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} dist* @@ -26,7 +26,6 @@ import Yesod.Default.Handlers import Network.Wai.Middleware.RequestLogger import Network.HTTP.Conduit (newManager, def) -import Control.Monad.Logger (runLoggingT) import System.IO (stdout) import System.Log.FastLogger (mkLogger) @@ -161,7 +160,7 @@ , css_bootstrap_css ]) $(widgetFile "default-layout") - hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet") + giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- This is done to provide an optimization for serving static files from -- a separate domain. Please see the staticRoot setting in Settings.hs @@ -220,7 +219,7 @@ -- The majority of the code you will write in Yesod lives in these handler -- functions. You can spread them across multiple files if you are so -- inclined, or create a single monolithic file. -getHomeR :: Handler RepHtml +getHomeR :: Handler Html getHomeR = do (formWidget, formEnctype) <- generateFormPost sampleForm let submission = Nothing :: Maybe (FileInfo, Text) @@ -230,7 +229,7 @@ setTitle "Welcome To Yesod!" $(widgetFile "homepage") -postHomeR :: Handler RepHtml +postHomeR :: Handler Html postHomeR = do ((result, formWidget), formEnctype) <- runFormPost sampleForm let handlerName = "postHomeR" :: Text @@ -5649,7 +5648,7 @@ import TestImport -homeSpecs :: Specs +homeSpecs :: Spec homeSpecs = ydescribe "These are some example tests" $ do @@ -5676,13 +5675,15 @@ module TestImport ( module Yesod.Test , module Foundation - , Specs + , Spec + , Example ) where import Yesod.Test import Foundation -type Specs = YesodSpec App +type Spec = YesodSpec App +type Example = YesodExample App {-# START_FILE tests/main.hs #-} {-# LANGUAGE OverloadedStrings #-} diff --git a/hsfiles/sqlite.hsfiles b/hsfiles/sqlite.hsfiles --- a/hsfiles/sqlite.hsfiles +++ b/hsfiles/sqlite.hsfiles @@ -1,6 +1,6 @@ {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen -:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls +:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable {-# START_FILE .gitignore #-} dist* @@ -182,7 +182,7 @@ , css_bootstrap_css ]) $(widgetFile "default-layout") - hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet") + giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- This is done to provide an optimization for serving static files from -- a separate domain. Please see the staticRoot setting in Settings.hs @@ -271,7 +271,7 @@ -- The majority of the code you will write in Yesod lives in these handler -- functions. You can spread them across multiple files if you are so -- inclined, or create a single monolithic file. -getHomeR :: Handler RepHtml +getHomeR :: Handler Html getHomeR = do (formWidget, formEnctype) <- generateFormPost sampleForm let submission = Nothing :: Maybe (FileInfo, Text) @@ -281,7 +281,7 @@ setTitle "Welcome To Yesod!" $(widgetFile "homepage") -postHomeR :: Handler RepHtml +postHomeR :: Handler Html postHomeR = do ((result, formWidget), formEnctype) <- runFormPost sampleForm let handlerName = "postHomeR" :: Text @@ -5768,7 +5768,7 @@ import TestImport import qualified Data.List as L -homeSpecs :: Specs +homeSpecs :: Spec homeSpecs = ydescribe "These are some example tests" $ do @@ -5807,25 +5807,25 @@ , module Foundation , module Database.Persist , runDB - , Specs + , Spec + , Example ) where import Yesod.Test import Database.Persist hiding (get) -import Database.Persist.Sql (runSqlPool, SqlPersist, Connection) -import Control.Monad.Trans.Resource (ResourceT, runResourceT) -import Control.Monad.Logger (NoLoggingT, runNoLoggingT) +import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool) import Control.Monad.IO.Class (liftIO) import Foundation import Model -type Specs = YesodSpec App +type Spec = YesodSpec App +type Example = YesodExample App -runDB :: SqlPersist (NoLoggingT (ResourceT IO)) a -> YesodExample App a +runDB :: SqlPersistM a -> Example a runDB query = do pool <- fmap connPool getTestYesod - liftIO $ runResourceT $ runNoLoggingT $ runSqlPool query pool + liftIO $ runSqlPersistMPool query pool {-# START_FILE tests/main.hs #-} {-# LANGUAGE OverloadedStrings #-} diff --git a/main.hs b/main.hs --- a/main.hs +++ b/main.hs @@ -55,6 +55,7 @@ , develExtraArgs :: [String] , _develPort :: Int , _proxyTimeout :: Int + , _noReverseProxy :: Bool } | Test | AddHandler @@ -92,7 +93,7 @@ Configure -> cabal ["configure"] Build es -> touch' >> cabal ("build":es) Touch -> touch' - Devel da s f r b _ig es p t -> devel (DevelOpts (optCabalPgm o == CabalDev) da (optVerbose o) r s f b p t) es + Devel da s f r b _ig es p t nrp -> devel (DevelOpts (optCabalPgm o == CabalDev) da (optVerbose o) r s f b p t (not nrp)) es Keter noRebuild -> keter (cabalCommand o) noRebuild Version -> do putStrLn ("yesod-bin version: " ++ showVersion Paths_yesod_bin.version) AddHandler -> addHandler @@ -150,6 +151,8 @@ <> help "Devel server listening port" ) <*> option ( long "proxy-timeout" <> short 'x' <> value 0 <> metavar "N" <> help "Devel server timeout before returning 'not ready' message (in seconds, 0 for none)" ) + <*> switch ( long "disable-reverse-proxy" <> short 'n' + <> help "Disable reverse proxy" ) extraCabalArgs :: Parser [String] extraCabalArgs = many (strOption ( long "extra-cabal-arg" <> short 'e' <> metavar "ARG" diff --git a/yesod-bin.cabal b/yesod-bin.cabal --- a/yesod-bin.cabal +++ b/yesod-bin.cabal @@ -1,5 +1,5 @@ name: yesod-bin -version: 1.2.0.1 +version: 1.2.1 license: MIT license-file: LICENSE author: Michael Snoyman