new devel procedure
This commit is contained in:
parent
cc7b2ef16c
commit
f9efb77224
1 changed files with 58 additions and 41 deletions
|
@ -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 ()))
|
|
||||||
|
|
Loading…
Reference in a new issue