@@ -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,47 +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− , readContent
28− , maybeReadContent
29− -- * Parsing attributes
30− , parseAttribute
31− , parseAttributeMaybe
3218 ) where
3319
34−import Control.Lens
35−import Control.Monad.Except
36−import Control.Monad.Reader
37−import Data.List.NonEmpty (NonEmpty(..))
38−import qualified Data.Map.Strict as M
39−import Data.Monoid
40−import Data.Text (Text)
41−import qualified Data.Text as T
42−import Data.Traversable
43−import Data.Typeable
44−import Text.Read
45−import Text.XML
46−import Text.XML.DOM.Parser.Types
47−import Text.XML.Lens
20+import Control.Lens
21+import Control.Monad.Reader
22+import Data.Foldable as F
23+import Data.List as L
24+import Data.List.NonEmpty (NonEmpty(..))
25+import Data.Text as T
26+import Data.Traversable
27+import Text.XML
28+import Text.XML.DOM.Parser.Buildable
29+import Text.XML.DOM.Parser.Types
30+import Text.XML.Lens
4831
4932
50−-- | Generic function to traverse arbitrary inner cursors.
33+-- | Generic function to traverse arbitrary inner elements.
5134traverseElems
5235 :: (Monad m, Foldable g, Traversable f)
5336 => ([Element] -> DomParserT g m (f (DomPath, Element)))
5437 -- ^ Takes list of current elements and returns container with
55− -- pairs of subpath (relatively to current element) and element
38+ -- pairs of subpath (relatively to current elements) and element
5639 -- to run parser in
5740 -> DomParserT Identity m a
58− -- ^ Parser will be runned for each element found in traversable
41+ -- ^ Parser to run for each element found in traversable 'f'
5942 -> DomParserT g m (f a)
6043traverseElems trav parser = do
6144 pd <- ask
@@ -65,68 +48,73 @@ traverseElems trav parser = do
6548 newpd = ParserData
6649 { _pdElements = Identity e
6750 , _pdPath = pd ^. pdPath <> subpath }
68− -- type of reader has been changed, local won't work here
69− magnify (to $ const newpd) parser
51+ lift $ runReaderT parser newpd
7052
71−-- | Takes function filtering
53+-- | Traverses elements located in same path using filtering function
7254inFilteredTrav
73− :: (Monad m, Foldable g, DomTraversable f)
55+ :: (Monad m, Foldable g, Buildable f)
7456 => ([Element] -> (DomPath, [Element]))
75− -- ^ Function returning some filtered elements with path suffixes which will
76− -- 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
7760 -> DomParserT Identity m a
7861 -> DomParserT g m (f a)
7962inFilteredTrav deeper = traverseElems trav
8063 where
8164 trav e = do
8265 let (path, elems) = deeper e
83− case buildDomTraversable elems of
66+ case build elems of
8467 Nothing -> throwParserError $ PENotFound . (<> path)
8568 Just tr -> return $ fmap (path,) tr
8669
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.
8774inElemTrav
88− :: (Monad m, Foldable g, DomTraversable f)
89− => Text
75+ :: (Monad m, Foldable g, Buildable f)
76+ => ElemMatcher -- ^ Tag(s) matcher to traverse in
9077 -> DomParserT Identity m a
9178 -> DomParserT g m (f a)
9279inElemTrav n = inFilteredTrav deeper
9380 where
94− deeper = (DomPath [n],) . toListOf (folded . nodes . folded . _Element . ell n)
81+ elemsFold = folded . nodes . folded . _Element . elMatch n
82+ deeper = (DomPath [_emShow n],) . toListOf elemsFold
9583
96−-- | Runs parser inside first children element with given name
84+-- | Runs parser inside first children element matched by macher
9785inElem
9886 :: (Monad m, Foldable g)
99− => Text
87+ => ElemMatcher
10088 -> DomParserT Identity m a
10189 -> DomParserT g m a
10290inElem n = fmap runIdentity . inElemTrav n
10391
10492inElemAll
10593 :: (Monad m, Foldable g)
106− => Text
94+ => ElemMatcher
10795 -> DomParserT Identity m a
10896 -> DomParserT g m [a]
10997inElemAll = inElemTrav
11098
11199inElemMay
112100 :: (Monad m, Foldable g)
113− => Text
101+ => ElemMatcher
114102 -> DomParserT Identity m a
115103 -> DomParserT g m (Maybe a)
116104inElemMay = inElemTrav
117105
118106inElemNe
119107 :: (Monad m, Foldable g)
120− => Text
108+ => ElemMatcher
121109 -> DomParserT Identity m a
122110 -> DomParserT g m (NonEmpty a)
123111inElemNe = inElemTrav
124112
125113{- | Dive given parser's current tags set into the given path. The @divePath
126−["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
127115will not fail if occured tag "a" which does not contains tag "b". This
128116behaviour is desireable when you dont want to parse whole XML and just want
129−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
130118elements. Consider this code
131119
132120@
@@ -144,29 +132,34 @@ which translates like: @a > b > c > fromDom@
144132As you can see, inElem always takes first element and runs inner parser in this
145133single element, unlike 'divePath' which runs inner parser @in all@ descendants
146134in 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.
147140-}
148141
149142divePath
150143 :: forall m g a
151144 . (Monad m, Foldable g)
152− => DomPath
145+ => [ElemMatcher]
153146 -> DomParserT [] m a
154147 -> DomParserT g m a
155148divePath path = magnify $ to modElems
156149 where
157150 modElems
158151 = over pdElements (toListOf $ folded . diver)
159− . over pdPath (<> path)
152+ . over pdPath (<> DomPath (L.map _emShow path))
160153 diver :: Fold Element Element
161− diver = foldr (.) id $ map toDive $ unDomPath path
162− toDive n = nodes . folded . _Element . ell n
154+ diver = F.foldr (.) id $ L.map toDive path
155+ toDive n = nodes . folded . _Element . elMatch n
163156
164157diveElem
165158 :: (Monad m, Foldable g)
166− => Text
159+ => ElemMatcher
167160 -> DomParserT [] m a
168161 -> DomParserT g m a
169−diveElem p = divePath $ DomPath [p]
162+diveElem p = divePath [p]
170163
171164-- | Ignore arbitrary current element if it conforms to predicate.
172165ignoreElem
@@ -190,7 +183,7 @@ ignoreEmpty
190183 -> DomParserT Identity m (Maybe a)
191184ignoreEmpty = ignoreElem test
192185 where
193− test e = null $ e ^. nodes
186+ test e = L.null $ e ^. nodes
194187
195188-- | If all current elements contains blank content, or contains nothing at all
196189-- , then returns Nothing, else runs parser.
@@ -204,130 +197,6 @@ ignoreBlank = ignoreElem test
204197 let
205198 elems = e ^.. nodes . folded . _Element
206199 cont = mconcat $ e ^.. nodes . folded . _Content
207− in if | not $ null elems -> False
200+ in if | not $ L.null elems -> False
208201 | T.null $ T.strip cont -> True
209202 | otherwise -> False
210−
211−-- | Returns name of current element.
212−--
213−-- @since 1.0.0
214−getCurrentName :: (Monad m) => DomParserT Identity m Text
215−getCurrentName = view $ pdElements . to runIdentity . localName
216−
217−-- | If name of current tag differs from first argument throws 'PENotFound' with
218−-- tag name replaced in last path's segment. Useful for checking root
219−-- document's element name.
220−checkCurrentName
221− :: (Monad m)
222− => Text
223− -> DomParserT Identity m ()
224−checkCurrentName n = do
225− cn <- getCurrentName
226− unless (cn == n) $ do
227− p <- view pdPath
228− let pinit = if null (unDomPath p) then [] else init $ unDomPath p
229− throwError $ ParserErrors [PENotFound $ DomPath $ pinit ++ [n]]
230− return ()
231−
232−-- | Get current content. If current element contains no content or
233−-- have inner elements then Nothing returned
234−--
235−-- @since 1.0.0
236−getCurrentContent :: (Monad m) => DomParserT Identity m (Maybe Text)
237−getCurrentContent = do
238− nds <- view $ pdElements . to runIdentity . nodes
239− let
240− els :: [Element]
241− els = nds ^.. folded . _Element
242− conts :: [Text]
243− conts = nds ^.. folded . _Content
244− return $ if
245− | not $ null els -> Nothing
246− | null conts -> Nothing
247− | otherwise -> Just $ mconcat conts
248−
249−-- | Parses content inside current tag. It expects current element set
250−-- consists of exactly ONE element. If current element does not
251−-- contains content or have other elements as childs then throws error
252−parseContent
253− :: (Monad m)
254− => (Text -> Either Text a)
255− -- ^ Content parser, return error msg if value is not parsed
256− -> DomParserT Identity m a
257−parseContent parse = getCurrentContent >>= \case
258− Nothing -> throwParserError PEContentNotFound
259− Just c -> case parse c of
260− Left e -> throwParserError $ PEWrongFormat e
261− Right a -> return a
262−
263−-- | If reader returns 'Nothing' then resulting function returns 'Left
264−-- "error message"'
265−--
266−-- @since 1.0.0
267−maybeReadContent
268− :: forall a
269− . (Typeable a)
270− => (Text -> Maybe a)
271− -- ^ Content or attribute reader
272− -> Text
273− -- ^ Content or attribute value
274− -> Either Text a
275−maybeReadContent f t = maybe (Left msg) Right $ f t
276− where
277− msg = "Not readable " <> n <> ": " <> t
278− n = T.pack $ show $ typeRep (Proxy :: Proxy a)
279−
280−-- | Tries to read given text to value using 'Read'. Useful to use
281−-- with 'parseContent' and 'parseAttribute'
282−readContent
283− :: (Read a, Typeable a)
284− => Text
285− -> Either Text a
286−readContent = maybeReadContent $ readMaybe . T.unpack . T.strip
287−
288−-- | Retuns map of attributes of current element
289−--
290−-- @since 1.0.0
291−getCurrentAttributes :: (Monad m) => DomParserT Identity m (M.Map Name Text)
292−getCurrentAttributes = view $ pdElements . to runIdentity . attrs
293−
294−-- | Returns element with given name or 'Nothing'
295−--
296−-- @since 1.0.0
297−getCurrentAttribute :: (Monad m) => Text -> DomParserT Identity m (Maybe Text)
298−getCurrentAttribute attrName'
299− = preview $ pdElements . to runIdentity . attr attrName
300− where
301− attrName = Name attrName' Nothing Nothing
302−
303−-- | Parses attribute with given name, throws error if attribute is not found.
304−--
305−-- @since 1.0.0
306−parseAttribute
307− :: (Monad m)
308− => Text
309− -- ^ Attribute name
310− -> (Text -> Either Text a)
311− -- ^ Attribute content parser
312− -> DomParserT Identity m a
313−parseAttribute attrName parser =
314− parseAttributeMaybe attrName parser >>= \case
315− Nothing -> throwParserError $ PEAttributeNotFound attrName
316− Just a -> return a
317−
318−-- | Parses attribute with given name.
319−--
320−-- @since 1.0.0
321−parseAttributeMaybe
322− :: (Monad m)
323− => Text
324− -- ^ Attribute name
325− -> (Text -> Either Text a)
326− -- ^ Attribute content parser
327− -> DomParserT Identity m (Maybe a)
328−parseAttributeMaybe attrName parser =
329− getCurrentAttribute attrName >>= \case
330− Nothing -> return Nothing
331− Just aval -> case parser aval of
332− Left err -> throwParserError $ PEAttributeWrongFormat attrName err
333− Right a -> return $ Just a