diff --git a/app/DevelMain.hs b/app/DevelMain.hs index 7c41167..b327943 100644 --- a/app/DevelMain.hs +++ b/app/DevelMain.hs @@ -1,52 +1,48 @@ --- yammat - Yet Another MateMAT --- Copyright (C) 2015 Amedeo Molnár +-- | Running your app inside GHCi. -- --- This program is free software: you can redistribute it and/or modify --- 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. +-- To start up GHCi for usage with Yesod, first make sure you are in dev mode: -- --- This program is distributed in the hope that it will be useful, --- 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. +-- > cabal configure -fdev -- --- You should have received a copy of the GNU Affero General Public License --- along with this program. If not, see . --- | Development version to be run inside GHCi. +-- Note that @yesod devel@ automatically sets the dev flag. +-- Now launch the repl: -- --- 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 --- DevelMain.update +-- You can also call @DevelMain.shutdown@ to stop the app -- --- You will need to add these packages to your .cabal file --- * foreign-store >= 0.1 (very light-weight) --- * warp (you already depend on this, it just isn't in your .cabal file) +-- You will need to add the foreign-store package to your .cabal file. +-- It is very light-weight. -- -- 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 -- --- There is more information about using ghci +-- There is more information about this approach, -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci module DevelMain where -import Application (getApplicationDev) +import Prelude +import Application (getApplicationRepl, shutdownApp) import Control.Exception (finally) +import Control.Monad ((>=>)) import Control.Concurrent import Data.IORef import Foreign.Store import Network.Wai.Handler.Warp +import GHC.Word -- | Start or restart the server. +-- newStore is from foreign-store. -- A Store holds onto some data across ghci reloads update :: IO () update = do @@ -59,24 +55,45 @@ update = do _ <- storeAction (Store tidStoreNum) (newIORef tid) return () -- server is already running - Just 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 + Just tidStore -> restartAppInNewThread tidStore where + doneStore :: Store (MVar ()) doneStore = Store 0 - tidStoreNum = 1 - modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () - modifyStoredIORef store f = withStore store $ \ref -> do - v <- readIORef ref - f v >>= writeIORef ref + -- 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 - (settings,app) <- getApplicationDev - forkIO (finally (runSettings settings app) - (putMVar done ())) + + -- | 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