Fix build
This commit is contained in:
parent
3297b56ebf
commit
d00c6abd6b
@ -33,13 +33,15 @@ module DevelMain where
|
||||
import Prelude
|
||||
import Application (getApplicationRepl, shutdownApp)
|
||||
|
||||
import Control.Exception (finally)
|
||||
import Control.Monad.Catch (finally)
|
||||
import Control.Monad ((>=>))
|
||||
import Control.Concurrent
|
||||
import Data.IORef
|
||||
import Foreign.Store
|
||||
import Network.Wai.Handler.Warp
|
||||
import GHC.Word
|
||||
import Control.Monad.Trans.Resource
|
||||
import Control.Monad.IO.Class
|
||||
|
||||
-- | Start or restart the server.
|
||||
-- newStore is from foreign-store.
|
||||
@ -71,13 +73,14 @@ update = do
|
||||
-- | Start the server in a separate thread.
|
||||
start :: MVar () -- ^ Written to when the thread is killed.
|
||||
-> IO ThreadId
|
||||
start done = do
|
||||
(port, site, app) <- getApplicationRepl
|
||||
forkIO (finally (runSettings (setPort port defaultSettings) app)
|
||||
-- Note that this implies concurrency
|
||||
-- between shutdownApp and the next app that is starting.
|
||||
-- Normally this should be fine
|
||||
(putMVar done () >> shutdownApp site))
|
||||
start done = runResourceT $ do
|
||||
(port, site, app) <- getApplicationRepl
|
||||
resourceForkIO $ do
|
||||
finally (liftIO $ runSettings (setPort port defaultSettings) app)
|
||||
-- Note that this implies concurrency
|
||||
-- between shutdownApp and the next app that is starting.
|
||||
-- Normally this should be fine
|
||||
(liftIO $ putMVar done () >> shutdownApp site)
|
||||
|
||||
-- | kill the server
|
||||
shutdown :: IO ()
|
||||
|
||||
@ -13,10 +13,10 @@ module Application
|
||||
, develMain
|
||||
, makeFoundation
|
||||
, makeLogWare
|
||||
-- -- * for DevelMain
|
||||
-- , foundationStoreNum
|
||||
-- , getApplicationRepl
|
||||
-- , shutdownApp
|
||||
-- * for DevelMain
|
||||
, foundationStoreNum
|
||||
, getApplicationRepl
|
||||
, shutdownApp
|
||||
-- * for GHCI
|
||||
, handler
|
||||
, db
|
||||
@ -251,28 +251,28 @@ appMain = runResourceT $ do
|
||||
liftIO $ runSettings (warpSettings foundation) app
|
||||
|
||||
|
||||
-- --------------------------------------------------------------
|
||||
-- -- Functions for DevelMain.hs (a way to run the app from GHCi)
|
||||
-- --------------------------------------------------------------
|
||||
-- foundationStoreNum :: Word32
|
||||
-- foundationStoreNum = 2
|
||||
--------------------------------------------------------------
|
||||
-- Functions for DevelMain.hs (a way to run the app from GHCi)
|
||||
--------------------------------------------------------------
|
||||
foundationStoreNum :: Word32
|
||||
foundationStoreNum = 2
|
||||
|
||||
-- getApplicationRepl :: IO (Int, UniWorX, Application)
|
||||
-- getApplicationRepl = do
|
||||
-- settings <- getAppDevSettings
|
||||
-- foundation <- makeFoundation settings
|
||||
-- wsettings <- getDevSettings $ warpSettings foundation
|
||||
-- app1 <- makeApplication foundation
|
||||
getApplicationRepl :: (MonadResource m, MonadBaseControl IO m) => m (Int, UniWorX, Application)
|
||||
getApplicationRepl = do
|
||||
settings <- getAppDevSettings
|
||||
foundation <- makeFoundation settings
|
||||
wsettings <- liftIO . getDevSettings $ warpSettings foundation
|
||||
app1 <- makeApplication foundation
|
||||
|
||||
-- let foundationStore = Store foundationStoreNum
|
||||
-- deleteStore foundationStore
|
||||
-- writeStore foundationStore foundation
|
||||
let foundationStore = Store foundationStoreNum
|
||||
liftIO $ deleteStore foundationStore
|
||||
liftIO $ writeStore foundationStore foundation
|
||||
|
||||
-- return (getPort wsettings, foundation, app1)
|
||||
return (getPort wsettings, foundation, app1)
|
||||
|
||||
-- shutdownApp :: UniWorX -> IO ()
|
||||
-- shutdownApp UniWorX{..} = do
|
||||
-- atomically $ mapM_ closeTMChan appJobCtl
|
||||
shutdownApp :: MonadIO m => UniWorX -> m ()
|
||||
shutdownApp UniWorX{..} = do
|
||||
liftIO . atomically $ mapM_ closeTMChan appJobCtl
|
||||
|
||||
|
||||
---------------------------------------------
|
||||
@ -281,7 +281,7 @@ appMain = runResourceT $ do
|
||||
|
||||
-- | Run a handler
|
||||
handler :: Handler a -> IO a
|
||||
handler h = runResourceT $ liftIO getAppDevSettings >>= makeFoundation >>= liftIO . flip unsafeHandler h
|
||||
handler h = runResourceT $ getAppDevSettings >>= makeFoundation >>= liftIO . flip unsafeHandler h
|
||||
|
||||
-- | Run DB queries
|
||||
db :: ReaderT SqlBackend (HandlerT UniWorX IO) a -> IO a
|
||||
|
||||
Loading…
Reference in New Issue
Block a user