master..bee2747 · typeable/dom-parser

.travis.yml+5−7

since splitsnapshots

unifiedsplit

@@ -4,12 +4,6 @@ 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−

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

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

14cache:

8cache:

15 directories:

9 directories:

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

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

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

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

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

29

23

24+install:

25+# Build dependencies

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

27+

30script:

28script:

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

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

32−- stack --no-terminal --install-ghc test --haddock --no-haddock-deps

30+- stack --no-terminal test --haddock --no-haddock-deps

CHANGELOG.md−44

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

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−

45## 1.0.0

3## 1.0.0

46−

47* Added support for parsing attributes

4* Added support for parsing attributes

48* Changed public interface for 'parseContent'

5* Changed public interface for 'parseContent'

49* Added useful functions

6* Added useful functions

50* Dropped unnecessary dependency from shakespeare

7* Dropped unnecessary dependency from shakespeare

51

8

52## 0.1.0

9## 0.1.0

53−

54* Public release

10* Public release

README.mddeleted−5

@@ -1,5 +0,0 @@

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: 3.2.0

2+version: 1.0.0

3synopsis: Simple monadic DOM parser

4license: MIT

5license-file: LICENSE

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

7maintainer: makeit@typeable.io

8category: XML

9build-type: Simple

10+extra-source-files: CHANGELOG.md

10cabal-version: >=1.10

11cabal-version: >=1.10

12+

13+extra-source-files: CHANGELOG.md

14+

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

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

17

16

18source-repository head

17source-repository head

19 type: git

18 type: git

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

44 , TypeFamilies

43 , TypeFamilies

45 , TypeOperators

44 , TypeOperators

46 , UndecidableInstances

45 , UndecidableInstances

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

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

48 , case-insensitive

47 , case-insensitive

49 , containers

48 , containers

50 , lens

49 , lens

51− , mtl < 2.3 || > 2.3

50+ , mtl

51+ , open-union >= 0.2

52 , scientific

53+ , semigroups

53 , text

54 , text

54 , transformers

55 , transformers

56+ , type-fun

55 , xml-conduit

57 , xml-conduit

56− , xml-conduit-writer

57 , xml-lens

58 , xml-lens

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

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

59 , Text.XML.DOM.Parser.Attributes

60 , Text.XML.DOM.Parser.Attributes

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

63 , Text.XML.DOM.Parser.FromAttribute

64 , Text.XML.DOM.Parser.FromAttribute

64 , Text.XML.DOM.Parser.FromDom

65 , Text.XML.DOM.Parser.FromDom

65 , Text.XML.DOM.Parser.Types

66 , Text.XML.DOM.Parser.Types

66− , Text.XML.Soap

67

68test-suite test

69 type: exitcode-stdio-1.0

ghc-963.yamldeleted−7

@@ -1,7 +0,0 @@

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,6 +22,7 @@ import Control.Monad.Reader

22import Data.Foldable as F

23import Data.List as L

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

25+import Data.Monoid

25import Data.Text as T

26import Data.Text as T

26import Data.Traversable

27import Data.Traversable

27import Text.XML

28import Text.XML

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

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

20import Data.Monoid

21import Data.Text as T

22import Data.Typeable

23−import Prelude as P

24import Text.Read

23import Text.Read

25import Text.XML.DOM.Parser.Types

24import Text.XML.DOM.Parser.Types

26import Text.XML.Lens

25import Text.XML.Lens

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

36parseContent parse = getCurrentContent >>= \case

35parseContent parse = getCurrentContent >>= \case

37 Nothing -> throwParserError PEContentNotFound

36 Nothing -> throwParserError PEContentNotFound

38 Just c -> case parse c of

37 Just c -> case parse c of

39− Left e -> throwParserError $ PEContentWrongFormat e

38+ Left e -> throwParserError $ PEWrongFormat e

40 Right a -> return a

39 Right a -> return a

41

40

42

41

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

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

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

95 where

94 where

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

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

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

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

98

97

99

98

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

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

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

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

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

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

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

117 in if

