master..7fb1685 · 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−11

@@ -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,26 +43,26 @@ 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.Buildable

61 , Text.XML.DOM.Parser.Combinators

62 , Text.XML.DOM.Parser.Content

63 , Text.XML.DOM.Parser.FromAttribute

64 , Text.XML.DOM.Parser.FromDom

65 , Text.XML.DOM.Parser.Types

66− , Text.XML.Soap

67

66

68test-suite test

67test-suite test

69 type: exitcode-stdio-1.0

68 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.hs+1−3

@@ -1,6 +1,5 @@

1module Text.XML.DOM.Parser

2− ( module Text.XML.DOM.Parser.Attributes

2+ ( module Text.XML.DOM.Parser.Buildable

3− , module Text.XML.DOM.Parser.Buildable

4 , module Text.XML.DOM.Parser.Combinators

3 , module Text.XML.DOM.Parser.Combinators

5 , module Text.XML.DOM.Parser.Content

4 , module Text.XML.DOM.Parser.Content

6 , module Text.XML.DOM.Parser.FromAttribute

5 , module Text.XML.DOM.Parser.FromAttribute

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

8 , module Text.XML.DOM.Parser.Types

7 , module Text.XML.DOM.Parser.Types

9 ) where

8 ) where

10

9

11−import Text.XML.DOM.Parser.Attributes

12import Text.XML.DOM.Parser.Buildable

10import Text.XML.DOM.Parser.Buildable

13import Text.XML.DOM.Parser.Combinators

11import Text.XML.DOM.Parser.Combinators

14import Text.XML.DOM.Parser.Content

12import Text.XML.DOM.Parser.Content

src/Text/XML/DOM/Parser/Attributes.hsdeleted−64

@@ -1,64 +0,0 @@

1−module Text.XML.DOM.Parser.Attributes

2− ( parseAttribute

3− , parseAttributeMaybe

4− , getCurrentAttributes

5− , getCurrentAttribute

6− ) where

7−

8−import Control.Lens

9−import Data.Map.Strict as M

10−import Data.Text as T

11−import Text.XML.DOM.Parser.Types

12−import Text.XML.Lens

13−

14−-- | Parses attribute with given name, throws error if attribute is not found.

15−--

16−-- @since 1.0.0

17−parseAttribute

18− :: (Monad m)

19− => NameMatcher

20− -- ^ Attribute name

21− -> (Text -> Either Text a)

22− -- ^ Attribute content parser

23− -> DomParserT Identity m a

24−parseAttribute attrName parser =

25− parseAttributeMaybe attrName parser >>= \case

26− Nothing -> throwParserError $ PEAttributeNotFound attrName

27− Just a -> return a

28−

29−-- | Parses attribute with given name. Returns Nothing if attribute is

30−-- not found.

31−--

32−-- @since 1.0.0

33−parseAttributeMaybe

34− :: (Monad m)

35− => NameMatcher

36− -- ^ Attribute name

37− -> (Text -> Either Text a)

38− -- ^ Attribute content parser

39− -> DomParserT Identity m (Maybe a)

40−parseAttributeMaybe attrName parser =

41− getCurrentAttribute attrName >>= \case

42− Nothing -> return Nothing

43− Just aval -> case parser aval of

44− Left err -> throwParserError $ PEAttributeWrongFormat attrName err

45− Right a -> return $ Just a

46−

47−-- | Retuns map of attributes of current element

48−--

49−-- @since 1.0.0

50−getCurrentAttributes

51− :: (Monad m)

52− => DomParserT Identity m (M.Map Name Text)

53−getCurrentAttributes = view $ pdElements . to runIdentity . attrs

54−

55−-- | Returns element with given name or 'Nothing'

56−--

57−-- @since 1.0.0

58−getCurrentAttribute

59− :: (Monad m)

60− => NameMatcher

61− -> DomParserT Identity m (Maybe Text)

62−getCurrentAttribute attrName

63− = preview $ pdElements . to runIdentity . attrs . to M.toList

64− . traversed . filtered (views _1 (attrName ^. nmMatch)) . _2

src/Text/XML/DOM/Parser/Combinators.hs+5−13

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

@@ -67,13 +68,9 @@ inFilteredTrav deeper = traverseElems trav

67 Nothing -> throwParserError $ PENotFound . (<> path)

68 Nothing -> throwParserError $ PENotFound . (<> path)

