@@ -2,7 +2,7 @@ module Text.XML.DOM.Parser.Combinators
22 ( -- * Generic combinators to traverse descendants
33 traverseElems
44 , inFilteredTrav
5− -- * Using 'DomTraversable'
5+ -- * Using 'Buildable'
66 , inElemTrav
77 , inElem
88 , inElemAll
@@ -15,45 +15,30 @@ module Text.XML.DOM.Parser.Combinators
1515 , ignoreElem
1616 , ignoreEmpty
1717 , ignoreBlank
18− -- * Getting current element's properties
19− , getCurrentName
20− , getCurrentContent
21− , getCurrentAttributes
22− , getCurrentAttribute
23− -- * Current element's checks
24− , checkCurrentName
25− -- * Parsing element's content
26− , parseContent
27− -- * Parsing attributes
28− , parseAttribute
29− , parseAttributeMaybe
3018 ) where
3119
3220import Control.Lens
33−import Control.Monad.Except
3421import Control.Monad.Reader
3522import Data.Foldable as F
3623import Data.List as L
3724import Data.List.NonEmpty (NonEmpty(..))
38−import Data.Map.Strict as M
39−import Data.Monoid
4025import Data.Text as T
4126import Data.Traversable
4227import Text.XML
43−import Text.XML.DOM.Parser.Common
28+import Text.XML.DOM.Parser.Buildable
4429import Text.XML.DOM.Parser.Types
4530import Text.XML.Lens
4631
4732
48−-- | Generic function to traverse arbitrary inner cursors.
33+-- | Generic function to traverse arbitrary inner elements.
4934traverseElems
5035 :: (Monad m, Foldable g, Traversable f)
5136 => ([Element] -> DomParserT g m (f (DomPath, Element)))
5237 -- ^ Takes list of current elements and returns container with
53− -- pairs of subpath (relatively to current element) and element
38+ -- pairs of subpath (relatively to current elements) and element
5439 -- to run parser in
5540 -> DomParserT Identity m a
56− -- ^ Parser will be runned for each element found in traversable
41+ -- ^ Parser to run for each element found in traversable 'f'
5742 -> DomParserT g m (f a)
5843traverseElems trav parser = do
5944 pd <- ask
@@ -63,68 +48,73 @@ traverseElems trav parser = do
6348 newpd = ParserData
6449 { _pdElements = Identity e
6550 , _pdPath = pd ^. pdPath <> subpath }
66− -- type of reader has been changed, local won't work here
67− magnify (to $ const newpd) parser
51+ lift $ runReaderT parser newpd
6852
69−-- | Takes function filtering
53+-- | Traverses elements located in same path using filtering function
7054inFilteredTrav
71− :: (Monad m, Foldable g, DomTraversable f)
55+ :: (Monad m, Foldable g, Buildable f)
7256 => ([Element] -> (DomPath, [Element]))
73− -- ^ Function returning some filtered elements with path suffixes which will
74− -- be appended to parser's state
57+ -- ^ Takes list of current elements and returns some descendants
58+ -- subset and path this descendants located at. Path is should be
59+ -- same for all descendants and required for error message
7560 -> DomParserT Identity m a
7661 -> DomParserT g m (f a)
7762inFilteredTrav deeper = traverseElems trav
7863 where
7964 trav e = do
8065 let (path, elems) = deeper e
81− case buildDomTraversable elems of
66+ case build elems of
8267 Nothing -> throwParserError $ PENotFound . (<> path)
8368 Just tr -> return $ fmap (path,) tr
8469
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.
8574inElemTrav
86− :: (Monad m, Foldable g, DomTraversable f)
87− => NameMatcher -- ^ Name of tag to traverse in
75+ :: (Monad m, Foldable g, Buildable f)
76+ => ElemMatcher -- ^ Tag(s) matcher to traverse in
8877 -> DomParserT Identity m a
8978 -> DomParserT g m (f a)
9079inElemTrav n = inFilteredTrav deeper
9180 where
92− deeper = (DomPath [_nmShow n],) . toListOf (folded . nodes . folded . _Element . elMatchName n)
81+ elemsFold = folded . nodes . folded . _Element . elMatch n
82+ deeper = (DomPath [_emShow n],) . toListOf elemsFold
9383
94−-- | Runs parser inside first children element with given name
84+-- | Runs parser inside first children element matched by macher
9585inElem
9686 :: (Monad m, Foldable g)
97− => NameMatcher
87+ => ElemMatcher
9888 -> DomParserT Identity m a
9989 -> DomParserT g m a
10090inElem n = fmap runIdentity . inElemTrav n
10191
10292inElemAll
10393 :: (Monad m, Foldable g)
104− => NameMatcher
94+ => ElemMatcher
10595 -> DomParserT Identity m a
10696 -> DomParserT g m [a]
10797inElemAll = inElemTrav
10898
10999inElemMay
110100 :: (Monad m, Foldable g)
111− => NameMatcher
101+ => ElemMatcher
112102 -> DomParserT Identity m a
113103 -> DomParserT g m (Maybe a)
114104inElemMay = inElemTrav
115105
116106inElemNe
117107 :: (Monad m, Foldable g)
118− => NameMatcher
108+ => ElemMatcher
119109 -> DomParserT Identity m a
120110 -> DomParserT g m (NonEmpty a)
121111inElemNe = inElemTrav
122112
123113{- | Dive given parser's current tags set into the given path. The @divePath
124−["a", "b"]@ differs from @inElem "a" . inElem "b"@. Namely the first variant
114+["a", "b"]@ differs from @inElem "a" $ inElem "b"@. Namely the first variant
125115will not fail if occured tag "a" which does not contains tag "b". This
126116behaviour is desireable when you dont want to parse whole XML and just want
127−to pull tags in some path. The other difference is in traversing inner
117+to pull tags located in some path. The other difference is in traversing inner
128118elements. Consider this code
129119
130120@
@@ -142,26 +132,31 @@ which translates like: @a > b > c > fromDom@
142132As you can see, inElem always takes first element and runs inner parser in this
143133single element, unlike 'divePath' which runs inner parser @in all@ descendants
144134in 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.
145140-}
146141
147142divePath
148143 :: forall m g a
149144 . (Monad m, Foldable g)
150− => [NameMatcher]
145+ => [ElemMatcher]
151146 -> DomParserT [] m a
152147 -> DomParserT g m a
153148divePath path = magnify $ to modElems
154149 where
155150 modElems
156151 = over pdElements (toListOf $ folded . diver)
157− . over pdPath (<> DomPath (L.map _nmShow path))
152+ . over pdPath (<> DomPath (L.map _emShow path))
158153 diver :: Fold Element Element
159154 diver = F.foldr (.) id $ L.map toDive path
160− toDive n = nodes . folded . _Element . elMatchName n
155+ toDive n = nodes . folded . _Element . elMatch n
161156
162157diveElem
163158 :: (Monad m, Foldable g)
164− => NameMatcher
159+ => ElemMatcher
165160 -> DomParserT [] m a
166161 -> DomParserT g m a
167162diveElem p = divePath [p]
@@ -202,109 +197,6 @@ ignoreBlank = ignoreElem test
202197 let
203198 elems = e ^.. nodes . folded . _Element
204199 cont = mconcat $ e ^.. nodes . folded . _Content
205− in if | not $ L.null elems -> False
200+ in if | not $ L.null elems -> False
206201 | T.null $ T.strip cont -> True
207202 | otherwise -> False
208−
209−-- | Returns name of current element.
210−--
211−-- @since 1.0.0
212−getCurrentName :: (Monad m) => DomParserT Identity m Name
213−getCurrentName = view $ pdElements . to runIdentity . name
214−
215−-- | If name of current tag differs from first argument throws 'PENotFound' with
216−-- tag name replaced in last path's segment. Useful for checking root
217−-- document's element name.
218−checkCurrentName
219− :: (Monad m)
220− => NameMatcher
221− -> DomParserT Identity m ()
222−checkCurrentName n = do
223− cn <- getCurrentName
224− unless ((n ^. nmMatch) cn) $ do
225− p <- view pdPath
226− let pinit = if L.null (unDomPath p) then [] else L.init $ unDomPath p
227− throwError $ ParserErrors [PENotFound $ DomPath $ pinit ++ [_nmShow n]]
228− return ()
229−
230−-- | Get current content. If current element contains no content or
231−-- have inner elements then Nothing returned
232−--
233−-- @since 1.0.0
234−getCurrentContent :: (Monad m) => DomParserT Identity m (Maybe Text)
235−getCurrentContent = do
236− nds <- view $ pdElements . to runIdentity . nodes
237− let
238− els :: [Element]
239− els = nds ^.. folded . _Element
240− conts :: [Text]
241− conts = nds ^.. folded . _Content
242− return $ if
243− | not $ L.null els -> Nothing
244− | L.null conts -> Nothing
245− | otherwise -> Just $ mconcat conts
246−
247−-- | Parses content inside current tag. It expects current element set
248−-- consists of exactly ONE element. If current element does not
249−-- contains content or have other elements as childs then throws error
250−parseContent
251− :: (Monad m)
252− => (Text -> Either Text a)
253− -- ^ Content parser, return error msg if value is not parsed
254− -> DomParserT Identity m a
255−parseContent parse = getCurrentContent >>= \case
256− Nothing -> throwParserError PEContentNotFound
257− Just c -> case parse c of
258− Left e -> throwParserError $ PEWrongFormat e
259− Right a -> return a
260−
261−-- | Retuns map of attributes of current element
262−--
263−-- @since 1.0.0
264−getCurrentAttributes
265− :: (Monad m)
266− => DomParserT Identity m (M.Map Name Text)
267−getCurrentAttributes = view $ pdElements . to runIdentity . attrs
268−
269−-- | Returns element with given name or 'Nothing'
270−--
271−-- @since 1.0.0
272−getCurrentAttribute
273− :: (Monad m)
274− => NameMatcher
275− -> DomParserT Identity m (Maybe Text)
276−getCurrentAttribute attrName
277− = preview $ pdElements . to runIdentity . attrs . to M.toList
278− . traversed . filtered (views _1 (attrName ^. nmMatch)) . _2
279−
280−-- | Parses attribute with given name, throws error if attribute is not found.
281−--
282−-- @since 1.0.0
283−parseAttribute
284− :: (Monad m)
285− => NameMatcher
286− -- ^ Attribute name
287− -> (Text -> Either Text a)
288− -- ^ Attribute content parser
289− -> DomParserT Identity m a
290−parseAttribute attrName parser =
291− parseAttributeMaybe attrName parser >>= \case
292− Nothing -> throwParserError $ PEAttributeNotFound attrName
293− Just a -> return a
294−
295−-- | Parses attribute with given name.
296−--
297−-- @since 1.0.0
298−parseAttributeMaybe
299− :: (Monad m)
300− => NameMatcher
301− -- ^ Attribute name
302− -> (Text -> Either Text a)
303− -- ^ Attribute content parser
304− -> DomParserT Identity m (Maybe a)
305−parseAttributeMaybe attrName parser =
306− getCurrentAttribute attrName >>= \case
307− Nothing -> return Nothing
308− Just aval -> case parser aval of
309− Left err -> throwParserError $ PEAttributeWrongFormat attrName err
310− Right a -> return $ Just a