@@ -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,46 +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
3118 ) where
3219
33−import Control.Lens
34−import Control.Monad.Except
35−import Control.Monad.Reader
36−import Data.List.NonEmpty (NonEmpty(..))
37−import qualified Data.Map.Strict as M
38−import Data.Monoid
39−import Data.Text (Text)
40−import qualified Data.Text as T
41−import Data.Traversable
42−import Data.Typeable
43−import Text.Read
44−import Text.XML
45−import Text.XML.DOM.Parser.Types
46−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
4731
4832
49−-- | Generic function to traverse arbitrary inner cursors.
33+-- | Generic function to traverse arbitrary inner elements.
5034traverseElems
5135 :: (Monad m, Foldable g, Traversable f)
5236 => ([Element] -> DomParserT g m (f (DomPath, Element)))
5337 -- ^ Takes list of current elements and returns container with
54− -- pairs of subpath (relatively to current element) and element
38+ -- pairs of subpath (relatively to current elements) and element
5539 -- to run parser in
5640 -> DomParserT Identity m a
57− -- ^ Parser will be runned for each element found in traversable
41+ -- ^ Parser to run for each element found in traversable 'f'
5842 -> DomParserT g m (f a)
5943traverseElems trav parser = do
6044 pd <- ask
@@ -64,68 +48,73 @@ traverseElems trav parser = do
6448 newpd = ParserData
6549 { _pdElements = Identity e
6650 , _pdPath = pd ^. pdPath <> subpath }
67− -- type of reader has been changed, local won't work here
68− magnify (to $ const newpd) parser
51+ lift $ runReaderT parser newpd
6952
70−-- | Takes function filtering
53+-- | Traverses elements located in same path using filtering function
7154inFilteredTrav
72− :: (Monad m, Foldable g, DomTraversable f)
55+ :: (Monad m, Foldable g, Buildable f)
7356 => ([Element] -> (DomPath, [Element]))
74− -- ^ Function returning some filtered elements with path suffixes which will
75− -- 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
7660 -> DomParserT Identity m a
7761 -> DomParserT g m (f a)
7862inFilteredTrav deeper = traverseElems trav
7963 where
8064 trav e = do
8165 let (path, elems) = deeper e
82− case buildDomTraversable elems of
66+ case build elems of
8367 Nothing -> throwParserError $ PENotFound . (<> path)
8468 Just tr -> return $ fmap (path,) tr
8569
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.
8674inElemTrav
87− :: (Monad m, Foldable g, DomTraversable f)
88− => Text
75+ :: (Monad m, Foldable g, Buildable f)
76+ => ElemMatcher -- ^ Tag(s) matcher to traverse in
8977 -> DomParserT Identity m a
9078 -> DomParserT g m (f a)
9179inElemTrav n = inFilteredTrav deeper
9280 where
93− deeper = ([n],) . toListOf (folded . nodes . folded . _Element . ell n)
81+ elemsFold = folded . nodes . folded . _Element . elMatch n
82+ deeper = (DomPath [_emShow n],) . toListOf elemsFold
9483
95−-- | Runs parser inside first children element with given name
84+-- | Runs parser inside first children element matched by macher
9685inElem
9786 :: (Monad m, Foldable g)
98− => Text
87+ => ElemMatcher
9988 -> DomParserT Identity m a
10089 -> DomParserT g m a
10190inElem n = fmap runIdentity . inElemTrav n
10291
10392inElemAll
10493 :: (Monad m, Foldable g)
105− => Text
94+ => ElemMatcher
10695 -> DomParserT Identity m a
10796 -> DomParserT g m [a]
10897inElemAll = inElemTrav
10998
11099inElemMay
111100 :: (Monad m, Foldable g)
112− => Text
101+ => ElemMatcher
113102 -> DomParserT Identity m a
114103 -> DomParserT g m (Maybe a)
115104inElemMay = inElemTrav
116105
117106inElemNe
118107 :: (Monad m, Foldable g)
119− => Text
108+ => ElemMatcher
120109 -> DomParserT Identity m a
121110 -> DomParserT g m (NonEmpty a)
122111inElemNe = inElemTrav
123112
124113{- | Dive given parser's current tags set into the given path. The @divePath
125−["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
126115will not fail if occured tag "a" which does not contains tag "b". This
127116behaviour is desireable when you dont want to parse whole XML and just want
128−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
129118elements. Consider this code
130119
131120@
@@ -143,26 +132,31 @@ which translates like: @a > b > c > fromDom@
143132As you can see, inElem always takes first element and runs inner parser in this
144133single element, unlike 'divePath' which runs inner parser @in all@ descendants
145134in 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.
146140-}
147141
148142divePath
149143 :: forall m g a
150144 . (Monad m, Foldable g)
151− => [Text]
145+ => [ElemMatcher]
152146 -> DomParserT [] m a
153147 -> DomParserT g m a
154148divePath path = magnify $ to modElems
155149 where
156150 modElems
157151 = over pdElements (toListOf $ folded . diver)
158− . over pdPath (<> path)
152+ . over pdPath (<> DomPath (L.map _emShow path))
159153 diver :: Fold Element Element
160− diver = foldr (.) id $ map toDive path
161− toDive n = nodes . folded . _Element . ell n
154+ diver = F.foldr (.) id $ L.map toDive path
155+ toDive n = nodes . folded . _Element . elMatch n
162156
163157diveElem
164158 :: (Monad m, Foldable g)
165− => Text
159+ => ElemMatcher
166160 -> DomParserT [] m a
167161 -> DomParserT g m a
168162diveElem p = divePath [p]
@@ -189,7 +183,7 @@ ignoreEmpty
189183 -> DomParserT Identity m (Maybe a)
190184ignoreEmpty = ignoreElem test
191185 where
192− test e = null $ e ^. nodes
186+ test e = L.null $ e ^. nodes
193187
194188-- | If all current elements contains blank content, or contains nothing at all
195189-- , then returns Nothing, else runs parser.
@@ -203,114 +197,6 @@ ignoreBlank = ignoreElem test
203197 let
204198 elems = e ^.. nodes . folded . _Element
205199 cont = mconcat $ e ^.. nodes . folded . _Content
206− in if | not $ null elems -> False
200+ in if | not $ L.null elems -> False
207201 | T.null $ T.strip cont -> True
208202 | otherwise -> False
209−
210−-- | Returns name of current element.
211−--
212−-- @since 1.0.0
213−getCurrentName :: (Monad m) => DomParserT Identity m Text
214−getCurrentName = view $ pdElements . to runIdentity . localName
215−
216−-- | If name of current tag differs from first argument throws 'PENotFound' with
217−-- tag name replaced in last path's segment. Useful for checking root
218−-- document's element name.
219−checkCurrentName
220− :: (Monad m)
221− => Text
222− -> DomParserT Identity m ()
223−checkCurrentName n = do
224− cn <- getCurrentName
225− unless (cn == n) $ do
226− p <- view pdPath
227− let pinit = if null p then [] else init p
228− throwError $ ParserErrors [PENotFound $ pinit ++ [n]]
229− return ()
230−
231−-- | Get current content. If current element contains no content or
232−-- have inner elements then Nothing returned
233−--
234−-- @since 1.0.0
235−getCurrentContent :: (Monad m) => DomParserT Identity m (Maybe Text)
236−getCurrentContent = do
237− nds <- view $ pdElements . to runIdentity . nodes
238− let
239− els :: [Element]
240− els = nds ^.. folded . _Element
241− conts :: [Text]
242− conts = nds ^.. folded . _Content
243− return $ if
244− | not $ null els -> Nothing
245− | null conts -> Nothing
246− | otherwise -> Just $ mconcat conts
247−
248−-- | Parses content inside current tag. It expects current element set
249−-- consists of exactly ONE element. If current element does not
250−-- contains content or have other elements as childs then throws error
251−parseContent
252− :: (Monad m)
253− => (Text -> Either Text a)
254− -- ^ Content parser, return error msg if value is not parsed
255− -> DomParserT Identity m a
256−parseContent parse = getCurrentContent >>= \case
257− Nothing -> throwParserError PEContentNotFound
258− Just c -> case parse c of
259− Left e -> throwParserError $ PEWrongFormat e
260− Right a -> return a
261−
262−-- | If reader returns 'Nothing' then resulting function returns 'Left
263−-- "error message"'
264−--
265−-- @since 1.0.0
266−maybeReadContent
267− :: forall a
268− . (Typeable a)
269− => (Text -> Maybe a)
270− -- ^ Content or attribute reader
271− -> Text
272− -- ^ Content or attribute value
273− -> Either Text a
274−maybeReadContent f t = maybe (Left msg) Right $ f t
275− where
276− msg = "Not readable " <> n <> ": " <> t
277− n = T.pack $ show $ typeRep (Proxy :: Proxy a)
278−
279−-- | Tries to read given text to value using 'Read'. Useful to use
280−-- with 'parseContent' and 'parseAttribute'
281−readContent
282− :: (Read a, Typeable a)
283− => Text
284− -> Either Text a
285−readContent = maybeReadContent $ readMaybe . T.unpack . T.strip
286−
287−-- | Retuns map of attributes of current element
288−--
289−-- @since 1.0.0
290−getCurrentAttributes :: (Monad m) => DomParserT Identity m (M.Map Name Text)
291−getCurrentAttributes = view $ pdElements . to runIdentity . attrs
292−
293−-- | Returns element with given name or 'Nothing'
294−--
295−-- @since 1.0.0
296−getCurrentAttribute :: (Monad m) => Text -> DomParserT Identity m (Maybe Text)
297−getCurrentAttribute attrName'
298− = preview $ pdElements . to runIdentity . attr attrName
299− where
300− attrName = Name attrName' Nothing Nothing
301−
302−-- | Parses attribute with given name, throws error if attribute is not found.
303−--
304−-- @since 1.0.0
305−parseAttribute
306− :: (Monad m)
307− => Text
308− -- ^ Attribute name
309− -> (Text -> Either Text a)
310− -- ^ Attribute content parser
311− -> DomParserT Identity m a
312−parseAttribute attrName parser = getCurrentAttribute attrName >>= \case
313− Nothing -> throwParserError $ PEAttributeNotFound attrName
314− Just aval -> case parser aval of
315− Left err -> throwParserError $ PEAttributeWrongFormat attrName err
316− Right a -> return a