68 Just tr -> return $ fmap (path,) tr

69 Just tr -> return $ fmap (path,) tr

69

70

70−-- | Runs parser arbitrary times, depending on 'Buildable' instance of

71−-- 'f'. For example if 'f' becomes 'NonEmpty' then 'inElemTrav' finds

72−-- @one or more@ elements matched by given 'ElemMatcher' and run

73−-- parser in each found element, then returns @NonEmpty a@ of results.

74inElemTrav

71inElemTrav

75 :: (Monad m, Foldable g, Buildable f)

72 :: (Monad m, Foldable g, Buildable f)

76− => ElemMatcher -- ^ Tag(s) matcher to traverse in

73+ => ElemMatcher -- ^ Name of tag to traverse in

77 -> DomParserT Identity m a

74 -> DomParserT Identity m a

78 -> DomParserT g m (f a)

75 -> DomParserT g m (f a)

79inElemTrav n = inFilteredTrav deeper

76inElemTrav n = inFilteredTrav deeper

@@ -81,7 +78,7 @@ inElemTrav n = inFilteredTrav deeper

81 elemsFold = folded . nodes . folded . _Element . elMatch n

78 elemsFold = folded . nodes . folded . _Element . elMatch n

82 deeper = (DomPath [_emShow n],) . toListOf elemsFold

79 deeper = (DomPath [_emShow n],) . toListOf elemsFold

83

80

84−-- | Runs parser inside first children element matched by macher

81+-- | Runs parser inside first children element with given name

85inElem

82inElem

86 :: (Monad m, Foldable g)

83 :: (Monad m, Foldable g)

87 => ElemMatcher

84 => ElemMatcher

@@ -111,10 +108,10 @@ inElemNe

111inElemNe = inElemTrav

108inElemNe = inElemTrav

112

109

113{- | Dive given parser's current tags set into the given path. The @divePath

110{- | Dive given parser's current tags set into the given path. The @divePath

114−["a", "b"]@ differs from @inElem "a" $ inElem "b"@. Namely the first variant

111+["a", "b"]@ differs from @inElem "a" . inElem "b"@. Namely the first variant

115will not fail if occured tag "a" which does not contains tag "b". This

112will not fail if occured tag "a" which does not contains tag "b". This

116behaviour is desireable when you dont want to parse whole XML and just want

113behaviour is desireable when you dont want to parse whole XML and just want

117−to pull tags located in some path. The other difference is in traversing inner

114+to pull tags in some path. The other difference is in traversing inner

118elements. Consider this code

115elements. Consider this code

119

116

120@

117@

@@ -132,11 +129,6 @@ which translates like: @a > b > c > fromDom@

132As you can see, inElem always takes first element and runs inner parser in this

129As you can see, inElem always takes first element and runs inner parser in this

133single element, unlike 'divePath' which runs inner parser @in all@ descendants

130single element, unlike 'divePath' which runs inner parser @in all@ descendants

134in given path.

131in given path.

135−

136−Note also that 'divePath' takes parser parameterized by @[]@ not by

137−'Identity'. This because when you dive using some path you will get a

138−list of found elements and all these elements will be @current@ for

139−parser.

140-}

132-}

141

133

142divePath

134divePath

src/Text/XML/DOM/Parser/Content.hs+118−63

@@ -1,44 +1,84 @@

1module Text.XML.DOM.Parser.Content

2− (

2+ ( -- * Content readers

3− -- * Parsing element's content

3+ readBool

4− parseContent

4+ , readChar

5+ -- ** Reader constructors

6+ , maybeReadContent

7+ , readContent

5 -- * Getting current element's properties

8 -- * Getting current element's properties

6 , getCurrentName

9 , getCurrentName

7 , getCurrentContent

10 , getCurrentContent

11+ , getCurrentAttributes

12+ , getCurrentAttribute

8 , checkCurrentName

13 , checkCurrentName

9− -- * Internal

14+ -- * Parsing element's content

10− , maybeReadContent

15+ , parseContent

11− , readContent

16+ -- * Parsing attributes

12− , readBool

17+ , parseAttribute

13− , readChar

18+ , parseAttributeMaybe

14 ) where

19 ) where

15

20

16import Control.Lens

21import Control.Lens

17import Control.Monad

22import Control.Monad

18import Control.Monad.Except

