module Text.XML.Soap where

import Control.Lens
import Data.String
import Text.XML
import Text.XML.DOM.Parser
import Text.XML.Writer

data XmlEnvelope h b = XmlEnvelope
  { forall h b. XmlEnvelope h b -> Maybe h
_xeHeader :: !(Maybe h)
  , forall h b. XmlEnvelope h b -> Maybe b
_xeBody   :: !(Maybe b)
  } deriving (XmlEnvelope h b -> XmlEnvelope h b -> Bool
(XmlEnvelope h b -> XmlEnvelope h b -> Bool)
-> (XmlEnvelope h b -> XmlEnvelope h b -> Bool)
-> Eq (XmlEnvelope h b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall h b.
(Eq h, Eq b) =>
XmlEnvelope h b -> XmlEnvelope h b -> Bool
$c== :: forall h b.
(Eq h, Eq b) =>
XmlEnvelope h b -> XmlEnvelope h b -> Bool
== :: XmlEnvelope h b -> XmlEnvelope h b -> Bool
$c/= :: forall h b.
(Eq h, Eq b) =>
XmlEnvelope h b -> XmlEnvelope h b -> Bool
/= :: XmlEnvelope h b -> XmlEnvelope h b -> Bool
Eq, Int -> XmlEnvelope h b -> ShowS
[XmlEnvelope h b] -> ShowS
XmlEnvelope h b -> String
(Int -> XmlEnvelope h b -> ShowS)
-> (XmlEnvelope h b -> String)
-> ([XmlEnvelope h b] -> ShowS)
-> Show (XmlEnvelope h b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall h b. (Show h, Show b) => Int -> XmlEnvelope h b -> ShowS
forall h b. (Show h, Show b) => [XmlEnvelope h b] -> ShowS
forall h b. (Show h, Show b) => XmlEnvelope h b -> String
$cshowsPrec :: forall h b. (Show h, Show b) => Int -> XmlEnvelope h b -> ShowS
showsPrec :: Int -> XmlEnvelope h b -> ShowS
$cshow :: forall h b. (Show h, Show b) => XmlEnvelope h b -> String
show :: XmlEnvelope h b -> String
$cshowList :: forall h b. (Show h, Show b) => [XmlEnvelope h b] -> ShowS
showList :: [XmlEnvelope h b] -> ShowS
Show)

makeLenses ''XmlEnvelope

xmlEnvelopeToDocument :: (ToXML h, ToXML b) => XmlEnvelope h b -> Document
xmlEnvelopeToDocument :: forall h b. (ToXML h, ToXML b) => XmlEnvelope h b -> Document
xmlEnvelopeToDocument XmlEnvelope h b
xe = Document
doc
  where
    sname :: String -> a
sname String
n = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"{http://schemas.xmlsoap.org/soap/envelope/}" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
n
    doc :: Document
doc    =
      Document
        { documentPrologue :: Prologue
documentPrologue = [Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []
        , documentRoot :: Element
documentRoot     =
          Element
            { elementName :: Name
elementName       = String -> Name
forall a. IsString a => String -> a
sname String
"Envelope"
            , elementAttributes :: Map Name Text
elementAttributes = Map Name Text
forall a. Monoid a => a
mempty
            , elementNodes :: [Node]
elementNodes      = [Element -> Node
NodeElement Element
header, Element -> Node
NodeElement Element
body]
            }
        , documentEpilogue :: [Miscellaneous]
documentEpilogue = []
        }
    header :: Element
header =
      Element
        { elementName :: Name
elementName       = String -> Name
forall a. IsString a => String -> a
sname String
"Header"
        , elementAttributes :: Map Name Text
elementAttributes = Map Name Text
forall a. Monoid a => a
mempty
        , elementNodes :: [Node]
elementNodes      = XML -> [Node]
render (XML -> [Node]) -> (Maybe h -> XML) -> Maybe h -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe h -> XML
forall a. ToXML a => a -> XML
toXML (Maybe h -> [Node]) -> Maybe h -> [Node]
forall a b. (a -> b) -> a -> b
$ XmlEnvelope h b
xe XmlEnvelope h b
-> Getting (Maybe h) (XmlEnvelope h b) (Maybe h) -> Maybe h
forall s a. s -> Getting a s a -> a
^. Getting (Maybe h) (XmlEnvelope h b) (Maybe h)
forall h b h (f :: * -> *).
Functor f =>
(Maybe h -> f (Maybe h)) -> XmlEnvelope h b -> f (XmlEnvelope h b)
xeHeader
        }
    body :: Element
body   =
      Element
        { elementName :: Name
elementName       = String -> Name
forall a. IsString a => String -> a
sname String
"Body"
        , elementAttributes :: Map Name Text
elementAttributes = Map Name Text
forall a. Monoid a => a
mempty
        , elementNodes :: [Node]
elementNodes      = XML -> [Node]
render (XML -> [Node]) -> (Maybe b -> XML) -> Maybe b -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> XML
forall a. ToXML a => a -> XML
toXML (Maybe b -> [Node]) -> Maybe b -> [Node]
forall a b. (a -> b) -> a -> b
$ XmlEnvelope h b
xe XmlEnvelope h b
-> Getting (Maybe b) (XmlEnvelope h b) (Maybe b) -> Maybe b
forall s a. s -> Getting a s a -> a
^. Getting (Maybe b) (XmlEnvelope h b) (Maybe b)
forall h b b (f :: * -> *).
Functor f =>
(Maybe b -> f (Maybe b)) -> XmlEnvelope h b -> f (XmlEnvelope h b)
xeBody
        }

instance (FromDom h, FromDom b) => FromDom (XmlEnvelope h b) where
  fromDom :: forall (m :: * -> *).
Monad m =>
DomParserT Identity m (XmlEnvelope h b)
fromDom = Maybe h -> Maybe b -> XmlEnvelope h b
forall h b. Maybe h -> Maybe b -> XmlEnvelope h b
XmlEnvelope (Maybe h -> Maybe b -> XmlEnvelope h b)
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) (Maybe h)
-> ReaderT
     (ParserData Identity)
     (ExceptT ParserErrors m)
     (Maybe b -> XmlEnvelope h b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElemMatcher
-> DomParserT Identity m h
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) (Maybe h)
forall (m :: * -> *) (g :: * -> *) a.
(Monad m, Foldable g) =>
ElemMatcher -> DomParserT Identity m a -> DomParserT g m (Maybe a)
inElemMay ElemMatcher
"Header" DomParserT Identity m h
forall a (m :: * -> *).
(FromDom a, Monad m) =>
DomParserT Identity m a
forall (m :: * -> *). Monad m => DomParserT Identity m h
fromDom
                        ReaderT
  (ParserData Identity)
  (ExceptT ParserErrors m)
  (Maybe b -> XmlEnvelope h b)
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) (Maybe b)
-> ReaderT
     (ParserData Identity) (ExceptT ParserErrors m) (XmlEnvelope h b)
forall a b.
ReaderT (ParserData Identity) (ExceptT ParserErrors m) (a -> b)
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) a
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ElemMatcher
-> DomParserT Identity m b
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) (Maybe b)
forall (m :: * -> *) (g :: * -> *) a.
(Monad m, Foldable g) =>
ElemMatcher -> DomParserT Identity m a -> DomParserT g m (Maybe a)
inElemMay ElemMatcher
"Body" DomParserT Identity m b
forall a (m :: * -> *).
(FromDom a, Monad m) =>
DomParserT Identity m a
forall (m :: * -> *). Monad m => DomParserT Identity m b
fromDom