diff --git a/README.md b/README.md index 9674180b..37e71c7c 100644 --- a/README.md +++ b/README.md @@ -27,7 +27,7 @@ Your application is a cabal package and you use `cabal` to install its dependenc Install conflicts are unfortunately common in Haskell development. If you are not using any sandbox tools, you may discover that some of the other haskell installs on your system are broken. -You can prevent this by using sandbox tools: `cabal-dev` or `virthualenv`, now being renamed to `hsenv`. +You can prevent this by using sandbox tools: `cabal-dev` or `hsenv`. Isolating an entire project with a virtual machine is also a great idea, you just need some tools to help that process. [Vagrant](http://vagrantup.com) is a great tool for that and there is a [Haskell Platform installer](https://bitbucket.org/puffnfresh/vagrant-haskell-heroku) for it. @@ -62,15 +62,13 @@ If you aren't building from an application, remove the `./` and create a new dir -## virthualenv +## hsenv (Linux only) -We recommend using [virthualenv](http://hackage.haskell.org/package/virthualenv)/[hsenv](https://github.com/Paczesiowa/hsenv) when hacking on Yesod from Linux. This is optional, but prevents your custom build of Yesod from interfering with your currently installed cabal packages. +[hsenv](http://hackage.haskell.org/package/hsenv) prevents your custom build of Yesod from interfering with your currently installed cabal packages: -virthualenv will not work on Windows and maybe not Mac. Use cabal-dev instead - -* virthualenv creates an isolated environment like cabal-dev -* virthualenv works at the shell level, so every shell must activate the virthualenv -* cabal-dev by default isolates a single cabal package, but virthualenv isolates multiple packages together. +* hsenv creates an isolated environment like cabal-dev +* hsenv works at the shell level, so every shell must activate the hsenv +* cabal-dev by default isolates a single cabal package, but hsenv isolates multiple packages together. * cabal-dev can isolate multiple packages together by using the -s sandbox argument diff --git a/yesod-auth/Yesod/Auth/Rpxnow.hs b/yesod-auth/Yesod/Auth/Rpxnow.hs index 63f51112..0c803004 100644 --- a/yesod-auth/Yesod/Auth/Rpxnow.hs +++ b/yesod-auth/Yesod/Auth/Rpxnow.hs @@ -1,5 +1,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE FlexibleContexts #-} module Yesod.Auth.Rpxnow ( authRpxnow ) where @@ -25,6 +27,10 @@ authRpxnow :: YesodAuth m authRpxnow app apiKey = AuthPlugin "rpxnow" dispatch login where + login :: + forall sub master. + ToWidget sub master (GWidget sub master ()) + => (Route Auth -> Route master) -> GWidget sub master () login tm = do render <- lift getUrlRender let queryString = decodeUtf8With lenientDecode diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index 7a2c284d..cada4030 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 1.1.3 +version: 1.1.4.1 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin diff --git a/yesod-core/Yesod/Handler.hs b/yesod-core/Yesod/Handler.hs index 554263dd..99edcc31 100644 --- a/yesod-core/Yesod/Handler.hs +++ b/yesod-core/Yesod/Handler.hs @@ -129,6 +129,7 @@ import Control.Exception hiding (Handler, catch, finally) import Control.Applicative import Control.Monad (liftM) +import Control.Failure (Failure (failure)) import Control.Monad.IO.Class import Control.Monad.Trans.Class (MonadTrans) @@ -1059,3 +1060,6 @@ instance MonadLogger (GHandler sub master) where monadLoggerLogSource a b c d = do hd <- ask liftIO $ handlerLog hd a b c (toLogStr d) + +instance Exception e => Failure e (GHandler sub master) where + failure = liftIO . throwIO diff --git a/yesod-core/Yesod/Internal/Core.hs b/yesod-core/Yesod/Internal/Core.hs index 1cd4444f..c4a9796f 100644 --- a/yesod-core/Yesod/Internal/Core.hs +++ b/yesod-core/Yesod/Internal/Core.hs @@ -878,7 +878,7 @@ runFakeHandler fakeSessionMap logger master handler = liftIO $ do let YesodApp yapp = runHandler handler' - (yesodRender master "") + (yesodRender master $ resolveApproot master fakeWaiRequest) Nothing id master diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 250e1ef8..071791af 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.1.7.1 +version: 1.1.8 license: MIT license-file: LICENSE author: Michael Snoyman @@ -72,7 +72,7 @@ library , monad-control >= 0.3 && < 0.4 , transformers-base >= 0.4 , cookie >= 0.4 && < 0.5 - , http-types >= 0.7 && < 0.8 + , http-types >= 0.7 , case-insensitive >= 0.2 , parsec >= 2 && < 3.2 , directory >= 1 diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index a2a93d89..7917ce27 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -60,6 +60,10 @@ import Text.Blaze (ToMarkup (toMarkup), preEscapedToMarkup, unsafeByteString) import Text.Cassius import Data.Time (Day, TimeOfDay(..)) import qualified Text.Email.Validate as Email +#if MIN_VERSION_email_validate(1, 0, 0) +import Data.Text.Encoding (encodeUtf8, decodeUtf8With) +import Data.Text.Encoding.Error (lenientDecode) +#endif import Network.URI (parseURI) import Database.Persist (PersistField) import Database.Persist.Store (Entity (..)) @@ -291,9 +295,16 @@ timeParser = do emailField :: RenderMessage master FormMessage => Field sub master Text emailField = Field { fieldParse = parseHelper $ +#if MIN_VERSION_email_validate(1, 0, 0) + \s -> + case Email.canonicalizeEmail $ encodeUtf8 s of + Just e -> Right $ decodeUtf8With lenientDecode e + Nothing -> Left $ MsgInvalidEmail s +#else \s -> if Email.isValid (unpack s) then Right s else Left $ MsgInvalidEmail s +#endif , fieldView = \theId name attrs val isReq -> toWidget [hamlet| $newline never diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal index b76d298b..a0d2a801 100644 --- a/yesod-form/yesod-form.cabal +++ b/yesod-form/yesod-form.cabal @@ -1,5 +1,5 @@ name: yesod-form -version: 1.2.0.2 +version: 1.2.1.1 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-platform/yesod-platform.cabal b/yesod-platform/yesod-platform.cabal index e9c0c556..5d50316a 100644 --- a/yesod-platform/yesod-platform.cabal +++ b/yesod-platform/yesod-platform.cabal @@ -1,5 +1,5 @@ name: yesod-platform -version: 1.1.6.1 +version: 1.1.7.2 license: MIT license-file: LICENSE author: Michael Snoyman @@ -33,19 +33,21 @@ library , byteorder == 1.0.3 , case-insensitive == 0.4.0.4 , cereal == 0.3.5.2 - , certificate == 1.3.3 + , certificate == 1.3.5 + , cipher-aes == 0.1.7 + , cipher-rc4 == 0.1.2 , classy-prelude == 0.4.3 , classy-prelude-conduit == 0.4.3 - , clientsession == 0.8.0.1 + , clientsession == 0.8.1 , conduit == 0.5.6 , cookie == 0.4.0.1 - , cprng-aes == 0.3.1 - , cpu == 0.1.1 + , cprng-aes == 0.3.4 , crypto-api == 0.10.2 - , crypto-conduit == 0.4.2 + , crypto-conduit == 0.4.3 + , crypto-numbers == 0.1.3 + , crypto-pubkey == 0.1.2 , crypto-pubkey-types == 0.2.0 - , crypto-random-api == 0.1.0 - , cryptocipher == 0.3.7 + , crypto-random-api == 0.2.0 , cryptohash == 0.8.3 , css-text == 0.1.1 , data-default == 0.5.0 @@ -57,30 +59,30 @@ library , fast-logger == 0.3.1 , file-embed == 0.0.4.7 , filesystem-conduit == 0.5.0.2 - , fsnotify == 0.0.5 + , fsnotify == 0.0.6 , ghc-paths == 0.1.0.9 , hamlet == 1.1.3.1 - , hashable == 1.1.2.5 + , hashable == 1.2.0.5 , hjsmin == 0.1.4 , hspec == 1.4.3 , hspec-expectations == 0.3.0.3 , html-conduit == 0.1.0.4 - , http-conduit == 1.8.6.1 - , http-date == 0.0.3 - , http-reverse-proxy == 0.1.1 + , http-conduit == 1.8.7 + , http-date == 0.0.4 + , http-reverse-proxy == 0.1.1.1 , http-types == 0.7.3.0.1 , language-javascript == 0.5.7 , largeword == 1.0.4 , lifted-base == 0.2.0.2 , mime-mail == 0.4.1.2 - , mime-types == 0.1.0.1 + , mime-types == 0.1.0.2 , monad-control == 0.3.1.4 , monad-logger == 0.2.3.2 - , network-conduit == 0.6.2.1 + , network-conduit == 0.6.2.2 , optparse-applicative == 0.5.2.1 , path-pieces == 0.1.2 , pem == 0.1.2 - , persistent == 1.1.3.2 + , persistent == 1.1.4 , persistent-template == 1.1.2.1 , pool-conduit == 0.1.1 , primitive == 0.5.0.1 @@ -91,7 +93,7 @@ library , resource-pool == 0.2.1.1 , resourcet == 0.4.4 , safe == 0.3.3 - , semigroups == 0.8.5 + , semigroups == 0.9 , setenv == 0.1.0 , shakespeare == 1.0.2 , shakespeare-css == 1.0.2 @@ -100,18 +102,18 @@ library , shakespeare-text == 1.0.0.5 , silently == 1.2.4.1 , simple-sendfile == 0.2.10 - , skein == 0.1.0.10 + , skein == 0.1.0.11 , socks == 0.4.2 , split == 0.2.1.1 , stringsearch == 0.3.6.4 - , system-fileio == 0.3.10 + , system-fileio == 0.3.11 , system-filepath == 0.4.7 , tagged == 0.4.4 , tagsoup == 0.12.8 , tagstream-conduit == 0.5.3 , tar == 0.4.0.1 - , tls == 1.0.3 - , tls-extra == 0.5.1 + , tls == 1.1.1 + , tls-extra == 0.6.1 , transformers-base == 0.4.1 , unix-compat == 0.4.1.0 , unordered-containers == 0.2.3.0 @@ -119,13 +121,13 @@ library , utf8-string == 0.3.7 , vault == 0.2.0.4 , vector == 0.10.0.1 - , void == 0.5.10 + , void == 0.5.11 , wai == 1.3.0.1 , wai-app-static == 1.3.1 - , wai-extra == 1.3.1.1 + , wai-extra == 1.3.2 , wai-logger == 0.3.0 , wai-test == 1.3.0 - , warp == 1.3.6 + , warp == 1.3.7.1 , word8 == 0.0.3 , xml-conduit == 1.0.3.3 , xml-types == 0.3.3 @@ -141,7 +143,7 @@ library , yesod-routes == 1.1.1.1 , yesod-static == 1.1.1.2 , yesod-test == 0.3.3 - , zlib-bindings == 0.1.1.2 + , zlib-bindings == 0.1.1.3 , zlib-conduit == 0.5.0.3 exposed-modules: Yesod.Platform diff --git a/yesod-routes/yesod-routes.cabal b/yesod-routes/yesod-routes.cabal index 83f78a93..eb367b35 100644 --- a/yesod-routes/yesod-routes.cabal +++ b/yesod-routes/yesod-routes.cabal @@ -1,5 +1,5 @@ name: yesod-routes -version: 1.1.1.1 +version: 1.1.2 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index 7a2280b0..045fb0f9 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -1,5 +1,5 @@ name: yesod-static -version: 1.1.1.2 +version: 1.1.2 license: MIT license-file: LICENSE author: Michael Snoyman @@ -34,7 +34,7 @@ library , wai >= 1.3 && < 1.4 , text >= 0.9 , file-embed >= 0.0.4.1 && < 0.5 - , http-types >= 0.7 && < 0.8 + , http-types >= 0.7 , unix-compat >= 0.2 , conduit >= 0.5 && < 0.6 , crypto-conduit >= 0.4 && < 0.5 diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 65805f05..117fbcf3 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -33,7 +33,7 @@ module Yesod.Test ( -- add values, add files, lookup fields by label and find the current -- nonce value and add it to your request too. -- - post, post_, get, get_, doRequest, + post, post_, get, get_, doRequest, doRequestHeaders, byName, fileByName, -- | Yesod cat auto generate field ids, so you are never sure what @@ -363,9 +363,14 @@ get url paramsBuild = doRequest "GET" url paramsBuild get_ :: BS8.ByteString -> OneSpec conn () get_ = flip get $ return () --- | General interface to performing requests, letting you specify the request method and extra headers. +-- | General interface to performing requests, letting you specify the request method doRequest :: H.Method -> BS8.ByteString -> RequestBuilder a -> OneSpec conn () -doRequest method url paramsBuild = do +doRequest method url paramsBuild = doRequestHeaders method url [] paramsBuild + +-- | General interface to performing requests, allowing you to add extra +-- headers as well as letting you specify the request method. +doRequestHeaders :: H.Method -> BS8.ByteString -> [H.Header] -> RequestBuilder a -> OneSpec conn () +doRequestHeaders method url extrahead paramsBuild = do OneSpecData app conn oldCookies mRes <- ST.get -- expire cookies and filter them for the current path. TODO: support max age @@ -398,10 +403,11 @@ doRequest method url paramsBuild = do boundary = "*******noneedtomakethisrandom" separator = BS8.concat ["--", BS8.pack boundary, "\r\n"] makeMultipart cookies parts = - flip SRequest (BSL8.fromChunks [multiPartBody parts]) $ mkRequest + flip SRequest (BSL8.fromChunks [multiPartBody parts]) $ mkRequest $ [ ("Cookie", Builder.toByteString $ Cookie.renderCookies [(Cookie.setCookieName c, Cookie.setCookieValue c) | c <- map snd $ M.toList cookies]) - , ("Content-Type", BS8.pack $ "multipart/form-data; boundary=" ++ boundary)] + , ("Content-Type", BS8.pack $ "multipart/form-data; boundary=" ++ boundary) + ] ++ extrahead multiPartBody parts = BS8.concat $ separator : [BS8.concat [multipartPart p, separator] | p <- parts] multipartPart (ReqPlainPart k v) = BS8.concat @@ -416,10 +422,11 @@ doRequest method url paramsBuild = do , BS8.concat $ BSL8.toChunks bytes, "\r\n"] -- For building the regular non-multipart requests - makeSinglepart cookies parts = SRequest (mkRequest + makeSinglepart cookies parts = SRequest (mkRequest $ [ ("Cookie", Builder.toByteString $ Cookie.renderCookies [(Cookie.setCookieName c, Cookie.setCookieValue c) | c <- map snd $ M.toList cookies]) - , ("Content-Type", "application/x-www-form-urlencoded")]) $ + , ("Content-Type", "application/x-www-form-urlencoded") + ] ++ extrahead) $ BSL8.fromChunks $ return $ TE.encodeUtf8 $ T.intercalate "&" $ map singlepartPart parts singlepartPart (ReqFilePart _ _ _ _) = "" diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index 5ad9c499..040ed8fa 100644 --- a/yesod-test/yesod-test.cabal +++ b/yesod-test/yesod-test.cabal @@ -1,5 +1,5 @@ name: yesod-test -version: 0.3.3 +version: 0.3.3.1 license: MIT license-file: LICENSE author: Nubis @@ -21,7 +21,7 @@ library , wai >= 1.3 && < 1.4 , wai-test >= 1.3 && < 1.4 , network >= 2.2 - , http-types >= 0.7 && < 0.8 + , http-types >= 0.7 , HUnit >= 1.2 && < 1.3 , hspec >= 1.4 , bytestring >= 0.9 diff --git a/yesod/Devel.hs b/yesod/Devel.hs index 0ba574ec..69ba08a0 100644 --- a/yesod/Devel.hs +++ b/yesod/Devel.hs @@ -107,13 +107,14 @@ data DevelOpts = DevelOpts , 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 @@ reverseProxy opts iappPort = do 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/yesod/GhcBuild.hs b/yesod/GhcBuild.hs index 712999f7..be4fecf7 100644 --- a/yesod/GhcBuild.hs +++ b/yesod/GhcBuild.hs @@ -19,29 +19,30 @@ module GhcBuild (getBuildFlags, buildPackage) where import qualified Control.Exception as Ex -import Control.Monad (when) +import Control.Monad (when) import Data.IORef -import System.Process (rawSystem) +import System.Process (rawSystem) +import System.Environment (getEnvironment) import CmdLineParser -import Data.Char (toLower) -import Data.List (isPrefixOf, partition) -import Data.Maybe (fromMaybe) -import DriverPhases (Phase (..), anyHsc, isHaskellSrcFilename, - isSourceFilename, startPhase) -import DriverPipeline (compileFile, link, linkBinary, oneShot) -import DynFlags (DynFlags, compilerInfo) +import Data.Char (toLower) +import Data.List (isPrefixOf, partition) +import Data.Maybe (fromMaybe) +import DriverPhases (Phase (..), anyHsc, isHaskellSrcFilename, + isSourceFilename, startPhase) +import DriverPipeline (compileFile, link, linkBinary, oneShot) +import DynFlags (DynFlags, compilerInfo) import qualified DynFlags import qualified GHC -import GHC.Paths (libdir) -import HscTypes (HscEnv (..), emptyHomePackageTable) -import MonadUtils (liftIO) -import Panic (ghcError, panic) -import SrcLoc (Located, mkGeneralLocated) -import StaticFlags (v_Ld_inputs) +import GHC.Paths (libdir) +import HscTypes (HscEnv (..), emptyHomePackageTable) +import MonadUtils (liftIO) +import Panic (ghcError, panic) +import SrcLoc (Located, mkGeneralLocated) +import StaticFlags (v_Ld_inputs) import qualified StaticFlags -import System.FilePath (normalise, ()) -import Util (consIORef, looksLikeModuleName) +import System.FilePath (normalise, ()) +import Util (consIORef, looksLikeModuleName) {- This contains a huge hack: @@ -53,7 +54,8 @@ import Util (consIORef, looksLikeModuleName) getBuildFlags :: IO [Located String] getBuildFlags = do argv0 <- fmap read $ readFile "yesod-devel/ghcargs.txt" -- generated by yesod-ghc-wrapper - let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0 + argv0' <- prependHsenvArgv argv0 + let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0' mbMinusB | null minusB_args = Nothing | otherwise = Just (drop 2 (last minusB_args)) let argv1' = map (mkGeneralLocated "on the commandline") argv1 @@ -61,6 +63,14 @@ getBuildFlags = do (argv2, staticFlagWarnings) <- GHC.parseStaticFlags argv1' return argv2 +prependHsenvArgv :: [String] -> IO [String] +prependHsenvArgv argv = do + env <- getEnvironment + return $ case (lookup "HSENV" env) of + Nothing -> argv + _ -> hsenvArgv ++ argv + where hsenvArgv = words $ fromMaybe "" (lookup "PACKAGE_DB_FOR_GHC" env) + buildPackage :: [Located String] -> FilePath -> FilePath -> IO Bool buildPackage a ld ar = buildPackage' a ld ar `Ex.catch` \e -> do putStrLn ("exception building package: " ++ show (e :: Ex.SomeException)) @@ -416,4 +426,3 @@ isCompManagerMode DoMake = True isCompManagerMode DoInteractive = True isCompManagerMode (DoEval _) = True isCompManagerMode _ = False - diff --git a/yesod/ghcwrapper.hs b/yesod/ghcwrapper.hs index bd0488cc..ef5e1f27 100644 --- a/yesod/ghcwrapper.hs +++ b/yesod/ghcwrapper.hs @@ -58,5 +58,3 @@ main = do when e $ writeFile outFile (show args ++ "\n") ex <- runProgram cmd args exitWith ex - - diff --git a/yesod/hsfiles/mongo.hsfiles b/yesod/hsfiles/mongo.hsfiles index e83746d7..47c8892a 100644 --- a/yesod/hsfiles/mongo.hsfiles +++ b/yesod/hsfiles/mongo.hsfiles @@ -425,6 +425,7 @@ test-suite test , 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 @@ module HomeTest ) 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 @@ homeSpecs = 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/yesod/hsfiles/mysql.hsfiles b/yesod/hsfiles/mysql.hsfiles index d911bdf7..99c83252 100644 --- a/yesod/hsfiles/mysql.hsfiles +++ b/yesod/hsfiles/mysql.hsfiles @@ -423,6 +423,7 @@ test-suite test , 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 @@ module HomeTest ) 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 @@ homeSpecs = 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/yesod/hsfiles/postgres.hsfiles b/yesod/hsfiles/postgres.hsfiles index 508b4861..1d176f23 100644 --- a/yesod/hsfiles/postgres.hsfiles +++ b/yesod/hsfiles/postgres.hsfiles @@ -423,6 +423,7 @@ test-suite test , 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 @@ module HomeTest ) 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 @@ homeSpecs = 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/yesod/hsfiles/sqlite.hsfiles b/yesod/hsfiles/sqlite.hsfiles index eaadf0c9..dbb49b34 100644 --- a/yesod/hsfiles/sqlite.hsfiles +++ b/yesod/hsfiles/sqlite.hsfiles @@ -423,6 +423,7 @@ test-suite test , 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 @@ module HomeTest ) 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 @@ homeSpecs = 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/yesod/main.hs b/yesod/main.hs index 49affcf1..9a8a482f 100755 --- a/yesod/main.hs +++ b/yesod/main.hs @@ -58,6 +58,7 @@ data Command = Init , develIgnore :: [String] , develExtraArgs :: [String] , _develPort :: Int + , _proxyTimeout :: Int } | Test | AddHandler @@ -95,7 +96,7 @@ main = do 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 @@ develOptions = Devel <$> switch ( long "disable-api" <> short 'd' <*> 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/yesod.cabal b/yesod/yesod.cabal index 0370c4ca..8764353a 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -1,5 +1,5 @@ name: yesod -version: 1.1.7.2 +version: 1.1.8 license: MIT license-file: LICENSE author: Michael Snoyman @@ -86,7 +86,7 @@ executable yesod , unix-compat >= 0.2 && < 0.5 , containers >= 0.2 , attoparsec >= 0.10 - , http-types >= 0.7 && < 0.8 + , http-types >= 0.7 , blaze-builder >= 0.2.1.4 && < 0.4 , filepath >= 1.1 , process