23import Control.Monad.Except

19import Data.List as L

24import Data.List as L

25+import Data.Map.Strict as M

20import Data.Monoid

26import Data.Monoid

21import Data.Text as T

27import Data.Text as T

22import Data.Typeable

28import Data.Typeable

23−import Prelude as P

24import Text.Read

29import Text.Read

25import Text.XML.DOM.Parser.Types

30import Text.XML.DOM.Parser.Types

26import Text.XML.Lens

31import Text.XML.Lens

27

32

28

33

29−-- | Parses content inside current tag. It expects current element set

34+-- | @since 1.0.0

30−-- consists of exactly ONE element.

31−parseContent

32− :: (Monad m)

33− => (Text -> Either Text a)

35+readBool :: Text -> Either Text Bool

34− -- ^ Content parser, return error msg if value is not parsed

36+readBool t =

35− -> DomParserT Identity m a

37+ let

36−parseContent parse = getCurrentContent >>= \case

38+ lowt = T.toLower $ T.strip t

37− Nothing -> throwParserError PEContentNotFound

39+ tvals = ["y", "yes", "t", "true", "1"]

38− Just c -> case parse c of

40+ fvals = ["n", "no", "f", "false", "0"]

39− Left e -> throwParserError $ PEContentWrongFormat e

41+ in if

40− Right a -> return a

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

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

44+ | otherwise ->

45+ Left $ "Could not read " <> t <> " as Bool"

41

46

47+-- | Expects text to be single character

48+--

49+-- @since 1.0.0

50+readChar :: Text -> Either Text Char

51+readChar t = case T.unpack $ T.strip t of

52+ [c] -> Right c

53+ _ -> Left "Should have exactly one non-blank character"

54+

55+-- | If reader returns 'Nothing' then resulting function returns 'Left

56+-- "error message"'. 'Typeable' is used for generating usefull error

57+-- message.

58+--

59+-- @since 1.0.0

60+maybeReadContent

61+ :: forall a

62+ . (Typeable a)

63+ => (Text -> Maybe a)

64+ -- ^ Content or attribute reader

65+ -> Text

66+ -- ^ Content or attribute value

67+ -> Either Text a

68+maybeReadContent f t = maybe (Left msg) Right $ f t

69+ where

70+ msg = "Not readable " <> n <> ": " <> t

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

72+

73+

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

75+-- with 'parseContent' and 'parseAttribute'. Content is stripped

76+-- before reading.

77+readContent

78+ :: (Read a, Typeable a)

79+ => Text

80+ -> Either Text a

81+readContent = maybeReadContent $ readMaybe . T.unpack . T.strip

42

82

43-- | Returns name of current element.

83-- | Returns name of current element.

44--

84--

@@ -78,52 +118,67 @@ getCurrentContent = do

78 | L.null conts -> Nothing

118 | L.null conts -> Nothing

79 | otherwise -> Just $ mconcat conts

119 | otherwise -> Just $ mconcat conts

80

120

81−-- | If reader returns 'Nothing' then resulting function returns 'Left

121+-- | Parses content inside current tag. It expects current element set

82−-- "error message"'. 'Typeable' is used for generating usefull error

122+-- consists of exactly ONE element.

83−-- message.

123+parseContent

124+ :: (Monad m)

125+ => (Text -> Either Text a)

126+ -- ^ Content parser, return error msg if value is not parsed

127+ -> DomParserT Identity m a

128+parseContent parse = getCurrentContent >>= \case

129+ Nothing -> throwParserError PEContentNotFound

130+ Just c -> case parse c of

131+ Left e -> throwParserError $ PEWrongFormat e

132+ Right a -> return a

133+

134+-- | Retuns map of attributes of current element

84--

135--

85-- @since 1.0.0

136-- @since 1.0.0

86−maybeReadContent

137+getCurrentAttributes

87− :: forall a

138+ :: (Monad m)

88− . (Typeable a)

139+ => DomParserT Identity m (M.Map Name Text)

89− => (Text -> Maybe a)

140+getCurrentAttributes = view $ pdElements . to runIdentity . attrs

90− -- ^ Content or attribute reader

91− -> Text

92− -- ^ Content or attribute value

93− -> Either Text a

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

95− where

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

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

98−

99−

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

101−-- with 'parseContent' and 'parseAttribute'. Content is stripped

102−-- before reading.

103−readContent