116 in if

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

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

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

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

120 | otherwise ->

119 | otherwise ->

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

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

122

121

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

@@ -26,8 +26,6 @@ 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

31class FromAttribute a where

29class FromAttribute a where

32 fromAttribute

30 fromAttribute

33 :: Text

31 :: Text

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

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

4 , proxyFromDom

5 -- * Explicit methods for convenience

6 , elementFromDom

7+ , unionFromDom

7 , textFromDom

8 , textFromDom

8 , stringFromDom

9 , stringFromDom

9 , charFromDom

10 , charFromDom

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

20import Control.Applicative

21import Control.Applicative

21import Control.Lens

22import Control.Lens

22import Data.Fixed

23import Data.Fixed

24+import Data.OpenUnion

23import Data.Scientific

25import Data.Scientific

24import Data.Text as T hiding (empty)

26import Data.Text as T hiding (empty)

25import Data.Typeable

27import Data.Typeable

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

27import Text.XML

29import Text.XML

28import Text.XML.DOM.Parser.Content

30import Text.XML.DOM.Parser.Content

29import Text.XML.DOM.Parser.Types

31import Text.XML.DOM.Parser.Types

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

30

33

31proxyFromDom

34proxyFromDom

32 :: forall proxy m a

35 :: forall proxy m a

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

35 -> DomParserT Identity m a

38 -> DomParserT Identity m a

36proxyFromDom _ = fromDom

39proxyFromDom _ = fromDom

37

40

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

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

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

40class FromDom a where

42class FromDom a where

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

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

42

44

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

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

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

114boolFromDom = parseContent readBool

116boolFromDom = parseContent readBool

115

117

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+

116instance FromDom Element where

135instance FromDom Element where

117 fromDom = elementFromDom

136 fromDom = elementFromDom

118

137

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

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

1module Text.XML.DOM.Parser.Types

