haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-01-12 15:28:29 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity
d39ab9400b
stackage/patching/patches/aws-0.8.6.patch
Michael Snoyman 912c03232c GHC 7.4 patches
2014-04-04 10:18:35 +03:00

597 lines
29 KiB
Diff
Raw Blame History

diff -ru orig/Aws/Aws.hs new/Aws/Aws.hs
--- orig/Aws/Aws.hs 2014-04-04 10:18:25.108401067 +0300
+++ new/Aws/Aws.hs 2014-04-04 10:18:24.000000000 +0300
@@ -33,7 +33,6 @@
import Control.Monad.IO.Class
import Control.Monad.Trans
import Control.Monad.Trans.Resource
-import Data.Attempt (Attempt(Success, Failure))
import qualified Data.ByteString as B
import qualified Data.CaseInsensitive as CI
import qualified Data.Conduit as C
@@ -185,11 +184,8 @@
unsafeAws cfg scfg manager request = do
metadataRef <- liftIO $ newIORef mempty
- let catchAll :: ResourceT IO a -> ResourceT IO (Attempt a)
- catchAll = E.handle (return . failure') . fmap Success
-
- failure' :: E.SomeException -> Attempt a
- failure' = Failure
+ let catchAll :: ResourceT IO a -> ResourceT IO (Either E.SomeException a)
+ catchAll = E.handle (return . Left) . fmap Right
resp <- catchAll $
unsafeAwsRef cfg scfg manager metadataRef request
@@ -268,8 +264,8 @@
where go request = do resp <- lift $ aws cfg scfg manager request
C.yield resp
case responseResult resp of
- Failure _ -> return ()
- Success x ->
+ Left _ -> return ()
+ Right x ->
case nextIteratedRequest request x of
Nothing -> return ()
Just nextRequest -> go nextRequest
diff -ru orig/Aws/Core.hs new/Aws/Core.hs
--- orig/Aws/Core.hs 2014-04-04 10:18:25.108401067 +0300
+++ new/Aws/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -89,13 +89,12 @@
import Control.Applicative
import Control.Arrow
import qualified Control.Exception as E
-import qualified Control.Failure as F
import Control.Monad
import Control.Monad.IO.Class
+import Control.Monad.Trans.Resource (ResourceT, MonadThrow (throwM))
import qualified Crypto.Classes as Crypto
import qualified Crypto.HMAC as HMAC
import Crypto.Hash.CryptoAPI (MD5, SHA1, SHA256, hash')
-import Data.Attempt (Attempt(..), FromAttempt(..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as Base16
@@ -104,7 +103,7 @@
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.UTF8 as BU
import Data.Char
-import Data.Conduit (ResourceT, ($$+-))
+import Data.Conduit (($$+-))
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import Data.Default (def)
@@ -137,12 +136,12 @@
--
-- Response forms a Writer-like monad.
data Response m a = Response { responseMetadata :: m
- , responseResult :: Attempt a }
+ , responseResult :: Either E.SomeException a }
deriving (Show, Functor)
-- | Read a response result (if it's a success response, fail otherwise).
-readResponse :: FromAttempt f => Response m a -> f a
-readResponse = fromAttempt . responseResult
+readResponse :: MonadThrow n => Response m a -> n a
+readResponse = either throwM return . responseResult
-- | Read a response result (if it's a success response, fail otherwise). In MonadIO.
readResponseIO :: MonadIO io => Response m a -> io a
@@ -159,13 +158,13 @@
--multiResponse :: Monoid m => Response m a -> Response [m] a ->
instance Monoid m => Monad (Response m) where
- return x = Response mempty (Success x)
- Response m1 (Failure e) >>= _ = Response m1 (Failure e)
- Response m1 (Success x) >>= f = let Response m2 y = f x
+ return x = Response mempty (Right x)
+ Response m1 (Left e) >>= _ = Response m1 (Left e)
+ Response m1 (Right x) >>= f = let Response m2 y = f x
in Response (m1 `mappend` m2) y -- currently using First-semantics, Last SHOULD work too
-instance (Monoid m, E.Exception e) => F.Failure e (Response m) where
- failure e = Response mempty (F.failure e)
+instance Monoid m => MonadThrow (Response m) where
+ throwM e = Response mempty (throwM e)
-- | Add metadata to an 'IORef' (using 'mappend').
tellMetadataRef :: Monoid m => IORef m -> m -> IO ()
@@ -696,24 +695,24 @@
elCont name = laxElement name &/ content &| T.unpack
-- | Extract the first element from a parser result list, and throw an 'XmlException' if the list is empty.
-force :: F.Failure XmlException m => String -> [a] -> m a
+force :: MonadThrow m => String -> [a] -> m a
force = Cu.force . XmlException
-- | Extract the first element from a monadic parser result list, and throw an 'XmlException' if the list is empty.
-forceM :: F.Failure XmlException m => String -> [m a] -> m a
+forceM :: MonadThrow m => String -> [m a] -> m a
forceM = Cu.forceM . XmlException
-- | Read an integer from a 'T.Text', throwing an 'XmlException' on failure.
-textReadInt :: (F.Failure XmlException m, Num a) => T.Text -> m a
+textReadInt :: (MonadThrow m, Num a) => T.Text -> m a
textReadInt s = case reads $ T.unpack s of
[(n,"")] -> return $ fromInteger n
- _ -> F.failure $ XmlException "Invalid Integer"
+ _ -> throwM $ XmlException "Invalid Integer"
-- | Read an integer from a 'String', throwing an 'XmlException' on failure.
-readInt :: (F.Failure XmlException m, Num a) => String -> m a
+readInt :: (MonadThrow m, Num a) => String -> m a
readInt s = case reads s of
[(n,"")] -> return $ fromInteger n
- _ -> F.failure $ XmlException "Invalid Integer"
+ _ -> throwM $ XmlException "Invalid Integer"
-- | Create a complete 'HTTPResponseConsumer' from a simple function that takes a 'Cu.Cursor' to XML in the response
-- body.
@@ -731,5 +730,5 @@
let Response metadata x = parse cursor
liftIO $ tellMetadataRef metadataRef metadata
case x of
- Failure err -> liftIO $ C.monadThrow err
- Success v -> return v
+ Left err -> liftIO $ throwM err
+ Right v -> return v
diff -ru orig/Aws/DynamoDb/Core.hs new/Aws/DynamoDb/Core.hs
--- orig/Aws/DynamoDb/Core.hs 2014-04-04 10:18:25.108401067 +0300
+++ new/Aws/DynamoDb/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -2,6 +2,7 @@
import Aws.Core
import qualified Control.Exception as C
+import Control.Monad.Trans.Resource (throwM)
import Crypto.Hash.CryptoAPI (SHA256, hash)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
@@ -125,5 +126,5 @@
(HTTP.Status{HTTP.statusCode=200}) -> do
case A.fromJSON val of
A.Success a -> return a
- A.Error err -> monadThrow $ DyError (HTTP.responseStatus resp) "" err
- _ -> monadThrow $ DyError (HTTP.responseStatus resp) "" (show val)
+ A.Error err -> throwM $ DyError (HTTP.responseStatus resp) "" err
+ _ -> throwM $ DyError (HTTP.responseStatus resp) "" (show val)
diff -ru orig/Aws/Ec2/InstanceMetadata.hs new/Aws/Ec2/InstanceMetadata.hs
--- orig/Aws/Ec2/InstanceMetadata.hs 2014-04-04 10:18:25.112401067 +0300
+++ new/Aws/Ec2/InstanceMetadata.hs 2014-04-04 10:18:24.000000000 +0300
@@ -2,7 +2,7 @@
import Control.Applicative
import Control.Exception
-import Control.Failure
+import Control.Monad.Trans.Resource (throwM)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as B8
import Data.ByteString.Lazy.UTF8 as BU
@@ -25,7 +25,7 @@
getInstanceMetadataFirst :: HTTP.Manager -> String -> IO L.ByteString
getInstanceMetadataFirst mgr p = do listing <- getInstanceMetadataListing mgr p
case listing of
- [] -> failure (MetadataNotFound p)
+ [] -> throwM (MetadataNotFound p)
(x:_) -> getInstanceMetadata mgr p x
getInstanceMetadataOrFirst :: HTTP.Manager -> String -> Maybe String -> IO L.ByteString
diff -ru orig/Aws/Iam/Core.hs new/Aws/Iam/Core.hs
--- orig/Aws/Iam/Core.hs 2014-04-04 10:18:25.112401067 +0300
+++ new/Aws/Iam/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -19,8 +19,8 @@
import qualified Blaze.ByteString.Builder as Blaze
import qualified Blaze.ByteString.Builder.Char8 as Blaze8
import Control.Exception (Exception)
-import qualified Control.Failure as F
import Control.Monad
+import Control.Monad.Trans.Resource (MonadThrow, throwM)
import Data.ByteString (ByteString)
import Data.IORef
import Data.List (intersperse, sort)
@@ -152,13 +152,13 @@
fromError cursor = do
errCode <- force "Missing Error Code" $ cursor $// elContent "Code"
errMsg <- force "Missing Error Message" $ cursor $// elContent "Message"
- F.failure $ IamError (HTTP.responseStatus resp) errCode errMsg
+ throwM $ IamError (HTTP.responseStatus resp) errCode errMsg
-- | Parses IAM @DateTime@ data type.
-parseDateTime :: (F.Failure XmlException m) => String -> m UTCTime
+parseDateTime :: MonadThrow m => String -> m UTCTime
parseDateTime x
= case parseTime defaultTimeLocale iso8601UtcDate x of
- Nothing -> F.failure $ XmlException $ "Invalid DateTime: " ++ x
+ Nothing -> throwM $ XmlException $ "Invalid DateTime: " ++ x
Just dt -> return dt
-- | The IAM @User@ data type.
@@ -180,7 +180,7 @@
deriving (Eq, Ord, Show, Typeable)
-- | Parses the IAM @User@ data type.
-parseUser :: (F.Failure XmlException m) => Cu.Cursor -> m User
+parseUser :: MonadThrow m => Cu.Cursor -> m User
parseUser cursor = do
userArn <- attr "Arn"
userCreateDate <- attr "CreateDate" >>= parseDateTime . Text.unpack
diff -ru orig/Aws/Iam/Internal.hs new/Aws/Iam/Internal.hs
--- orig/Aws/Iam/Internal.hs 2014-04-04 10:18:25.112401067 +0300
+++ new/Aws/Iam/Internal.hs 2014-04-04 10:18:24.000000000 +0300
@@ -15,8 +15,8 @@
import Aws.Iam.Core
import Control.Applicative
import Control.Arrow (second)
-import qualified Control.Failure as F
import Control.Monad
+import Control.Monad.Trans.Resource (MonadThrow)
import Data.ByteString (ByteString)
import Data.Maybe
import Data.Monoid ((<>))
@@ -62,7 +62,7 @@
-- | Reads and returns the @IsTruncated@ and @Marker@ attributes present in
-- all IAM data pagination responses.
markedIterResponse
- :: F.Failure XmlException m
+ :: MonadThrow m
=> Cu.Cursor
-> m (Bool, Maybe Text)
markedIterResponse cursor = do
diff -ru orig/Aws/S3/Commands/CopyObject.hs new/Aws/S3/Commands/CopyObject.hs
--- orig/Aws/S3/Commands/CopyObject.hs 2014-04-04 10:18:25.112401067 +0300
+++ new/Aws/S3/Commands/CopyObject.hs 2014-04-04 10:18:24.000000000 +0300
@@ -5,7 +5,7 @@
import Aws.S3.Core
import Control.Applicative
import Control.Arrow (second)
-import Control.Failure
+import Control.Monad.Trans.Resource (throwM)
import qualified Data.CaseInsensitive as CI
import Data.Maybe
import qualified Data.Text as T
@@ -93,7 +93,7 @@
return $ CopyObjectResponse vid lastMod etag
where parse el = do
let parseHttpDate' x = case parseTime defaultTimeLocale iso8601UtcDate x of
- Nothing -> failure $ XmlException ("Invalid Last-Modified " ++ x)
+ Nothing -> throwM $ XmlException ("Invalid Last-Modified " ++ x)
Just y -> return y
lastMod <- forceM "Missing Last-Modified" $ el $/ elContent "LastModified" &| (parseHttpDate' . T.unpack)
etag <- force "Missing ETag" $ el $/ elContent "ETag"
diff -ru orig/Aws/S3/Core.hs new/Aws/S3/Core.hs
--- orig/Aws/S3/Core.hs 2014-04-04 10:18:25.112401067 +0300
+++ new/Aws/S3/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -5,8 +5,8 @@
import Control.Arrow ((***))
import Control.Monad
import Control.Monad.IO.Class
+import Control.Monad.Trans.Resource (MonadThrow, throwM)
import Crypto.Hash.CryptoAPI (MD5)
-import Data.Attempt (Attempt(..))
import Data.Conduit (($$+-))
import Data.Function
import Data.IORef
@@ -20,12 +20,10 @@
import qualified Blaze.ByteString.Builder as Blaze
import qualified Blaze.ByteString.Builder.Char8 as Blaze8
import qualified Control.Exception as C
-import qualified Control.Failure as F
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Base64 as Base64
import qualified Data.CaseInsensitive as CI
-import qualified Data.Conduit as C
import qualified Data.Serialize as Serialize
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
@@ -248,10 +246,10 @@
= do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def
let cursor = Cu.fromDocument doc
liftIO $ case parseError cursor of
- Success err -> C.monadThrow err
- Failure otherErr -> C.monadThrow otherErr
+ Right err -> throwM err
+ Left otherErr -> throwM otherErr
where
- parseError :: Cu.Cursor -> Attempt S3Error
+ parseError :: Cu.Cursor -> Either C.SomeException S3Error
parseError root = do code <- force "Missing error Code" $ root $/ elContent "Code"
message <- force "Missing error Message" $ root $/ elContent "Message"
let resource = listToMaybe $ root $/ elContent "Resource"
@@ -279,7 +277,7 @@
}
deriving (Show)
-parseUserInfo :: F.Failure XmlException m => Cu.Cursor -> m UserInfo
+parseUserInfo :: MonadThrow m => Cu.Cursor -> m UserInfo
parseUserInfo el = do id_ <- force "Missing user ID" $ el $/ elContent "ID"
displayName <- force "Missing user DisplayName" $ el $/ elContent "DisplayName"
return UserInfo { userId = id_, userDisplayName = displayName }
@@ -308,10 +306,10 @@
| ReducedRedundancy
deriving (Show)
-parseStorageClass :: F.Failure XmlException m => T.Text -> m StorageClass
+parseStorageClass :: MonadThrow m => T.Text -> m StorageClass
parseStorageClass "STANDARD" = return Standard
parseStorageClass "REDUCED_REDUNDANCY" = return ReducedRedundancy
-parseStorageClass s = F.failure . XmlException $ "Invalid Storage Class: " ++ T.unpack s
+parseStorageClass s = throwM . XmlException $ "Invalid Storage Class: " ++ T.unpack s
writeStorageClass :: StorageClass -> T.Text
writeStorageClass Standard = "STANDARD"
@@ -321,9 +319,9 @@
= AES256
deriving (Show)
-parseServerSideEncryption :: F.Failure XmlException m => T.Text -> m ServerSideEncryption
+parseServerSideEncryption :: MonadThrow m => T.Text -> m ServerSideEncryption
parseServerSideEncryption "AES256" = return AES256
-parseServerSideEncryption s = F.failure . XmlException $ "Invalid Server Side Encryption: " ++ T.unpack s
+parseServerSideEncryption s = throwM . XmlException $ "Invalid Server Side Encryption: " ++ T.unpack s
writeServerSideEncryption :: ServerSideEncryption -> T.Text
writeServerSideEncryption AES256 = "AES256"
@@ -358,11 +356,11 @@
}
deriving (Show)
-parseObjectInfo :: F.Failure XmlException m => Cu.Cursor -> m ObjectInfo
+parseObjectInfo :: MonadThrow m => Cu.Cursor -> m ObjectInfo
parseObjectInfo el
= do key <- force "Missing object Key" $ el $/ elContent "Key"
let time s = case parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" $ T.unpack s of
- Nothing -> F.failure $ XmlException "Invalid time"
+ Nothing -> throwM $ XmlException "Invalid time"
Just v -> return v
lastModified <- forceM "Missing object LastModified" $ el $/ elContent "LastModified" &| time
eTag <- force "Missing object ETag" $ el $/ elContent "ETag"
@@ -392,7 +390,7 @@
}
deriving (Show)
-parseObjectMetadata :: F.Failure HeaderException m => HTTP.ResponseHeaders -> m ObjectMetadata
+parseObjectMetadata :: MonadThrow m => HTTP.ResponseHeaders -> m ObjectMetadata
parseObjectMetadata h = ObjectMetadata
`liftM` deleteMarker
`ap` etag
@@ -406,15 +404,15 @@
Nothing -> return False
Just "true" -> return True
Just "false" -> return False
- Just x -> F.failure $ HeaderException ("Invalid x-amz-delete-marker " ++ x)
+ Just x -> throwM $ HeaderException ("Invalid x-amz-delete-marker " ++ x)
etag = case T.decodeUtf8 `fmap` lookup "ETag" h of
Just x -> return x
- Nothing -> F.failure $ HeaderException "ETag missing"
+ Nothing -> throwM $ HeaderException "ETag missing"
lastModified = case B8.unpack `fmap` lookup "Last-Modified" h of
Just ts -> case parseHttpDate ts of
Just t -> return t
- Nothing -> F.failure $ HeaderException ("Invalid Last-Modified: " ++ ts)
- Nothing -> F.failure $ HeaderException "Last-Modified missing"
+ Nothing -> throwM $ HeaderException ("Invalid Last-Modified: " ++ ts)
+ Nothing -> throwM $ HeaderException "Last-Modified missing"
versionId = T.decodeUtf8 `fmap` lookup "x-amz-version-id" h
-- expiration = return undefined
userMetadata = flip mapMaybe ht $
diff -ru orig/Aws/Ses/Core.hs new/Aws/Ses/Core.hs
--- orig/Aws/Ses/Core.hs 2014-04-04 10:18:25.112401067 +0300
+++ new/Aws/Ses/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -22,8 +22,8 @@
import qualified Blaze.ByteString.Builder as Blaze
import qualified Blaze.ByteString.Builder.Char8 as Blaze8
import qualified Control.Exception as C
-import qualified Control.Failure as F
import Control.Monad (mplus)
+import Control.Monad.Trans.Resource (throwM)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 ({-IsString-})
@@ -128,7 +128,7 @@
fromError cursor = do
errCode <- force "Missing Error Code" $ cursor $// elContent "Code"
errMessage <- force "Missing Error Message" $ cursor $// elContent "Message"
- F.failure $ SesError (HTTP.responseStatus resp) errCode errMessage
+ throwM $ SesError (HTTP.responseStatus resp) errCode errMessage
class SesAsQuery a where
-- | Write a data type as a list of query parameters.
diff -ru orig/Aws/SimpleDb/Core.hs new/Aws/SimpleDb/Core.hs
--- orig/Aws/SimpleDb/Core.hs 2014-04-04 10:18:25.116401067 +0300
+++ new/Aws/SimpleDb/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -4,8 +4,8 @@
import qualified Blaze.ByteString.Builder as Blaze
import qualified Blaze.ByteString.Builder.Char8 as Blaze8
import qualified Control.Exception as C
-import qualified Control.Failure as F
import Control.Monad
+import Control.Monad.Trans.Resource (MonadThrow, throwM)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as Base64
import Data.IORef
@@ -149,16 +149,16 @@
(err:_) -> fromError err
fromError cursor = do errCode <- force "Missing Error Code" $ cursor $// elCont "Code"
errMessage <- force "Missing Error Message" $ cursor $// elCont "Message"
- F.failure $ SdbError (HTTP.responseStatus resp) errCode errMessage
+ throwM $ SdbError (HTTP.responseStatus resp) errCode errMessage
class SdbFromResponse a where
sdbFromResponse :: Cu.Cursor -> Response SdbMetadata a
-sdbCheckResponseType :: F.Failure XmlException m => a -> T.Text -> Cu.Cursor -> m a
+sdbCheckResponseType :: MonadThrow m => a -> T.Text -> Cu.Cursor -> m a
sdbCheckResponseType a n c = do _ <- force ("Expected response type " ++ T.unpack n) (Cu.laxElement n c)
return a
-decodeBase64 :: F.Failure XmlException m => Cu.Cursor -> m T.Text
+decodeBase64 :: MonadThrow m => Cu.Cursor -> m T.Text
decodeBase64 cursor =
let encoded = T.concat $ cursor $/ Cu.content
encoding = listToMaybe $ cursor $| Cu.laxAttribute "encoding" &| T.toCaseFold
@@ -166,15 +166,15 @@
case encoding of
Nothing -> return encoded
Just "base64" -> case Base64.decode . T.encodeUtf8 $ encoded of
- Left msg -> F.failure $ XmlException ("Invalid Base64 data: " ++ msg)
+ Left msg -> throwM $ XmlException ("Invalid Base64 data: " ++ msg)
Right x -> return $ T.decodeUtf8 x
- Just actual -> F.failure $ XmlException ("Unrecognized encoding " ++ T.unpack actual)
+ Just actual -> throwM $ XmlException ("Unrecognized encoding " ++ T.unpack actual)
data Attribute a
= ForAttribute { attributeName :: T.Text, attributeData :: a }
deriving (Show)
-readAttribute :: F.Failure XmlException m => Cu.Cursor -> m (Attribute T.Text)
+readAttribute :: MonadThrow m => Cu.Cursor -> m (Attribute T.Text)
readAttribute cursor = do
name <- forceM "Missing Name" $ cursor $/ Cu.laxElement "Name" &| decodeBase64
value <- forceM "Missing Value" $ cursor $/ Cu.laxElement "Value" &| decodeBase64
@@ -225,7 +225,7 @@
= Item { itemName :: T.Text, itemData :: a }
deriving (Show)
-readItem :: F.Failure XmlException m => Cu.Cursor -> m (Item [Attribute T.Text])
+readItem :: MonadThrow m => Cu.Cursor -> m (Item [Attribute T.Text])
readItem cursor = do
name <- force "Missing Name" <=< sequence $ cursor $/ Cu.laxElement "Name" &| decodeBase64
attributes <- sequence $ cursor $/ Cu.laxElement "Attribute" &| readAttribute
diff -ru orig/Aws/Sqs/Commands/Message.hs new/Aws/Sqs/Commands/Message.hs
--- orig/Aws/Sqs/Commands/Message.hs 2014-04-04 10:18:25.116401067 +0300
+++ new/Aws/Sqs/Commands/Message.hs 2014-04-04 10:18:24.000000000 +0300
@@ -4,9 +4,9 @@
import Aws.Core
import Aws.Sqs.Core
import Control.Applicative
+import Control.Monad.Trans.Resource (MonadThrow)
import Data.Maybe
import Text.XML.Cursor (($/), ($//), (&/), (&|))
-import qualified Control.Failure as F
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
@@ -98,7 +98,7 @@
}
deriving (Show)
-readMessageAttribute :: F.Failure XmlException m => Cu.Cursor -> m (MessageAttribute,T.Text)
+readMessageAttribute :: MonadThrow m => Cu.Cursor -> m (MessageAttribute,T.Text)
readMessageAttribute cursor = do
name <- force "Missing Name" $ cursor $/ Cu.laxElement "Name" &/ Cu.content
value <- force "Missing Value" $ cursor $/ Cu.laxElement "Value" &/ Cu.content
diff -ru orig/Aws/Sqs/Core.hs new/Aws/Sqs/Core.hs
--- orig/Aws/Sqs/Core.hs 2014-04-04 10:18:25.116401067 +0300
+++ new/Aws/Sqs/Core.hs 2014-04-04 10:18:24.000000000 +0300
@@ -5,14 +5,12 @@
import qualified Blaze.ByteString.Builder as Blaze
import qualified Blaze.ByteString.Builder.Char8 as Blaze8
import qualified Control.Exception as C
-import qualified Control.Failure as F
import Control.Monad
import Control.Monad.IO.Class
-import Data.Attempt (Attempt(..))
+import Control.Monad.Trans.Resource (MonadThrow, throwM)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.Conduit (($$+-))
-import qualified Data.Conduit as C
import Data.IORef
import Data.List
import Data.Maybe
@@ -234,10 +232,10 @@
= do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def
let cursor = Cu.fromDocument doc
liftIO $ case parseError cursor of
- Success err -> C.monadThrow err
- Failure otherErr -> C.monadThrow otherErr
+ Right err -> throwM err
+ Left otherErr -> throwM otherErr
where
- parseError :: Cu.Cursor -> Attempt SqsError
+ parseError :: Cu.Cursor -> Either C.SomeException SqsError
parseError root = do cursor <- force "Missing Error" $ root $/ Cu.laxElement "Error"
code <- force "Missing error Code" $ cursor $/ elContent "Code"
message <- force "Missing error Message" $ cursor $/ elContent "Message"
@@ -291,7 +289,7 @@
| PermissionGetQueueAttributes
deriving (Show, Enum, Eq)
-parseQueueAttribute :: F.Failure XmlException m => T.Text -> m QueueAttribute
+parseQueueAttribute :: MonadThrow m => T.Text -> m QueueAttribute
parseQueueAttribute "ApproximateNumberOfMessages" = return ApproximateNumberOfMessages
parseQueueAttribute "ApproximateNumberOfMessagesNotVisible" = return ApproximateNumberOfMessagesNotVisible
parseQueueAttribute "VisibilityTimeout" = return VisibilityTimeout
@@ -301,7 +299,7 @@
parseQueueAttribute "MaximumMessageSize" = return MaximumMessageSize
parseQueueAttribute "MessageRetentionPeriod" = return MessageRetentionPeriod
parseQueueAttribute "QueueArn" = return QueueArn
-parseQueueAttribute x = F.failure $ XmlException ( "Invalid Attribute Name. " ++ show x)
+parseQueueAttribute x = throwM $ XmlException ( "Invalid Attribute Name. " ++ show x)
printQueueAttribute :: QueueAttribute -> T.Text
printQueueAttribute QueueAll = "All"
@@ -315,12 +313,12 @@
printQueueAttribute MessageRetentionPeriod = "MessageRetentionPeriod"
printQueueAttribute QueueArn = "QueueArn"
-parseMessageAttribute :: F.Failure XmlException m => T.Text -> m MessageAttribute
+parseMessageAttribute :: MonadThrow m => T.Text -> m MessageAttribute
parseMessageAttribute "SenderId" = return SenderId
parseMessageAttribute "SentTimestamp" = return SentTimestamp
parseMessageAttribute "ApproximateReceiveCount" = return ApproximateReceiveCount
parseMessageAttribute "ApproximateFirstReceiveTimestamp" = return ApproximateFirstReceiveTimestamp
-parseMessageAttribute x = F.failure $ XmlException ( "Invalid Attribute Name. " ++ show x)
+parseMessageAttribute x = throwM $ XmlException ( "Invalid Attribute Name. " ++ show x)
printMessageAttribute :: MessageAttribute -> T.Text
printMessageAttribute MessageAll = "All"
diff -ru orig/aws.cabal new/aws.cabal
--- orig/aws.cabal 2014-04-04 10:18:25.120401065 +0300
+++ new/aws.cabal 2014-04-04 10:18:24.000000000 +0300
@@ -98,8 +98,6 @@
Aws.DynamoDb.Core
Build-depends:
- attempt >= 0.3.1.1 && < 0.5,
- attoparsec-conduit >= 1.0 && < 1.1,
aeson >= 0.6 && < 0.8,
base == 4.*,
base16-bytestring == 0.1.*,
@@ -108,29 +106,30 @@
bytestring >= 0.9 && < 0.11,
case-insensitive >= 0.2 && < 1.3,
cereal >= 0.3 && < 0.5,
- conduit >= 1.0 && < 1.1,
+ conduit >= 1.1 && < 1.2,
+ conduit-extra >= 1.1 && < 1.2,
containers >= 0.4,
crypto-api >= 0.9,
cryptohash >= 0.8 && < 0.12,
cryptohash-cryptoapi == 0.1.*,
data-default == 0.5.*,
directory >= 1.0 && < 1.3,
- failure >= 0.2.0.1 && < 0.3,
filepath >= 1.1 && < 1.4,
- http-conduit >= 1.9 && < 2.1,
+ http-conduit >= 2.1 && < 2.2,
http-types >= 0.7 && < 0.9,
lifted-base >= 0.1 && < 0.3,
monad-control >= 0.3,
mtl == 2.*,
old-locale == 1.*,
- resourcet >= 0.3.3 && <0.5,
+ resourcet >= 1.1 && < 1.2,
text >= 0.11,
time >= 1.1.4 && < 1.5,
transformers >= 0.2.2.0 && < 0.4,
unordered-containers >= 0.2,
utf8-string == 0.3.*,
vector >= 0.10,
- xml-conduit >= 1.1 && <1.2
+ xml-conduit >= 1.2 && <1.3
+ , ghc-prim
GHC-Options: -Wall
Reference in New Issue View Git Blame Copy Permalink