2014-05-30 12:59:48 +00:00
|
|
|
{-# LANGUAGE ImplicitPrelude #-}
|
|
|
|
|
|
|
|
-- | Devel web server.
|
|
|
|
--
|
|
|
|
-- > :l DevelMain
|
|
|
|
-- > DevelMain.update
|
|
|
|
--
|
|
|
|
-- To start/restart the server.
|
|
|
|
|
|
|
|
module DevelMain where
|
|
|
|
|
|
|
|
import Application (getApplicationDev)
|
|
|
|
|
|
|
|
import Control.Concurrent
|
|
|
|
import Data.IORef
|
|
|
|
import Foreign.Store
|
|
|
|
import Network.Wai.Handler.Warp
|
|
|
|
import Yesod
|
|
|
|
import Yesod.Static
|
|
|
|
|
|
|
|
-- | Start the web server.
|
|
|
|
main :: IO (Store (IORef Application))
|
|
|
|
main =
|
|
|
|
do s <- static "static"
|
|
|
|
c <- newChan
|
2014-06-01 10:55:57 +00:00
|
|
|
(port,app) <- getApplicationDev True
|
2014-05-30 12:59:48 +00:00
|
|
|
ref <- newIORef app
|
|
|
|
tid <- forkIO
|
|
|
|
(runSettings
|
|
|
|
(setPort port defaultSettings)
|
2014-07-21 10:35:53 +00:00
|
|
|
(\req cont ->
|
2014-05-30 12:59:48 +00:00
|
|
|
do handler <- readIORef ref
|
2014-07-21 10:35:53 +00:00
|
|
|
handler req cont))
|
2014-05-30 12:59:48 +00:00
|
|
|
_ <- newStore tid
|
|
|
|
ref' <- newStore ref
|
|
|
|
_ <- newStore c
|
|
|
|
return ref'
|
|
|
|
|
|
|
|
-- | Update the server, start it if not running.
|
|
|
|
update :: IO (Store (IORef Application))
|
|
|
|
update =
|
|
|
|
do m <- lookupStore 1
|
|
|
|
case m of
|
|
|
|
Nothing -> main
|
|
|
|
Just store ->
|
|
|
|
do ref <- readStore store
|
|
|
|
c <- readStore (Store 2)
|
|
|
|
writeChan c ()
|
|
|
|
s <- static "static"
|
2014-06-01 10:55:57 +00:00
|
|
|
(port,app) <- getApplicationDev True
|
2014-05-30 12:59:48 +00:00
|
|
|
writeIORef ref app
|
|
|
|
return store
|