2− (-- * Element matching

3− ElemMatcher(..)

4− , emMatch

5− , emShow

6− , matchElemName

7− , elMatch

8− -- * Name matching

2+ ( -- * Name matching

9− , NameMatcher(..)

3+ NameMatcher(..)

10 , nmMatch

4 , nmMatch

11 , nmShow

5 , nmShow

12 , matchName

6 , matchName

13 , matchLocalName

7 , matchLocalName

14 , matchCILocalName

8 , matchCILocalName

9+ -- * Element matching

10+ , ElemMatcher(..)

11+ , emMatch

12+ , emShow

13+ , matchElemName

14+ , elMatch

15 -- * Parser internals

16 , DomPath(..)

17 , ParserError(..)

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

43import Text.XML.Lens

44

45-- | Arbitrary element matcher

46−--

47−-- @since 2.0.0

48data ElemMatcher = ElemMatcher

46data ElemMatcher = ElemMatcher

49 { _emMatch :: Element -> Bool

47 { _emMatch :: Element -> Bool

50 , _emShow :: Text

48 , _emShow :: Text

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

53

51

54makeLenses ''ElemMatcher

52makeLenses ''ElemMatcher

55

53

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

57instance IsString ElemMatcher where

54instance IsString ElemMatcher where

58 fromString = matchElemName . fromString

55 fromString = matchElemName . fromString

59

56

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

61 show = T.unpack . _emShow

58 show = T.unpack . _emShow

62

59

63-- | Match element by name

60-- | Match element by name

64−--

65−-- @since 2.0.0

66matchElemName :: NameMatcher -> ElemMatcher

61matchElemName :: NameMatcher -> ElemMatcher

67matchElemName (NameMatcher matchName showName) = ElemMatcher

62matchElemName (NameMatcher matchName showName) = ElemMatcher

68 { _emMatch = views name matchName

63 { _emMatch = views name matchName

69 , _emShow = showName

64 , _emShow = showName

70 }

65 }

71

66

72−-- | Match over elements

73−--

74−-- @since 2.0.0

75elMatch :: ElemMatcher -> Traversal' Element Element

67elMatch :: ElemMatcher -> Traversal' Element Element

76elMatch (ElemMatcher match _) = filtered match

68elMatch (ElemMatcher match _) = filtered match

77

69

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

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

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

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

80−--

81−-- @since 2.0.0

82data NameMatcher = NameMatcher

72data NameMatcher = NameMatcher

83 { _nmMatch :: Name -> Bool

73 { _nmMatch :: Name -> Bool

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

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

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

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

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

89 }

79 }

90

80

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

81+makeLenses ''NameMatcher

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

82+

93−--

94−-- @since 2.0.0

95instance IsString NameMatcher where

83instance IsString NameMatcher where

96 fromString = matchCILocalName . T.pack

84 fromString = matchCILocalName . T.pack

97

85

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

100

88

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

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

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

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

103−--

104−-- @since 2.0.0

105matchLocalName :: Text -> NameMatcher

91matchLocalName :: Text -> NameMatcher

106matchLocalName tname = NameMatcher

92matchLocalName tname = NameMatcher

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

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

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

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

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

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

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

113-- is the most common case.

99-- is the most common case.

114−--

115−-- @since 2.0.0

116matchCILocalName :: Text -> NameMatcher

100matchCILocalName :: Text -> NameMatcher

117matchCILocalName tname = NameMatcher

101matchCILocalName tname = NameMatcher

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

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

119 , _nmShow = tname

103 , _nmShow = tname

120 }

104 }

121

105

122−makeLenses ''NameMatcher

123−

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

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

125−--

126−-- @since 2.0.0

127matchName :: Name -> NameMatcher

107matchName :: Name -> NameMatcher

128matchName n = NameMatcher

108matchName n = NameMatcher

129 { _nmMatch = (== n)

109 { _nmMatch = (== n)

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

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

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

135newtype DomPath = DomPath

115newtype DomPath = DomPath

136 { unDomPath :: [Text]

116 { unDomPath :: [Text]

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

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

138

118

139-- | DOM parser error description.

119-- | DOM parser error description.

140data ParserError

120data ParserError

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

144 -- ^ Path of element error occured in

124 -- ^ Path of element error occured in

145 }

125 }

146

126

147− -- | Expected attribute but not found

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

148− --

128+ | PEWrongFormat

149− -- @since 1.0.0

129+ { _peDetails :: Text

150− | PEAttributeNotFound

151− { _peAttributeName :: NameMatcher

152− , _pePath :: DomPath

130+ , _pePath :: DomPath

153 }

131 }

154

132

155 -- | Could not parse attribute

133 -- | Could not parse attribute

156− --

157− -- @since 1.0.0

158 | PEAttributeWrongFormat

134 | PEAttributeWrongFormat

159 { _peAttributeName :: NameMatcher

135 { _peAttributeName :: NameMatcher

160 , _peDetails :: Text

136 , _peDetails :: Text

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

166 { _pePath :: DomPath

142 { _pePath :: DomPath

167 }

143 }

168

144

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

145+ -- | Expected attribute but not found

170− | PEContentWrongFormat

146+ | PEAttributeNotFound

171− { _peDetails :: Text

147+ { _peAttributeName :: NameMatcher

172− , _pePath :: DomPath

148+ , _pePath :: DomPath

173 }

149 }

174

150

175 -- | Some other error

151 -- | Some other error

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

184

160

185newtype ParserErrors = ParserErrors

161newtype ParserErrors = ParserErrors

186 { unParserErrors :: [ParserError]

162 { unParserErrors :: [ParserError]

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

163+ } deriving (Show, Monoid, Generic)

188

164

189makePrisms ''ParserErrors

165makePrisms ''ParserErrors

190

166

src/Text/XML/Soap.hsdeleted−46

@@ -1,46 +0,0 @@

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 120000 → 100644+6−1

@@ -1 +0,0 @@

1−ghc-963.yaml

@@ -0,0 +1,6 @@

1+packages:

2+ - .

3+extra-deps:

4+ - open-union-0.2.0.0

5+ - type-fun-0.1.1

6+resolver: lts-6.25