    {-# LANGUAGE CPP #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Network.XmlRpc.Internals
    -- Copyright   :  (c) Bjorn Bringert 2003
    -- License     :  BSD-style
    --
    -- Maintainer  :  bjorn@bringert.net
    -- Stability   :  experimental
    -- Portability :  non-portable (requires extensions and non-portable libraries)
    --
    -- This module contains the core functionality of the XML-RPC library.
    -- Most applications should not need to use this module. Client
    -- applications should use "Network.XmlRpc.Client" and server applications should
    -- use "Network.XmlRpc.Server".
    --
    -- The XML-RPC specifcation is available at <http://www.xmlrpc.com/spec>.
    --
    -----------------------------------------------------------------------------

    #if __GLASGOW_HASKELL__ >= 710
    #define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
    #define OVERLAPPING_  {-# OVERLAPPING #-}
    #else
    {-# LANGUAGE OverlappingInstances #-}
    #define OVERLAPPABLE_
    #define OVERLAPPING_
    #endif

    module Network.XmlRpc.Internals (
    -- * Method calls and repsonses
    MethodCall(..), MethodResponse(..),
    -- * XML-RPC types
    Value(..), Type(..), XmlRpcType(..),
    -- * Converting from XML
    parseResponse, parseCall, getField, getFieldMaybe,
    -- * Converting to XML
    renderCall, renderResponse,
    -- * Converting to and from DTD types
    toXRValue, fromXRValue,
    toXRMethodCall, fromXRMethodCall,
    toXRMethodResponse, fromXRMethodResponse,
    toXRParams, fromXRParams,
    toXRMember, fromXRMember,
    -- * Error monad
    Err, maybeToM, handleError, ioErrorToErr
    ) where

    import           Control.Exception
    import           Control.Monad
    import           Control.Monad.Except
    import qualified Control.Monad.Fail as Fail
    import           Control.Monad.Fail (MonadFail)
    import           Data.Char
    import           Data.List
    import           Data.Maybe
    import           Data.Time.Calendar
    import           Data.Time.Calendar.OrdinalDate (toOrdinalDate)
    import           Data.Time.Calendar.WeekDate (toWeekDate)
    import           Data.Time.Format
    import           Data.Time.LocalTime
    import           Numeric (showFFloat)
    import           Prelude hiding (showString, catch)
    import           System.IO.Unsafe (unsafePerformIO)
    import           System.Time (CalendarTime(..))

    #if ! MIN_VERSION_time(1,5,0)
    import           System.Locale (defaultTimeLocale)
    #endif

    import           Data.Text (Text)
    import qualified Data.Text as T
    import qualified Data.ByteString.Char8 as BS (ByteString, pack, unpack)
    import qualified Data.ByteString.Lazy.Char8 as BSL (ByteString, pack)
    import qualified Network.XmlRpc.Base64 as Base64
    import qualified Network.XmlRpc.DTD_XMLRPC as XR
    import           Network.XmlRpc.Pretty
    import           Text.XML.HaXml.XmlContent

    --
    -- General utilities
    --

    -- | Replaces all occurances of a sublist in a list with another list.
    --   If the list to replace is the empty list, does nothing.
    replace :: Eq a =>
            [a] -- ^ The sublist to replace when found
            -> [a] -- ^ The list to replace it with
            -> [a] -- ^ The list to replace in
            -> [a] -- ^ The result
    replace :: [a] -> [a] -> [a] -> [a]
    replace [] _ xs :: [a]
    xs = [a]
    xs
    replace _ _ [] = []
    replace ys :: [a]
    ys zs :: [a]
    zs xs :: [a]
    xs@(x :: a
    x:xs' :: [a]
    xs')
        | [a] -> [a] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf [a]
    ys [a]
    xs = [a]
    zs [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a] -> [a] -> [a] -> [a]
    forall a. Eq a => [a] -> [a] -> [a] -> [a]
    replace [a]
    ys [a]
    zs (Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop ([a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    ys) [a]
    xs)
        | Bool
    otherwise = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a] -> [a] -> [a] -> [a]
    forall a. Eq a => [a] -> [a] -> [a] -> [a]
    replace [a]
    ys [a]
    zs [a]
    xs'

    -- | Convert a 'Maybe' value to a value in any monad
    maybeToM :: MonadFail m =>
                    String -- ^ Error message to fail with for 'Nothing'
                 -> Maybe a -- ^ The 'Maybe' value.
                 -> m a -- ^ The resulting value in the monad.
    maybeToM :: String -> Maybe a -> m a
    maybeToM err :: String
    err Nothing = String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    Fail.fail String
    err
    maybeToM _ (Just x :: a
    x) = a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x

    -- | Convert a 'Maybe' value to a value in any monad
    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 :: String -> Either String a -> m a
    eitherToM err :: String
    err (Left s :: String
    s)  = String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    Fail.fail (String
    err String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ": " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s)
    eitherToM   _ (Right x :: a
    x) = a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x

    -- | The format for \"dateTime.iso8601\"
    xmlRpcDateFormat :: String
    xmlRpcDateFormat :: String
    xmlRpcDateFormat = "%Y%m%dT%H:%M:%S"

    --
    -- Error monad stuff
    --

    type Err m a = ExceptT String m a

    -- | Evaluate the argument and catch error call exceptions
    errorToErr :: (Show e, MonadError e m) => a -> Err m a
    errorToErr :: a -> Err m a
    errorToErr x :: a
    x = IO (Err m a) -> Err m a
    forall a. IO a -> a
    unsafePerformIO ((a -> Err m a) -> IO a -> IO (Err m a)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM a -> Err m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> IO a
    forall a. a -> IO a
    evaluate a
    x) IO (Err m a) -> (SomeException -> IO (Err m a)) -> IO (Err m a)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` SomeException -> IO (Err m a)
    forall (m :: * -> *) a. Monad m => SomeException -> IO (Err m a)
    handleErr)
      where handleErr :: Monad m => SomeException -> IO (Err m a)
            handleErr :: SomeException -> IO (Err m a)
    handleErr = Err m a -> IO (Err m a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Err m a -> IO (Err m a))
    -> (SomeException -> Err m a) -> SomeException -> IO (Err m a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Err m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (String -> Err m a)
    -> (SomeException -> String) -> SomeException -> Err m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SomeException -> String
    forall a. Show a => a -> String
    show

    -- | Catch IO errors in the error monad.
    ioErrorToErr :: IO a -> Err IO a
    ioErrorToErr :: IO a -> Err IO a
    ioErrorToErr x :: IO a
    x = (IO a -> Err IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO a
    x Err IO a -> (a -> Err IO a) -> Err IO a
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= a -> Err IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return) Err IO a -> (String -> Err IO a) -> Err IO a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` \e :: String
    e -> String -> Err IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (String -> String
    forall a. Show a => a -> String
    show String
    e)

    -- | Handle errors from the error monad.
    handleError :: MonadFail m => (String -> m a) -> Err m a -> m a
    handleError :: (String -> m a) -> Err m a -> m a
    handleError h :: String -> m a
    h m :: Err m a
    m = do
                      Right x :: a
    x <- Err m a -> m (Either String a)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (Err m a -> (String -> Err m a) -> Err m a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    catchError Err m a
    m (m a -> Err m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m a -> Err m a) -> (String -> m a) -> String -> Err m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> m a
    h))
                      a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x

    errorRead :: (MonadFail m, Read a) =>
                 ReadS a -- ^ Parser
              -> String -- ^ Error message
              -> String -- ^ String to parse
              -> Err m a
    errorRead :: ReadS a -> String -> String -> Err m a
    errorRead r :: ReadS a
    r err :: String
    err s :: String
    s = case [a
    x | (x :: a
    x,t :: String
    t) <- ReadS a
    r String
    s, ("","") <- ReadS String
    lex String
    t] of
                              [x :: a
    x] -> a -> Err m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
                              _   -> String -> Err m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    Fail.fail (String
    err String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ": '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "'")

    --
    -- Types for methods calls and responses
    --

    -- | An XML-RPC method call. Consists of a method name and a list of
    --   parameters.
    data MethodCall = MethodCall String [Value]
                      deriving (MethodCall -> MethodCall -> Bool
    (MethodCall -> MethodCall -> Bool)
    -> (MethodCall -> MethodCall -> Bool) -> Eq MethodCall
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: MethodCall -> MethodCall -> Bool
    $c/= :: MethodCall -> MethodCall -> Bool
    == :: MethodCall -> MethodCall -> Bool
    $c== :: MethodCall -> MethodCall -> Bool
    Eq, Int -> MethodCall -> String -> String
    [MethodCall] -> String -> String
    MethodCall -> String
    (Int -> MethodCall -> String -> String)
    -> (MethodCall -> String)
    -> ([MethodCall] -> String -> String)
    -> Show MethodCall
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    showList :: [MethodCall] -> String -> String
    $cshowList :: [MethodCall] -> String -> String
    show :: MethodCall -> String
    $cshow :: MethodCall -> String
    showsPrec :: Int -> MethodCall -> String -> String
    $cshowsPrec :: Int -> MethodCall -> String -> String
    Show) -- for debugging

    -- | An XML-RPC response.
    data MethodResponse = Return Value -- ^ A method response returning a value
                        | Fault Int String -- ^ A fault response
                          deriving (MethodResponse -> MethodResponse -> Bool
    (MethodResponse -> MethodResponse -> Bool)
    -> (MethodResponse -> MethodResponse -> Bool) -> Eq MethodResponse
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: MethodResponse -> MethodResponse -> Bool
    $c/= :: MethodResponse -> MethodResponse -> Bool
    == :: MethodResponse -> MethodResponse -> Bool
    $c== :: MethodResponse -> MethodResponse -> Bool
    Eq, Int -> MethodResponse -> String -> String
    [MethodResponse] -> String -> String
    MethodResponse -> String
    (Int -> MethodResponse -> String -> String)
    -> (MethodResponse -> String)
    -> ([MethodResponse] -> String -> String)
    -> Show MethodResponse
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    showList :: [MethodResponse] -> String -> String
    $cshowList :: [MethodResponse] -> String -> String
    show :: MethodResponse -> String
    $cshow :: MethodResponse -> String
    showsPrec :: Int -> MethodResponse -> String -> String
    $cshowsPrec :: Int -> MethodResponse -> String -> String
    Show) -- for debugging

    -- | An XML-RPC value.
    data Value =
          ValueInt Int -- ^ int, i4, or i8
        | ValueBool Bool -- ^ bool
        | ValueString String -- ^ string
        | ValueUnwrapped String -- ^ no inner element
        | ValueDouble Double -- ^ double
        | ValueDateTime LocalTime -- ^ dateTime.iso8601
        | ValueBase64 BS.ByteString -- ^ base 64.  NOTE that you should provide the raw data; the haxr library takes care of doing the base-64 encoding.
        | ValueStruct [(String,Value)] -- ^ struct
        | ValueArray [Value]  -- ^ array
        | ValueNil -- ^ nil
          deriving (Value -> Value -> Bool
    (Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Value -> Value -> Bool
    $c/= :: Value -> Value -> Bool
    == :: Value -> Value -> Bool
    $c== :: Value -> Value -> Bool
    Eq, Int -> Value -> String -> String
    [Value] -> String -> String
    Value -> String
    (Int -> Value -> String -> String)
    -> (Value -> String) -> ([Value] -> String -> String) -> Show Value
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    showList :: [Value] -> String -> String
    $cshowList :: [Value] -> String -> String
    show :: Value -> String
    $cshow :: Value -> String
    showsPrec :: Int -> Value -> String -> String
    $cshowsPrec :: Int -> Value -> String -> String
    Show) -- for debugging

    -- | An XML-RPC value. Use for error messages and introspection.
    data Type =
              TInt
              | TBool
              | TString
              | TDouble
              | TDateTime
              | TBase64
              | TStruct
              | TArray
              | TUnknown
              | TNil
          deriving (Type -> Type -> Bool
    (Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Type -> Type -> Bool
    $c/= :: Type -> Type -> Bool
    == :: Type -> Type -> Bool
    $c== :: Type -> Type -> Bool
    Eq)

    instance Show Type where
        show :: Type -> String
    show TInt = "int"
        show TBool = "bool"
        show TString = "string"
        show TDouble = "double"
        show TDateTime = "dateTime.iso8601"
        show TBase64 = "base64"
        show TStruct = "struct"
        show TArray = "array"
        show TUnknown = "unknown"
        show TNil = "nil"

    instance Read Type where
        readsPrec :: Int -> ReadS Type
    readsPrec _ s :: String
    s = case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Char -> Bool
    isSpace ((Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace String
    s) of
                        ("int",r :: String
    r) -> [(Type
    TInt,String
    r)]
                        ("bool",r :: String
    r) -> [(Type
    TBool,String
    r)]
                        ("string",r :: String
    r) -> [(Type
    TString,String
    r)]
                        ("double",r :: String
    r) -> [(Type
    TDouble,String
    r)]
                        ("dateTime.iso8601",r :: String
    r) -> [(Type
    TDateTime,String
    r)]
                        ("base64",r :: String
    r) -> [(Type
    TBase64,String
    r)]
                        ("struct",r :: String
    r) -> [(Type
    TStruct,String
    r)]
                        ("array",r :: String
    r) -> [(Type
    TArray,String
    r)]
                        ("nil",r :: String
    r) -> [(Type
    TNil,String
    r)]

    -- | Gets the value of a struct member
    structGetValue :: MonadFail m => String -> Value -> Err m Value
    structGetValue :: String -> Value -> Err m Value
    structGetValue n :: String
    n (ValueStruct t :: [(String, Value)]
    t) =
        String -> Maybe Value -> Err m Value
    forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
    maybeToM ("Unknown member '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "'") (String -> [(String, Value)] -> Maybe Value
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    n [(String, Value)]
    t)
    structGetValue _ _ = String -> Err m Value
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "Value is not a struct"

    -- | Builds a fault struct
    faultStruct :: Int -> String -> Value
    faultStruct :: Int -> String -> Value
    faultStruct code :: Int
    code str :: String
    str = [(String, Value)] -> Value
    ValueStruct [("faultCode",Int -> Value
    ValueInt Int
    code),
                                        ("faultString",String -> Value
    ValueString String
    str)]

    -- XML-RPC specification:
    -- "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 :: MonadFail m => [Value] -> Err m Value
    onlyOneResult :: [Value] -> Err m Value
    onlyOneResult [] = String -> Err m Value
    forall (m :: * -> *) a. MonadFail m => String -> m a
    Fail.fail "Method returned no result"
    onlyOneResult [x :: Value
    x] = Value -> Err m Value
    forall (m :: * -> *) a. Monad m => a -> m a
    return Value
    x
    onlyOneResult _ = String -> Err m Value
    forall (m :: * -> *) a. MonadFail m => String -> m a
    Fail.fail "Method returned more than one result"

    --
    -- Converting to and from XML-RPC types
    --

    -- | A class for mapping Haskell types to XML-RPC types.
    class XmlRpcType a where
        -- | Convert from this type to a 'Value'
        toValue :: a -> Value
        -- | Convert from a 'Value' to this type. May fail if
        --   if there is a type error.
        fromValue :: MonadFail m => Value -> Err m a
        getType :: a -> Type

    typeError :: (XmlRpcType a, MonadFail m) => Value -> Err m a
    typeError :: Value -> Err m a
    typeError v :: Value
    v = (a -> Err m a) -> Err m a
    forall a (m :: * -> *). (a -> Err m a) -> Err m a
    withType ((a -> Err m a) -> Err m a) -> (a -> Err m a) -> Err m a
    forall a b. (a -> b) -> a -> b
    $ \t :: a
    t ->
           String -> Err m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    Fail.fail ("Wanted: "
                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Show a => a -> String
    show (a -> Type
    forall a. XmlRpcType a => a -> Type
    getType a
    t)
                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "', got: '"
                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> Value -> String
    forall a. XmlContent a => Bool -> a -> String
    showXml Bool
    False (Value -> Value
    toXRValue Value
    v) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "'") Err m a -> Err m a -> Err m a
    forall a. a -> a -> a
    `asTypeOf` a -> Err m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    t

    -- a type hack for use in 'typeError'
    withType :: (a -> Err m a) -> Err m a
    withType :: (a -> Err m a) -> Err m a
    withType f :: a -> Err m a
    f = a -> Err m a
    f a
    forall a. HasCallStack => a
    undefined

    simpleFromValue :: (MonadFail m, XmlRpcType a) => (Value -> Maybe a)
                    -> Value -> Err m a
    simpleFromValue :: (Value -> Maybe a) -> Value -> Err m a
    simpleFromValue f :: Value -> Maybe a
    f v :: Value
    v =
        Err m a -> (a -> Err m a) -> Maybe a -> Err m a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Value -> Err m a
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    typeError Value
    v) a -> Err m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> Maybe a
    f Value
    v)

    -- | Exists to allow explicit type conversions.
    instance XmlRpcType Value where
        toValue :: Value -> Value
    toValue = Value -> Value
    forall a. a -> a
    id
        fromValue :: Value -> Err m Value
    fromValue = Value -> Err m Value
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> Err m Value) -> (Value -> Value) -> Value -> Err m Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value -> Value
    forall a. a -> a
    id
        getType :: Value -> Type
    getType _ = Type
    TUnknown

    -- FIXME: instance for ()?

    instance XmlRpcType Int where
        toValue :: Int -> Value
    toValue = Int -> Value
    ValueInt
        fromValue :: Value -> Err m Int
    fromValue = (Value -> Maybe Int) -> Value -> Err m Int
    forall (m :: * -> *) a.
    (MonadFail m, XmlRpcType a) =>
    (Value -> Maybe a) -> Value -> Err m a
    simpleFromValue Value -> Maybe Int
    f
            where f :: Value -> Maybe Int
    f (ValueInt x :: Int
    x) = Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    x
                  f _ = Maybe Int
    forall a. Maybe a
    Nothing
        getType :: Int -> Type
    getType _ = Type
    TInt

    instance XmlRpcType Bool where
        toValue :: Bool -> Value
    toValue = Bool -> Value
    ValueBool
        fromValue :: Value -> Err m Bool
    fromValue = (Value -> Maybe Bool) -> Value -> Err m Bool
    forall (m :: * -> *) a.
    (MonadFail m, XmlRpcType a) =>
    (Value -> Maybe a) -> Value -> Err m a
    simpleFromValue Value -> Maybe Bool
    f
            where f :: Value -> Maybe Bool
    f (ValueBool x :: Bool
    x) = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    x
                  f _ = Maybe Bool
    forall a. Maybe a
    Nothing
        getType :: Bool -> Type
    getType _ = Type
    TBool

    instance OVERLAPPING_ XmlRpcType String where
        toValue :: String -> Value
    toValue = String -> Value
    ValueString
        fromValue :: Value -> Err m String
    fromValue = (Value -> Maybe String) -> Value -> Err m String
    forall (m :: * -> *) a.
    (MonadFail m, XmlRpcType a) =>
    (Value -> Maybe a) -> Value -> Err m a
    simpleFromValue Value -> Maybe String
    f
            where f :: Value -> Maybe String
    f (ValueString x :: String
    x) = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    x
                  f (ValueUnwrapped x :: String
    x) = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    x
                  f _ = Maybe String
    forall a. Maybe a
    Nothing
        getType :: String -> Type
    getType _ = Type
    TString

    instance XmlRpcType Text where
        toValue :: Text -> Value
    toValue = String -> Value
    ValueString (String -> Value) -> (Text -> String) -> Text -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack
        fromValue :: Value -> Err m Text
    fromValue = ((String -> Text) -> ExceptT String m String -> Err m Text
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM String -> Text
    T.pack) (ExceptT String m String -> Err m Text)
    -> (Value -> ExceptT String m String) -> Value -> Err m Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value -> ExceptT String m String
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue
        getType :: Text -> Type
    getType _ = Type
    TString

    instance XmlRpcType BS.ByteString where
        toValue :: ByteString -> Value
    toValue = ByteString -> Value
    ValueBase64
        fromValue :: Value -> Err m ByteString
    fromValue = (Value -> Maybe ByteString) -> Value -> Err m ByteString
    forall (m :: * -> *) a.
    (MonadFail m, XmlRpcType a) =>
    (Value -> Maybe a) -> Value -> Err m a
    simpleFromValue Value -> Maybe ByteString
    f
            where f :: Value -> Maybe ByteString
    f (ValueBase64 x :: ByteString
    x) = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    x
                  f _ = Maybe ByteString
    forall a. Maybe a
    Nothing
        getType :: ByteString -> Type
    getType _ = Type
    TBase64

    instance XmlRpcType Double where
        toValue :: Double -> Value
    toValue = Double -> Value
    ValueDouble
        fromValue :: Value -> Err m Double
    fromValue = (Value -> Maybe Double) -> Value -> Err m Double
    forall (m :: * -> *) a.
    (MonadFail m, XmlRpcType a) =>
    (Value -> Maybe a) -> Value -> Err m a
    simpleFromValue Value -> Maybe Double
    f
            where f :: Value -> Maybe Double
    f (ValueDouble x :: Double
    x) = Double -> Maybe Double
    forall a. a -> Maybe a
    Just Double
    x
                  f _ = Maybe Double
    forall a. Maybe a
    Nothing
        getType :: Double -> Type
    getType _ = Type
    TDouble

    instance XmlRpcType LocalTime where
        toValue :: LocalTime -> Value
    toValue = LocalTime -> Value
    ValueDateTime
        fromValue :: Value -> Err m LocalTime
    fromValue = (Value -> Maybe LocalTime) -> Value -> Err m LocalTime
    forall (m :: * -> *) a.
    (MonadFail m, XmlRpcType a) =>
    (Value -> Maybe a) -> Value -> Err m a
    simpleFromValue Value -> Maybe LocalTime
    f
            where f :: Value -> Maybe LocalTime
    f (ValueDateTime x :: LocalTime
    x) = LocalTime -> Maybe LocalTime
    forall a. a -> Maybe a
    Just LocalTime
    x
                  f _ = Maybe LocalTime
    forall a. Maybe a
    Nothing
        getType :: LocalTime -> Type
    getType _ = Type
    TDateTime

    instance XmlRpcType CalendarTime where
        toValue :: CalendarTime -> Value
    toValue = LocalTime -> Value
    forall a. XmlRpcType a => a -> Value
    toValue (LocalTime -> Value)
    -> (CalendarTime -> LocalTime) -> CalendarTime -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CalendarTime -> LocalTime
    calendarTimeToLocalTime
        fromValue :: Value -> Err m CalendarTime
    fromValue = (LocalTime -> CalendarTime)
    -> ExceptT String m LocalTime -> Err m CalendarTime
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM LocalTime -> CalendarTime
    localTimeToCalendarTime (ExceptT String m LocalTime -> Err m CalendarTime)
    -> (Value -> ExceptT String m LocalTime)
    -> Value
    -> Err m CalendarTime
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value -> ExceptT String m LocalTime
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue
        getType :: CalendarTime -> Type
    getType _ = Type
    TDateTime

    instance XmlRpcType () where
        toValue :: () -> Value
    toValue = Value -> () -> Value
    forall a b. a -> b -> a
    const Value
    ValueNil
        fromValue :: Value -> Err m ()
    fromValue = (Value -> Maybe ()) -> Value -> Err m ()
    forall (m :: * -> *) a.
    (MonadFail m, XmlRpcType a) =>
    (Value -> Maybe a) -> Value -> Err m a
    simpleFromValue Value -> Maybe ()
    f
            where f :: Value -> Maybe ()
    f ValueNil = () -> Maybe ()
    forall a. a -> Maybe a
    Just ()
                  f _ = Maybe ()
    forall a. Maybe a
    Nothing
        getType :: () -> Type
    getType _ = Type
    TNil

    -- FIXME: array elements may have different types
    instance OVERLAPPABLE_ XmlRpcType a => XmlRpcType [a] where
        toValue :: [a] -> Value
    toValue = [Value] -> Value
    ValueArray ([Value] -> Value) -> ([a] -> [Value]) -> [a] -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Value) -> [a] -> [Value]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Value
    forall a. XmlRpcType a => a -> Value
    toValue
        fromValue :: Value -> Err m [a]
    fromValue v :: Value
    v = case Value
    v of
                             ValueArray xs :: [Value]
    xs -> (Value -> ExceptT String m a) -> [Value] -> Err m [a]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Value -> ExceptT String m a
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue [Value]
    xs
                             _ -> Value -> Err m [a]
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    typeError Value
    v
        getType :: [a] -> Type
    getType _ = Type
    TArray

    -- FIXME: struct elements may have different types
    instance OVERLAPPING_ XmlRpcType a => XmlRpcType [(String,a)] where
        toValue :: [(String, a)] -> Value
    toValue xs :: [(String, a)]
    xs = [(String, Value)] -> Value
    ValueStruct [(String
    n, a -> Value
    forall a. XmlRpcType a => a -> Value
    toValue a
    v) | (n :: String
    n,v :: a
    v) <- [(String, a)]
    xs]

        fromValue :: Value -> Err m [(String, a)]
    fromValue v :: Value
    v = case Value
    v of
                      ValueStruct xs :: [(String, Value)]
    xs -> ((String, Value) -> ExceptT String m (String, a))
    -> [(String, Value)] -> Err m [(String, a)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (\ (n :: String
    n,v' :: Value
    v') -> (a -> (String, a))
    -> ExceptT String m a -> ExceptT String m (String, a)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ((,) String
    n) (Value -> ExceptT String m a
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    v')) [(String, Value)]
    xs
                      _ -> Value -> Err m [(String, a)]
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    typeError Value
    v
        getType :: [(String, a)] -> Type
    getType _ = Type
    TStruct

    -- Tuple instances may be used for heterogenous array types.
    instance (XmlRpcType a, XmlRpcType b, XmlRpcType c, XmlRpcType d,
              XmlRpcType e) =>
             XmlRpcType (a,b,c,d,e) where
        toValue :: (a, b, c, d, e) -> Value
    toValue (v :: a
    v,w :: b
    w,x :: c
    x,y :: d
    y,z :: e
    z) =
            [Value] -> Value
    ValueArray [a -> Value
    forall a. XmlRpcType a => a -> Value
    toValue a
    v, b -> Value
    forall a. XmlRpcType a => a -> Value
    toValue b
    w, c -> Value
    forall a. XmlRpcType a => a -> Value
    toValue c
    x, d -> Value
    forall a. XmlRpcType a => a -> Value
    toValue d
    y, e -> Value
    forall a. XmlRpcType a => a -> Value
    toValue e
    z]
        fromValue :: Value -> Err m (a, b, c, d, e)
    fromValue (ValueArray [v :: Value
    v,w :: Value
    w,x :: Value
    x,y :: Value
    y,z :: Value
    z]) =
            (a -> b -> c -> d -> e -> (a, b, c, d, e))
    -> ExceptT String m a
    -> ExceptT String m b
    -> ExceptT String m c
    -> ExceptT String m d
    -> ExceptT String m e
    -> Err m (a, b, c, d, e)
    forall (m :: * -> *) a1 a2 a3 a4 a5 r.
    Monad m =>
    (a1 -> a2 -> a3 -> a4 -> a5 -> r)
    -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
    liftM5 (,,,,) (Value -> ExceptT String m a
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    v) (Value -> ExceptT String m b
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    w) (Value -> ExceptT String m c
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    x)
                          (Value -> ExceptT String m d
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    y) (Value -> ExceptT String m e
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    z)
        fromValue _ = String -> Err m (a, b, c, d, e)
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError "Expected 5-element tuple!"
        getType :: (a, b, c, d, e) -> Type
    getType _ = Type
    TArray

    instance (XmlRpcType a, XmlRpcType b, XmlRpcType c, XmlRpcType d) =>
             XmlRpcType (a,b,c,d) where
        toValue :: (a, b, c, d) -> Value
    toValue (w :: a
    w,x :: b
    x,y :: c
    y,z :: d
    z) = [Value] -> Value
    ValueArray [a -> Value
    forall a. XmlRpcType a => a -> Value
    toValue a
    w, b -> Value
    forall a. XmlRpcType a => a -> Value
    toValue b
    x, c -> Value
    forall a. XmlRpcType a => a -> Value
    toValue c
    y, d -> Value
    forall a. XmlRpcType a => a -> Value
    toValue d
    z]
        fromValue :: Value -> Err m (a, b, c, d)
    fromValue (ValueArray [w :: Value
    w,x :: Value
    x,y :: Value
    y,z :: Value
    z]) =
            (a -> b -> c -> d -> (a, b, c, d))
    -> ExceptT String m a
    -> ExceptT String m b
    -> ExceptT String m c
    -> ExceptT String m d
    -> Err m (a, b, c, d)
    forall (m :: * -> *) a1 a2 a3 a4 r.
    Monad m =>
    (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
    liftM4 (,,,) (Value -> ExceptT String m a
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    w) (Value -> ExceptT String m b
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    x) (Value -> ExceptT String m c
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    y) (Value -> ExceptT String m d
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    z)
        fromValue _ = String -> Err m (a, b, c, d)
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError "Expected 4-element tuple!"
        getType :: (a, b, c, d) -> Type
    getType _ = Type
    TArray

    instance (XmlRpcType a, XmlRpcType b, XmlRpcType c) => XmlRpcType (a,b,c) where
        toValue :: (a, b, c) -> Value
    toValue (x :: a
    x,y :: b
    y,z :: c
    z) = [Value] -> Value
    ValueArray [a -> Value
    forall a. XmlRpcType a => a -> Value
    toValue a
    x, b -> Value
    forall a. XmlRpcType a => a -> Value
    toValue b
    y, c -> Value
    forall a. XmlRpcType a => a -> Value
    toValue c
    z]
        fromValue :: Value -> Err m (a, b, c)
    fromValue (ValueArray [x :: Value
    x,y :: Value
    y,z :: Value
    z]) =
            (a -> b -> c -> (a, b, c))
    -> ExceptT String m a
    -> ExceptT String m b
    -> ExceptT String m c
    -> Err m (a, b, c)
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 (,,) (Value -> ExceptT String m a
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    x) (Value -> ExceptT String m b
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    y) (Value -> ExceptT String m c
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    z)
        fromValue _ = String -> Err m (a, b, c)
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError "Expected 3-element tuple!"
        getType :: (a, b, c) -> Type
    getType _ = Type
    TArray

    instance (XmlRpcType a, XmlRpcType b) => XmlRpcType (a,b) where
        toValue :: (a, b) -> Value
    toValue (x :: a
    x,y :: b
    y) = [Value] -> Value
    ValueArray [a -> Value
    forall a. XmlRpcType a => a -> Value
    toValue a
    x, b -> Value
    forall a. XmlRpcType a => a -> Value
    toValue b
    y]
        fromValue :: Value -> Err m (a, b)
    fromValue (ValueArray [x :: Value
    x,y :: Value
    y]) = (a -> b -> (a, b))
    -> ExceptT String m a -> ExceptT String m b -> Err m (a, b)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (,) (Value -> ExceptT String m a
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    x) (Value -> ExceptT String m b
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    y)
        fromValue _ = String -> Err m (a, b)
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError "Expected 2-element tuple."
        getType :: (a, b) -> Type
    getType _ = Type
    TArray

    -- | Get a field value from a (possibly heterogeneous) struct.
    getField :: (MonadFail m, XmlRpcType a) =>
                String           -- ^ Field name
             -> [(String,Value)] -- ^ Struct
             -> Err m a
    getField :: String -> [(String, Value)] -> Err m a
    getField x :: String
    x xs :: [(String, Value)]
    xs = String -> Maybe Value -> ExceptT String m Value
    forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
    maybeToM ("struct member " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " not found")
                    (String -> [(String, Value)] -> Maybe Value
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    x [(String, Value)]
    xs) ExceptT String m Value -> (Value -> Err m a) -> Err m a
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Value -> Err m a
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue

    -- | Get a field value from a (possibly heterogeneous) struct.
    getFieldMaybe :: (MonadFail m, XmlRpcType a) =>
                String           -- ^ Field name
             -> [(String,Value)] -- ^ Struct
             -> Err m (Maybe a)
    getFieldMaybe :: String -> [(String, Value)] -> Err m (Maybe a)
    getFieldMaybe x :: String
    x xs :: [(String, Value)]
    xs = case String -> [(String, Value)] -> Maybe Value
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    x [(String, Value)]
    xs of
                                          Nothing -> Maybe a -> Err m (Maybe a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
                                          Just v :: Value
    v -> (a -> Maybe a) -> ExceptT String m a -> Err m (Maybe a)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM a -> Maybe a
    forall a. a -> Maybe a
    Just (Value -> ExceptT String m a
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    v)

    --
    -- Converting to XR types
    --

    toXRValue :: Value -> XR.Value
    toXRValue :: Value -> Value
    toXRValue (ValueInt x :: Int
    x) = [Value_] -> Value
    XR.Value [AInt -> Value_
    XR.Value_AInt (String -> AInt
    XR.AInt (Int -> String
    showInt Int
    x))]
    toXRValue (ValueBool b :: Bool
    b) = [Value_] -> Value
    XR.Value [Boolean -> Value_
    XR.Value_Boolean (String -> Boolean
    XR.Boolean (Bool -> String
    showBool Bool
    b))]
    toXRValue (ValueString s :: String
    s) = [Value_] -> Value
    XR.Value [AString -> Value_
    XR.Value_AString (String -> AString
    XR.AString (String -> String
    showString String
    s))]
    toXRValue (ValueUnwrapped s :: String
    s) = [Value_] -> Value
    XR.Value [String -> Value_
    XR.Value_Str String
    s]
    toXRValue (ValueDouble d :: Double
    d) = [Value_] -> Value
    XR.Value [ADouble -> Value_
    XR.Value_ADouble (String -> ADouble
    XR.ADouble (Double -> String
    showDouble Double
    d))]
    toXRValue (ValueDateTime t :: LocalTime
    t) =
       [Value_] -> Value
    XR.Value [ DateTime_iso8601 -> Value_
    XR.Value_DateTime_iso8601 (String -> DateTime_iso8601
    XR.DateTime_iso8601 (LocalTime -> String
    showDateTime LocalTime
    t))]
    toXRValue (ValueBase64 s :: ByteString
    s) = [Value_] -> Value
    XR.Value [Base64 -> Value_
    XR.Value_Base64 (String -> Base64
    XR.Base64 (ByteString -> String
    showBase64 ByteString
    s))]
    toXRValue (ValueStruct xs :: [(String, Value)]
    xs) = [Value_] -> Value
    XR.Value [Struct -> Value_
    XR.Value_Struct ([Member] -> Struct
    XR.Struct (((String, Value) -> Member) -> [(String, Value)] -> [Member]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Value) -> Member
    toXRMember [(String, Value)]
    xs))]
    toXRValue (ValueArray xs :: [Value]
    xs) =
        [Value_] -> Value
    XR.Value [Array -> Value_
    XR.Value_Array (Data -> Array
    XR.Array ([Value] -> Data
    XR.Data ((Value -> Value) -> [Value] -> [Value]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Value
    toXRValue [Value]
    xs)))]
    toXRValue ValueNil = [Value_] -> Value
    XR.Value [Nil -> Value_
    XR.Value_Nil (() -> Nil
    XR.Nil ())]

    showInt :: Int -> String
    showInt :: Int -> String
    showInt = Int -> String
    forall a. Show a => a -> String
    show

    showBool :: Bool -> String
    showBool :: Bool -> String
    showBool b :: Bool
    b = if Bool
    b then "1" else "0"

    -- escapes &, <, and <
    showString :: String -> String
    showString :: String -> String
    showString = String -> String -> String -> String
    forall a. Eq a => [a] -> [a] -> [a] -> [a]
    replace ">" "&gt;" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String -> String
    forall a. Eq a => [a] -> [a] -> [a] -> [a]
    replace "<" "&lt;" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String -> String
    forall a. Eq a => [a] -> [a] -> [a] -> [a]
    replace "&" "&amp;"

    -- | Shows a double in signed decimal point notation.
    showDouble :: Double -> String
    showDouble :: Double -> String
    showDouble d :: Double
    d = Maybe Int -> Double -> String -> String
    forall a. RealFloat a => Maybe Int -> a -> String -> String
    showFFloat Maybe Int
    forall a. Maybe a
    Nothing Double
    d ""

    -- | Shows a date and time on the format: YYYYMMDDTHH:mm:SS
    showDateTime :: LocalTime -> String
    showDateTime :: LocalTime -> String
    showDateTime t :: LocalTime
    t = TimeLocale -> String -> LocalTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    xmlRpcDateFormat LocalTime
    t

    showBase64 :: BS.ByteString -> String
    showBase64 :: ByteString -> String
    showBase64 = ByteString -> String
    BS.unpack (ByteString -> String)
    -> (ByteString -> ByteString) -> ByteString -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    Base64.encode

    toXRMethodCall :: MethodCall -> XR.MethodCall
    toXRMethodCall :: MethodCall -> MethodCall
    toXRMethodCall (MethodCall name :: String
    name vs :: [Value]
    vs) =
        MethodName -> Maybe Params -> MethodCall
    XR.MethodCall (String -> MethodName
    XR.MethodName String
    name) (Params -> Maybe Params
    forall a. a -> Maybe a
    Just ([Value] -> Params
    toXRParams [Value]
    vs))

    toXRMethodResponse :: MethodResponse -> XR.MethodResponse
    toXRMethodResponse :: MethodResponse -> MethodResponse
    toXRMethodResponse (Return val :: Value
    val) = Params -> MethodResponse
    XR.MethodResponseParams ([Value] -> Params
    toXRParams [Value
    val])
    toXRMethodResponse (Fault code :: Int
    code str :: String
    str) =
        Fault -> MethodResponse
    XR.MethodResponseFault (Value -> Fault
    XR.Fault (Value -> Value
    toXRValue (Int -> String -> Value
    faultStruct Int
    code String
    str)))

    toXRParams :: [Value] -> XR.Params
    toXRParams :: [Value] -> Params
    toXRParams vs :: [Value]
    vs = [Param] -> Params
    XR.Params ((Value -> Param) -> [Value] -> [Param]
    forall a b. (a -> b) -> [a] -> [b]
    map (Value -> Param
    XR.Param (Value -> Param) -> (Value -> Value) -> Value -> Param
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value -> Value
    toXRValue) [Value]
    vs)

    toXRMember :: (String, Value) -> XR.Member
    toXRMember :: (String, Value) -> Member
    toXRMember (n :: String
    n, v :: Value
    v) = Name -> Value -> Member
    XR.Member (String -> Name
    XR.Name String
    n) (Value -> Value
    toXRValue Value
    v)

    --
    -- Converting from XR types
    --

    fromXRValue :: MonadFail m => XR.Value -> Err m Value
    fromXRValue :: Value -> Err m Value
    fromXRValue (XR.Value vs :: [Value_]
    vs)
      =  case ((Value_ -> Bool) -> [Value_] -> [Value_]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Value_ -> Bool
    notstr [Value_]
    vs) of
           []     -> ([String] -> Value) -> ExceptT String m [String] -> Err m Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM  (String -> Value
    ValueUnwrapped (String -> Value) -> ([String] -> String) -> [String] -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat) ((Value_ -> ExceptT String m String)
    -> [Value_] -> ExceptT String m [String]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (String -> ExceptT String m String
    forall (m :: * -> *). Monad m => String -> Err m String
    readString (String -> ExceptT String m String)
    -> (Value_ -> String) -> Value_ -> ExceptT String m String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value_ -> String
    unstr) [Value_]
    vs)
           (v :: Value_
    v:_)  -> Value_ -> Err m Value
    forall (m :: * -> *).
    MonadFail m =>
    Value_ -> ExceptT String m Value
    f Value_
    v
      where
      notstr :: Value_ -> Bool
    notstr (XR.Value_Str _)  = Bool
    False
      notstr _                 = Bool
    True

      unstr :: Value_ -> String
    unstr (XR.Value_Str x :: String
    x)  = String
    x

      f :: Value_ -> ExceptT String m Value
    f (XR.Value_I4 (XR.I4 x :: String
    x)) = (Int -> Value) -> ExceptT String m Int -> ExceptT String m Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Int -> Value
    ValueInt (String -> ExceptT String m Int
    forall (m :: * -> *). MonadFail m => String -> Err m Int
    readInt String
    x)
      f (XR.Value_I8 (XR.I8 x :: String
    x)) = (Int -> Value) -> ExceptT String m Int -> ExceptT String m Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Int -> Value
    ValueInt (String -> ExceptT String m Int
    forall (m :: * -> *). MonadFail m => String -> Err m Int
    readInt String
    x)
      f (XR.Value_AInt (XR.AInt x :: String
    x)) = (Int -> Value) -> ExceptT String m Int -> ExceptT String m Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Int -> Value
    ValueInt (String -> ExceptT String m Int
    forall (m :: * -> *). MonadFail m => String -> Err m Int
    readInt String
    x)
      f (XR.Value_Boolean (XR.Boolean x :: String
    x)) = (Bool -> Value) -> ExceptT String m Bool -> ExceptT String m Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Bool -> Value
    ValueBool (String -> ExceptT String m Bool
    forall (m :: * -> *). MonadFail m => String -> Err m Bool
    readBool String
    x)
      f (XR.Value_ADouble (XR.ADouble x :: String
    x)) = (Double -> Value)
    -> ExceptT String m Double -> ExceptT String m Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Double -> Value
    ValueDouble (String -> ExceptT String m Double
    forall (m :: * -> *). MonadFail m => String -> Err m Double
    readDouble String
    x)
      f (XR.Value_AString (XR.AString x :: String
    x)) = (String -> Value)
    -> ExceptT String m String -> ExceptT String m Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM String -> Value
    ValueString (String -> ExceptT String m String
    forall (m :: * -> *). Monad m => String -> Err m String
    readString String
    x)
      f (XR.Value_DateTime_iso8601 (XR.DateTime_iso8601 x :: String
    x)) =
        (LocalTime -> Value)
    -> ExceptT String m LocalTime -> ExceptT String m Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM LocalTime -> Value
    ValueDateTime (String -> ExceptT String m LocalTime
    forall (m :: * -> *). MonadFail m => String -> Err m LocalTime
    readDateTime String
    x)
      f (XR.Value_Base64 (XR.Base64 x :: String
    x)) = (ByteString -> Value)
    -> ExceptT String m ByteString -> ExceptT String m Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ByteString -> Value
    ValueBase64 (String -> ExceptT String m ByteString
    forall (m :: * -> *). Monad m => String -> Err m ByteString
    readBase64 String
    x)
      f (XR.Value_Struct (XR.Struct ms :: [Member]
    ms)) =
        ([(String, Value)] -> Value)
    -> ExceptT String m [(String, Value)] -> ExceptT String m Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM [(String, Value)] -> Value
    ValueStruct ((Member -> ExceptT String m (String, Value))
    -> [Member] -> ExceptT String m [(String, Value)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Member -> ExceptT String m (String, Value)
    forall (m :: * -> *).
    MonadFail m =>
    Member -> Err m (String, Value)
    fromXRMember [Member]
    ms)
      f (XR.Value_Array (XR.Array (XR.Data xs :: [Value]
    xs))) =
        ([Value] -> Value)
    -> ExceptT String m [Value] -> ExceptT String m Value
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM [Value] -> Value
    ValueArray ((Value -> ExceptT String m Value)
    -> [Value] -> ExceptT String m [Value]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Value -> ExceptT String m Value
    forall (m :: * -> *). MonadFail m => Value -> Err m Value
    fromXRValue [Value]
    xs)
      f (XR.Value_Nil (XR.Nil x :: ()
    x)) = Value -> ExceptT String m Value
    forall (m :: * -> *) a. Monad m => a -> m a
    return Value
    ValueNil

    fromXRMember :: MonadFail m => XR.Member -> Err m (String,Value)
    fromXRMember :: Member -> Err m (String, Value)
    fromXRMember (XR.Member (XR.Name n :: String
    n) xv :: Value
    xv) = (Value -> (String, Value))
    -> ExceptT String m Value -> Err m (String, Value)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (\v :: Value
    v -> (String
    n,Value
    v)) (Value -> ExceptT String m Value
    forall (m :: * -> *). MonadFail m => Value -> Err m Value
    fromXRValue Value
    xv)

    -- | From the XML-RPC specification:
    --
    -- \"An integer is a 32-bit signed number. You can include a plus or
    -- 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 :: MonadFail m => String -> Err m Int
    readInt :: String -> Err m Int
    readInt s :: String
    s = ReadS Int -> String -> String -> Err m Int
    forall (m :: * -> *) a.
    (MonadFail m, Read a) =>
    ReadS a -> String -> String -> Err m a
    errorRead ReadS Int
    forall a. Read a => ReadS a
    reads "Error parsing integer" String
    s

    -- | From the XML-RPC specification:
    --
    -- \"0 (false) or 1 (true)\"
    readBool :: MonadFail m => String -> Err m Bool
    readBool :: String -> Err m Bool
    readBool s :: String
    s = ReadS Bool -> String -> String -> Err m Bool
    forall (m :: * -> *) a.
    (MonadFail m, Read a) =>
    ReadS a -> String -> String -> Err m a
    errorRead ReadS Bool
    readsBool "Error parsing boolean" String
    s
        where readsBool :: ReadS Bool
    readsBool "true" = [(Bool
    True,"")]
              readsBool "false" = [(Bool
    False,"")]
              readsBool "1" = [(Bool
    True,"")]
              readsBool "0" = [(Bool
    False,"")]
              readsBool _ = []

    -- | From the XML-RPC specification:
    --
    -- \"Any characters are allowed in a string except \< and &, which are
    -- encoded as &lt; and &amp;. A string can be used to encode binary data.\"
    --
    -- To work with implementations (such as some Python bindings for example)
    -- which also escape \>, &gt; is unescaped. This is non-standard, but
    -- seems unlikely to cause problems.
    readString :: Monad m => String -> Err m String
    readString :: String -> Err m String
    readString = String -> Err m String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Err m String)
    -> (String -> String) -> String -> Err m String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String -> String
    forall a. Eq a => [a] -> [a] -> [a] -> [a]
    replace "&amp;" "&" (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String -> String
    forall a. Eq a => [a] -> [a] -> [a] -> [a]
    replace "&lt;" "<"
                 (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String -> String
    forall a. Eq a => [a] -> [a] -> [a] -> [a]
    replace "&gt;" ">"

    -- | From the XML-RPC specification:
    --
    -- There is no representation for infinity or negative infinity or \"not
    -- a number\". At this time, only decimal point notation is allowed, a
    -- plus or a minus, followed by any number of numeric characters,
    -- followed by a period and any number of numeric
    -- characters. Whitespace is not allowed. The range of allowable values
    -- is implementation-dependent, is not specified.
    --
    -- FIXME: accepts more than decimal point notation
    readDouble :: MonadFail m => String -> Err m Double
    readDouble :: String -> Err m Double
    readDouble s :: String
    s = ReadS Double -> String -> String -> Err m Double
    forall (m :: * -> *) a.
    (MonadFail m, Read a) =>
    ReadS a -> String -> String -> Err m a
    errorRead ReadS Double
    forall a. Read a => ReadS a
    reads "Error parsing double" String
    s

    -- | From <http://groups.yahoo.com/group/xml-rpc/message/4733>:
    --
    --   \"Essentially \"dateTime.iso8601\" is a misnomer and the format of the
    --   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 :: MonadFail m => String -> Err m LocalTime
    readDateTime :: String -> Err m LocalTime
    readDateTime dt :: String
    dt =
        Err m LocalTime
    -> (LocalTime -> Err m LocalTime)
    -> Maybe LocalTime
    -> Err m LocalTime
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
            (String -> Err m LocalTime
    forall (m :: * -> *) a. MonadFail m => String -> m a
    Fail.fail (String -> Err m LocalTime) -> String -> Err m LocalTime
    forall a b. (a -> b) -> a -> b
    $ "Error parsing dateTime '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dt String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "'")
            LocalTime -> Err m LocalTime
    forall (m :: * -> *) a. Monad m => a -> m a
    return
            (Bool -> TimeLocale -> String -> String -> Maybe LocalTime
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> String -> String -> m t
    parseTimeM Bool
    True TimeLocale
    defaultTimeLocale String
    xmlRpcDateFormat String
    dt)

    localTimeToCalendarTime :: LocalTime -> CalendarTime
    localTimeToCalendarTime :: LocalTime -> CalendarTime
    localTimeToCalendarTime l :: LocalTime
    l =
        let (y :: Integer
    y,mo :: Int
    mo,d :: Int
    d) = Day -> (Integer, Int, Int)
    toGregorian (LocalTime -> Day
    localDay LocalTime
    l)
            TimeOfDay { todHour :: TimeOfDay -> Int
    todHour = Int
    h, todMin :: TimeOfDay -> Int
    todMin = Int
    mi, todSec :: TimeOfDay -> Pico
    todSec = Pico
    s } = LocalTime -> TimeOfDay
    localTimeOfDay LocalTime
    l
            (_,_,wd :: Int
    wd) = Day -> (Integer, Int, Int)
    toWeekDate (LocalTime -> Day
    localDay LocalTime
    l)
            (_,yd :: Int
    yd) = Day -> (Integer, Int)
    toOrdinalDate (LocalTime -> Day
    localDay LocalTime
    l)
         in CalendarTime :: Int
    -> Month
    -> Int
    -> Int
    -> Int
    -> Int
    -> Integer
    -> Day
    -> Int
    -> String
    -> Int
    -> Bool
    -> CalendarTime
    CalendarTime {
                          ctYear :: Int
    ctYear    = Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    y,
                          ctMonth :: Month
    ctMonth   = Int -> Month
    forall a. Enum a => Int -> a
    toEnum (Int
    moInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1),
                          ctDay :: Int
    ctDay     = Int
    d,
                          ctHour :: Int
    ctHour    = Int
    h,
                          ctMin :: Int
    ctMin     = Int
    mi,
                          ctSec :: Int
    ctSec     = Pico -> Int
    forall a b. (RealFrac a, Integral b) => a -> b
    truncate Pico
    s,
                          ctPicosec :: Integer
    ctPicosec = 0,
                          ctWDay :: Day
    ctWDay    = Int -> Day
    forall a. Enum a => Int -> a
    toEnum (Int
    wd Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` 7),
                          ctYDay :: Int
    ctYDay    = Int
    yd,
                          ctTZName :: String
    ctTZName  = "UTC",
                          ctTZ :: Int
    ctTZ      = 0,
                          ctIsDST :: Bool
    ctIsDST   = Bool
    False
                         }

    calendarTimeToLocalTime :: CalendarTime -> LocalTime
    calendarTimeToLocalTime :: CalendarTime -> LocalTime
    calendarTimeToLocalTime ct :: CalendarTime
    ct =
        let (y :: Int
    y,mo :: Month
    mo,d :: Int
    d) = (CalendarTime -> Int
    ctYear CalendarTime
    ct, CalendarTime -> Month
    ctMonth CalendarTime
    ct, CalendarTime -> Int
    ctDay CalendarTime
    ct)
            (h :: Int
    h,mi :: Int
    mi,s :: Int
    s) = (CalendarTime -> Int
    ctHour CalendarTime
    ct, CalendarTime -> Int
    ctMin CalendarTime
    ct, CalendarTime -> Int
    ctSec CalendarTime
    ct)
         in LocalTime :: Day -> TimeOfDay -> LocalTime
    LocalTime {
                       localDay :: Day
    localDay = Integer -> Int -> Int -> Day
    fromGregorian (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    y) (Month -> Int
    forall a. Enum a => a -> Int
    fromEnum Month
    mo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1) Int
    d,
                       localTimeOfDay :: TimeOfDay
    localTimeOfDay = TimeOfDay :: Int -> Int -> Pico -> TimeOfDay
    TimeOfDay { todHour :: Int
    todHour = Int
    h, todMin :: Int
    todMin = Int
    mi, todSec :: Pico
    todSec = Int -> Pico
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    s }
                      }

    -- FIXME: what if data contains non-base64 characters?
    readBase64 :: Monad m => String -> Err m BS.ByteString
    readBase64 :: String -> Err m ByteString
    readBase64 = ByteString -> Err m ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> Err m ByteString)
    -> (String -> ByteString) -> String -> Err m ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    Base64.decode (ByteString -> ByteString)
    -> (String -> ByteString) -> String -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ByteString
    BS.pack

    fromXRParams :: MonadFail m => XR.Params -> Err m [Value]
    fromXRParams :: Params -> Err m [Value]
    fromXRParams (XR.Params xps :: [Param]
    xps) = (Param -> ExceptT String m Value) -> [Param] -> Err m [Value]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (\(XR.Param v :: Value
    v) -> Value -> ExceptT String m Value
    forall (m :: * -> *). MonadFail m => Value -> Err m Value
    fromXRValue Value
    v) [Param]
    xps

    fromXRMethodCall :: MonadFail m => XR.MethodCall -> Err m MethodCall
    fromXRMethodCall :: MethodCall -> Err m MethodCall
    fromXRMethodCall (XR.MethodCall (XR.MethodName name :: String
    name) params :: Maybe Params
    params) =
        ([Value] -> MethodCall)
    -> ExceptT String m [Value] -> Err m MethodCall
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (String -> [Value] -> MethodCall
    MethodCall String
    name) (Params -> ExceptT String m [Value]
    forall (m :: * -> *). MonadFail m => Params -> Err m [Value]
    fromXRParams (Params -> Maybe Params -> Params
    forall a. a -> Maybe a -> a
    fromMaybe ([Param] -> Params
    XR.Params []) Maybe Params
    params))

    fromXRMethodResponse :: MonadFail m => XR.MethodResponse -> Err m MethodResponse
    fromXRMethodResponse :: MethodResponse -> Err m MethodResponse
    fromXRMethodResponse (XR.MethodResponseParams xps :: Params
    xps) =
        (Value -> MethodResponse)
    -> ExceptT String m Value -> Err m MethodResponse
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Value -> MethodResponse
    Return (Params -> Err m [Value]
    forall (m :: * -> *). MonadFail m => Params -> Err m [Value]
    fromXRParams Params
    xps Err m [Value]
    -> ([Value] -> ExceptT String m Value) -> ExceptT String m Value
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Value] -> ExceptT String m Value
    forall (m :: * -> *). MonadFail m => [Value] -> Err m Value
    onlyOneResult)
    fromXRMethodResponse (XR.MethodResponseFault (XR.Fault v :: Value
    v)) =
        do
        Value
    struct <- Value -> ExceptT String m Value
    forall (m :: * -> *). MonadFail m => Value -> Err m Value
    fromXRValue Value
    v
        Value
    vcode <- String -> Value -> ExceptT String m Value
    forall (m :: * -> *). MonadFail m => String -> Value -> Err m Value
    structGetValue "faultCode" Value
    struct
        Int
    code <- Value -> Err m Int
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    vcode
        Value
    vstr <- String -> Value -> ExceptT String m Value
    forall (m :: * -> *). MonadFail m => String -> Value -> Err m Value
    structGetValue "faultString" Value
    struct
        String
    str <- Value -> Err m String
    forall a (m :: * -> *).
    (XmlRpcType a, MonadFail m) =>
    Value -> Err m a
    fromValue Value
    vstr
        MethodResponse -> Err m MethodResponse
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> String -> MethodResponse
    Fault Int
    code String
    str)

    --
    -- Parsing calls and reponses from XML
    --

    -- | Parses a method call from XML.
    parseCall :: (Show e, MonadError e m, MonadFail m) => String -> Err m MethodCall
    parseCall :: String -> Err m MethodCall
    parseCall c :: String
    c =
        do
        Either String MethodCall
    mxc <- Either String MethodCall -> Err m (Either String MethodCall)
    forall e (m :: * -> *) a. (Show e, MonadError e m) => a -> Err m a
    errorToErr (String -> Either String MethodCall
    forall a. XmlContent a => String -> Either String a
    readXml String
    c)
        MethodCall
    xc <- String -> Either String MethodCall -> ExceptT String m MethodCall
    forall (m :: * -> *) a.
    MonadFail m =>
    String -> Either String a -> m a
    eitherToM "Error parsing method call" Either String MethodCall
    mxc
        MethodCall -> Err m MethodCall
    forall (m :: * -> *). MonadFail m => MethodCall -> Err m MethodCall
    fromXRMethodCall MethodCall
    xc

    -- | Parses a method response from XML.
    parseResponse :: (Show e, MonadError e m, MonadFail m) => String -> Err m MethodResponse
    parseResponse :: String -> Err m MethodResponse
    parseResponse c :: String
    c =
        do
        Either String MethodResponse
    mxr <- Either String MethodResponse
    -> Err m (Either String MethodResponse)
    forall e (m :: * -> *) a. (Show e, MonadError e m) => a -> Err m a
    errorToErr (String -> Either String MethodResponse
    forall a. XmlContent a => String -> Either String a
    readXml String
    c)
        MethodResponse
    xr <- String
    -> Either String MethodResponse -> ExceptT String m MethodResponse
    forall (m :: * -> *) a.
    MonadFail m =>
    String -> Either String a -> m a
    eitherToM "Error parsing method response" Either String MethodResponse
    mxr
        MethodResponse -> Err m MethodResponse
    forall (m :: * -> *).
    MonadFail m =>
    MethodResponse -> Err m MethodResponse
    fromXRMethodResponse MethodResponse
    xr

    --
    -- Rendering calls and reponses to XML
    --

    -- | Makes an XML-representation of a method call.
    -- FIXME: pretty prints ugly XML
    renderCall :: MethodCall -> BSL.ByteString
    renderCall :: MethodCall -> ByteString
    renderCall = Bool -> MethodCall -> ByteString
    forall a. XmlContent a => Bool -> a -> ByteString
    showXml' Bool
    False (MethodCall -> ByteString)
    -> (MethodCall -> MethodCall) -> MethodCall -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MethodCall -> MethodCall
    toXRMethodCall

    -- | Makes an XML-representation of a method response.
    -- FIXME: pretty prints ugly XML
    renderResponse :: MethodResponse -> BSL.ByteString
    renderResponse :: MethodResponse -> ByteString
    renderResponse  = Bool -> MethodResponse -> ByteString
    forall a. XmlContent a => Bool -> a -> ByteString
    showXml' Bool
    False (MethodResponse -> ByteString)
    -> (MethodResponse -> MethodResponse)
    -> MethodResponse
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MethodResponse -> MethodResponse
    toXRMethodResponse

    showXml' :: XmlContent a => Bool -> a -> BSL.ByteString
    showXml' :: Bool -> a -> ByteString
    showXml' dtd :: Bool
    dtd x :: a
    x = case a -> [Content ()]
    forall a. XmlContent a => a -> [Content ()]
    toContents a
    x of
                       [CElem _ _] -> (Document () -> ByteString
    forall i. Document i -> ByteString
    document (Document () -> ByteString)
    -> (a -> Document ()) -> a -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> a -> Document ()
    forall a. XmlContent a => Bool -> a -> Document ()
    toXml Bool
    dtd) a
    x
                       _ -> String -> ByteString
    BSL.pack ""