yammat/app/DevelMain.hs

100 lines
2.9 KiB
Haskell
Raw Normal View History

2015-09-17 19:16:31 +00:00
-- | Running your app inside GHCi.
2015-08-09 19:16:33 +00:00
--
2015-09-17 19:16:31 +00:00
-- To start up GHCi for usage with Yesod, first make sure you are in dev mode:
2015-08-09 19:16:33 +00:00
--
2015-09-17 19:16:31 +00:00
-- > cabal configure -fdev
2015-08-09 19:16:33 +00:00
--
2015-09-17 19:16:31 +00:00
-- Note that @yesod devel@ automatically sets the dev flag.
-- Now launch the repl:
2015-04-04 04:46:33 +00:00
--
2015-09-17 19:16:31 +00:00
-- > cabal repl --ghc-options="-O0 -fobject-code"
2015-04-04 04:46:33 +00:00
--
2015-09-17 19:16:31 +00:00
-- To start your app, run:
2015-04-04 04:46:33 +00:00
--
2015-09-17 19:16:31 +00:00
-- > :l DevelMain
-- > DevelMain.update
2015-04-04 04:46:33 +00:00
--
2015-09-17 19:16:31 +00:00
-- You can also call @DevelMain.shutdown@ to stop the app
2015-04-04 04:46:33 +00:00
--
2015-09-17 19:16:31 +00:00
-- You will need to add the foreign-store package to your .cabal file.
-- It is very light-weight.
2015-04-04 04:46:33 +00:00
--
-- If you don't use cabal repl, you will need
2015-09-17 19:16:31 +00:00
-- to run the following in GHCi or to add it to
-- your .ghci file.
2015-04-04 04:46:33 +00:00
--
-- :set -DDEVELOPMENT
--
2015-09-17 19:16:31 +00:00
-- There is more information about this approach,
2015-04-04 04:46:33 +00:00
-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
module DevelMain where
2015-09-17 19:16:31 +00:00
import Prelude
import Application (getApplicationRepl, shutdownApp)
2015-04-04 04:46:33 +00:00
import Control.Exception (finally)
2015-09-17 19:16:31 +00:00
import Control.Monad ((>=>))
2015-04-04 04:46:33 +00:00
import Control.Concurrent
import Data.IORef
import Foreign.Store
import Network.Wai.Handler.Warp
2015-09-17 19:16:31 +00:00
import GHC.Word
2015-04-04 04:46:33 +00:00
-- | Start or restart the server.
2015-09-17 19:16:31 +00:00
-- newStore is from foreign-store.
2015-04-04 04:46:33 +00:00
-- A Store holds onto some data across ghci reloads
update :: IO ()
update = do
mtidStore <- lookupStore tidStoreNum
case mtidStore of
-- no server running
Nothing -> do
done <- storeAction doneStore newEmptyMVar
tid <- start done
_ <- storeAction (Store tidStoreNum) (newIORef tid)
return ()
-- server is already running
2015-09-17 19:16:31 +00:00
Just tidStore -> restartAppInNewThread tidStore
2015-04-04 04:46:33 +00:00
where
2015-09-17 19:16:31 +00:00
doneStore :: Store (MVar ())
2015-04-04 04:46:33 +00:00
doneStore = Store 0
2015-09-17 19:16:31 +00:00
-- shut the server down with killThread and wait for the done signal
restartAppInNewThread :: Store (IORef ThreadId) -> IO ()
restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do
killThread tid
withStore doneStore takeMVar
readStore doneStore >>= start
2015-04-04 04:46:33 +00:00
2015-09-17 19:16:31 +00:00
-- | 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))
-- | kill the server
shutdown :: IO ()
shutdown = do
mtidStore <- lookupStore tidStoreNum
case mtidStore of
-- no server running
Nothing -> putStrLn "no Yesod app running"
Just tidStore -> do
withStore tidStore $ readIORef >=> killThread
putStrLn "Yesod app is shutdown"
tidStoreNum :: Word32
tidStoreNum = 1
modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
modifyStoredIORef store f = withStore store $ \ref -> do
v <- readIORef ref
f v >>= writeIORef ref