scaffolding fixes

breakup getApplication into makeFoundation and makeApplication
that way tests can re-use makeFoundation
This commit is contained in:
gregwebs 2012-03-26 09:23:35 -07:00
parent a3cdb27ff0
commit 127ddf7181
7 changed files with 58 additions and 51 deletions

View File

@ -1,6 +1,6 @@
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Application module Application
( getApplication ( makeApplication
, getApplicationDev , getApplicationDev
) where ) where
@ -32,15 +32,9 @@ mkYesodDispatch "~sitearg~" resources~sitearg~
-- performs initialization and creates a WAI application. This is also the -- performs initialization and creates a WAI application. This is also the
-- place to put your migrate statements to have automatic database -- place to put your migrate statements to have automatic database
-- migrations handled by Yesod. -- migrations handled by Yesod.
getApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application makeApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
getApplication conf logger = do makeApplication conf logger = do
manager <- newManager def foundation <- makeFoundation conf logger
s <- staticSite
dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf)
Database.Persist.Store.loadConfig >>=
Database.Persist.Store.applyEnv
p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~
let foundation = ~sitearg~ conf setLogger s p manager dbconf
app <- toWaiAppPlain foundation app <- toWaiAppPlain foundation
return $ logWare app return $ logWare app
where where
@ -52,10 +46,20 @@ getApplication conf logger = do
logWare = logCallback (logBS setLogger) logWare = logCallback (logBS setLogger)
#endif #endif
makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO ~sitearg~
makeFoundation conf _ = do
manager <- newManager def
s <- staticSite
dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf)
Database.Persist.Store.loadConfig >>=
Database.Persist.Store.applyEnv
p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~
return $ ~sitearg~ conf setLogger s p manager dbconf
-- for yesod devel -- for yesod devel
getApplicationDev :: IO (Int, Application) getApplicationDev :: IO (Int, Application)
getApplicationDev = getApplicationDev =
defaultDevelApp loader getApplication defaultDevelApp loader makeApplication
where where
loader = loadConfig (configSettings Development) loader = loadConfig (configSettings Development)
{ csParseExtra = parseExtra { csParseExtra = parseExtra

View File

@ -25,8 +25,8 @@
# #endif # #endif
# #
# #
# getApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application # makeApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
# getApplication conf logger = do # makeApplication conf logger = do
# manager <- newManager def # manager <- newManager def
# s <- staticSite # s <- staticSite
# hconfig <- loadHerokuConfig # hconfig <- loadHerokuConfig

View File

@ -2,7 +2,7 @@ import Prelude (IO)
import Yesod.Default.Config (fromArgs) import Yesod.Default.Config (fromArgs)
import Yesod.Default.Main (defaultMain) import Yesod.Default.Main (defaultMain)
import Settings (parseExtra) import Settings (parseExtra)
import Application (getApplication) import Application (makeApplication)
main :: IO () main :: IO ()
main = defaultMain (fromArgs parseExtra) getApplication main = defaultMain (fromArgs parseExtra) makeApplication

View File

@ -0,0 +1,22 @@
module TestHome (homeSpecs) where
import Import
import Yesod.Test
homeSpecs :: Specs
homeSpecs =
describe "These are some example tests" $
it "loads the index and checks it looks right" $ do
get_ "/"
statusIs 200
htmlAllContain "h1" "Hello"
post "/" $ do
addNonce
fileByLabel "Choose a file" "tests/main.hs" "text/plain" -- talk about self-reference
byLabel "What's on the file?" "Some Content"
statusIs 200
htmlCount ".message" 1
htmlAllContain ".message" "Some Content"
htmlAllContain ".message" "text/plain"

View File

@ -6,41 +6,15 @@ module Main where
import Import import Import
import Settings import Settings
import Yesod.Static
import Yesod.Logger (defaultDevelopmentLogger) import Yesod.Logger (defaultDevelopmentLogger)
import qualified Database.Persist.Store
import Database.Persist.GenericSql (runMigration)
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Test import Yesod.Test
import Network.HTTP.Conduit (newManager, def) import Application (makeFoundation)
import Application()
main :: IO a main :: IO a
main = do main = do
conf <- loadConfig $ (configSettings Testing) { csParseExtra = parseExtra } conf <- loadConfig $ (configSettings Testing) { csParseExtra = parseExtra }
manager <- newManager def
logger <- defaultDevelopmentLogger logger <- defaultDevelopmentLogger
dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf) foundation <- makeFoundation conf logger
Database.Persist.Store.loadConfig app <- toWaiAppPlain foundation
s <- static Settings.staticDir runTests app (connPool foundation) homeSpecs
p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~
app <- toWaiAppPlain $ ~sitearg~ conf logger s p manager dbconf
runTests app p allTests
allTests :: Specs
allTests = do
describe "These are some example tests" $ do
it "loads the index and checks it looks right" $ do
get_ "/"
statusIs 200
htmlAllContain "h1" "Hello"
post "/" $ do
addNonce
fileByLabel "Choose a file" "tests/main.hs" "text/plain" -- talk about self-reference
byLabel "What's on the file?" "Some Content"
statusIs 200
htmlCount ".message" 1
htmlAllContain ".message" "Some Content"
htmlAllContain ".message" "text/plain"

View File

@ -1,6 +1,6 @@
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Application module Application
( getApplication ( makeApplication
, getApplicationDev , getApplicationDev
) where ) where
@ -27,14 +27,18 @@ import Handler.Home
-- the comments there for more details. -- the comments there for more details.
mkYesodDispatch "~sitearg~" resources~sitearg~ mkYesodDispatch "~sitearg~" resources~sitearg~
makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO ~sitearg~
makeFoundation conf _ = do
s <- staticSite
return $ ~sitearg~ conf setLogger s
-- This function allocates resources (such as a database connection pool), -- This function allocates resources (such as a database connection pool),
-- performs initialization and creates a WAI application. This is also the -- performs initialization and creates a WAI application. This is also the
-- place to put your migrate statements to have automatic database -- place to put your migrate statements to have automatic database
-- migrations handled by Yesod. -- migrations handled by Yesod.
getApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application makeApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
getApplication conf logger = do makeApplication conf logger = do
s <- staticSite foundation <- makeFoundation
let foundation = ~sitearg~ conf setLogger s
app <- toWaiAppPlain foundation app <- toWaiAppPlain foundation
return $ logWare app return $ logWare app
where where
@ -49,7 +53,7 @@ getApplication conf logger = do
-- for yesod devel -- for yesod devel
getApplicationDev :: IO (Int, Application) getApplicationDev :: IO (Int, Application)
getApplicationDev = getApplicationDev =
defaultDevelApp loader getApplication defaultDevelApp loader makeApplication
where where
loader = loadConfig (configSettings Development) loader = loadConfig (configSettings Development)
{ csParseExtra = parseExtra { csParseExtra = parseExtra

View File

@ -5,6 +5,7 @@ module Foundation
, resources~sitearg~ , resources~sitearg~
, Handler , Handler
, Widget , Widget
, Form
, module Yesod.Core , module Yesod.Core
, module Settings , module Settings
, liftIO , liftIO
@ -57,6 +58,8 @@ mkMessage "~sitearg~" "messages" "en"
-- split these actions into two functions and place them in separate files. -- split these actions into two functions and place them in separate files.
mkYesodData "~sitearg~" $(parseRoutesFile "config/routes") mkYesodData "~sitearg~" $(parseRoutesFile "config/routes")
type Form x = Html -> MForm ~sitearg~ ~sitearg~ (FormResult x, Widget)
-- Please see the documentation for the Yesod typeclass. There are a number -- Please see the documentation for the Yesod typeclass. There are a number
-- of settings which can be configured by overriding methods here. -- of settings which can be configured by overriding methods here.
instance Yesod ~sitearg~ where instance Yesod ~sitearg~ where