    {-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}

    module Network.SOAP.Exception
        ( SOAPParsingError(..)
        , SOAPFault(..), extractSoapFault
        ) where

    import Control.Exception as E
    import Data.Typeable
    import Text.XML (Document)
    import Text.XML.Cursor
    import qualified Data.Text as T

    data SOAPParsingError = SOAPParsingError String deriving (Int -> SOAPParsingError -> ShowS
    [SOAPParsingError] -> ShowS
    SOAPParsingError -> String
    (Int -> SOAPParsingError -> ShowS)
    -> (SOAPParsingError -> String)
    -> ([SOAPParsingError] -> ShowS)
    -> Show SOAPParsingError
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SOAPParsingError -> ShowS
    showsPrec :: Int -> SOAPParsingError -> ShowS
    $cshow :: SOAPParsingError -> String
    show :: SOAPParsingError -> String
    $cshowList :: [SOAPParsingError] -> ShowS
    showList :: [SOAPParsingError] -> ShowS
    Show, Typeable)
    instance Exception SOAPParsingError

    -- | Exception to be thrown when transport encounters an exception that is
    --   acutally a SOAP Fault.
    data SOAPFault = SOAPFault { SOAPFault -> Text
    faultCode   :: T.Text
                               , SOAPFault -> Text
    faultString :: T.Text
                               , SOAPFault -> Text
    faultDetail :: T.Text
                               } deriving (SOAPFault -> SOAPFault -> Bool
    (SOAPFault -> SOAPFault -> Bool)
    -> (SOAPFault -> SOAPFault -> Bool) -> Eq SOAPFault
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SOAPFault -> SOAPFault -> Bool
    == :: SOAPFault -> SOAPFault -> Bool
    $c/= :: SOAPFault -> SOAPFault -> Bool
    /= :: SOAPFault -> SOAPFault -> Bool
    Eq, Int -> SOAPFault -> ShowS
    [SOAPFault] -> ShowS
    SOAPFault -> String
    (Int -> SOAPFault -> ShowS)
    -> (SOAPFault -> String)
    -> ([SOAPFault] -> ShowS)
    -> Show SOAPFault
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SOAPFault -> ShowS
    showsPrec :: Int -> SOAPFault -> ShowS
    $cshow :: SOAPFault -> String
    show :: SOAPFault -> String
    $cshowList :: [SOAPFault] -> ShowS
    showList :: [SOAPFault] -> ShowS
    Show, Typeable)

    instance Exception SOAPFault

    -- | Try to find a SOAP Fault in a document.
    extractSoapFault :: Document -> Maybe SOAPFault
    extractSoapFault :: Document -> Maybe SOAPFault
    extractSoapFault Document
    doc =
        case [Cursor]
    cur' of
            []    -> Maybe SOAPFault
    forall a. Maybe a
    Nothing
            Cursor
    cur:[Cursor]
    _ -> SOAPFault -> Maybe SOAPFault
    forall a. a -> Maybe a
    Just (SOAPFault -> Maybe SOAPFault) -> SOAPFault -> Maybe SOAPFault
    forall a b. (a -> b) -> a -> b
    $ SOAPFault { faultCode :: Text
    faultCode   = Text -> Cursor -> Text
    peek Text
    "faultcode" Cursor
    cur
                                      , faultString :: Text
    faultString = Text -> Cursor -> Text
    peek Text
    "faultstring" Cursor
    cur
                                      , faultDetail :: Text
    faultDetail = Text -> Cursor -> Text
    peek Text
    "detail" Cursor
    cur
                                      }
        where
            cur' :: [Cursor]
    cur' = Document -> Cursor
    fromDocument Document
    doc Cursor -> (Cursor -> [Cursor]) -> [Cursor]
    forall node a. Cursor node -> (Cursor node -> a) -> a
    $| Text -> Cursor -> [Cursor]
    laxElement Text
    "Envelope"
                                    (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Text -> Cursor -> [Cursor]
    laxElement Text
    "Body"
                                    (Cursor -> [Cursor]) -> (Cursor -> [Cursor]) -> Cursor -> [Cursor]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Text -> Cursor -> [Cursor]
    laxElement Text
    "Fault"

            peek :: Text -> Cursor -> Text
    peek Text
    name Cursor
    cur = [Text] -> Text
    T.concat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ Cursor
    cur Cursor -> (Cursor -> [Text]) -> [Text]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Text -> Cursor -> [Cursor]
    laxElement Text
    name (Cursor -> [Cursor]) -> (Cursor -> [Text]) -> Cursor -> [Text]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Cursor -> [Text]
    content