haxr 3000.1.1.2 → 3000.2.0
raw patch · 4 files changed
+320/−309 lines, 4 filesdep ~HTTPdep ~basedep ~dataencnew-uploader
Dependency ranges changed: HTTP, base, dataenc, network
Files
- Network/XmlRpc/Client.hs +2/−1
- Network/XmlRpc/DTD_XMLRPC.hs +294/−296
- Network/XmlRpc/Internals.hs +15/−6
- haxr.cabal +9/−6
Network/XmlRpc/Client.hs view
@@ -46,6 +46,7 @@ import Network.Socket (withSocketsDo) import Network.HTTP+import Network.Stream -- | Gets the return value from a method response.@@ -143,7 +144,7 @@ httpError resp = showRspCode (rspCode resp) ++ " " ++ rspReason resp -- | Create an XML-RPC compliant HTTP request.-request :: URI -> URIAuthority -> String -> Request+request :: URI -> URIAuthority -> String -> Request_String request uri auth content = Request{ rqURI = uri, rqMethod = POST, rqHeaders = headers,
Network/XmlRpc/DTD_XMLRPC.hs view
@@ -1,296 +1,294 @@-module Network.XmlRpc.DTD_XMLRPC where--import Text.XML.HaXml.Xml2Haskell-import Text.XML.HaXml.OneOfN-import Data.Char (isSpace)-import Prelude hiding (String, Int, Double)-import qualified Prelude---{-Type decls-}--newtype I4 = I4 Prelude.String deriving (Prelude.Eq,Prelude.Show)-newtype Int = Int Prelude.String deriving (Prelude.Eq,Prelude.Show)-newtype Boolean = Boolean Prelude.String deriving (Prelude.Eq,Prelude.Show)-newtype String = String Prelude.String deriving (Prelude.Eq,Prelude.Show)-newtype Double = Double Prelude.String deriving (Prelude.Eq,Prelude.Show)-newtype DateTime_iso8601 = DateTime_iso8601 Prelude.String deriving (Prelude.Eq,Prelude.Show)-newtype Base64 = Base64 Prelude.String deriving (Prelude.Eq,Prelude.Show)-newtype Data = Data [Value] deriving (Prelude.Eq,Prelude.Show)-newtype Array = Array Data deriving (Prelude.Eq,Prelude.Show)-newtype Name = Name Prelude.String deriving (Prelude.Eq,Prelude.Show)-data Member = Member Name Value- deriving (Prelude.Eq,Prelude.Show)-newtype Struct = Struct [Member] deriving (Prelude.Eq,Prelude.Show)-newtype Value = Value [Value_] deriving (Prelude.Eq,Prelude.Show)-data Value_ = Value_Str Prelude.String- | Value_I4 I4- | Value_Int Int- | Value_Boolean Boolean- | Value_String String- | Value_DateTime_iso8601 DateTime_iso8601- | Value_Double Double- | Value_Base64 Base64- | Value_Struct Struct- | Value_Array Array- deriving (Prelude.Eq,Prelude.Show)-newtype Param = Param Value deriving (Prelude.Eq,Prelude.Show)-newtype Params = Params [Param] deriving (Prelude.Eq,Prelude.Show)-newtype MethodName = MethodName Prelude.String deriving (Prelude.Eq,Prelude.Show)-data MethodCall = MethodCall MethodName (Prelude.Maybe Params)- deriving (Prelude.Eq,Prelude.Show)-newtype Fault = Fault Value deriving (Prelude.Eq,Prelude.Show)-data MethodResponse = MethodResponseParams Params- | MethodResponseFault Fault- deriving (Prelude.Eq,Prelude.Show)---{-Instance decls-}--instance XmlContent I4 where- fromElem (CElem (Elem "i4" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (I4 a), rest))- (definite fromText "text" "i4" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (I4 a) =- [CElem (Elem "i4" [] (toText a))]-instance XmlContent Int where- fromElem (CElem (Elem "int" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (Int a), rest))- (definite fromText "text" "int" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Int a) =- [CElem (Elem "int" [] (toText a))]-instance XmlContent Boolean where- fromElem (CElem (Elem "boolean" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (Boolean a), rest))- (definite fromText "text" "boolean" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Boolean a) =- [CElem (Elem "boolean" [] (toText a))]-instance XmlContent String where- fromElem (CElem (Elem "string" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (String a), rest))- (definite fromText "text" "string" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (String a) =- [CElem (Elem "string" [] (toText a))]-instance XmlContent Double where- fromElem (CElem (Elem "double" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (Double a), rest))- (definite fromText "text" "double" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Double a) =- [CElem (Elem "double" [] (toText a))]-instance XmlContent DateTime_iso8601 where- fromElem (CElem (Elem "dateTime.iso8601" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (DateTime_iso8601 a), rest))- (definite fromText "text" "dateTime.iso8601" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (DateTime_iso8601 a) =- [CElem (Elem "dateTime.iso8601" [] (toText a))]-instance XmlContent Base64 where- fromElem (CElem (Elem "base64" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (Base64 a), rest))- (definite fromText "text" "base64" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Base64 a) =- [CElem (Elem "base64" [] (toText a))]-instance XmlContent Data where- fromElem (CElem (Elem "data" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (Data a), rest))- (many fromElem c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Data a) =- [CElem (Elem "data" [] (concatMap toElem a))]-instance XmlContent Array where- fromElem (CElem (Elem "array" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (Array a), rest))- (definite fromElem "<data>" "array" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Array a) =- [CElem (Elem "array" [] (toElem a))]-instance XmlContent Name where- fromElem (CElem (Elem "name" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (Name a), rest))- (definite fromText "text" "name" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Name a) =- [CElem (Elem "name" [] (toText a))]-instance XmlContent Member where- fromElem (CElem (Elem "member" [] c0):rest) =- (\(a,ca)->- (\(b,cb)->- (Prelude.Just (Member a b), rest))- (definite fromElem "<value>" "member" ca))- (definite fromElem "<name>" "member" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Member a b) =- [CElem (Elem "member" [] (toElem a ++ toElem b))]-instance XmlContent Struct where- fromElem (CElem (Elem "struct" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (Struct a), rest))- (many fromElem c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Struct a) =- [CElem (Elem "struct" [] (concatMap toElem a))]-instance XmlContent Value where- fromElem (CElem (Elem "value" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (Value a), rest))- (many fromElem c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Value a) =- [CElem (Elem "value" [] (concatMap toElem a))]-instance XmlContent Value_ where- fromElem c0 =- case (fromText c0) of- (Prelude.Just a,rest) -> (Prelude.Just (Value_Str a), rest)- (_,_) ->- case (fromElem c0) of- (Prelude.Just a,rest) -> (Prelude.Just (Value_I4 a), rest)- (_,_) ->- case (fromElem c0) of- (Prelude.Just a,rest) -> (Prelude.Just (Value_Int a), rest)- (_,_) ->- case (fromElem c0) of- (Prelude.Just a,rest) -> (Prelude.Just (Value_Boolean a), rest)- (_,_) ->- case (fromElem c0) of- (Prelude.Just a,rest) -> (Prelude.Just (Value_String a), rest)- (_,_) ->- case (fromElem c0) of- (Prelude.Just a,rest) -> (Prelude.Just (Value_DateTime_iso8601 a), rest)- (_,_) ->- case (fromElem c0) of- (Prelude.Just a,rest) -> (Prelude.Just (Value_Double a), rest)- (_,_) ->- case (fromElem c0) of- (Prelude.Just a,rest) -> (Prelude.Just (Value_Base64 a), rest)- (_,_) ->- case (fromElem c0) of- (Prelude.Just a,rest) -> (Prelude.Just (Value_Struct a), rest)- (_,_) ->- case (fromElem c0) of- (Prelude.Just a,rest) -> (Prelude.Just (Value_Array a), rest)- (_,_) ->- (Prelude.Nothing, c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Value_Str a) = toText a- toElem (Value_I4 a) = toElem a- toElem (Value_Int a) = toElem a- toElem (Value_Boolean a) = toElem a- toElem (Value_String a) = toElem a- toElem (Value_DateTime_iso8601 a) = toElem a- toElem (Value_Double a) = toElem a- toElem (Value_Base64 a) = toElem a- toElem (Value_Struct a) = toElem a- toElem (Value_Array a) = toElem a-instance XmlContent Param where- fromElem (CElem (Elem "param" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (Param a), rest))- (definite fromElem "<value>" "param" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Param a) =- [CElem (Elem "param" [] (toElem a))]-instance XmlContent Params where- fromElem (CElem (Elem "params" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (Params a), rest))- (many fromElem c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Params a) =- [CElem (Elem "params" [] (concatMap toElem a))]-instance XmlContent MethodName where- fromElem (CElem (Elem "methodName" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (MethodName a), rest))- (definite fromText "text" "methodName" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (MethodName a) =- [CElem (Elem "methodName" [] (toText a))]-instance XmlContent MethodCall where- fromElem (CElem (Elem "methodCall" [] c0):rest) =- (\(a,ca)->- (\(b,cb)->- (Prelude.Just (MethodCall a b), rest))- (fromElem ca))- (definite fromElem "<methodName>" "methodCall" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (MethodCall a b) =- [CElem (Elem "methodCall" [] (toElem a ++ maybe [] toElem b))]-instance XmlContent Fault where- fromElem (CElem (Elem "fault" [] c0):rest) =- (\(a,ca)->- (Prelude.Just (Fault a), rest))- (definite fromElem "<value>" "fault" c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (Fault a) =- [CElem (Elem "fault" [] (toElem a))]-instance XmlContent MethodResponse where- fromElem (CElem (Elem "methodResponse" [] c0):rest) =- case (fromElem c0) of- (Prelude.Just a,_) -> (Prelude.Just (MethodResponseParams a), rest)- (_,_) ->- case (fromElem c0) of- (Prelude.Just a,_) -> (Prelude.Just (MethodResponseFault a), rest)- (_,_) ->- (Prelude.Nothing, c0)- fromElem (CMisc _:rest) = fromElem rest- fromElem (CString _ s:rest) | all isSpace s = fromElem rest- fromElem rest = (Prelude.Nothing, rest)- toElem (MethodResponseParams a) = [CElem (Elem "methodResponse" [] (toElem a) )]- toElem (MethodResponseFault a) = [CElem (Elem "methodResponse" [] (toElem a) )]---{-Done-}+module Network.XmlRpc.DTD_XMLRPC where + +import Text.XML.HaXml.Xml2Haskell +import Text.XML.HaXml.OneOfN +import Data.Char (isSpace) + + +{-Type decls-} + +newtype I4 = I4 String deriving (Eq,Show) +newtype AInt = AInt String deriving (Eq,Show) +newtype Boolean = Boolean String deriving (Eq,Show) +newtype AString = AString String deriving (Eq,Show) +newtype ADouble = ADouble String deriving (Eq,Show) +newtype DateTime_iso8601 = DateTime_iso8601 String deriving (Eq,Show) +newtype Base64 = Base64 String deriving (Eq,Show) +newtype Data = Data [Value] deriving (Eq,Show) +newtype Array = Array Data deriving (Eq,Show) +newtype Name = Name String deriving (Eq,Show) +data Member = Member Name Value + deriving (Eq,Show) +newtype Struct = Struct [Member] deriving (Eq,Show) +newtype Value = Value [Value_] deriving (Eq,Show) +data Value_ = Value_Str String + | Value_I4 I4 + | Value_AInt AInt + | Value_Boolean Boolean + | Value_AString AString + | Value_DateTime_iso8601 DateTime_iso8601 + | Value_ADouble ADouble + | Value_Base64 Base64 + | Value_Struct Struct + | Value_Array Array + deriving (Eq,Show) +newtype Param = Param Value deriving (Eq,Show) +newtype Params = Params [Param] deriving (Eq,Show) +newtype MethodName = MethodName String deriving (Eq,Show) +data MethodCall = MethodCall MethodName (Maybe Params) + deriving (Eq,Show) +newtype Fault = Fault Value deriving (Eq,Show) +data MethodResponse = MethodResponseParams Params + | MethodResponseFault Fault + deriving (Eq,Show) + + +{-Instance decls-} + +instance XmlContent I4 where + fromElem (CElem (Elem "i4" [] c0):rest) = + (\(a,ca)-> + (Just (I4 a), rest)) + (definite fromText "text" "i4" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (I4 a) = + [CElem (Elem "i4" [] (toText a))] +instance XmlContent AInt where + fromElem (CElem (Elem "int" [] c0):rest) = + (\(a,ca)-> + (Just (AInt a), rest)) + (definite fromText "text" "int" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (AInt a) = + [CElem (Elem "int" [] (toText a))] +instance XmlContent Boolean where + fromElem (CElem (Elem "boolean" [] c0):rest) = + (\(a,ca)-> + (Just (Boolean a), rest)) + (definite fromText "text" "boolean" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Boolean a) = + [CElem (Elem "boolean" [] (toText a))] +instance XmlContent AString where + fromElem (CElem (Elem "string" [] c0):rest) = + (\(a,ca)-> + (Just (AString a), rest)) + (definite fromText "text" "string" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (AString a) = + [CElem (Elem "string" [] (toText a))] +instance XmlContent ADouble where + fromElem (CElem (Elem "double" [] c0):rest) = + (\(a,ca)-> + (Just (ADouble a), rest)) + (definite fromText "text" "double" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (ADouble a) = + [CElem (Elem "double" [] (toText a))] +instance XmlContent DateTime_iso8601 where + fromElem (CElem (Elem "dateTime.iso8601" [] c0):rest) = + (\(a,ca)-> + (Just (DateTime_iso8601 a), rest)) + (definite fromText "text" "dateTime.iso8601" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (DateTime_iso8601 a) = + [CElem (Elem "dateTime.iso8601" [] (toText a))] +instance XmlContent Base64 where + fromElem (CElem (Elem "base64" [] c0):rest) = + (\(a,ca)-> + (Just (Base64 a), rest)) + (definite fromText "text" "base64" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Base64 a) = + [CElem (Elem "base64" [] (toText a))] +instance XmlContent Data where + fromElem (CElem (Elem "data" [] c0):rest) = + (\(a,ca)-> + (Just (Data a), rest)) + (many fromElem c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Data a) = + [CElem (Elem "data" [] (concatMap toElem a))] +instance XmlContent Array where + fromElem (CElem (Elem "array" [] c0):rest) = + (\(a,ca)-> + (Just (Array a), rest)) + (definite fromElem "<data>" "array" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Array a) = + [CElem (Elem "array" [] (toElem a))] +instance XmlContent Name where + fromElem (CElem (Elem "name" [] c0):rest) = + (\(a,ca)-> + (Just (Name a), rest)) + (definite fromText "text" "name" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Name a) = + [CElem (Elem "name" [] (toText a))] +instance XmlContent Member where + fromElem (CElem (Elem "member" [] c0):rest) = + (\(a,ca)-> + (\(b,cb)-> + (Just (Member a b), rest)) + (definite fromElem "<value>" "member" ca)) + (definite fromElem "<name>" "member" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Member a b) = + [CElem (Elem "member" [] (toElem a ++ toElem b))] +instance XmlContent Struct where + fromElem (CElem (Elem "struct" [] c0):rest) = + (\(a,ca)-> + (Just (Struct a), rest)) + (many fromElem c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Struct a) = + [CElem (Elem "struct" [] (concatMap toElem a))] +instance XmlContent Value where + fromElem (CElem (Elem "value" [] c0):rest) = + (\(a,ca)-> + (Just (Value a), rest)) + (many fromElem c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Value a) = + [CElem (Elem "value" [] (concatMap toElem a))] +instance XmlContent Value_ where + fromElem c0 = + case (fromText c0) of + (Just a,rest) -> (Just (Value_Str a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,rest) -> (Just (Value_I4 a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,rest) -> (Just (Value_AInt a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,rest) -> (Just (Value_Boolean a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,rest) -> (Just (Value_AString a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,rest) -> (Just (Value_DateTime_iso8601 a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,rest) -> (Just (Value_ADouble a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,rest) -> (Just (Value_Base64 a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,rest) -> (Just (Value_Struct a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,rest) -> (Just (Value_Array a), rest) + (_,_) -> + (Nothing, c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Value_Str a) = toText a + toElem (Value_I4 a) = toElem a + toElem (Value_AInt a) = toElem a + toElem (Value_Boolean a) = toElem a + toElem (Value_AString a) = toElem a + toElem (Value_DateTime_iso8601 a) = toElem a + toElem (Value_ADouble a) = toElem a + toElem (Value_Base64 a) = toElem a + toElem (Value_Struct a) = toElem a + toElem (Value_Array a) = toElem a +instance XmlContent Param where + fromElem (CElem (Elem "param" [] c0):rest) = + (\(a,ca)-> + (Just (Param a), rest)) + (definite fromElem "<value>" "param" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Param a) = + [CElem (Elem "param" [] (toElem a))] +instance XmlContent Params where + fromElem (CElem (Elem "params" [] c0):rest) = + (\(a,ca)-> + (Just (Params a), rest)) + (many fromElem c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Params a) = + [CElem (Elem "params" [] (concatMap toElem a))] +instance XmlContent MethodName where + fromElem (CElem (Elem "methodName" [] c0):rest) = + (\(a,ca)-> + (Just (MethodName a), rest)) + (definite fromText "text" "methodName" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (MethodName a) = + [CElem (Elem "methodName" [] (toText a))] +instance XmlContent MethodCall where + fromElem (CElem (Elem "methodCall" [] c0):rest) = + (\(a,ca)-> + (\(b,cb)-> + (Just (MethodCall a b), rest)) + (fromElem ca)) + (definite fromElem "<methodName>" "methodCall" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (MethodCall a b) = + [CElem (Elem "methodCall" [] (toElem a ++ maybe [] toElem b))] +instance XmlContent Fault where + fromElem (CElem (Elem "fault" [] c0):rest) = + (\(a,ca)-> + (Just (Fault a), rest)) + (definite fromElem "<value>" "fault" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Fault a) = + [CElem (Elem "fault" [] (toElem a))] +instance XmlContent MethodResponse where + fromElem (CElem (Elem "methodResponse" [] c0):rest) = + case (fromElem c0) of + (Just a,_) -> (Just (MethodResponseParams a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,_) -> (Just (MethodResponseFault a), rest) + (_,_) -> + (Nothing, c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (MethodResponseParams a) = [CElem (Elem "methodResponse" [] (toElem a) )] + toElem (MethodResponseFault a) = [CElem (Elem "methodResponse" [] (toElem a) )] + + +{-Done-}
Network/XmlRpc/Internals.hs view
@@ -50,6 +50,7 @@ import System.IO.Unsafe (unsafePerformIO) import Text.XML.HaXml.Xml2Haskell+--import Text.XML.HaXml.XmlContent import qualified Network.XmlRpc.Base64 as Base64 import qualified Network.XmlRpc.DTD_XMLRPC as XR@@ -79,6 +80,14 @@ maybeToM err Nothing = fail err maybeToM _ (Just x) = return x +-- | Convert a 'Maybe' value to a value in any monad+eitherToM :: Monad 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 _ (Right x) = return x+ -- | The format for \"dateTime.iso8601\" xmlRpcDateFormat = "%Y%m%dT%H:%M:%S" @@ -324,10 +333,10 @@ -- toXRValue :: Value -> XR.Value-toXRValue (ValueInt x) = XR.Value [XR.Value_Int (XR.Int (showInt x))]+toXRValue (ValueInt x) = XR.Value [XR.Value_AInt (XR.AInt (showInt x))] toXRValue (ValueBool b) = XR.Value [XR.Value_Boolean (XR.Boolean (showBool b))]-toXRValue (ValueString s) = XR.Value [XR.Value_String (XR.String (showString s))]-toXRValue (ValueDouble d) = XR.Value [XR.Value_Double (XR.Double (showDouble d))]+toXRValue (ValueString s) = XR.Value [XR.Value_AString (XR.AString (showString s))]+toXRValue (ValueDouble d) = XR.Value [XR.Value_ADouble (XR.ADouble (showDouble d))] toXRValue (ValueDateTime t) = XR.Value [ XR.Value_DateTime_iso8601 (XR.DateTime_iso8601 (showDateTime t))] toXRValue (ValueBase64 s) = XR.Value [XR.Value_Base64 (XR.Base64 (showBase64 s))]@@ -392,10 +401,10 @@ unstr (XR.Value_Str x) = x f (XR.Value_I4 (XR.I4 x)) = liftM ValueInt (readInt x)- f (XR.Value_Int (XR.Int x)) = liftM ValueInt (readInt x)+ f (XR.Value_AInt (XR.AInt x)) = liftM ValueInt (readInt x) f (XR.Value_Boolean (XR.Boolean x)) = liftM ValueBool (readBool x)- f (XR.Value_Double (XR.Double x)) = liftM ValueDouble (readDouble x)- f (XR.Value_String (XR.String x)) = liftM ValueString (readString x)+ f (XR.Value_ADouble (XR.ADouble x)) = liftM ValueDouble (readDouble x)+ f (XR.Value_AString (XR.AString x)) = liftM ValueString (readString x) f (XR.Value_DateTime_iso8601 (XR.DateTime_iso8601 x)) = liftM ValueDateTime (readDateTime x) f (XR.Value_Base64 (XR.Base64 x)) = liftM ValueBase64 (readBase64 x)
haxr.cabal view
@@ -1,5 +1,5 @@ Name: haxr-Version: 3000.1.1.2+Version: 3000.2.0 Cabal-version: >=1.2 Build-type: Simple Copyright: Bjorn Bringert, 2003-2006@@ -8,19 +8,22 @@ Author: Bjorn Bringert <bjorn@bringert.net> Maintainer: Bjorn Bringert <bjorn@bringert.net> Homepage: http://www.haskell.org/haxr/+Category: Network Synopsis: XML-RPC client and server library. Description: HaXR is a library for writing XML-RPC client and server applications in Haskell. -Flag split-base+flag old-base+ description: Old, monolithic base+ default: False Library- Build-depends: mtl, network, HaXml >= 1.13 && < 1.14, HTTP >= 1.0, dataenc == 0.11.1- if flag(split-base)- Build-depends: base == 3.*, array, old-time, old-locale, time+ Build-depends: mtl, network, HaXml >= 1.13, HTTP >= 4000, dataenc, old-locale, old-time, time, array+ if flag(old-base)+ Build-Depends: base < 4 else- Build-depends: base < 3.0+ Build-Depends: base >= 4 Exposed-Modules: Network.XmlRpc.Client, Network.XmlRpc.Server,