← Back to branch summary

~lambdacircus-maint/lambdacircus/970938-implement-add-quote

« back to all changes in this revision

Viewing changes to Application.hs

  • Committer: Tristan Seligmann
  • Date: 2012-04-23 18:00:50 UTC
  • mfrom: (19.2.4 trunk)
  • Revision ID: mithrandi@mithrandi.net-20120423180050-f8fwtegg6oatnzed
Merge trunk.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Application.hs
1
1
{-# OPTIONS_GHC -fno-warn-orphans #-}
2
2
module Application
3
 
    ( getApplication
 
3
    ( makeApplication
4
4
    , getApplicationDev
5
5
    ) where
6
6
 
35
35
-- performs initialization and creates a WAI application. This is also the
36
36
-- place to put your migrate statements to have automatic database
37
37
-- migrations handled by Yesod.
38
 
getApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
39
 
getApplication conf logger = do
 
38
makeApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
 
39
makeApplication conf logger = do
 
40
    foundation <- makeFoundation conf setLogger
 
41
    app <- toWaiAppPlain foundation
 
42
    return $ logWare app
 
43
  where
 
44
#ifdef DEVELOPMENT
 
45
    logWare = logCallbackDev (logBS setLogger)
 
46
    setLogger = logger
 
47
#else
 
48
    setLogger = toProduction logger -- by default the logger is set for development
 
49
    logWare = logCallback (logBS setLogger)
 
50
#endif
 
51
 
 
52
makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO FlyingCircus
 
53
makeFoundation conf setLogger = do
40
54
    manager <- newManager def
41
55
    s <- staticSite
42
56
    dbconf <- withYamlEnvironment "config/sqlite.yml" (appEnv conf)
44
58
              Database.Persist.Store.applyEnv
45
59
    p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)
46
60
    Database.Persist.Store.runPool dbconf (runMigration migrateAll) p
47
 
    let foundation = FlyingCircus conf setLogger s p manager dbconf
48
 
    app <- toWaiAppPlain foundation
49
 
    return $ logWare app
50
 
  where
51
 
#ifdef DEVELOPMENT
52
 
    logWare = logCallbackDev (logBS setLogger)
53
 
    setLogger = logger
54
 
#else
55
 
    setLogger = toProduction logger -- by default the logger is set for development
56
 
    logWare = logCallback (logBS setLogger)
57
 
#endif
 
61
    return $ FlyingCircus conf setLogger s p manager dbconf
58
62
 
59
63
-- for yesod devel
60
64
getApplicationDev :: IO (Int, Application)
61
65
getApplicationDev =
62
 
    defaultDevelApp loader getApplication
 
66
    defaultDevelApp loader makeApplication
63
67
  where
64
68
    loader = loadConfig (configSettings Development)
65
69
        { csParseExtra = parseExtra