scaffolding fixes
breakup getApplication into makeFoundation and makeApplication that way tests can re-use makeFoundation
This commit is contained in:
parent
a3cdb27ff0
commit
127ddf7181
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
22
yesod/scaffold/tests/HomeTest.hs.cg
Normal file
22
yesod/scaffold/tests/HomeTest.hs.cg
Normal 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"
|
||||||
@ -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"
|
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user