web/app/DevelMain.hs

   1 -- | Running your app inside GHCi.
   2 --
   3 -- To start up GHCi for usage with Yesod, first make sure you are in dev mode:
   4 --
   5 -- > cabal configure -fdev
   6 --
   7 -- Note that @yesod devel@ automatically sets the dev flag.
   8 -- Now launch the repl:
   9 --
  10 -- > cabal repl --ghc-options="-O0 -fobject-code"
  11 --
  12 -- To start your app, run:
  13 --
  14 -- > :l DevelMain
  15 -- > DevelMain.update
  16 --
  17 -- You can also call @DevelMain.shutdown@ to stop the app
  18 --
  19 -- You will need to add the foreign-store package to your .cabal file.
  20 -- It is very light-weight.
  21 --
  22 -- If you don't use cabal repl, you will need
  23 -- to run the following in GHCi or to add it to
  24 -- your .ghci file.
  25 --
  26 -- :set -DDEVELOPMENT
  27 --
  28 -- There is more information about this approach,
  29 -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
  30
  31 module DevelMain where
  32
  33 import Prelude
  34 import Application (getApplicationRepl, shutdownApp)
  35
  36 import Control.Exception (finally)
  37 import Control.Monad ((>=>))
  38 import Control.Concurrent
  39 import Data.IORef
  40 import Foreign.Store
  41 import Network.Wai.Handler.Warp
  42 import GHC.Word
  43
  44 -- | Start or restart the server.
  45 -- newStore is from foreign-store.
  46 -- A Store holds onto some data across ghci reloads
  47 update :: IO ()
  48 update = do
  49     mtidStore <- lookupStore tidStoreNum
  50     case mtidStore of
  51       -- no server running
  52       Nothing -> do
  53           done <- storeAction doneStore newEmptyMVar
  54           tid <- start done
  55           _ <- storeAction (Store tidStoreNum) (newIORef tid)
  56           return ()
  57       -- server is already running
  58       Just tidStore -> restartAppInNewThread tidStore
  59   where
  60     doneStore :: Store (MVar ())
  61     doneStore = Store 0
  62
  63     -- shut the server down with killThread and wait for the done signal
  64     restartAppInNewThread :: Store (IORef ThreadId) -> IO ()
  65     restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do
  66         killThread tid
  67         withStore doneStore takeMVar
  68         readStore doneStore >>= start
  69
  70
  71     -- | Start the server in a separate thread.
  72     start :: MVar () -- ^ Written to when the thread is killed.
  73           -> IO ThreadId
  74     start done = do
  75         (port, site, app) <- getApplicationRepl
  76         forkIO (finally (runSettings (setPort port defaultSettings) app)
  77                         -- Note that this implies concurrency
  78                         -- between shutdownApp and the next app that is starting.
  79                         -- Normally this should be fine
  80                         (putMVar done () >> shutdownApp site))
  81
  82 -- | kill the server
  83 shutdown :: IO ()
  84 shutdown = do
  85     mtidStore <- lookupStore tidStoreNum
  86     case mtidStore of
  87       -- no server running
  88       Nothing -> putStrLn "no Yesod app running"
  89       Just tidStore -> do
  90           withStore tidStore $ readIORef >=> killThread
  91           putStrLn "Yesod app is shutdown"
  92
  93 tidStoreNum :: Word32
  94 tidStoreNum = 1
  95
  96 modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
  97 modifyStoredIORef store f = withStore store $ \ref -> do
  98     v <- readIORef ref
  99     f v >>= writeIORef ref