fix scaffolding

This commit is contained in:
Greg Weber 2011-08-23 07:25:54 -07:00
parent 9b9b021705
commit c0a8a53ad2
3 changed files with 29 additions and 30 deletions

View File

@ -83,11 +83,10 @@ devel cabalCmd = do
, concat
[ "import \""
, pi'
, "\" Application (withDevelApp)"
, "\" Application (withDevelAppPort)"
]
, "import Data.Dynamic (fromDynamic)"
, "import Network.Wai.Handler.Warp (run)"
, "import Network.Wai.Middleware.Debug (debugHandle)"
, "import Data.Maybe (fromJust)"
, "import Control.Concurrent (forkIO)"
, "import System.Directory (doesFileExist, removeFile)"
@ -97,7 +96,7 @@ devel cabalCmd = do
, "main = do"
, " putStrLn \"Starting app\""
, " wdap <- return $ fromJust $ fromDynamic withDevelAppPort"
, " forkIO $ wdap $ \\(port, debugLogHandle app) -> (run port . debugHandle debugLogHandle) app"
, " forkIO $ wdap $ \\(port, app) -> run port app"
, " loop"
, ""
, "loop :: IO ()"

View File

@ -46,25 +46,24 @@ getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
-- migrations handled by Yesod.
with~sitearg~ :: AppConfig -> Logger -> (Application -> IO a) -> IO ()
with~sitearg~ conf logger f = do
Settings.withConnectionPool conf $ \p -> do
runConnectionPool (runMigration migrateAll) p
let h = ~sitearg~ conf logger s p
#ifdef WINDOWS
toWaiApp h >>= f >> return ()
#else
tid <- forkIO $ toWaiApp h >>= f >> return ()
flag <- newEmptyMVar
_ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do
putStrLn "Caught an interrupt"
killThread tid
putMVar flag ()) Nothing
takeMVar flag
#endif
where
#ifdef PRODUCTION
s = static Settings.staticDir
s <- static Settings.staticDir
#else
s = staticDevel Settings.staticDir
s <- staticDevel Settings.staticDir
#endif
Settings.withConnectionPool conf $ \p -> do
runConnectionPool (runMigration migrateAll) p
let h = ~sitearg~ conf logger s p
#ifdef WINDOWS
toWaiApp h >>= f >> return ()
#else
tid <- forkIO $ toWaiApp h >>= f >> return ()
flag <- newEmptyMVar
_ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do
putStrLn "Caught an interrupt"
killThread tid
putMVar flag ()) Nothing
takeMVar flag
#endif
-- for yesod devel

View File

@ -1,19 +1,21 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Application
( with~sitearg~
, withDevelApp
, withDevelAppPort
) where
import Foundation
import Settings
import Yesod.Static
import Yesod.Logger (makeLogger, flushLogger, Logger)
import Yesod.Logger (makeLogger, flushLogger, Logger, logLazyText, logString)
import Data.ByteString (ByteString)
import Network.Wai (Application)
import Data.Dynamic (Dynamic, toDyn)
import Network.Wai.Middleware.Debug (debugHandle)
-- Import all relevant handler modules here.
import Handler.Root
@ -37,18 +39,17 @@ getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
-- migrations handled by Yesod.
with~sitearg~ :: AppConfig -> Logger -> (Application -> IO a) -> IO a
with~sitearg~ conf logger f = do
#ifdef PRODUCTION
s <- static Settings.staticDir
#else
s <- staticDevel Settings.staticDir
#endif
let h = ~sitearg~ conf logger s
toWaiApp h >>= f
where
#ifdef PRODUCTION
s = static Settings.staticDir
#else
s = staticDevel Settings.staticDir
#endif
-- for yesod devel
withDevelApp :: Dynamic
withDevelApp =
withDevelAppPort :: Dynamic
withDevelAppPort =
toDyn go
where
go :: ((Int, Application) -> IO ()) -> IO ()