mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-12 15:28:29 +01:00
73 lines
2.1 KiB
Diff
73 lines
2.1 KiB
Diff
diff -ru orig/src/General/Web.hs new/src/General/Web.hs
|
|
--- orig/src/General/Web.hs 2013-12-04 19:36:25.387122831 +0200
|
|
+++ new/src/General/Web.hs 2013-12-04 19:36:25.000000000 +0200
|
|
@@ -1,3 +1,4 @@
|
|
+{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE PatternGuards #-}
|
|
|
|
{- |
|
|
@@ -15,6 +16,9 @@
|
|
import General.System
|
|
import General.Base
|
|
import Network.Wai
|
|
+#if MIN_VERSION_wai(2, 0, 0)
|
|
+import Network.Wai.Internal
|
|
+#endif
|
|
import Network.HTTP.Types
|
|
import Data.CaseInsensitive(original)
|
|
import qualified Data.ByteString.Lazy.Char8 as LBS
|
|
@@ -34,10 +38,17 @@
|
|
|
|
responseFlatten :: Response -> IO (Status, ResponseHeaders, LBString)
|
|
responseFlatten r = do
|
|
+#if 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]
|
|
+ return (s,hs,res)
|
|
+#else
|
|
let (s,hs,rest) = responseSource r
|
|
chunks <- runResourceT $ rest $$ consume
|
|
let res = toLazyByteString $ mconcat [x | Chunk x <- chunks]
|
|
return (s,hs,res)
|
|
+#endif
|
|
|
|
|
|
responseEvaluate :: Response -> IO ()
|
|
diff -ru orig/src/Web/Server.hs new/src/Web/Server.hs
|
|
--- orig/src/Web/Server.hs 2013-12-04 19:36:25.379122832 +0200
|
|
+++ new/src/Web/Server.hs 2013-12-04 19:36:25.000000000 +0200
|
|
@@ -1,4 +1,4 @@
|
|
-{-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards #-}
|
|
+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards, CPP #-}
|
|
|
|
module Web.Server(server) where
|
|
|
|
@@ -16,6 +16,9 @@
|
|
import Data.Time.Clock
|
|
|
|
import Network.Wai
|
|
+#if MIN_VERSION_wai(2, 0, 0)
|
|
+import Network.Wai.Internal
|
|
+#endif
|
|
import Network.Wai.Handler.Warp
|
|
|
|
|
|
@@ -34,9 +37,15 @@
|
|
return res
|
|
|
|
|
|
+#if MIN_VERSION_wai(2, 0, 0)
|
|
+exception :: Maybe Request -> SomeException -> IO ()
|
|
+exception _ e | Just (_ :: InvalidRequest) <- fromException e = return ()
|
|
+ | otherwise = putStrLn $ "Error: " ++ show e
|
|
+#else
|
|
exception :: SomeException -> IO ()
|
|
exception e | Just (_ :: InvalidRequest) <- fromException e = return ()
|
|
| otherwise = putStrLn $ "Error: " ++ show e
|
|
+#endif
|
|
|
|
|
|
respArgs :: CmdLine -> IO (IO ResponseArgs)
|
|
Only in orig: test
|