blob: b327943d8f9ed8f3d5932cf3b6fec55596b775a7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
-- | Running your app inside GHCi.
--
-- To start up GHCi for usage with Yesod, first make sure you are in dev mode:
--
-- > cabal configure -fdev
--
-- Note that @yesod devel@ automatically sets the dev flag.
-- Now launch the repl:
--
-- > cabal repl --ghc-options="-O0 -fobject-code"
--
-- To start your app, run:
--
-- > :l DevelMain
-- > DevelMain.update
--
-- You can also call @DevelMain.shutdown@ to stop the app
--
-- 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 run the following in GHCi or to add it to
-- your .ghci file.
--
-- :set -DDEVELOPMENT
--
-- There is more information about this approach,
-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
module DevelMain where
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
mtidStore <- lookupStore tidStoreNum
case mtidStore of
-- no server running
Nothing -> do
done <- storeAction doneStore newEmptyMVar
tid <- start done
_ <- storeAction (Store tidStoreNum) (newIORef tid)
return ()
-- server is already running
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
|
