bee2747...master · typeable/dom-parser

.travis.yml+7−5

since splitsnapshots

unifiedsplit

@@ -4,6 +4,12 @@ sudo: false

4# Do not choose a language; we provide our own build tools.

5language: generic

6

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+

7# Caching so the next build will be fast too.

13# Caching so the next build will be fast too.

8cache:

14cache:

9 directories:

15 directories:

@@ -21,10 +27,6 @@ before_install:

21- export PATH=$HOME/.local/bin:$PATH

27- export PATH=$HOME/.local/bin:$PATH

22- travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'

28- travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'

23

29

24−install:

25−# Build dependencies

26−- stack --no-terminal --install-ghc build --only-dependencies

27−

28script:

30script:

29# Build the package, its tests, and its docs and run the tests

31# 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+44

@@ -1,10 +1,54 @@

1# CHANGELOG

2

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+

31+## 2.0.0

32+

33+### Added

34+

35+* `NameMatcher` and `ElemMatcher` as more flexible mechanisms for

36+ matching names and elements instead of just matching by name.

37+* Class `FromAttribute` and some default instances

38+

39+### Changed

40+

41+* `DomTraversable` renamed to `Buildable`

42+* Combinators use `NameMatcher` and `ElemMatcher`

43+* Documentation improved

44+

3## 1.0.0

45## 1.0.0

46+

4* Added support for parsing attributes

47* Added support for parsing attributes

5* Changed public interface for 'parseContent'

48* Changed public interface for 'parseContent'

6* Added useful functions

49* Added useful functions

7* Dropped unnecessary dependency from shakespeare

50* Dropped unnecessary dependency from shakespeare

8

51

9## 0.1.0

52## 0.1.0

53+

10* Public release

54* Public release

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 @@

1name: dom-parser

2−version: 1.0.0

2+version: 3.2.0

3synopsis: Simple monadic DOM parser

4license: MIT

5license-file: LICENSE

@@ -7,12 +7,13 @@ author: Typeable.io contributors

7maintainer: makeit@typeable.io

8category: XML

9build-type: Simple

10−extra-source-files: CHANGELOG.md

11cabal-version: >=1.10

10cabal-version: >=1.10

12−

13−extra-source-files: CHANGELOG.md

14−

15homepage: https://github.com/typeable/dom-parser

11homepage: 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

16

17

17source-repository head

18source-repository head

18 type: git

19 type: git

@@ -43,18 +44,16 @@ library

43 , TypeFamilies

44 , TypeFamilies

44 , TypeOperators

45 , TypeOperators

45 , UndecidableInstances

46 , UndecidableInstances

46− build-depends: base >= 4.7 && < 5

47+ build-depends: base >= 4.11 && < 5

47 , case-insensitive

48 , case-insensitive

48 , containers

49 , containers

49 , lens

50 , lens

50− , mtl

51+ , mtl < 2.3 || > 2.3

51− , open-union >= 0.2

52 , scientific

53− , semigroups

54 , text

53 , text

55 , transformers

54 , transformers

56− , type-fun

57 , xml-conduit

55 , xml-conduit

56+ , xml-conduit-writer

58 , xml-lens

57 , xml-lens

59 exposed-modules: Text.XML.DOM.Parser

58 exposed-modules: Text.XML.DOM.Parser

60 , Text.XML.DOM.Parser.Attributes

59 , Text.XML.DOM.Parser.Attributes

@@ -64,6 +63,7 @@ library

64 , Text.XML.DOM.Parser.FromAttribute

63 , Text.XML.DOM.Parser.FromAttribute

65 , Text.XML.DOM.Parser.FromDom

64 , Text.XML.DOM.Parser.FromDom

66 , Text.XML.DOM.Parser.Types

65 , Text.XML.DOM.Parser.Types

66+ , Text.XML.Soap

67

68test-suite test

69 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

22import Data.Foldable as F

23import Data.List as L

24import Data.List.NonEmpty (NonEmpty(..))

25−import Data.Monoid

26import Data.Text as T

25import Data.Text as T

27import Data.Traversable

26import Data.Traversable

28import Text.XML

27import Text.XML

src/Text/XML/DOM/Parser/Content.hs+5−4

@@ -20,6 +20,7 @@ import Data.List as L

20import Data.Monoid

21import Data.Text as T

22import Data.Typeable

23+import Prelude as P

23import Text.Read

24import Text.Read

24import Text.XML.DOM.Parser.Types

25import Text.XML.DOM.Parser.Types

25import Text.XML.Lens

26import Text.XML.Lens

@@ -35,7 +36,7 @@ parseContent

