fix scaffolding
This commit is contained in:
parent
9b9b021705
commit
c0a8a53ad2
@ -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 ()"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 ()
|
||||
|
||||
Loading…
Reference in New Issue
Block a user