@@ -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,105 +15,106 @@ module Text.XML.DOM.Parser.Combinators
1515 , ignoreElem
1616 , ignoreEmpty
1717 , ignoreBlank
18− -- * Checking current element properties
19− , checkCurrentName
20− -- * Parsing arbitrary content
21− , parseContent
22− , readContent
2318 ) where
2419
25−import Control.Lens
26−import Control.Monad.Except
27−import Control.Monad.Reader
28−import Data.List.NonEmpty (NonEmpty(..))
29−import Data.Monoid
30−import Data.Text (Text)
31−import qualified Data.Text as T
32−import Data.Traversable
33−import Data.Typeable
34−import Text.Read
35−import Text.Shakespeare.Text (st)
36−import Text.XML
37−import Text.XML.DOM.Parser.Types
38−import Text.XML.Lens
39−
40−
41−-- | 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.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
31+
32+
33+-- | Generic function to traverse arbitrary inner elements.
4234traverseElems
4335 :: (Monad m, Foldable g, Traversable f)
44− => ([Element] -> DomParserT g m (f ([Text], Element)))
45− -- ^ Takes set of current elements and
36+ => ([Element] -> DomParserT g m (f (DomPath, Element)))
37+ -- ^ Takes list of current elements and returns container with
38+ -- pairs of subpath (relatively to current elements) and element
39+ -- to run parser in
4640 -> DomParserT Identity m a
47− -- ^ Parser will be runned for each element found in traversable
41+ -- ^ Parser to run for each element found in traversable 'f'
4842 -> DomParserT g m (f a)
4943traverseElems trav parser = do
5044 pd <- ask
5145 inner <- trav $ pd ^.. pdElements . folded
5246 for inner $ \(subpath, e) -> do
53− let newpd = ParserData
54− { _pdElements = Identity e
55− , _pdPath = pd ^. pdPath <> subpath }
56− magnify (to $ const newpd) parser
47+ let
48+ newpd = ParserData
49+ { _pdElements = Identity e
50+ , _pdPath = pd ^. pdPath <> subpath }
51+ lift $ runReaderT parser newpd
5752
58−-- | Takes function filtering
53+-- | Traverses elements located in same path using filtering function
5954inFilteredTrav
60− :: (Monad m, Foldable g, DomTraversable f)
61− => ([Element] -> ([Text], [Element]))
62− -- ^ Function returning some filtered elements with path suffixes which will
63− -- be appended to parser's state
55+ :: (Monad m, Foldable g, Buildable f)
56+ => ([Element] -> (DomPath, [Element]))
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
6460 -> DomParserT Identity m a
6561 -> DomParserT g m (f a)
6662inFilteredTrav deeper = traverseElems trav
6763 where
6864 trav e = do
6965 let (path, elems) = deeper e
70− case buildDomTraversable elems of
66+ case build elems of
7167 Nothing -> throwParserError $ PENotFound . (<> path)
7268 Just tr -> return $ fmap (path,) tr
7369
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.
7474inElemTrav
75− :: (Monad m, Foldable g, DomTraversable f)
76− => Text
75+ :: (Monad m, Foldable g, Buildable f)
76+ => ElemMatcher -- ^ Tag(s) matcher to traverse in
7777 -> DomParserT Identity m a
7878 -> DomParserT g m (f a)
7979inElemTrav n = inFilteredTrav deeper
8080 where
81− deeper = ([n],) . toListOf (folded . nodes . folded . _Element . ell n)
81+ elemsFold = folded . nodes . folded . _Element . elMatch n
82+ deeper = (DomPath [_emShow n],) . toListOf elemsFold
8283
83−-- | Runs parser inside first children element with given name
84+-- | Runs parser inside first children element matched by macher
8485inElem
8586 :: (Monad m, Foldable g)
86− => Text
87+ => ElemMatcher
8788 -> DomParserT Identity m a
8889 -> DomParserT g m a
8990inElem n = fmap runIdentity . inElemTrav n
9091
9192inElemAll
9293 :: (Monad m, Foldable g)
93− => Text
94+ => ElemMatcher
9495 -> DomParserT Identity m a
9596 -> DomParserT g m [a]
9697inElemAll = inElemTrav
9798
9899inElemMay
99100 :: (Monad m, Foldable g)
100− => Text
101+ => ElemMatcher
101102 -> DomParserT Identity m a
102103 -> DomParserT g m (Maybe a)
103104inElemMay = inElemTrav
104105
105106inElemNe
106107 :: (Monad m, Foldable g)
107− => Text
108+ => ElemMatcher
108109 -> DomParserT Identity m a
109110 -> DomParserT g m (NonEmpty a)
110111inElemNe = inElemTrav
111112
112113{- | Dive given parser's current tags set into the given path. The @divePath
113−["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
114115will not fail if occured tag "a" which does not contains tag "b". This
115116behaviour is desireable when you dont want to parse whole XML and just want
116−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
117118elements. Consider this code
118119
119120@
@@ -131,26 +132,31 @@ which translates like: @a > b > c > fromDom@
131132As you can see, inElem always takes first element and runs inner parser in this
132133single element, unlike 'divePath' which runs inner parser @in all@ descendants
133134in 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.
134140-}
135141
136142divePath
137143 :: forall m g a
138144 . (Monad m, Foldable g)
139− => [Text]
145+ => [ElemMatcher]
140146 -> DomParserT [] m a
141147 -> DomParserT g m a
142148divePath path = magnify $ to modElems
143149 where
144150 modElems
145151 = over pdElements (toListOf $ folded . diver)
146− . over pdPath (<> path)
152+ . over pdPath (<> DomPath (L.map _emShow path))
147153 diver :: Fold Element Element
148− diver = foldr (.) id $ map toDive path
149− toDive n = nodes . folded . _Element . ell n
154+ diver = F.foldr (.) id $ L.map toDive path
155+ toDive n = nodes . folded . _Element . elMatch n
150156
151157diveElem
152158 :: (Monad m, Foldable g)
153− => Text
159+ => ElemMatcher
154160 -> DomParserT [] m a
155161 -> DomParserT g m a
156162diveElem p = divePath [p]
@@ -160,7 +166,7 @@ ignoreElem
160166 :: (Monad m)
161167 => (Element -> Bool)
162168 -- ^ Predicate checking that we must ignore some current tag. If returns
163− -- true then parser will not be runned and combinator just returns Nothing.
169+ -- 'True' then parser will not be runned and combinator just returns Nothing.
164170 -> DomParserT Identity m a
165171 -> DomParserT Identity m (Maybe a)
166172ignoreElem test parser = do
@@ -168,7 +174,7 @@ ignoreElem test parser = do
168174 if ign then pure Nothing else Just <$> parser
169175
170176-- | If current element has no children nodes does not run parser and returns
171−-- Nothing. Otherwise runs parser inside current element. Usefull when you got
177+-- Nothing. Otherwise runs parser inside current element. Useful when you got
172178-- XML with strange empty elements which must be just ignored, but `inElem` runs
173179-- parser inside of this elements which causes to parser error.
174180ignoreEmpty
@@ -177,7 +183,7 @@ ignoreEmpty
177183 -> DomParserT Identity m (Maybe a)
178184ignoreEmpty = ignoreElem test
179185 where
180− test e = null $ e ^. nodes
186+ test e = L.null $ e ^. nodes
181187
182188-- | If all current elements contains blank content, or contains nothing at all
183189-- , then returns Nothing, else runs parser.
@@ -191,49 +197,6 @@ ignoreBlank = ignoreElem test
191197 let
192198 elems = e ^.. nodes . folded . _Element
193199 cont = mconcat $ e ^.. nodes . folded . _Content
194− in if | not $ null elems -> False
200+ in if | not $ L.null elems -> False
195201 | T.null $ T.strip cont -> True
196202 | otherwise -> False
197−
198−-- | If name of current tag differs from first argument throws 'PENotFound' with
199−-- tag name replaced in last path's segment. Usefull for checking root
200−-- document's element name.
201−checkCurrentName
202− :: (Monad m)
203− => Text
204− -> DomParserT Identity m ()
205−checkCurrentName n = do
206− cn <- view $ pdElements . to runIdentity . localName
207− unless (cn == n) $ do
208− p <- view pdPath
209− let pinit = if null p then [] else init p
210− throwError $ ParserErrors [PENotFound $ pinit ++ [n]]
211− return ()
212−
213−-- | Parses content inside current tag. It expects current element set consists
214−-- of exactly ONE element. Throws error if current elements set contains
215−-- multiple of them.
216−parseContent
217− :: (Monad m)
218− => (Text -> DomParserT Identity m a)
219− -> DomParserT Identity m a
220−parseContent parse = do
221− e <- view $ pdElements . to runIdentity
222− let
223− nds = e ^. nodes
224− els = nds ^.. folded . _Element
225− conts = nds ^.. folded . _Content
226− when (not $ null els) $ throwParserError PEContentNotFound
227− when (null conts) $ throwParserError PEContentNotFound
228− parse $ mconcat conts
229−
230−readContent
231− :: forall m g a
232− . (Read a, Typeable a, Monad m)
233− => Text
234− -> DomParserT g m a
235−readContent t = case readMaybe $ T.unpack t of
236− Nothing -> throwParserError $ PEWrongFormat [st|Not readable #{n}: #{t}|]
237− Just a -> pure a
238− where
239− n = show $ typeRep (Proxy :: Proxy a)