new devel procedure

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 <http://www.gnu.org/licenses/>.
--- | 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
+
+    -- 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
 
 modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
 modifyStoredIORef store f = withStore store $ \ref -> do
     v <- readIORef 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 ()))