@@ -36,29 +36,26 @@ run :: Port -> ModuleName -> FunctionName -> IO ()
3636run port modu func = do
3737 queue <- C.newChan
3838 mqueue <- M.newMVar queue
39− mmqueue <- M.newMVar mqueue
40− startApp mqueue $ loadingApp Nothing
41− _ <- forkIO $ fillApp modu func mmqueue
42− run' port queue
39+ startApp queue $ loadingApp Nothing
40+ _ <- forkIO $ fillApp modu func mqueue
41+ run' port mqueue
4342
44−startApp :: M.MVar Queue -> Handler -> IO ()
45−startApp mqueue withApp =
43+startApp :: Queue -> Handler -> IO ()
44+startApp queue withApp = do
4645 forkIO (withApp go) >> return ()
4746 where
4847 go app = do
49− queue' <- M.tryTakeMVar mqueue
50− case queue' of
48+ msession <- C.readChan queue
49+ case msession of
5150 Nothing -> return ()
52− Just queue -> do
53− M.putMVar mqueue queue
54− (req, onRes) <- C.readChan queue
51+ Just (req, onRes) -> do
5552 res <- app req
5653 -- FIXME exceptions?
5754 onRes res
5855 go app
5956
60−fillApp :: String -> String -> M.MVar (M.MVar Queue) -> IO ()
61−fillApp modu func mmqueue =
57+fillApp :: String -> String -> M.MVar Queue -> IO ()
58+fillApp modu func mqueue =
6259 go Nothing []
6360 where
6461 go prevError prevFiles = do
@@ -76,35 +73,35 @@ fillApp modu func mmqueue =
7673 go newError newFiles
7774 reload prevError = do
7875 putStrLn "Attempting to interpret your app..."
79− loadingApp' prevError mmqueue
76+ loadingApp' prevError mqueue
8077 res <- theapp modu func
8178 case res of
8279 Left err -> do
8380 putStrLn $ "Compile failed: " ++ show err
84− loadingApp' (Just $ toException err) mmqueue
81+ loadingApp' (Just $ toException err) mqueue
8582 return (Just $ toException err, [])
8683 Right (app, files) -> do
8784 putStrLn "Interpreting success, new app loaded"
8885 handle onInitErr $ do
89− swapApp app mmqueue
86+ swapApp app mqueue
9087 files' <- forM files $ \f -> do
9188 t <- getModificationTime f
9289 return (f, t)
9390 return (Nothing, files')
9491 onInitErr e = do
9592 putStrLn $ "Error initializing application: " ++ show e
96− loadingApp' (Just e) mmqueue
93+ loadingApp' (Just e) mqueue
9794 return (Just e, [])
9895
99−loadingApp' :: Maybe SomeException -> M.MVar (M.MVar Queue) -> IO ()
100−loadingApp' err mmqueue = swapApp (loadingApp err) mmqueue
96+loadingApp' :: Maybe SomeException -> M.MVar Queue -> IO ()
97+loadingApp' err mqueue = swapApp (loadingApp err) mqueue
10198
102−swapApp app mmqueue = do
103− oldmqueue <- M.takeMVar mmqueue
104− queue <- M.takeMVar oldmqueue
105− mqueue <- M.newMVar queue
106− M.putMVar mmqueue mqueue
107− startApp mqueue app
99+swapApp app mqueue = do
100+ oldqueue <- M.takeMVar mqueue
101+ C.writeChan oldqueue Nothing
102+ queue <- C.newChan
103+ M.putMVar mqueue queue
104+ startApp queue app
108105
109106loadingApp :: Maybe SomeException -> Handler
110107loadingApp err f =
@@ -132,7 +129,7 @@ theapp modu func =
132129 toSlash '.' = '/'
133130 toSlash c = c
134131
135−run' :: Port -> Queue -> IO ()
132+run' :: Port -> M.MVar Queue -> IO ()
136133run' port = withSocketsDo .
137134 bracket
138135 (listenOn $ PortNumber $ fromIntegral port)
@@ -140,22 +137,23 @@ run' port = withSocketsDo .
140137 serveConnections port
141138type Port = Int
142139
143−serveConnections :: Port -> Queue -> Socket -> IO ()
144−serveConnections port queue socket = do
140+serveConnections :: Port -> M.MVar Queue -> Socket -> IO ()
141+serveConnections port mqueue socket = do
145142 (conn, remoteHost', _) <- accept socket
146− _ <- forkIO $ serveConnection port queue conn remoteHost'
147− serveConnections port queue socket
143+ _ <- forkIO $ serveConnection port mqueue conn remoteHost'
144+ serveConnections port mqueue socket
148145
149−type Queue = C.Chan (Request, Response -> IO ())
146+type Queue = C.Chan (Maybe (Request, Response -> IO ()))
150147
151−serveConnection :: Port -> Queue -> Handle -> String -> IO ()
152−serveConnection port queue conn remoteHost' = do
148+serveConnection :: Port -> M.MVar Queue -> Handle -> String -> IO ()
149+serveConnection port mqueue conn remoteHost' = do
153150 env <- hParseRequest port conn remoteHost'
154151 let onRes res =
155152 finally
156153 (sendResponse (httpVersion env) conn res)
157154 (hClose conn)
158− C.writeChan queue (env, onRes)
155+ queue <- M.readMVar mqueue
156+ C.writeChan queue $ Just (env, onRes)
159157
160158hParseRequest :: Port -> Handle -> String -> IO Request
161159hParseRequest port conn remoteHost' = do