d77c950 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

WAI 0.3

d77c950Michael Snoyman16 years ago

Network/Wai/Handler/DevelServer.hs+16−8

compare with master

unifiedsplit

@@ -21,7 +21,7 @@ import Control.Concurrent (forkIO, threadDelay)

21import qualified Control.Concurrent.MVar as M

22import qualified Control.Concurrent.Chan as C

23import System.Directory (getModificationTime)

24−import Network.Wai.Handler.SimpleServer (parseRequest, sendResponse)

24+import Network.Wai.Handler.Warp (parseRequest, sendResponse, drainRequestBody)

25import Control.Monad (filterM)

27import Control.Arrow ((&&&))

@@ -62,8 +62,10 @@ startApp queue withApp = do

62 go app

63 onErr :: SomeException -> IO Response

64 onErr e = return

65+ $ responseLBS

66+ status500

65− $ Response status500 [("Content-Type", "text/plain; charset=utf-8")]

67+ [("Content-Type", "text/plain; charset=utf-8")]

66− $ ResponseLBS $ encodeUtf8 $ pack

68+ $ charsToLBS

67 $ "Exception thrown while running application\n\n" ++ show e

69 $ "Exception thrown while running application\n\n" ++ show e

68 void x = x >> return ()

70 void x = x >> return ()

@@ -155,15 +157,18 @@ swapApp app mqueue = do

155

157

156loadingApp :: Maybe SomeException -> Handler

158loadingApp :: Maybe SomeException -> Handler

157loadingApp err f =

159loadingApp err f =

158− f $ const $ return $ Response status200

160+ f $ const $ return $ responseLBS status200

159 ( ("Content-Type", "text/plain")

161 ( ("Content-Type", "text/plain")

160 : case err of

162 : case err of

161 Nothing -> [("Refresh", "1")]

163 Nothing -> [("Refresh", "1")]

162 Just _ -> []

164 Just _ -> []

163− ) $ ResponseLBS $ L8.pack $ toMessage err

165+ ) $ toMessage err

164 where

166 where

165 toMessage Nothing = "Loading code changes, please wait"

167 toMessage Nothing = "Loading code changes, please wait"

166− toMessage (Just err') = "Error loading code: " ++ show err'

168+ toMessage (Just err') = charsToLBS $ "Error loading code: " ++ show err'

169+

170+charsToLBS :: String -> L8.ByteString

171+charsToLBS = encodeUtf8 . pack

167

172

168type Handler = (Application -> IO ()) -> IO ()

173type Handler = (Application -> IO ()) -> IO ()

169

174

@@ -198,10 +203,13 @@ type Queue = C.Chan (Maybe (Request, Response -> IO ()))

198

203

199serveConnection :: Port -> M.MVar Queue -> Handle -> String -> IO ()

204serveConnection :: Port -> M.MVar Queue -> Handle -> String -> IO ()

200serveConnection port mqueue conn remoteHost' = do

205serveConnection port mqueue conn remoteHost' = do

201− env <- parseRequest port conn remoteHost'

206+ (ilen, env) <- parseRequest port conn remoteHost'

202 let onRes res =

207 let onRes res =

203 finally

208 finally

209+ (do

204− (sendResponse (httpVersion env) conn res)

210+ _ <- sendResponse env (httpVersion env) conn res

211+ drainRequestBody conn ilen

212+ return ())

205 (hClose conn)

213 (hClose conn)

206 queue <- M.readMVar mqueue

214 queue <- M.readMVar mqueue

207 C.writeChan queue $ Just (env, onRes)

215 C.writeChan queue $ Just (env, onRes)

wai-handler-devel.cabal+3−3

@@ -1,5 +1,5 @@

1Name: wai-handler-devel

2−Version: 0.1.1.2

2+Version: 0.2.0

3Synopsis: WAI server that automatically reloads code after modification.

4Description: 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.

5 .

@@ -22,8 +22,8 @@ Source-repository head

23Library

24 Build-Depends: base >= 4 && < 5

25− , wai >= 0.2.1 && < 0.3

25+ , wai >= 0.3 && < 0.4

26− , wai-extra >= 0.2.3 && < 0.3

26+ , warp >= 0.3 && < 0.4

27 , directory >= 1.0 && < 1.2

28 , network >= 2.2 && < 2.4

29 , bytestring >= 0.9 && < 0.10