new devel procedure

This commit is contained in:
nek0 2015-09-17 21:16:31 +02:00
parent cc7b2ef16c
commit f9efb77224

View file

@ -1,52 +1,48 @@
-- yammat - Yet Another MateMAT -- | Running your app inside GHCi.
-- Copyright (C) 2015 Amedeo Molnár
-- --
-- This program is free software: you can redistribute it and/or modify -- To start up GHCi for usage with Yesod, first make sure you are in dev mode:
-- it under the terms of the GNU Affero General Public License as published
-- by the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
-- --
-- This program is distributed in the hope that it will be useful, -- > cabal configure -fdev
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Affero General Public License for more details.
-- --
-- You should have received a copy of the GNU Affero General Public License -- Note that @yesod devel@ automatically sets the dev flag.
-- along with this program. If not, see <http://www.gnu.org/licenses/>. -- Now launch the repl:
-- | Development version to be run inside GHCi.
-- --
-- start this up with: -- > cabal repl --ghc-options="-O0 -fobject-code"
-- --
-- cabal repl --ghc-options="-O0 -fobject-code" -- To start your app, run:
-- --
-- run with: -- > :l DevelMain
-- > DevelMain.update
-- --
-- :l DevelMain -- You can also call @DevelMain.shutdown@ to stop the app
-- DevelMain.update
-- --
-- You will need to add these packages to your .cabal file -- You will need to add the foreign-store package to your .cabal file.
-- * foreign-store >= 0.1 (very light-weight) -- It is very light-weight.
-- * warp (you already depend on this, it just isn't in your .cabal file)
-- --
-- If you don't use cabal repl, you will need -- If you don't use cabal repl, you will need
-- to add settings to your .ghci file. -- to run the following in GHCi or to add it to
-- your .ghci file.
-- --
-- :set -DDEVELOPMENT -- :set -DDEVELOPMENT
-- --
-- There is more information about using ghci -- There is more information about this approach,
-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
module DevelMain where module DevelMain where
import Application (getApplicationDev) import Prelude
import Application (getApplicationRepl, shutdownApp)
import Control.Exception (finally) import Control.Exception (finally)
import Control.Monad ((>=>))
import Control.Concurrent import Control.Concurrent
import Data.IORef import Data.IORef
import Foreign.Store import Foreign.Store
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
import GHC.Word
-- | Start or restart the server. -- | Start or restart the server.
-- newStore is from foreign-store.
-- A Store holds onto some data across ghci reloads -- A Store holds onto some data across ghci reloads
update :: IO () update :: IO ()
update = do update = do
@ -59,24 +55,45 @@ update = do
_ <- storeAction (Store tidStoreNum) (newIORef tid) _ <- storeAction (Store tidStoreNum) (newIORef tid)
return () return ()
-- server is already running -- server is already running
Just tidStore -> Just tidStore -> restartAppInNewThread tidStore
-- shut the server down with killThread and wait for the done signal
modifyStoredIORef tidStore $ \tid -> do
killThread tid
withStore doneStore takeMVar >> readStore doneStore >>= start
where where
doneStore :: Store (MVar ())
doneStore = Store 0 doneStore = Store 0
-- 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
-- | 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 tidStoreNum = 1
modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
modifyStoredIORef store f = withStore store $ \ref -> do modifyStoredIORef store f = withStore store $ \ref -> do
v <- readIORef ref v <- readIORef ref
f v >>= writeIORef ref f v >>= writeIORef ref
-- | Start the server in a separate thread.
start :: MVar () -- ^ Written to when the thread is killed.
-> IO ThreadId
start done = do
(settings,app) <- getApplicationDev
forkIO (finally (runSettings settings app)
(putMVar done ()))