@@ -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,106 @@ 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
6145 inner <- trav $ pd ^.. pdElements . folded
6246 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
47+ let
48+ newpd = ParserData
49+ { _pdElements = Identity e
50+ , _pdPath = pd ^. pdPath <> subpath }
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− => Text
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 = ([n],) . toListOf (folded . nodes . folded . _Element . ell 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− => Text
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− => Text
94+ => ElemMatcher
10595 -> DomParserT Identity m a
10696 -> DomParserT g m [a]
10797inElemAll = inElemTrav
10898
10999inElemMay
110100 :: (Monad m, Foldable g)
111− => Text
101+ => ElemMatcher
112102 -> DomParserT Identity m a
113103 -> DomParserT g m (Maybe a)
114104inElemMay = inElemTrav
115105
116106inElemNe
117107 :: (Monad m, Foldable g)
118− => Text
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− => [Text]
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 (<> path)
152+ . over pdPath (<> DomPath (L.map _emShow path))
158153 diver :: Fold Element Element
159− diver = foldr (.) id $ map toDive path
160− toDive n = nodes . folded . _Element . ell n
154+ diver = F.foldr (.) id $ L.map toDive path
155+ toDive n = nodes . folded . _Element . elMatch n
161156
162157diveElem
163158 :: (Monad m, Foldable g)
164− => Text
159+ => ElemMatcher
165160 -> DomParserT [] m a
166161 -> DomParserT g m a
167162diveElem p = divePath [p]
@@ -179,7 +174,7 @@ ignoreElem test parser = do
179174 if ign then pure Nothing else Just <$> parser
180175
181176-- | 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
177+-- Nothing. Otherwise runs parser inside current element. Useful when you got
183178-- XML with strange empty elements which must be just ignored, but `inElem` runs
184179-- parser inside of this elements which causes to parser error.
185180ignoreEmpty
@@ -188,7 +183,7 @@ ignoreEmpty
188183 -> DomParserT Identity m (Maybe a)
189184ignoreEmpty = ignoreElem test
190185 where
191− test e = null $ e ^. nodes
186+ test e = L.null $ e ^. nodes
192187
193188-- | If all current elements contains blank content, or contains nothing at all
194189-- , then returns Nothing, else runs parser.
@@ -202,114 +197,6 @@ ignoreBlank = ignoreElem test
202197 let
203198 elems = e ^.. nodes . folded . _Element
204199 cont = mconcat $ e ^.. nodes . folded . _Content
205− in if | not $ 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 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