haxr 3000.11.3 → 3000.11.3.1
raw patch · 4 files changed
+50/−38 lines, 4 filesdep ~base-compat
Dependency ranges changed: base-compat
Files
- CHANGES +9/−0
- Network/XmlRpc/Client.hs +14/−11
- Network/XmlRpc/Internals.hs +22/−22
- haxr.cabal +5/−5
CHANGES view
@@ -1,3 +1,12 @@+* 3000.11.3.1 (17 December 2019)++ - Updates for GHC 8.8, network-3.1+ - Use MonadFail instead of Monad for 'fail' method++* 3000.11.3 (19 January 2019)++ - Updates for GHC 8.6+ * 3000.11.2 (9 August 2016) - Add XmlRpcType instance for Text
Network/XmlRpc/Client.hs view
@@ -39,32 +39,35 @@ import Network.XmlRpc.Internals +import Control.Monad.Fail (MonadFail)+import qualified Control.Monad.Fail as Fail import Data.Functor ((<$>))-import Data.Maybe import Data.Int+import Data.Maybe import Network.URI import Text.Read.Compat (readMaybe) import Network.Http.Client (Method (..), Request, baselineContextSSL, buildRequest, closeConnection, getStatusCode,- getStatusMessage, http, openConnection,- inputStreamBody, openConnectionSSL,- receiveResponse, sendRequest,- setAuthorizationBasic,- setContentType, setContentLength, setHeader)+ getStatusMessage, http,+ inputStreamBody, openConnection,+ openConnectionSSL, receiveResponse,+ sendRequest, setAuthorizationBasic,+ setContentLength, setContentType,+ setHeader) import OpenSSL import qualified System.IO.Streams as Streams import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL (ByteString, fromChunks,- unpack, length)+ length, unpack) import qualified Data.ByteString.Lazy.UTF8 as U -- | Gets the return value from a method response. -- Throws an exception if the response was a fault.-handleResponse :: Monad m => MethodResponse -> m Value-handleResponse (Return v) = return v+handleResponse :: MonadFail m => MethodResponse -> m Value+handleResponse (Return v) = return v handleResponse (Fault code str) = fail ("Error " ++ show code ++ ": " ++ str) type HeadersAList = [(BS.ByteString, BS.ByteString)]@@ -223,8 +226,8 @@ -- Utility functions -- -maybeFail :: Monad m => String -> Maybe a -> m a-maybeFail msg = maybe (fail msg) return+maybeFail :: MonadFail m => String -> Maybe a -> m a+maybeFail msg = maybe (Fail.fail msg) return dropAtEnd :: String -> String dropAtEnd l = take (length l - 1) l
Network/XmlRpc/Internals.hs view
@@ -103,11 +103,11 @@ maybeToM _ (Just x) = return x -- | Convert a 'Maybe' value to a value in any monad-eitherToM :: Monad m+eitherToM :: MonadFail m => String -- ^ Error message to fail with for 'Nothing' -> Either String a -- ^ The 'Maybe' value. -> m a -- ^ The resulting value in the monad.-eitherToM err (Left s) = fail (err ++ ": " ++ s)+eitherToM err (Left s) = Fail.fail (err ++ ": " ++ s) eitherToM _ (Right x) = return x -- | The format for \"dateTime.iso8601\"@@ -136,14 +136,14 @@ Right x <- runExceptT (catchError m (lift . h)) return x -errorRead :: (Monad m, Read a) =>+errorRead :: (MonadFail m, Read a) => ReadS a -- ^ Parser -> String -- ^ Error message -> String -- ^ String to parse -> Err m a errorRead r err s = case [x | (x,t) <- r s, ("","") <- lex t] of [x] -> return x- _ -> fail (err ++ ": '" ++ s ++ "'")+ _ -> Fail.fail (err ++ ": '" ++ s ++ "'") -- -- Types for methods calls and responses@@ -222,10 +222,10 @@ -- "The body of the response is a single XML structure, a -- <methodResponse>, which can contain a single <params> which contains a -- single <param> which contains a single <value>."-onlyOneResult :: Monad m => [Value] -> Err m Value-onlyOneResult [] = fail "Method returned no result"+onlyOneResult :: MonadFail m => [Value] -> Err m Value+onlyOneResult [] = Fail.fail "Method returned no result" onlyOneResult [x] = return x-onlyOneResult _ = fail "Method returned more than one result"+onlyOneResult _ = Fail.fail "Method returned more than one result" -- -- Converting to and from XML-RPC types@@ -237,12 +237,12 @@ toValue :: a -> Value -- | Convert from a 'Value' to this type. May fail if -- if there is a type error.- fromValue :: Monad m => Value -> Err m a+ fromValue :: MonadFail m => Value -> Err m a getType :: a -> Type -typeError :: (XmlRpcType a, Monad m) => Value -> Err m a+typeError :: (XmlRpcType a, MonadFail m) => Value -> Err m a typeError v = withType $ \t ->- fail ("Wanted: "+ Fail.fail ("Wanted: " ++ show (getType t) ++ "', got: '" ++ showXml False (toXRValue v) ++ "'") `asTypeOf` return t@@ -251,7 +251,7 @@ withType :: (a -> Err m a) -> Err m a withType f = f undefined -simpleFromValue :: (Monad m, XmlRpcType a) => (Value -> Maybe a)+simpleFromValue :: (MonadFail m, XmlRpcType a) => (Value -> Maybe a) -> Value -> Err m a simpleFromValue f v = maybe (typeError v) return (f v)@@ -378,7 +378,7 @@ (lookup x xs) >>= fromValue -- | Get a field value from a (possibly heterogeneous) struct.-getFieldMaybe :: (Monad m, XmlRpcType a) =>+getFieldMaybe :: (MonadFail m, XmlRpcType a) => String -- ^ Field name -> [(String,Value)] -- ^ Struct -> Err m (Maybe a)@@ -443,7 +443,7 @@ -- Converting from XR types -- -fromXRValue :: Monad m => XR.Value -> Err m Value+fromXRValue :: MonadFail m => XR.Value -> Err m Value fromXRValue (XR.Value vs) = case (filter notstr vs) of [] -> liftM (ValueUnwrapped . concat) (mapM (readString . unstr) vs)@@ -469,7 +469,7 @@ liftM ValueArray (mapM fromXRValue xs) -fromXRMember :: Monad m => XR.Member -> Err m (String,Value)+fromXRMember :: MonadFail m => XR.Member -> Err m (String,Value) fromXRMember (XR.Member (XR.Name n) xv) = liftM (\v -> (n,v)) (fromXRValue xv) -- | From the XML-RPC specification:@@ -478,14 +478,14 @@ -- minus at the beginning of a string of numeric characters. Leading -- zeros are collapsed. Whitespace is not permitted. Just numeric -- characters preceeded by a plus or minus.\"-readInt :: Monad m => String -> Err m Int+readInt :: MonadFail m => String -> Err m Int readInt s = errorRead reads "Error parsing integer" s -- | From the XML-RPC specification: -- -- \"0 (false) or 1 (true)\"-readBool :: Monad m => String -> Err m Bool+readBool :: MonadFail m => String -> Err m Bool readBool s = errorRead readsBool "Error parsing boolean" s where readsBool "true" = [(True,"")] readsBool "false" = [(False,"")]@@ -516,7 +516,7 @@ -- is implementation-dependent, is not specified. -- -- FIXME: accepts more than decimal point notation-readDouble :: Monad m => String -> Err m Double+readDouble :: MonadFail m => String -> Err m Double readDouble s = errorRead reads "Error parsing double" s -- | From <http://groups.yahoo.com/group/xml-rpc/message/4733>:@@ -525,10 +525,10 @@ -- content of this element should not be assumed to comply with the -- variants of the ISO8601 standard. Only assume YYYYMMDDTHH:mm:SS\" -- FIXME: make more robust-readDateTime :: Monad m => String -> Err m LocalTime+readDateTime :: MonadFail m => String -> Err m LocalTime readDateTime dt = maybe- (fail $ "Error parsing dateTime '" ++ dt ++ "'")+ (Fail.fail $ "Error parsing dateTime '" ++ dt ++ "'") return (parseTimeM True defaultTimeLocale xmlRpcDateFormat dt) @@ -566,10 +566,10 @@ readBase64 :: Monad m => String -> Err m BS.ByteString readBase64 = return . Base64.decode . BS.pack -fromXRParams :: Monad m => XR.Params -> Err m [Value]+fromXRParams :: MonadFail m => XR.Params -> Err m [Value] fromXRParams (XR.Params xps) = mapM (\(XR.Param v) -> fromXRValue v) xps -fromXRMethodCall :: Monad m => XR.MethodCall -> Err m MethodCall+fromXRMethodCall :: MonadFail m => XR.MethodCall -> Err m MethodCall fromXRMethodCall (XR.MethodCall (XR.MethodName name) params) = liftM (MethodCall name) (fromXRParams (fromMaybe (XR.Params []) params)) @@ -590,7 +590,7 @@ -- -- | Parses a method call from XML.-parseCall :: (Show e, MonadError e m) => String -> Err m MethodCall+parseCall :: (Show e, MonadError e m, MonadFail m) => String -> Err m MethodCall parseCall c = do mxc <- errorToErr (readXml c)
haxr.cabal view
@@ -1,5 +1,5 @@ Name: haxr-Version: 3000.11.3+Version: 3000.11.3.1 Cabal-version: >=1.10 Build-type: Simple Copyright: Bjorn Bringert, 2003-2006@@ -22,7 +22,7 @@ examples/test_client.hs examples/test_server.hs examples/time-xmlrpc-com.hs examples/validate.hs examples/Makefile Bug-reports: https://github.com/byorgey/haxr/issues-Tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3+Tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.3 || ==8.8.1 Source-repository head type: git@@ -33,11 +33,11 @@ default: True Library- Build-depends: base >= 4.9 && < 4.13,- base-compat >= 0.8 && < 0.10,+ Build-depends: base >= 4.9 && < 4.14,+ base-compat >= 0.8 && < 0.11, mtl, mtl-compat,- network < 2.7,+ network < 3.2, http-streams, HsOpenSSL, io-streams,