wai-handler-devel 0.0.0 → 0.0.1
raw patch · 3 files changed
+75/−36 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Network/Wai/Handler/DevelServer.hs +65/−34
- wai-handler-devel.cabal +1/−1
- wai-handler-devel.hs +9/−1
Network/Wai/Handler/DevelServer.hs view
@@ -15,7 +15,8 @@ import Network ( listenOn, accept, sClose, PortID(PortNumber), Socket , withSocketsDo)-import Control.Exception (bracket, finally, Exception, throwIO)+import Control.Exception (bracket, finally, Exception, throwIO,+ handle, SomeException, toException) import System.IO (Handle, hClose) import Control.Concurrent (forkIO, threadDelay) import Control.Monad (unless, forM)@@ -25,19 +26,36 @@ import Network.Socket.SendFile import Control.Arrow (first)-import Control.Concurrent.MVar as M+import qualified Control.Concurrent.MVar as M+import qualified Control.Concurrent.Chan as C import System.Directory (getModificationTime) type FunctionName = String run :: Port -> ModuleName -> FunctionName -> IO () run port modu func = do- app <- M.newMVar $ loadingApp Nothing- _ <- forkIO $ fillApp modu func app- run' port app+ queue <- C.newChan+ mqueue <- M.newMVar queue+ startApp queue $ loadingApp Nothing+ _ <- forkIO $ fillApp modu func mqueue+ run' port mqueue -fillApp :: String -> String -> MVar Handler -> IO ()-fillApp modu func mapp =+startApp :: Queue -> Handler -> IO ()+startApp queue withApp = do+ forkIO (withApp go) >> return ()+ where+ go app = do+ msession <- C.readChan queue+ case msession of+ Nothing -> return ()+ Just (req, onRes) -> do+ res <- app req+ -- FIXME exceptions?+ onRes res+ go app++fillApp :: String -> String -> M.MVar Queue -> IO ()+fillApp modu func mqueue = go Nothing [] where go prevError prevFiles = do@@ -55,23 +73,37 @@ go newError newFiles reload prevError = do putStrLn "Attempting to interpret your app..."- _ <- swapMVar mapp $ loadingApp prevError+ loadingApp' prevError mqueue res <- theapp modu func case res of Left err -> do putStrLn $ "Compile failed: " ++ show err- _ <- swapMVar mapp $ loadingApp $ Just err- return (Just err, [])+ loadingApp' (Just $ toException err) mqueue+ return (Just $ toException err, []) Right (app, files) -> do putStrLn "Interpreting success, new app loaded"- _ <- swapMVar mapp app- files' <- forM files $ \f -> do- t <- getModificationTime f- return (f, t)- return (Nothing, files')+ handle onInitErr $ do+ swapApp app mqueue+ files' <- forM files $ \f -> do+ t <- getModificationTime f+ return (f, t)+ return (Nothing, files')+ onInitErr e = do+ putStrLn $ "Error initializing application: " ++ show e+ loadingApp' (Just e) mqueue+ return (Just e, []) +loadingApp' :: Maybe SomeException -> M.MVar Queue -> IO ()+loadingApp' err mqueue = swapApp (loadingApp err) mqueue -loadingApp :: Maybe InterpreterError -> Handler+swapApp app mqueue = do+ oldqueue <- M.takeMVar mqueue+ C.writeChan oldqueue Nothing+ queue <- C.newChan+ M.putMVar mqueue queue+ startApp queue app++loadingApp :: Maybe SomeException -> Handler loadingApp err f = f $ const $ return $ Response status200 [ ("Content-Type", "text/plain")@@ -82,7 +114,7 @@ toMessage (Just err') = "Error loading code: " ++ show err' type Handler = (Application -> IO ()) -> IO ()-type MHandler = M.MVar Handler+type MHandler = M.MVar Application theapp :: String -> String -> IO (Either InterpreterError (Handler, [FilePath])) theapp modu func =@@ -97,7 +129,7 @@ toSlash '.' = '/' toSlash c = c -run' :: Port -> MHandler -> IO ()+run' :: Port -> M.MVar Queue -> IO () run' port = withSocketsDo . bracket (listenOn $ PortNumber $ fromIntegral port)@@ -105,24 +137,23 @@ serveConnections port type Port = Int -serveConnections :: Port -> MHandler -> Socket -> IO ()-serveConnections port app socket = do+serveConnections :: Port -> M.MVar Queue -> Socket -> IO ()+serveConnections port mqueue socket = do (conn, remoteHost', _) <- accept socket- _ <- forkIO $ serveConnection port app conn remoteHost'- serveConnections port app socket+ _ <- forkIO $ serveConnection port mqueue conn remoteHost'+ serveConnections port mqueue socket -serveConnection :: Port -> MHandler -> Handle -> String -> IO ()-serveConnection port handler conn remoteHost' =- finally- serveConnection'- (hClose conn)- where- serveConnection' = do- env <- hParseRequest port conn remoteHost'- handler' <- M.readMVar handler- handler' $ \app -> do- res <- app env- sendResponse (httpVersion env) conn res+type Queue = C.Chan (Maybe (Request, Response -> IO ()))++serveConnection :: Port -> M.MVar Queue -> Handle -> String -> IO ()+serveConnection port mqueue conn remoteHost' = do+ env <- hParseRequest port conn remoteHost'+ let onRes res =+ finally+ (sendResponse (httpVersion env) conn res)+ (hClose conn)+ queue <- M.readMVar mqueue+ C.writeChan queue $ Just (env, onRes) hParseRequest :: Port -> Handle -> String -> IO Request hParseRequest port conn remoteHost' = do
wai-handler-devel.cabal view
@@ -1,5 +1,5 @@ Name: wai-handler-devel-Version: 0.0.0+Version: 0.0.1 Synopsis: WAI server that automatically reloads code after modification. Description: This handler automatically reloads your source code upon any changes. It works by using the hint package, essentially embedding GHC inside the handler. The handler (both the executable and library) takes three arguments: the port to listen on, the module name containing the application function, and the name of the function. .
wai-handler-devel.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} import Network.Wai.Handler.DevelServer (run) import System.Console.CmdArgs+import Control.Concurrent (forkIO) data Devel = Devel { port :: Int@@ -16,4 +17,11 @@ , moduleName = "" &= argPos 1 &= typ "MODULE" , function = "" &= argPos 2 &= typ "FUNCTION" } &= summary "WAI development web server"- run p m f+ forkIO $ run p m f+ go+ where+ go = do+ x <- getLine+ case x of+ 'q':_ -> putStrLn "Quitting, goodbye!"+ _ -> go