haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into yesod1.2

Browse Source
This commit is contained in:
Michael Snoyman 2013-02-12 16:59:40 +02:00
commit 8eb898931a
22 changed files with 210 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
README.md
View File

@ -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

6
yesod-auth/Yesod/Auth/Rpxnow.hs
View File

@ -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

2
yesod-auth/yesod-auth.cabal
View File

@ -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

4
yesod-core/Yesod/Handler.hs
View File

@ -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

2
yesod-core/Yesod/Internal/Core.hs
View File

@ -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

4
yesod-core/yesod-core.cabal
View File

@ -1,5 +1,5 @@
name: yesod-core
version: 1.1.7.1
version: 1.1.8
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@ -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

11
yesod-form/Yesod/Form/Fields.hs
View File

@ -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
<input id="#{theId}" name="#{name}" *{attrs} type="email" :isReq:required="" value="#{either id id val}">

2
yesod-form/yesod-form.cabal
View File

@ -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 <michael@snoyman.com>

52
yesod-platform/yesod-platform.cabal
View File

@ -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 <michael@snoyman.com>
@ -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

2
yesod-routes/yesod-routes.cabal
View File

@ -1,5 +1,5 @@
name: yesod-routes
version: 1.1.1.1
version: 1.1.2
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>

4
yesod-static/yesod-static.cabal
View File

@ -1,5 +1,5 @@
name: yesod-static
version: 1.1.1.2
version: 1.1.2
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@ -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

21
yesod-test/Yesod/Test.hs
View File

@ -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 _ _ _ _) = ""

4
yesod-test/yesod-test.cabal
View File

@ -1,5 +1,5 @@
name: yesod-test
version: 0.3.3
version: 0.3.3.1
license: MIT
license-file: LICENSE
author: Nubis <nubis@woobiz.com.ar>
@ -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

5
yesod/Devel.hs
View File

@ -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"

47
yesod/GhcBuild.hs
View File

@ -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

2
yesod/ghcwrapper.hs
View File

@ -58,5 +58,3 @@ main = do
when e $ writeFile outFile (show args ++ "\n")
ex <- runProgram cmd args
exitWith ex

26
yesod/hsfiles/mongo.hsfiles
View File

@ -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 #-}

28
yesod/hsfiles/mysql.hsfiles
View File

@ -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 #-}

28
yesod/hsfiles/postgres.hsfiles
View File

@ -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 #-}

28
yesod/hsfiles/sqlite.hsfiles
View File

@ -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 #-}

5
yesod/main.hs
View File

@ -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"

4
yesod/yesod.cabal
View File

@ -1,5 +1,5 @@
name: yesod
version: 1.1.7.2
version: 1.1.8
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@ -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