@@ -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,116 +15,107 @@ 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
47−
48−
49−-- | Generic function to traverse arbitrary inner cursors.
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.Monoid
26+import Data.Text as T
27+import Data.Traversable
28+import Text.XML
29+import Text.XML.DOM.Parser.Buildable
30+import Text.XML.DOM.Parser.Types
31+import Text.XML.Lens
32+
33+
34+-- | Generic function to traverse arbitrary inner elements.
5035traverseElems
5136 :: (Monad m, Foldable g, Traversable f)
5237 => ([Element] -> DomParserT g m (f (DomPath, Element)))
5338 -- ^ Takes list of current elements and returns container with
54− -- pairs of subpath (relatively to current element) and element
39+ -- pairs of subpath (relatively to current elements) and element
5540 -- to run parser in
5641 -> DomParserT Identity m a
57− -- ^ Parser will be runned for each element found in traversable
42+ -- ^ Parser to run for each element found in traversable 'f'
5843 -> DomParserT g m (f a)
5944traverseElems trav parser = do
6045 pd <- ask
6146 inner <- trav $ pd ^.. pdElements . folded
6247 for inner $ \(subpath, e) -> do
63− let newpd = ParserData
64− { _pdElements = Identity e
65− , _pdPath = pd ^. pdPath <> subpath }
66− magnify (to $ const newpd) parser -- type of reader is changed, so
67− -- local does not work
48+ let
49+ newpd = ParserData
50+ { _pdElements = Identity e
51+ , _pdPath = pd ^. pdPath <> subpath }
52+ lift $ runReaderT parser newpd
6853
69−-- | Takes function filtering
54+-- | Traverses elements located in same path using filtering function
7055inFilteredTrav
71− :: (Monad m, Foldable g, DomTraversable f)
56+ :: (Monad m, Foldable g, Buildable f)
7257 => ([Element] -> (DomPath, [Element]))
73− -- ^ Function returning some filtered elements with path suffixes which will
74− -- be appended to parser's state
58+ -- ^ Takes list of current elements and returns some descendants
59+ -- subset and path this descendants located at. Path is should be
60+ -- same for all descendants and required for error message
7561 -> DomParserT Identity m a
7662 -> DomParserT g m (f a)
7763inFilteredTrav 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
71+-- | Runs parser arbitrary times, depending on 'Buildable' instance of
72+-- 'f'. For example if 'f' becomes 'NonEmpty' then 'inElemTrav' finds
73+-- @one or more@ elements matched by given 'ElemMatcher' and run
74+-- parser in each found element, then returns @NonEmpty a@ of results.
8575inElemTrav
86− :: (Monad m, Foldable g, DomTraversable f)
87− => Text
76+ :: (Monad m, Foldable g, Buildable f)
77+ => ElemMatcher -- ^ Tag(s) matcher to traverse in
8878 -> DomParserT Identity m a
8979 -> DomParserT g m (f a)
9080inElemTrav n = inFilteredTrav deeper
9181 where
92− deeper = ([n],) . toListOf (folded . nodes . folded . _Element . ell n)
82+ elemsFold = folded . nodes . folded . _Element . elMatch n
83+ deeper = (DomPath [_emShow n],) . toListOf elemsFold
9384
94−-- | Runs parser inside first children element with given name
85+-- | Runs parser inside first children element matched by macher
9586inElem
9687 :: (Monad m, Foldable g)
97− => Text
88+ => ElemMatcher
9889 -> DomParserT Identity m a
9990 -> DomParserT g m a
10091inElem n = fmap runIdentity . inElemTrav n
10192
10293inElemAll
10394 :: (Monad m, Foldable g)
104− => Text
95+ => ElemMatcher
10596 -> DomParserT Identity m a
10697 -> DomParserT g m [a]
10798inElemAll = inElemTrav
10899
109100inElemMay
110101 :: (Monad m, Foldable g)
111− => Text
102+ => ElemMatcher
112103 -> DomParserT Identity m a
113104 -> DomParserT g m (Maybe a)
114105inElemMay = inElemTrav
115106
116107inElemNe
117108 :: (Monad m, Foldable g)
118− => Text
109+ => ElemMatcher
119110 -> DomParserT Identity m a
120111 -> DomParserT g m (NonEmpty a)
121112inElemNe = inElemTrav
122113
123114{- | 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
115+["a", "b"]@ differs from @inElem "a" $ inElem "b"@. Namely the first variant
125116will not fail if occured tag "a" which does not contains tag "b". This
126117behaviour 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
118+to pull tags located in some path. The other difference is in traversing inner
128119elements. Consider this code
129120
130121@
@@ -142,26 +133,31 @@ which translates like: @a > b > c > fromDom@
142133As you can see, inElem always takes first element and runs inner parser in this
143134single element, unlike 'divePath' which runs inner parser @in all@ descendants
144135in given path.
136+
137+Note also that 'divePath' takes parser parameterized by @[]@ not by
138+'Identity'. This because when you dive using some path you will get a
139+list of found elements and all these elements will be @current@ for
140+parser.
145141-}
146142
147143divePath
148144 :: forall m g a
149145 . (Monad m, Foldable g)
150− => [Text]
146+ => [ElemMatcher]
151147 -> DomParserT [] m a
152148 -> DomParserT g m a
153149divePath path = magnify $ to modElems
154150 where
155151 modElems
156152 = over pdElements (toListOf $ folded . diver)
157− . over pdPath (<> path)
153+ . over pdPath (<> DomPath (L.map _emShow path))
158154 diver :: Fold Element Element
159− diver = foldr (.) id $ map toDive path
160− toDive n = nodes . folded . _Element . ell n
155+ diver = F.foldr (.) id $ L.map toDive path
156+ toDive n = nodes . folded . _Element . elMatch n
161157
162158diveElem
163159 :: (Monad m, Foldable g)
164− => Text
160+ => ElemMatcher
165161 -> DomParserT [] m a
166162 -> DomParserT g m a
167163diveElem p = divePath [p]
@@ -179,7 +175,7 @@ ignoreElem test parser = do
179175 if ign then pure Nothing else Just <$> parser
180176
181177-- | If current element has no children nodes does not run parser and returns
182−-- Nothing. Otherwise runs parser inside current element. Usefull when you got
178+-- Nothing. Otherwise runs parser inside current element. Useful when you got
183179-- XML with strange empty elements which must be just ignored, but `inElem` runs
184180-- parser inside of this elements which causes to parser error.
185181ignoreEmpty
@@ -188,7 +184,7 @@ ignoreEmpty
188184 -> DomParserT Identity m (Maybe a)
189185ignoreEmpty = ignoreElem test
190186 where
191− test e = null $ e ^. nodes
187+ test e = L.null $ e ^. nodes
192188
193189-- | If all current elements contains blank content, or contains nothing at all
194190-- , then returns Nothing, else runs parser.
@@ -202,114 +198,6 @@ ignoreBlank = ignoreElem test
202198 let
203199 elems = e ^.. nodes . folded . _Element
204200 cont = mconcat $ e ^.. nodes . folded . _Content
205− in if | not $ null elems -> False
201+ in if | not $ L.null elems -> False
206202 | T.null $ T.strip cont -> True
207203 | otherwise -> False
208−
209−-- | Returns name of current element.
210−--
211−-- @since 1.0.0
212−getCurrentName :: (Monad m) => DomParserT Identity m Text
213−getCurrentName = view $ pdElements . to runIdentity . localName
214−
215−-- | If name of current tag differs from first argument throws 'PENotFound' with
216−-- tag name replaced in last path's segment. Usefull for checking root
217−-- document's element name.
218−checkCurrentName
219− :: (Monad m)
220− => Text
221− -> DomParserT Identity m ()
222−checkCurrentName n = do
223− cn <- getCurrentName
224− unless (cn == n) $ do
225− p <- view pdPath
226− let pinit = if null p then [] else init p
227− throwError $ ParserErrors [PENotFound $ pinit ++ [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 $ null els -> Nothing
244− | 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−-- | If reader returns 'Nothing' then resulting function returns 'Left
262−-- "error message"'
263−--
264−-- @since 1.0.0
265−maybeReadContent
266− :: forall a
267− . (Typeable a)
268− => (Text -> Maybe a)
269− -- ^ Content or attribute reader
270− -> Text
271− -- ^ Content or attribute value
272− -> Either Text a
273−maybeReadContent f t = maybe (Left msg) Right $ f t
274− where
275− msg = "Not readable " <> n <> ": " <> t
276− n = T.pack $ show $ typeRep (Proxy :: Proxy a)
277−
278−-- | Tries to read given text to value using 'Read'. Usefull to use
279−-- with 'parseContent' and 'parseAttribute'
280−readContent
281− :: (Read a, Typeable a)
282− => Text
283− -> Either Text a
284−readContent = maybeReadContent $ readMaybe . T.unpack . T.strip
285−
286−-- | Retuns map of attributes of current element
287−--
288−-- @since 1.0.0
289−getCurrentAttributes :: (Monad m) => DomParserT Identity m (M.Map Name Text)
290−getCurrentAttributes = view $ pdElements . to runIdentity . attrs
291−
292−-- | Returns element with given name or 'Nothing'
293−--
294−-- @since 1.0.0
295−getCurrentAttribute :: (Monad m) => Text -> DomParserT Identity m (Maybe Text)
296−getCurrentAttribute attrName'
297− = preview $ pdElements . to runIdentity . attr attrName
298− where
299− attrName = Name attrName' Nothing Nothing
300−
301−-- | Parses attribute with given name, throws error if attribute is not found.
302−--
303−-- @since 1.0.0
304−parseAttribute
305− :: (Monad m)
306− => Text
307− -- ^ Attribute name
308− -> (Text -> Either Text a)
309− -- ^ Attribute content parser
310− -> DomParserT Identity m a
311−parseAttribute attrName parser = getCurrentAttribute attrName >>= \case
312− Nothing -> throwParserError $ PEAttributeNotFound attrName
313− Just aval -> case parser aval of
314− Left err -> throwParserError $ PEAttributeWrongFormat attrName err
315− Right a -> return a