35parseContent parse = getCurrentContent >>= \case

36parseContent parse = getCurrentContent >>= \case

36 Nothing -> throwParserError PEContentNotFound

37 Nothing -> throwParserError PEContentNotFound

37 Just c -> case parse c of

38 Just c -> case parse c of

38− Left e -> throwParserError $ PEWrongFormat e

39+ Left e -> throwParserError $ PEContentWrongFormat e

39 Right a -> return a

40 Right a -> return a

40

41

42

@@ -93,7 +94,7 @@ maybeReadContent

93maybeReadContent f t = maybe (Left msg) Right $ f t

94maybeReadContent f t = maybe (Left msg) Right $ f t

94 where

95 where

95 msg = "Not readable " <> n <> ": " <> t

96 msg = "Not readable " <> n <> ": " <> t

96− n = T.pack $ show $ typeRep (Proxy :: Proxy a)

97+ n = T.pack $ P.show $ typeRep (Proxy :: Proxy a)

97

98

99

99-- | Tries to read given text to value using 'Read'. Useful to use

100-- | Tries to read given text to value using 'Read'. Useful to use

@@ -114,8 +115,8 @@ readBool t =

114 tvals = ["y", "yes", "t", "true", "1"]

115 tvals = ["y", "yes", "t", "true", "1"]

115 fvals = ["n", "no", "f", "false", "0"]

116 fvals = ["n", "no", "f", "false", "0"]

116 in if

117 in if

117− | lowt `elem` tvals -> Right True

118+ | lowt `L.elem` tvals -> Right True

118− | lowt `elem` fvals -> Right False

119+ | lowt `L.elem` fvals -> Right False

119 | otherwise ->

120 | otherwise ->

120 Left $ "Could not read " <> t <> " as Bool"

121 Left $ "Could not read " <> t <> " as Bool"

121

122

src/Text/XML/DOM/Parser/FromAttribute.hs+2

@@ -26,6 +26,8 @@ import Text.XML.DOM.Parser.Content

26-- | Class of types which can be get from attribute value. Method

27-- 'fromAttribute' is a convenient default parameter for

28-- 'parseAttribute'

29+--

30+-- @since 2.0.0

29class FromAttribute a where

31class FromAttribute a where

30 fromAttribute

32 fromAttribute

31 :: Text

33 :: Text

src/Text/XML/DOM/Parser/FromDom.hs+2−21

@@ -4,7 +4,6 @@ module Text.XML.DOM.Parser.FromDom

4 , proxyFromDom

5 -- * Explicit methods for convenience

6 , elementFromDom

7− , unionFromDom

8 , textFromDom

7 , textFromDom

9 , stringFromDom

8 , stringFromDom

10 , charFromDom

9 , charFromDom

@@ -21,7 +20,6 @@ module Text.XML.DOM.Parser.FromDom

21import Control.Applicative

20import Control.Applicative

22import Control.Lens

21import Control.Lens

23import Data.Fixed

22import Data.Fixed

24−import Data.OpenUnion

25import Data.Scientific

23import Data.Scientific

26import Data.Text as T hiding (empty)

24import Data.Text as T hiding (empty)

27import Data.Typeable

25import Data.Typeable

@@ -29,7 +27,6 @@ import Data.Void

29import Text.XML

27import Text.XML

30import Text.XML.DOM.Parser.Content

28import Text.XML.DOM.Parser.Content

31import Text.XML.DOM.Parser.Types

29import Text.XML.DOM.Parser.Types

32−import TypeFun.Data.List hiding (Union)

33

30

34proxyFromDom

31proxyFromDom

35 :: forall proxy m a

32 :: forall proxy m a

@@ -38,7 +35,8 @@ proxyFromDom

38 -> DomParserT Identity m a

35 -> DomParserT Identity m a

39proxyFromDom _ = fromDom

36proxyFromDom _ = fromDom

40

37

41−-- | Class of types which can be parsed from single XML element.

38+-- | Class of types which can be parsed from single XML element. The

39+-- method 'fromDom' is convenient default to use with 'inElem'

42class FromDom a where

40class FromDom a where

43 fromDom :: (Monad m) => DomParserT Identity m a

41 fromDom :: (Monad m) => DomParserT Identity m a

44

42

@@ -115,23 +113,6 @@ instance FromDom Bool where

115boolFromDom :: (Monad m) => DomParserT Identity m Bool

113boolFromDom :: (Monad m) => DomParserT Identity m Bool

116boolFromDom = parseContent readBool

114boolFromDom = parseContent readBool

117

115

