Permalink
Browse files

More safety for filling profiles, library bumps

  • Loading branch information...
1 parent 83f9821 commit 28192816e95d72c4814e1ae0752ccc79c847fad8 @snoyberg committed Mar 14, 2013
Showing with 12 additions and 9 deletions.
  1. +9 −6 Application.hs
  2. +3 −3 haskellers.cabal
View
15 Application.hs
@@ -20,8 +20,9 @@ import Control.Concurrent
import Database.Persist.GenericSql
import Data.Maybe
import qualified Data.Set as Set
-import Control.Monad.Logger (MonadLogger)
+import Control.Monad.Logger (MonadLogger, runNoLoggingT)
import Control.Monad.Trans.Resource (MonadResource, runResourceT)
+import System.Timeout
-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
@@ -66,15 +67,17 @@ makeFoundation conf = do
Database.Persist.Store.loadConfig >>=
Database.Persist.Store.applyEnv
p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)
- Database.Persist.Store.runPool dbconf (runMigration migrateAll) p
+ runNoLoggingT $ Database.Persist.Store.runPool dbconf (runMigration migrateAll) p
hprofs <- newIORef ([], 0)
pprofs <- newIORef []
if production
then do
_ <- forkIO $ forever $ do
- _ <- fillProfs p hprofs pprofs
- threadDelay (1000 * 1000 * 60 * 5)
+ _ <- forkIO $ do
+ _ <- timeout (1000 * 1000 * 60 * 2) $ fillProfs p hprofs pprofs
+ return ()
+ threadDelay (1000 * 1000 * 60 * 10)
return ()
else fillProfs p hprofs pprofs
@@ -90,7 +93,7 @@ getApplicationDev =
}
getHomepageProfs :: ConnectionPool -> IO [Profile]
-getHomepageProfs pool = runResourceT $ flip runSqlPool pool $ do
+getHomepageProfs pool = runNoLoggingT $ runResourceT $ flip runSqlPool pool $ do
users <-
selectList [ UserVerifiedEmail ==. True
, UserVisible ==. True
@@ -101,7 +104,7 @@ getHomepageProfs pool = runResourceT $ flip runSqlPool pool $ do
fmap catMaybes $ mapM userToProfile users
getPublicProfs :: ConnectionPool -> IO [Profile]
-getPublicProfs pool = runResourceT $ flip runSqlPool pool $ do
+getPublicProfs pool = runNoLoggingT $ runResourceT $ flip runSqlPool pool $ do
users <-
selectList [ UserVerifiedEmail ==. True
, UserVisible ==. True
View
6 haskellers.cabal
@@ -68,7 +68,7 @@ library
, yesod >= 1.1 && < 1.2
, yesod-core >= 1.1 && < 1.2
, yesod-auth >= 1.1 && < 1.4
- , yesod-auth-fb >= 1.3 && < 1.4
+ , yesod-auth-fb >= 1.4 && < 1.5
, yesod-static >= 1.1 && < 1.2
, yesod-default >= 1.1.1 && < 1.2
, yesod-form >= 1.2 && < 1.3
@@ -88,10 +88,10 @@ library
, monad-control >= 0.3 && < 0.4
, wai-extra >= 1.3 && < 1.4
, yaml >= 0.8 && < 0.9
- , http-conduit >= 1.8 && < 1.9
+ , http-conduit >= 1.9 && < 1.10
, directory >= 1.1 && < 1.3
, warp >= 1.3 && < 1.4
- , blaze-html >= 0.5 && < 0.6
+ , blaze-html >= 0.5 && < 0.7
, data-default
, time
, containers

0 comments on commit 2819281

Please sign in to comment.