@@ -25,7 +25,7 @@ import Data.Typeable (Typeable)
2525
2626import Network.Socket.SendFile
2727import Control.Arrow (first)
28−import Control.Concurrent.MVar as M
28+import qualified Control.Concurrent.MVar as M
2929import System.Directory (getModificationTime)
3030
3131type FunctionName = String
@@ -36,7 +36,7 @@ run port modu func = do
3636 _ <- forkIO $ fillApp modu func app
3737 run' port app
3838
39−fillApp :: String -> String -> MVar Handler -> IO ()
39+fillApp :: String -> String -> M.MVar Application -> IO ()
4040fillApp modu func mapp =
4141 go Nothing []
4242 where
@@ -55,25 +55,27 @@ fillApp modu func mapp =
5555 go newError newFiles
5656 reload prevError = do
5757 putStrLn "Attempting to interpret your app..."
58− _ <- swapMVar mapp $ loadingApp prevError
58+ _ <- M.swapMVar mapp $ loadingApp prevError
5959 res <- theapp modu func
6060 case res of
6161 Left err -> do
6262 putStrLn $ "Compile failed: " ++ show err
63− _ <- swapMVar mapp $ loadingApp $ Just err
63+ _ <- M.swapMVar mapp $ loadingApp $ Just err
6464 return (Just err, [])
6565 Right (app, files) -> do
6666 putStrLn "Interpreting success, new app loaded"
67− _ <- swapMVar mapp app
67+ app $ \app' -> (forkIO $ do
68+ _ <- M.swapMVar mapp app'
69+ return ()) >> return ()
6870 files' <- forM files $ \f -> do
6971 t <- getModificationTime f
7072 return (f, t)
7173 return (Nothing, files')
7274
7375
74−loadingApp :: Maybe InterpreterError -> Handler
75−loadingApp err f =
76− f $ const $ return $ Response status200
76+loadingApp :: Maybe InterpreterError -> Application
77+loadingApp err _ =
78+ return $ Response status200
7779 [ ("Content-Type", "text/plain")
7880 , ("Refresh", "1")
7981 ] $ ResponseLBS $ L8.pack $ toMessage err
@@ -82,7 +84,7 @@ loadingApp err f =
8284 toMessage (Just err') = "Error loading code: " ++ show err'
8385
8486type Handler = (Application -> IO ()) -> IO ()
85−type MHandler = M.MVar Handler
87+type MHandler = M.MVar Application
8688
8789theapp :: String -> String -> IO (Either InterpreterError (Handler, [FilePath]))
8890theapp modu func =
@@ -119,10 +121,12 @@ serveConnection port handler conn remoteHost' =
119121 where
120122 serveConnection' = do
121123 env <- hParseRequest port conn remoteHost'
122− handler' <- M.readMVar handler
123− handler' $ \app -> do
124− res <- app env
125− sendResponse (httpVersion env) conn res
124+ putStrLn "reading handler"
125+ app <- M.readMVar handler
126+ putStrLn "done reading handler"
127+ res <- app env
128+ putStrLn "got result"
129+ sendResponse (httpVersion env) conn res
126130
127131hParseRequest :: Port -> Handle -> String -> IO Request
128132hParseRequest port conn remoteHost' = do