git.iko.soy/typeable/dom-parser
on master help sign in
Add Text.XML.Soap from our internal package.
3289eabNick
dom-parser.cabal+5−4
@@ -9,10 +9,9 @@ category: XML
9build-type: Simple
9build-type: Simple
10cabal-version: >=1.10
10cabal-version: >=1.10
11homepage: https://github.com/typeable/dom-parser
11homepage: https://github.com/typeable/dom-parser
12−tested-with: GHC == 7.10.3
12+tested-with: GHC == 9.2.7
13− , GHC == 8.0.2
13+ , GHC == 9.4.8
14− , GHC == 8.2.2
14+ , GHC == 9.6.3
15− , GHC == 8.4.1
16extra-source-files: CHANGELOG.md
15extra-source-files: CHANGELOG.md
17 , README.md
16 , README.md
18
17
@@ -55,6 +54,7 @@ library
55 , text
54 , text
56 , transformers
55 , transformers
57 , xml-conduit
56 , xml-conduit
57+ , xml-conduit-writer
58 , xml-lens
58 , xml-lens
59 exposed-modules: Text.XML.DOM.Parser
59 exposed-modules: Text.XML.DOM.Parser
60 , Text.XML.DOM.Parser.Attributes
60 , Text.XML.DOM.Parser.Attributes
@@ -64,6 +64,7 @@ library
64 , Text.XML.DOM.Parser.FromAttribute
64 , Text.XML.DOM.Parser.FromAttribute
65 , Text.XML.DOM.Parser.FromDom
65 , Text.XML.DOM.Parser.FromDom
66 , Text.XML.DOM.Parser.Types
66 , Text.XML.DOM.Parser.Types
67+ , Text.XML.Soap
67
68
68test-suite test
69test-suite test
69 type: exitcode-stdio-1.0
70 type: exitcode-stdio-1.0
src/Text/XML/Soap.hsnew file+46
@@ -0,0 +1,46 @@
1+module Text.XML.Soap where
2+
3+import Control.Lens
4+import Data.String
5+import Text.XML
6+import Text.XML.DOM.Parser
7+import Text.XML.Writer
8+
9+data XmlEnvelope h b = XmlEnvelope
10+ { _xeHeader :: !(Maybe h)
11+ , _xeBody :: !(Maybe b)
12+ } deriving (Eq, Show)
13+
14+makeLenses ''XmlEnvelope
15+
16+xmlEnvelopeToDocument :: (ToXML h, ToXML b) => XmlEnvelope h b -> Document
17+xmlEnvelopeToDocument xe = doc
18+ where
19+ sname n = fromString $ "{http://schemas.xmlsoap.org/soap/envelope/}" <> n
20+ doc =
21+ Document
22+ { documentPrologue = Prologue [] Nothing []
23+ , documentRoot =
24+ Element
25+ { elementName = sname "Envelope"
26+ , elementAttributes = mempty
27+ , elementNodes = [NodeElement header, NodeElement body]
28+ }
29+ , documentEpilogue = []
30+ }
31+ header =
32+ Element
33+ { elementName = sname "Header"
34+ , elementAttributes = mempty
35+ , elementNodes = render . toXML $ xe ^. xeHeader
36+ }
37+ body =
38+ Element
39+ { elementName = sname "Body"
40+ , elementAttributes = mempty
41+ , elementNodes = render . toXML $ xe ^. xeBody
42+ }
43+
44+instance (FromDom h, FromDom b) => FromDom (XmlEnvelope h b) where
45+ fromDom = XmlEnvelope <$> inElemMay "Header" fromDom
46+ <*> inElemMay "Body" fromDom