mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-12 07:18:31 +01:00
59 lines
2.0 KiB
Diff
59 lines
2.0 KiB
Diff
diff -ru orig/src/General/Web.hs new/src/General/Web.hs
|
|
--- orig/src/General/Web.hs 2014-06-09 15:25:38.583521732 +0300
|
|
+++ new/src/General/Web.hs 2014-06-09 15:25:38.000000000 +0300
|
|
@@ -21,6 +21,9 @@
|
|
import General.Base
|
|
import System.FilePath
|
|
import Network.Wai
|
|
+#if MIN_VERSION_wai(3, 0, 0)
|
|
+import Data.IORef
|
|
+#endif
|
|
#if MIN_VERSION_wai(2, 0, 0)
|
|
import Network.Wai.Internal
|
|
#endif
|
|
@@ -46,7 +49,15 @@
|
|
|
|
responseFlatten :: Response -> IO (Status, ResponseHeaders, LBString)
|
|
responseFlatten r = do
|
|
-#if MIN_VERSION_wai(2, 0, 0)
|
|
+#if MIN_VERSION_wai(3, 0, 0)
|
|
+ let (s,hs,withBody) = responseToStream r
|
|
+ ref <- newIORef mempty
|
|
+ let addChunk builder = modifyIORef ref (<> builder)
|
|
+ withBody $ \body -> body addChunk (return ())
|
|
+ builder <- readIORef ref
|
|
+ let res = toLazyByteString builder
|
|
+ return (s,hs,res)
|
|
+#elif MIN_VERSION_wai(2, 0, 0)
|
|
let (s,hs,withSrc) = responseToSource r
|
|
chunks <- withSrc $ \src -> src $$ consume
|
|
let res = toLazyByteString $ mconcat [x | Chunk x <- chunks]
|
|
diff -ru orig/src/Web/Server.hs new/src/Web/Server.hs
|
|
--- orig/src/Web/Server.hs 2014-06-09 15:25:38.575521732 +0300
|
|
+++ new/src/Web/Server.hs 2014-06-09 15:25:38.000000000 +0300
|
|
@@ -32,14 +32,23 @@
|
|
resp <- respArgs q
|
|
v <- newMVar ()
|
|
putStrLn $ "Starting Hoogle Server on port " ++ show port
|
|
- runSettings defaultSettings{settingsOnException=exception, settingsPort=port} $ \r -> liftIO $ do
|
|
+ runSettings defaultSettings{settingsOnException=exception, settingsPort=port}
|
|
+#if MIN_VERSION_wai(3, 0, 0)
|
|
+ $ \r sendResponse -> do
|
|
+#else
|
|
+ $ \r -> liftIO $ do
|
|
+#endif
|
|
start <- getCurrentTime
|
|
res <- talk resp q r
|
|
responseEvaluate res
|
|
stop <- getCurrentTime
|
|
let t = floor $ diffUTCTime stop start * 1000
|
|
withMVar v $ const $ putStrLn $ bsUnpack (rawPathInfo r) ++ bsUnpack (rawQueryString r) ++ " ms:" ++ show t
|
|
+#if MIN_VERSION_wai(3, 0, 0)
|
|
+ sendResponse res
|
|
+#else
|
|
return res
|
|
+#endif
|
|
|
|
|
|
#if MIN_VERSION_wai(2, 0, 0)
|