diff --git a/Devel.hs b/Devel.hs --- a/Devel.hs +++ b/Devel.hs @@ -107,13 +107,14 @@ , failHook :: Maybe String , buildDir :: Maybe String , develPort :: Int + , proxyTimeout :: Int } deriving (Show, Eq) getBuildDir :: DevelOpts -> String getBuildDir opts = fromMaybe "dist" (buildDir opts) defaultDevelOpts :: DevelOpts -defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 +defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 10 -- | Run a reverse proxy from port 3000 to 3001. If there is no response on -- 3001, give an appropriate message to the user. @@ -127,7 +128,7 @@ return $ Right $ ProxyDest "127.0.0.1" appPort) def { wpsOnExc = onExc - , wpsTimeout = Just 10000000 + , wpsTimeout = Just (1000000 * proxyTimeout opts) } manager putStrLn "Reverse proxy stopped, but it shouldn't" diff --git a/hsfiles/mongo.hsfiles b/hsfiles/mongo.hsfiles --- a/hsfiles/mongo.hsfiles +++ b/hsfiles/mongo.hsfiles @@ -425,6 +425,7 @@ , yesod-core , persistent , persistent-mongoDB + , resourcet {-# START_FILE Settings.hs #-} -- | Settings are centralized, as much as possible, into this file. This @@ -5728,10 +5729,12 @@ ) where import TestImport +import qualified Data.List as L homeSpecs :: Specs homeSpecs = - describe "These are some example tests" $ + describe "These are some example tests" $ do + it "loads the index and checks it looks right" $ do get_ "/" statusIs 200 @@ -5747,21 +5750,38 @@ htmlAllContain ".message" "Some Content" htmlAllContain ".message" "text/plain" + -- This is a simple example of using a database access in a test. The + -- test will succeed for a fresh scaffolded site with an empty database, + -- but will fail on an existing database with a non-empty user table. + it "leaves the user table empty" $ do + get_ "/" + statusIs 200 + users <- runDB $ selectList ([] :: [Filter User]) [] + assertEqual "user table empty" 0 $ L.length users + {-# START_FILE tests/TestImport.hs #-} {-# LANGUAGE OverloadedStrings #-} module TestImport ( module Yesod.Test + , module Model + , module Database.Persist , runDB , Specs ) where import Yesod.Test +import Database.Persist hiding (get) import Database.Persist.MongoDB hiding (master) +import Control.Monad.Trans.Resource (ResourceT, runResourceT) +import Model + type Specs = SpecsConn Connection -runDB :: Action IO a -> OneSpec Connection a -runDB = runDBRunner runMongoDBPoolDef +runDB :: Action (ResourceT IO) a -> OneSpec Connection a +runDB = runDBRunner poolRunner + where + poolRunner query pool = runResourceT $ runMongoDBPoolDef query pool {-# START_FILE tests/main.hs #-} {-# LANGUAGE OverloadedStrings #-} diff --git a/hsfiles/mysql.hsfiles b/hsfiles/mysql.hsfiles --- a/hsfiles/mysql.hsfiles +++ b/hsfiles/mysql.hsfiles @@ -423,6 +423,7 @@ , yesod-core , persistent , persistent-mysql + , resourcet {-# START_FILE Settings.hs #-} -- | Settings are centralized, as much as possible, into this file. This @@ -5752,10 +5753,12 @@ ) where import TestImport +import qualified Data.List as L homeSpecs :: Specs homeSpecs = - describe "These are some example tests" $ + describe "These are some example tests" $ do + it "loads the index and checks it looks right" $ do get_ "/" statusIs 200 @@ -5771,21 +5774,38 @@ htmlAllContain ".message" "Some Content" htmlAllContain ".message" "text/plain" + -- This is a simple example of using a database access in a test. The + -- test will succeed for a fresh scaffolded site with an empty database, + -- but will fail on an existing database with a non-empty user table. + it "leaves the user table empty" $ do + get_ "/" + statusIs 200 + users <- runDB $ selectList ([] :: [Filter User]) [] + assertEqual "user table empty" 0 $ L.length users + {-# START_FILE tests/TestImport.hs #-} {-# LANGUAGE OverloadedStrings #-} module TestImport ( module Yesod.Test + , module Model + , module Database.Persist , runDB , Specs ) where import Yesod.Test -import Database.Persist.GenericSql +import Database.Persist hiding (get) +import Database.Persist.GenericSql (runSqlPool, SqlPersist, Connection) +import Control.Monad.Trans.Resource (ResourceT, runResourceT) +import Model + type Specs = SpecsConn Connection -runDB :: SqlPersist IO a -> OneSpec Connection a -runDB = runDBRunner runSqlPool +runDB :: SqlPersist (ResourceT IO) a -> OneSpec Connection a +runDB = runDBRunner poolRunner + where + poolRunner query pool = runResourceT $ runSqlPool 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 @@ -423,6 +423,7 @@ , yesod-core , persistent , persistent-postgresql + , resourcet {-# START_FILE Settings.hs #-} -- | Settings are centralized, as much as possible, into this file. This @@ -5726,10 +5727,12 @@ ) where import TestImport +import qualified Data.List as L homeSpecs :: Specs homeSpecs = - describe "These are some example tests" $ + describe "These are some example tests" $ do + it "loads the index and checks it looks right" $ do get_ "/" statusIs 200 @@ -5745,21 +5748,38 @@ htmlAllContain ".message" "Some Content" htmlAllContain ".message" "text/plain" + -- This is a simple example of using a database access in a test. The + -- test will succeed for a fresh scaffolded site with an empty database, + -- but will fail on an existing database with a non-empty user table. + it "leaves the user table empty" $ do + get_ "/" + statusIs 200 + users <- runDB $ selectList ([] :: [Filter User]) [] + assertEqual "user table empty" 0 $ L.length users + {-# START_FILE tests/TestImport.hs #-} {-# LANGUAGE OverloadedStrings #-} module TestImport ( module Yesod.Test + , module Model + , module Database.Persist , runDB , Specs ) where import Yesod.Test -import Database.Persist.GenericSql +import Database.Persist hiding (get) +import Database.Persist.GenericSql (runSqlPool, SqlPersist, Connection) +import Control.Monad.Trans.Resource (ResourceT, runResourceT) +import Model + type Specs = SpecsConn Connection -runDB :: SqlPersist IO a -> OneSpec Connection a -runDB = runDBRunner runSqlPool +runDB :: SqlPersist (ResourceT IO) a -> OneSpec Connection a +runDB = runDBRunner poolRunner + where + poolRunner query pool = runResourceT $ runSqlPool query pool {-# 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 @@ -423,6 +423,7 @@ , yesod-core , persistent , persistent-sqlite + , resourcet {-# START_FILE Settings.hs #-} -- | Settings are centralized, as much as possible, into this file. This @@ -5722,10 +5723,12 @@ ) where import TestImport +import qualified Data.List as L homeSpecs :: Specs homeSpecs = - describe "These are some example tests" $ + describe "These are some example tests" $ do + it "loads the index and checks it looks right" $ do get_ "/" statusIs 200 @@ -5741,21 +5744,38 @@ htmlAllContain ".message" "Some Content" htmlAllContain ".message" "text/plain" + -- This is a simple example of using a database access in a test. The + -- test will succeed for a fresh scaffolded site with an empty database, + -- but will fail on an existing database with a non-empty user table. + it "leaves the user table empty" $ do + get_ "/" + statusIs 200 + users <- runDB $ selectList ([] :: [Filter User]) [] + assertEqual "user table empty" 0 $ L.length users + {-# START_FILE tests/TestImport.hs #-} {-# LANGUAGE OverloadedStrings #-} module TestImport ( module Yesod.Test + , module Model + , module Database.Persist , runDB , Specs ) where import Yesod.Test -import Database.Persist.GenericSql +import Database.Persist hiding (get) +import Database.Persist.GenericSql (runSqlPool, SqlPersist, Connection) +import Control.Monad.Trans.Resource (ResourceT, runResourceT) +import Model + type Specs = SpecsConn Connection -runDB :: SqlPersist IO a -> OneSpec Connection a -runDB = runDBRunner runSqlPool +runDB :: SqlPersist (ResourceT IO) a -> OneSpec Connection a +runDB = runDBRunner poolRunner + where + poolRunner query pool = runResourceT $ runSqlPool query pool {-# START_FILE tests/main.hs #-} {-# LANGUAGE OverloadedStrings #-} diff --git a/main.hs b/main.hs --- a/main.hs +++ b/main.hs @@ -58,6 +58,7 @@ , develIgnore :: [String] , develExtraArgs :: [String] , _develPort :: Int + , _proxyTimeout :: Int } | Test | AddHandler @@ -95,7 +96,7 @@ Configure -> cabal ["configure"] Build es -> touch' >> cabal ("build":es) Touch -> touch' - Devel da s f r b _ig es p -> devel (DevelOpts (optCabalPgm o == CabalDev) da (optVerbose o) r s f b p) es + 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 Keter noRebuild -> keter (cabalCommand o) noRebuild Version -> do putStrLn ("yesod-core version:" ++ yesodVersion) putStrLn ("yesod version:" ++ showVersion Paths_yesod.version) @@ -152,6 +153,8 @@ <*> extraCabalArgs <*> option ( long "port" <> short 'p' <> value 3000 <> metavar "N" <> help "Devel server listening port" ) + <*> option ( long "proxy-timeout" <> short 'x' <> value 10 <> metavar "N" + <> help "Devel server timeout before returning 'not ready' message (in seconds)" ) extraCabalArgs :: Parser [String] extraCabalArgs = many (strOption ( long "extra-cabal-arg" <> short 'e' <> metavar "ARG" diff --git a/yesod.cabal b/yesod.cabal --- a/yesod.cabal +++ b/yesod.cabal @@ -1,5 +1,5 @@ name: yesod -version: 1.1.8 +version: 1.1.8.1 license: MIT license-file: LICENSE author: Michael Snoyman @@ -101,7 +101,7 @@ , fsnotify >= 0.0 && < 0.1 , split >= 0.2 && < 0.3 , file-embed - , conduit >= 0.5 && < 0.6 + , conduit >= 0.5 && < 1.1 , resourcet >= 0.3 && < 0.5 , base64-bytestring , lifted-base