@@ -15,27 +15,13 @@ 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
3925import Data.Monoid
4026import Data.Text as T
4127import Data.Traversable
@@ -68,7 +54,7 @@ traverseElems trav parser = do
6854
6955-- | Takes function filtering
7056inFilteredTrav
71− :: (Monad m, Foldable g, DomTraversable f)
57+ :: (Monad m, Foldable g, Buildable f)
7258 => ([Element] -> (DomPath, [Element]))
7359 -- ^ Function returning some filtered elements with path suffixes which will
7460 -- be appended to parser's state
@@ -78,12 +64,12 @@ inFilteredTrav deeper = traverseElems trav
7864 where
7965 trav e = do
8066 let (path, elems) = deeper e
81− case buildDomTraversable elems of
67+ case build elems of
8268 Nothing -> throwParserError $ PENotFound . (<> path)
8369 Just tr -> return $ fmap (path,) tr
8470
8571inElemTrav
86− :: (Monad m, Foldable g, DomTraversable f)
72+ :: (Monad m, Foldable g, Buildable f)
8773 => NameMatcher -- ^ Name of tag to traverse in
8874 -> DomParserT Identity m a
8975 -> DomParserT g m (f a)
@@ -205,106 +191,3 @@ ignoreBlank = ignoreElem test
205191 in if | not $ L.null elems -> False
206192 | T.null $ T.strip cont -> True
207193 | 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