104− :: (Read a, Typeable a)

105− => Text

106− -> Either Text a

107−readContent = maybeReadContent $ readMaybe . T.unpack . T.strip

108

141

142+-- | Returns element with given name or 'Nothing'

143+--

144+-- @since 1.0.0

145+getCurrentAttribute

146+ :: (Monad m)

147+ => NameMatcher

148+ -> DomParserT Identity m (Maybe Text)

149+getCurrentAttribute attrName

150+ = preview $ pdElements . to runIdentity . attrs . to M.toList

151+ . traversed . filtered (views _1 (attrName ^. nmMatch)) . _2

109

152

153+-- | Parses attribute with given name, throws error if attribute is not found.

154+--

110−-- | @since 1.0.0

155+-- @since 1.0.0

156+parseAttribute

157+ :: (Monad m)

158+ => NameMatcher

159+ -- ^ Attribute name

111−readBool :: Text -> Either Text Bool

160+ -> (Text -> Either Text a)

112−readBool t =

161+ -- ^ Attribute content parser

113− let

162+ -> DomParserT Identity m a

114− lowt = T.toLower $ T.strip t

163+parseAttribute attrName parser =

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

164+ parseAttributeMaybe attrName parser >>= \case

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

165+ Nothing -> throwParserError $ PEAttributeNotFound attrName

117− in if

166+ Just a -> return a

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

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

120− | otherwise ->

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

122

167

123−-- | Expects text to be single character

168+-- | Parses attribute with given name. Returns Nothing if attribute is

169+-- not found.

124--

170--

125-- @since 1.0.0

171-- @since 1.0.0

172+parseAttributeMaybe

173+ :: (Monad m)

174+ => NameMatcher

175+ -- ^ Attribute name

126−readChar :: Text -> Either Text Char

176+ -> (Text -> Either Text a)

127−readChar t = case T.unpack $ T.strip t of

177+ -- ^ Attribute content parser

128− [c] -> Right c

178+ -> DomParserT Identity m (Maybe a)

129− _ -> Left "Should have exactly one non-blank character"

179+parseAttributeMaybe attrName parser =

180+ getCurrentAttribute attrName >>= \case

181+ Nothing -> return Nothing

182+ Just aval -> case parser aval of

183+ Left err -> throwParserError $ PEAttributeWrongFormat attrName err

184+ Right a -> return $ Just a

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+22−46

@@ -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,17 +43,13 @@ 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

51− -- ^ Field for 'Show' instance and bulding usefull errors

52 }

49 }

53

50

54makeLenses ''ElemMatcher

51makeLenses ''ElemMatcher

55

52

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

57instance IsString ElemMatcher where

53instance IsString ElemMatcher where

58 fromString = matchElemName . fromString

54 fromString = matchElemName . fromString

59

55

@@ -61,37 +57,29 @@ instance Show ElemMatcher where

61 show = T.unpack . _emShow

57 show = T.unpack . _emShow

62

58

63-- | Match element by name

59-- | Match element by name

64−--

65−-- @since 2.0.0

66matchElemName :: NameMatcher -> ElemMatcher

60matchElemName :: NameMatcher -> ElemMatcher

67matchElemName (NameMatcher matchName showName) = ElemMatcher

61matchElemName (NameMatcher matchName showName) = ElemMatcher

68 { _emMatch = views name matchName

62 { _emMatch = views name matchName

69 , _emShow = showName

63 , _emShow = showName

70 }

64 }

71

65

72−-- | Match over elements

73−--

74−-- @since 2.0.0

75elMatch :: ElemMatcher -> Traversal' Element Element

66elMatch :: ElemMatcher -> Traversal' Element Element

76elMatch (ElemMatcher match _) = filtered match

67elMatch (ElemMatcher match _) = filtered match

77

68

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

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

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

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

80−--

81−-- @since 2.0.0

82data NameMatcher = NameMatcher

71data NameMatcher = NameMatcher

83 { _nmMatch :: Name -> Bool

72 { _nmMatch :: Name -> Bool

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

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

85 -- function takin in account only local name or other components

74 -- function takin in account only local name or other components

86 -- of 'Name'

75 -- of 'Name'

87 , _nmShow :: Text

76 , _nmShow :: Text

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

77+ -- ^ How to show the name matcher, since there is no 'Read'

78+ -- instance we can do it any way we want

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