git.iko.soy/typeable/dom-parser
on master help sign in
11 files changed+112−49
since splitsnapshots
unifiedsplit
.travis.yml+7−5 CHANGELOG.md+28 README.md+5 dom-parser.cabal+10−10 ghc-963.yaml+7 src/Text/XML/DOM/Parser/Combinators.hs−1 src/Text/XML/DOM/Parser/Content.hs+4−3 src/Text/XML/DOM/Parser/FromDom.hs−20 src/Text/XML/DOM/Parser/Types.hs+4−4 src/Text/XML/Soap.hs+46 stack.yaml+1−6
.travis.yml+7−5
@@ -4,6 +4,12 @@ sudo: false
44# Do not choose a language; we provide our own build tools.
55language: generic
66
7+env:
8+ - STACK_YAML=stack.yaml
9+ - STACK_YAML=ghc-802.yaml
10+ - STACK_YAML=ghc-822.yaml
11+ - STACK_YAML=ghc-841.yaml
12+
713# Caching so the next build will be fast too.
814cache:
915 directories:
@@ -21,10 +27,6 @@ before_install:
2127- export PATH=$HOME/.local/bin:$PATH
2228- travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
2329
24−install:
25−# Build dependencies
26−- stack --no-terminal --install-ghc build --only-dependencies
27−
2830script:
2931# Build the package, its tests, and its docs and run the tests
30−- stack --no-terminal test --haddock --no-haddock-deps
32+- stack --no-terminal --install-ghc test --haddock --no-haddock-deps
CHANGELOG.md+28
@@ -1,5 +1,33 @@
11# CHANGELOG
22
3+## HEAD
4+
5+## 3.2.0
6+
7+### Added
8+
9+* Text.XML.Soap module with XmlEnvelope stuff in it.
10+* GHC 9 compatibility.
11+
12+### Removed
13+
14+* Old stackage files.
15+
16+## 3.1.0
17+
18+### Added
19+
20+* Additional builds with GHC 8.0.2 and 8.2.1
21+* Compatibility with GHC 8.4.1
22+
23+## 3.0.0
24+
25+* GHC 8 compatible release
26+
27+### Removed
28+
29+* `open-union` dependency
30+
331## 2.0.0
432
533### Added
README.mdnew file+5
@@ -0,0 +1,5 @@
1+# dom-parser
2+
3+[![Build Status](https://travis-ci.org/typeable/dom-parser.svg?branch=master)](https://travis-ci.org/typeable/dom-parser)
4+
5+Simple monadic DOM parser
dom-parser.cabal+10−10
@@ -1,5 +1,5 @@
11name: dom-parser
2−version: 2.0.0
2+version: 3.2.0
33synopsis: Simple monadic DOM parser
44license: MIT
55license-file: LICENSE
@@ -7,12 +7,13 @@ author: Typeable.io contributors
77maintainer: makeit@typeable.io
88category: XML
99build-type: Simple
10−extra-source-files: CHANGELOG.md
1110cabal-version: >=1.10
12−
13−extra-source-files: CHANGELOG.md
14−
1511homepage: https://github.com/typeable/dom-parser
12+tested-with: GHC == 9.2.7
13+ , GHC == 9.4.8
14+ , GHC == 9.6.3
15+extra-source-files: CHANGELOG.md
16+ , README.md
1617
1718source-repository head
1819 type: git
@@ -43,18 +44,16 @@ library
4344 , TypeFamilies
4445 , TypeOperators
4546 , UndecidableInstances
46− build-depends: base >= 4.7 && < 5
47+ build-depends: base >= 4.11 && < 5
4748 , case-insensitive
4849 , containers
4950 , lens
50− , mtl
51− , open-union >= 0.2
51+ , mtl < 2.3 || > 2.3
5252 , scientific
53− , semigroups
5453 , text
5554 , transformers
56− , type-fun
5755 , xml-conduit
56+ , xml-conduit-writer
5857 , xml-lens
5958 exposed-modules: Text.XML.DOM.Parser
6059 , Text.XML.DOM.Parser.Attributes
@@ -64,6 +63,7 @@ library
6463 , Text.XML.DOM.Parser.FromAttribute
6564 , Text.XML.DOM.Parser.FromDom
6665 , Text.XML.DOM.Parser.Types
66+ , Text.XML.Soap
6767
6868test-suite test
6969 type: exitcode-stdio-1.0
ghc-963.yamlnew file+7
@@ -0,0 +1,7 @@
1+resolver: lts-22.6
2+
3+extra-deps:
4+ - xml-conduit-writer-0.1.1.5
5+
6+nix:
7+ packages: [zlib]
src/Text/XML/DOM/Parser/Combinators.hs−1
@@ -22,7 +22,6 @@ import Control.Monad.Reader
2222import Data.Foldable as F
2323import Data.List as L
2424import Data.List.NonEmpty (NonEmpty(..))
25−import Data.Monoid
2625import Data.Text as T
2726import Data.Traversable
2827import Text.XML
src/Text/XML/DOM/Parser/Content.hs+4−3
@@ -20,6 +20,7 @@ import Data.List as L
2020import Data.Monoid
2121import Data.Text as T
2222import Data.Typeable
23+import Prelude as P
2324import Text.Read
2425import Text.XML.DOM.Parser.Types
2526import Text.XML.Lens
@@ -93,7 +94,7 @@ maybeReadContent
9394maybeReadContent f t = maybe (Left msg) Right $ f t
9495 where
9596 msg = "Not readable " <> n <> ": " <> t
96− n = T.pack $ show $ typeRep (Proxy :: Proxy a)
97+ n = T.pack $ P.show $ typeRep (Proxy :: Proxy a)
9798
9899
99100-- | Tries to read given text to value using 'Read'. Useful to use
@@ -114,8 +115,8 @@ readBool t =
114115 tvals = ["y", "yes", "t", "true", "1"]
115116 fvals = ["n", "no", "f", "false", "0"]
116117 in if
117− | lowt `elem` tvals -> Right True
118− | lowt `elem` fvals -> Right False
118+ | lowt `L.elem` tvals -> Right True
119+ | lowt `L.elem` fvals -> Right False
119120 | otherwise ->
120121 Left $ "Could not read " <> t <> " as Bool"
121122
src/Text/XML/DOM/Parser/FromDom.hs−20
@@ -4,7 +4,6 @@ module Text.XML.DOM.Parser.FromDom
44 , proxyFromDom
55 -- * Explicit methods for convenience
66 , elementFromDom
7− , unionFromDom
87 , textFromDom
98 , stringFromDom
109 , charFromDom
@@ -21,7 +20,6 @@ module Text.XML.DOM.Parser.FromDom
2120import Control.Applicative
2221import Control.Lens
2322import Data.Fixed
24−import Data.OpenUnion
2523import Data.Scientific
2624import Data.Text as T hiding (empty)
2725import Data.Typeable
@@ -29,7 +27,6 @@ import Data.Void
2927import Text.XML
3028import Text.XML.DOM.Parser.Content
3129import Text.XML.DOM.Parser.Types
32−import TypeFun.Data.List hiding (Union)
3330
3431proxyFromDom
3532 :: forall proxy m a
@@ -116,23 +113,6 @@ instance FromDom Bool where
116113boolFromDom :: (Monad m) => DomParserT Identity m Bool
117114boolFromDom = parseContent readBool
118115
119−instance FromDom (Union '[]) where
120− fromDom = empty
121−
122−instance
123− ( Typeable a, FromDom a, FromDom (Union as)
124− , SubList as (a ': as) )
125− => FromDom (Union (a ': as)) where
126− -- fromDom :: forall m. (DomParserMonad m) => m a
127− fromDom = (liftUnion <$> (proxyFromDom (Proxy :: Proxy a)))
128− <|> (reUnion <$> (proxyFromDom (Proxy :: Proxy (Union as))))
129−
130−unionFromDom
131− :: (Monad m, FromDom (Union as))
132− => proxy as
133− -> DomParserT Identity m (Union as)
134−unionFromDom _ = fromDom
135−
136116instance FromDom Element where
137117 fromDom = elementFromDom
138118
src/Text/XML/DOM/Parser/Types.hs+4−4
@@ -88,8 +88,6 @@ data NameMatcher = NameMatcher
8888 -- ^ Field for 'Show' instance and bulding usefull errors
8989 }
9090
91−makeLenses ''NameMatcher
92−
9391-- | Instance use 'matchCILocalName' as most general and liberal
9492-- matching strategy (while XML is often malformed).
9593--
@@ -121,6 +119,8 @@ matchCILocalName tname = NameMatcher
121119 , _nmShow = tname
122120 }
123121
122+makeLenses ''NameMatcher
123+
124124-- | Makes matcher which match name by 'Eq' with given
125125--
126126-- @since 2.0.0
@@ -134,7 +134,7 @@ matchName n = NameMatcher
134134-- element of the document. Errors are much more usefull with path.
135135newtype DomPath = DomPath
136136 { unDomPath :: [Text]
137− } deriving (Eq, Ord, Show, Monoid)
137+ } deriving (Eq, Ord, Show, Semigroup, Monoid)
138138
139139-- | DOM parser error description.
140140data ParserError
@@ -184,7 +184,7 @@ instance Exception ParserError
184184
185185newtype ParserErrors = ParserErrors
186186 { unParserErrors :: [ParserError]
187− } deriving (Show, Monoid, Generic)
187+ } deriving (Show, Semigroup, Monoid, Generic)
188188
189189makePrisms ''ParserErrors
190190
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
stack.yamlmode 100644 → 120000+1−6
@@ -1,6 +0,0 @@
1−packages:
2− - .
3−extra-deps:
4− - open-union-0.2.0.0
5− - type-fun-0.1.1
6−resolver: lts-6.25
@@ -0,0 +1 @@
1+ghc-963.yaml