118−instance FromDom (Union '[]) where

119− fromDom = empty

120−

121−instance

122− ( Typeable a, FromDom a, FromDom (Union as)

123− , SubList as (a ': as) )

124− => FromDom (Union (a ': as)) where

125− -- fromDom :: forall m. (DomParserMonad m) => m a

126− fromDom = (liftUnion <$> (proxyFromDom (Proxy :: Proxy a)))

127− <|> (reUnion <$> (proxyFromDom (Proxy :: Proxy (Union as))))

128−

129−unionFromDom

130− :: (Monad m, FromDom (Union as))

131− => proxy as

132− -> DomParserT Identity m (Union as)

133−unionFromDom _ = fromDom

134−

135instance FromDom Element where

116instance FromDom Element where

136 fromDom = elementFromDom

117 fromDom = elementFromDom

137

118

src/Text/XML/DOM/Parser/Types.hs+44−20

@@ -1,17 +1,17 @@

1module Text.XML.DOM.Parser.Types

2+ (-- * Element matching

3+ ElemMatcher(..)

4+ , emMatch

5+ , emShow

6+ , matchElemName

7+ , elMatch

2− ( -- * Name matching

8+ -- * Name matching

3− NameMatcher(..)

9+ , NameMatcher(..)

4 , nmMatch

10 , nmMatch

5 , nmShow

11 , nmShow

6 , matchName

12 , matchName

7 , matchLocalName

13 , matchLocalName

8 , matchCILocalName

14 , matchCILocalName

9− -- * Element matching

10− , ElemMatcher(..)

11− , emMatch

12− , emShow

13− , matchElemName

14− , elMatch

15 -- * Parser internals

16 , DomPath(..)

17 , ParserError(..)

@@ -43,6 +43,8 @@ import Text.XML

43import Text.XML.Lens

44

45-- | Arbitrary element matcher

46+--

47+-- @since 2.0.0

46data ElemMatcher = ElemMatcher

48data ElemMatcher = ElemMatcher

47 { _emMatch :: Element -> Bool

49 { _emMatch :: Element -> Bool

48 , _emShow :: Text

50 , _emShow :: Text

@@ -51,6 +53,7 @@ data ElemMatcher = ElemMatcher

51

53

52makeLenses ''ElemMatcher

54makeLenses ''ElemMatcher

53

55

56+-- | Instance using instance of 'NameMatcher'

54instance IsString ElemMatcher where

57instance IsString ElemMatcher where

55 fromString = matchElemName . fromString

58 fromString = matchElemName . fromString

56

59

@@ -58,17 +61,24 @@ instance Show ElemMatcher where

58 show = T.unpack . _emShow

61 show = T.unpack . _emShow

59

62

60-- | Match element by name

63-- | Match element by name

64+--

65+-- @since 2.0.0

61matchElemName :: NameMatcher -> ElemMatcher

66matchElemName :: NameMatcher -> ElemMatcher

62matchElemName (NameMatcher matchName showName) = ElemMatcher

67matchElemName (NameMatcher matchName showName) = ElemMatcher

63 { _emMatch = views name matchName

68 { _emMatch = views name matchName

64 , _emShow = showName

69 , _emShow = showName

65 }

70 }

66

71

72+-- | Match over elements

73+--

74+-- @since 2.0.0

67elMatch :: ElemMatcher -> Traversal' Element Element

75elMatch :: ElemMatcher -> Traversal' Element Element

68elMatch (ElemMatcher match _) = filtered match

76elMatch (ElemMatcher match _) = filtered match

69

77

70-- | Arbitrary name matcher. Match name any way you want, but

78-- | Arbitrary name matcher. Match name any way you want, but

71-- considered to be used as comparator with some name with some rules

79-- considered to be used as comparator with some name with some rules

80+--

81+-- @since 2.0.0

72data NameMatcher = NameMatcher

82data NameMatcher = NameMatcher

73 { _nmMatch :: Name -> Bool

83 { _nmMatch :: Name -> Bool

74 -- ^ Name matching function, usually should be simple comparsion

84 -- ^ Name matching function, usually should be simple comparsion

@@ -78,8 +88,10 @@ data NameMatcher = NameMatcher

78 -- ^ Field for 'Show' instance and bulding usefull errors

88 -- ^ Field for 'Show' instance and bulding usefull errors

79 }

89 }

80

90

81−makeLenses ''NameMatcher

91+-- | Instance use 'matchCILocalName' as most general and liberal

82−

92+-- matching strategy (while XML is often malformed).

93+--

94+-- @since 2.0.0

83instance IsString NameMatcher where

95instance IsString NameMatcher where

84 fromString = matchCILocalName . T.pack

96 fromString = matchCILocalName . T.pack

85

97

@@ -88,6 +100,8 @@ instance Show NameMatcher where

88

100

89-- | Makes matcher which matches only local part of name igoring

101-- | Makes matcher which matches only local part of name igoring

90-- namespace and prefix. Local name matching is case sensitive.

102-- namespace and prefix. Local name matching is case sensitive.

103+--

104+-- @since 2.0.0

91matchLocalName :: Text -> NameMatcher

105matchLocalName :: Text -> NameMatcher

92matchLocalName tname = NameMatcher

106matchLocalName tname = NameMatcher

93 { _nmMatch = \n -> nameLocalName n == tname

107 { _nmMatch = \n -> nameLocalName n == tname

@@ -97,13 +111,19 @@ matchLocalName tname = NameMatcher

97-- | Makes matcher which matches only local part of name igoring

111-- | Makes matcher which matches only local part of name igoring

98-- namespace and prefix. Local name matching is case insensitive. This

112-- namespace and prefix. Local name matching is case insensitive. This

99-- is the most common case.

113-- is the most common case.

114+--

115+-- @since 2.0.0

100matchCILocalName :: Text -> NameMatcher

116matchCILocalName :: Text -> NameMatcher

101matchCILocalName tname = NameMatcher

117matchCILocalName tname = NameMatcher

102 { _nmMatch = \n -> CI.mk (nameLocalName n) == CI.mk tname

118 { _nmMatch = \n -> CI.mk (nameLocalName n) == CI.mk tname

103 , _nmShow = tname

119 , _nmShow = tname

104 }

120 }

105

121

122+makeLenses ''NameMatcher

123+

106-- | Makes matcher which match name by 'Eq' with given

124-- | Makes matcher which match name by 'Eq' with given

125+--

126+-- @since 2.0.0

107matchName :: Name -> NameMatcher

127matchName :: Name -> NameMatcher

108matchName n = NameMatcher

128matchName n = NameMatcher

109 { _nmMatch = (== n)

129 { _nmMatch = (== n)

@@ -114,7 +134,7 @@ matchName n = NameMatcher

114-- element of the document. Errors are much more usefull with path.

134-- element of the document. Errors are much more usefull with path.

115newtype DomPath = DomPath

135newtype DomPath = DomPath

116 { unDomPath :: [Text]

136 { unDomPath :: [Text]

117− } deriving (Eq, Ord, Show, Monoid)

137+ } deriving (Eq, Ord, Show, Semigroup, Monoid)

118

138

119-- | DOM parser error description.

139-- | DOM parser error description.

120data ParserError

140data ParserError

@@ -124,13 +144,17 @@ data ParserError

124 -- ^ Path of element error occured in

144 -- ^ Path of element error occured in

125 }

145 }

126

146

127− -- | Tag contents has wrong format, (could not read text to value)

147+ -- | Expected attribute but not found

128− | PEWrongFormat

148+ --

129− { _peDetails :: Text

149+ -- @since 1.0.0

150+ | PEAttributeNotFound

151+ { _peAttributeName :: NameMatcher

130− , _pePath :: DomPath

152+ , _pePath :: DomPath

131 }

153 }

132

154

133 -- | Could not parse attribute

155 -- | Could not parse attribute

156+ --

157+ -- @since 1.0.0

134 | PEAttributeWrongFormat

158 | PEAttributeWrongFormat

135 { _peAttributeName :: NameMatcher

159 { _peAttributeName :: NameMatcher

136 , _peDetails :: Text

160 , _peDetails :: Text

@@ -142,10 +166,10 @@ data ParserError

142 { _pePath :: DomPath

166 { _pePath :: DomPath

143 }

167 }

144

168

145− -- | Expected attribute but not found

169+ -- | Tag contents has wrong format, (could not read text to value)

146− | PEAttributeNotFound

170+ | PEContentWrongFormat

147− { _peAttributeName :: NameMatcher

171+ { _peDetails :: Text

148− , _pePath :: DomPath

172+ , _pePath :: DomPath

149 }

173 }

150

174

151 -- | Some other error

175 -- | Some other error

@@ -160,7 +184,7 @@ instance Exception ParserError

160

184

161newtype ParserErrors = ParserErrors

185newtype ParserErrors = ParserErrors

162 { unParserErrors :: [ParserError]

186 { unParserErrors :: [ParserError]

163− } deriving (Show, Monoid, Generic)

187+ } deriving (Show, Semigroup, Monoid, Generic)

164

188

165makePrisms ''ParserErrors

189makePrisms ''ParserErrors

166

190

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