1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
--- HTTP-4000.2.3-orig/HTTP.cabal 2012-04-13 06:39:31.000000000 +1000
+++ HTTP-4000.2.3/HTTP.cabal 2012-09-12 21:08:30.027554352 +1000
@@ -77,7 +77,7 @@
Network.HTTP.Utils
Paths_HTTP
GHC-options: -fwarn-missing-signatures -Wall
- Build-depends: base >= 2 && < 4.6, network, parsec
+ Build-depends: base >= 2 && < 5.0, network, parsec
Extensions: FlexibleInstances
if flag(old-base)
Build-depends: base < 3
@@ -95,7 +95,7 @@
Test-Suite test
type: exitcode-stdio-1.0
- build-tools: ghc >= 6.10 && < 7.6
+ build-tools: ghc >= 6.10 && < 8.0
hs-source-dirs: test
main-is: httpTests.hs
@@ -103,7 +103,7 @@
build-depends: HTTP,
HUnit,
httpd-shed,
- base >= 2 && < 4.6,
+ base >= 2 && < 5.0,
network,
split >= 0.1 && < 0.2,
test-framework,
--- HTTP-4000.2.3-orig/Network/HTTP/Base.hs 2012-04-13 06:39:31.000000000 +1000
+++ HTTP-4000.2.3/Network/HTTP/Base.hs 2012-09-12 21:44:26.218546007 +1000
@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module : Network.HTTP.Base
@@ -105,6 +106,7 @@
, parseURIReference
)
+import Control.Exception ( catch )
import Control.Monad ( guard )
import Control.Monad.Error ()
import Data.Char ( digitToInt, intToDigit, toLower, isDigit,
@@ -886,10 +888,10 @@
-- | @catchIO a h@ handles IO action exceptions throughout codebase; version-specific
-- tweaks better go here.
catchIO :: IO a -> (IOException -> IO a) -> IO a
-catchIO a h = Prelude.catch a h
+catchIO a h = Control.Exception.catch a h
catchIO_ :: IO a -> IO a -> IO a
-catchIO_ a h = Prelude.catch a (const h)
+catchIO_ a h = Control.Exception.catch a (\(_ :: IOException) -> h)
responseParseError :: String -> String -> Result a
responseParseError loc v = failWith (ErrorParse (loc ++ ' ':v))
--- HTTP-4000.2.3-orig/Network/TCP.hs 2012-04-13 06:39:31.000000000 +1000
+++ HTTP-4000.2.3/Network/TCP.hs 2012-09-12 21:51:35.633839689 +1000
@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
@@ -57,6 +58,7 @@
import Data.Char ( toLower )
import Data.Word ( Word8 )
+import qualified Control.Exception ( catch, IOException )
import Control.Concurrent
import Control.Monad ( liftM, when )
import System.IO ( Handle, hFlush, IOMode(..), hClose )
@@ -302,7 +304,7 @@
ConnClosed -> print "aa" >> return False
_
| connEndPoint v == endPoint ->
- catch (getPeerName (connSock v) >> return True) (const $ return False)
+ Control.Exception.catch (getPeerName (connSock v) >> return True) (\(_:: Control.Exception.IOException) -> return False)
| otherwise -> return False
isTCPConnectedTo :: HandleStream ty -> EndPoint -> IO Bool
@@ -312,7 +314,7 @@
ConnClosed -> return False
_
| connEndPoint v == endPoint ->
- catch (getPeerName (connSock v) >> return True) (const $ return False)
+ Control.Exception.catch (getPeerName (connSock v) >> return True) (\(_:: Control.Exception.IOException) -> return False)
| otherwise -> return False
readBlockBS :: HStream a => HandleStream a -> Int -> IO (Result a)
@@ -364,18 +366,18 @@
modifyMVar_ (getRef ref) (\ co -> return co{connInput=Just b})
return (return a)
_ -> do
- Prelude.catch (buf_hGet (connBuffer conn) (connHandle conn) n >>= return.return)
+ Control.Exception.catch (buf_hGet (connBuffer conn) (connHandle conn) n >>= return.return)
(\ e ->
if isEOFError e
then do
- when (connCloseEOF conn) $ catch (closeQuick ref) (\ _ -> return ())
+ when (connCloseEOF conn) $ Control.Exception.catch (closeQuick ref) (\ (_ :: Control.Exception.IOException) -> return ())
return (return (buf_empty (connBuffer conn)))
else return (failMisc (show e)))
bufferPutBlock :: BufferOp a -> Handle -> a -> IO (Result ())
bufferPutBlock ops h b =
- Prelude.catch (buf_hPut ops h b >> hFlush h >> return (return ()))
- (\ e -> return (failMisc (show e)))
+ Control.Exception.catch (buf_hPut ops h b >> hFlush h >> return (return ()))
+ (\ (e :: Control.Exception.IOException) -> return (failMisc (show e)))
bufferReadLine :: HStream a => HandleStream a -> IO (Result a)
bufferReadLine ref = onNonClosedDo ref $ \ conn -> do
@@ -385,13 +387,13 @@
let (newl,b1) = buf_splitAt (connBuffer conn) 1 b0
modifyMVar_ (getRef ref) (\ co -> return co{connInput=Just b1})
return (return (buf_append (connBuffer conn) a newl))
- _ -> Prelude.catch
+ _ -> Control.Exception.catch
(buf_hGetLine (connBuffer conn) (connHandle conn) >>=
return . return . appendNL (connBuffer conn))
(\ e ->
if isEOFError e
then do
- when (connCloseEOF conn) $ catch (closeQuick ref) (\ _ -> return ())
+ when (connCloseEOF conn) $ Control.Exception.catch (closeQuick ref) (\ (_ :: Control.Exception.IOException) -> return ())
return (return (buf_empty (connBuffer conn)))
else return (failMisc (show e)))
where
--- HTTP-4000.2.3-orig/Network/StreamSocket.hs 2012-04-13 06:39:31.000000000 +1000
+++ HTTP-4000.2.3/Network/StreamSocket.hs 2012-09-12 22:27:16.119222147 +1000
@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
@@ -36,7 +37,7 @@
import Network.HTTP.Base ( catchIO )
import Control.Monad (liftM)
import Control.Exception as Exception (IOException)
-import System.IO.Error (catch, isEOFError)
+import System.IO.Error (isEOFError)
-- | Exception handler for socket operations.
handleSocketError :: Socket -> IOException -> IO (Result a)
@@ -50,7 +51,7 @@
myrecv :: Socket -> Int -> IO String
myrecv sock len =
let handler e = if isEOFError e then return [] else ioError e
- in System.IO.Error.catch (recv sock len) handler
+ in catchIO (recv sock len) handler
instance Stream Socket where
readBlock sk n = readBlockSocket sk n
|
GitWeb