Fix build

app/DevelMain.hs

@@ -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
+    start done = runResourceT $ do
-        (port, site, app) <- getApplicationRepl
+      (port, site, app) <- getApplicationRepl
-        forkIO (finally (runSettings (setPort port defaultSettings) app)
+      resourceForkIO $ do
-                        -- Note that this implies concurrency
+        finally (liftIO $ runSettings (setPort port defaultSettings) app)
-                        -- between shutdownApp and the next app that is starting.
+          -- Note that this implies concurrency
-                        -- Normally this should be fine
+          -- between shutdownApp and the next app that is starting.
-                        (putMVar done () >> shutdownApp site))
+          -- Normally this should be fine
+          (liftIO $ putMVar done () >> shutdownApp site)
 
 -- | kill the server
 shutdown :: IO ()

src/Application.hs

@@ -13,10 +13,10 @@ module Application
     , develMain
     , makeFoundation
     , makeLogWare
-    -- -- * for DevelMain
+    -- * for DevelMain
-    -- , foundationStoreNum
+    , foundationStoreNum
-    -- , getApplicationRepl
+    , getApplicationRepl
-    -- , shutdownApp
+    , 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)
+-- Functions for DevelMain.hs (a way to run the app from GHCi)
--- --------------------------------------------------------------
+--------------------------------------------------------------
--- foundationStoreNum :: Word32
+foundationStoreNum :: Word32
--- foundationStoreNum = 2
+foundationStoreNum = 2
   
--- getApplicationRepl :: IO (Int, UniWorX, Application)
+getApplicationRepl :: (MonadResource m, MonadBaseControl IO m) => m (Int, UniWorX, Application)
--- getApplicationRepl = do
+getApplicationRepl = do
---     settings <- getAppDevSettings
+    settings <- getAppDevSettings
---     foundation <- makeFoundation settings
+    foundation <- makeFoundation settings
---     wsettings <- getDevSettings $ warpSettings foundation
+    wsettings <- liftIO . getDevSettings $ warpSettings foundation
---     app1 <- makeApplication foundation
+    app1 <- makeApplication foundation
 
---     let foundationStore = Store foundationStoreNum
+    let foundationStore = Store foundationStoreNum
---     deleteStore foundationStore
+    liftIO $ deleteStore foundationStore
---     writeStore foundationStore foundation
+    liftIO $ writeStore foundationStore foundation
   
---     return (getPort wsettings, foundation, app1)
+    return (getPort wsettings, foundation, app1)
 
--- shutdownApp :: UniWorX -> IO ()
+shutdownApp :: MonadIO m => UniWorX -> m ()
--- shutdownApp UniWorX{..} = do
+shutdownApp UniWorX{..} = do
---   atomically $ mapM_ closeTMChan appJobCtl
+  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