Enable job-handling explicitly where needed
This commit is contained in:
parent
5bf7c42a66
commit
7933877bed
@ -1,7 +1,7 @@
|
|||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
|
|
||||||
module Application
|
module Application
|
||||||
( getApplicationDev, getAppDevSettings
|
( getAppDevSettings
|
||||||
, appMain
|
, appMain
|
||||||
, develMain
|
, develMain
|
||||||
, makeFoundation
|
, makeFoundation
|
||||||
@ -202,9 +202,6 @@ makeFoundation appSettings'@AppSettings{..} = do
|
|||||||
|
|
||||||
let foundation = mkFoundation sqlPool smtpPool ldapPool appCryptoIDKey appSessionKey appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID
|
let foundation = mkFoundation sqlPool smtpPool ldapPool appCryptoIDKey appSessionKey appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID
|
||||||
|
|
||||||
$logDebugS "setup" "Job-Handling"
|
|
||||||
handleJobs foundation
|
|
||||||
|
|
||||||
-- Return the foundation
|
-- Return the foundation
|
||||||
$logDebugS "setup" "Done"
|
$logDebugS "setup" "Done"
|
||||||
return foundation
|
return foundation
|
||||||
@ -343,15 +340,6 @@ warpSettings foundation = defaultSettings
|
|||||||
LevelError
|
LevelError
|
||||||
(toLogStr $ "Exception from Warp: " ++ show e))
|
(toLogStr $ "Exception from Warp: " ++ show e))
|
||||||
|
|
||||||
-- | For yesod devel, return the Warp settings and WAI Application.
|
|
||||||
getApplicationDev :: (MonadResource m, MonadBaseControl IO m) => m (Settings, Application)
|
|
||||||
getApplicationDev = do
|
|
||||||
settings <- getAppDevSettings
|
|
||||||
foundation <- makeFoundation settings
|
|
||||||
wsettings <- liftIO . getDevSettings $ warpSettings foundation
|
|
||||||
app <- makeApplication foundation
|
|
||||||
return (wsettings, app)
|
|
||||||
|
|
||||||
getAppDevSettings, getAppSettings :: MonadIO m => m AppSettings
|
getAppDevSettings, getAppSettings :: MonadIO m => m AppSettings
|
||||||
getAppDevSettings = liftIO $ adjustSettings =<< loadYamlSettings [configSettingsYml] [configSettingsYmlValue] useEnv
|
getAppDevSettings = liftIO $ adjustSettings =<< loadYamlSettings [configSettingsYml] [configSettingsYmlValue] useEnv
|
||||||
getAppSettings = liftIO $ adjustSettings =<< loadYamlSettingsArgs [configSettingsYmlValue] useEnv
|
getAppSettings = liftIO $ adjustSettings =<< loadYamlSettingsArgs [configSettingsYmlValue] useEnv
|
||||||
@ -369,8 +357,14 @@ adjustSettings = execStateT $ do
|
|||||||
|
|
||||||
-- | main function for use by yesod devel
|
-- | main function for use by yesod devel
|
||||||
develMain :: IO ()
|
develMain :: IO ()
|
||||||
develMain = runResourceT $
|
develMain = runResourceT $ do
|
||||||
liftIO . develMainHelper . return =<< getApplicationDev
|
settings <- getAppDevSettings
|
||||||
|
foundation <- makeFoundation settings
|
||||||
|
wsettings <- liftIO . getDevSettings $ warpSettings foundation
|
||||||
|
app <- makeApplication foundation
|
||||||
|
|
||||||
|
handleJobs foundation
|
||||||
|
liftIO . develMainHelper $ return (wsettings, app)
|
||||||
|
|
||||||
-- | The @main@ function for an executable running this site.
|
-- | The @main@ function for an executable running this site.
|
||||||
appMain :: MonadResourceBase m => m ()
|
appMain :: MonadResourceBase m => m ()
|
||||||
@ -381,6 +375,9 @@ appMain = runResourceT $ do
|
|||||||
foundation <- makeFoundation settings
|
foundation <- makeFoundation settings
|
||||||
|
|
||||||
runAppLoggingT foundation $ do
|
runAppLoggingT foundation $ do
|
||||||
|
$logDebugS "setup" "Job-Handling"
|
||||||
|
handleJobs foundation
|
||||||
|
|
||||||
-- Generate a WAI Application from the foundation
|
-- Generate a WAI Application from the foundation
|
||||||
app <- makeApplication foundation
|
app <- makeApplication foundation
|
||||||
|
|
||||||
@ -414,6 +411,7 @@ getApplicationRepl :: (MonadResource m, MonadBaseControl IO m) => m (Int, UniWor
|
|||||||
getApplicationRepl = do
|
getApplicationRepl = do
|
||||||
settings <- getAppDevSettings
|
settings <- getAppDevSettings
|
||||||
foundation <- makeFoundation settings
|
foundation <- makeFoundation settings
|
||||||
|
handleJobs foundation
|
||||||
wsettings <- liftIO . getDevSettings $ warpSettings foundation
|
wsettings <- liftIO . getDevSettings $ warpSettings foundation
|
||||||
app1 <- makeApplication foundation
|
app1 <- makeApplication foundation
|
||||||
|
|
||||||
|
|||||||
@ -113,7 +113,7 @@ data UniWorX = UniWorX
|
|||||||
, appConnPool :: ConnectionPool -- ^ Database connection pool.
|
, appConnPool :: ConnectionPool -- ^ Database connection pool.
|
||||||
, appSmtpPool :: Maybe SMTPPool
|
, appSmtpPool :: Maybe SMTPPool
|
||||||
, appLdapPool :: Maybe LdapPool
|
, appLdapPool :: Maybe LdapPool
|
||||||
, appWidgetMemcached :: Maybe Memcached.Connection
|
, appWidgetMemcached :: Maybe Memcached.Connection -- ^ Actually a proper pool
|
||||||
, appHttpManager :: Manager
|
, appHttpManager :: Manager
|
||||||
, appLogger :: (ReleaseKey, TVar Logger)
|
, appLogger :: (ReleaseKey, TVar Logger)
|
||||||
, appLogSettings :: TVar LogSettings
|
, appLogSettings :: TVar LogSettings
|
||||||
|
|||||||
@ -53,8 +53,6 @@ main = do
|
|||||||
rawExecute "drop owned by current_user;" []
|
rawExecute "drop owned by current_user;" []
|
||||||
DBTruncate -> db $ do
|
DBTruncate -> db $ do
|
||||||
foundation <- getYesod
|
foundation <- getYesod
|
||||||
stopJobCtl foundation
|
|
||||||
release . fst $ appLogger foundation
|
|
||||||
liftIO . destroyAllResources $ appConnPool foundation
|
liftIO . destroyAllResources $ appConnPool foundation
|
||||||
truncateDb
|
truncateDb
|
||||||
DBMigrate -> db $ return ()
|
DBMigrate -> db $ return ()
|
||||||
|
|||||||
Reference in New Issue
Block a user