@@ -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,47 +15,31 @@ 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
31− , parseAttributeMaybe
3218 ) where
3319
34−import Control.Lens
35−import Control.Monad.Except
36−import Control.Monad.Reader
37−import Data.List.NonEmpty (NonEmpty(..))
38−import qualified Data.Map.Strict as M
39−import Data.Monoid
40−import Data.Text (Text)
41−import qualified Data.Text as T
42−import Data.Traversable
43−import Data.Typeable
44−import Text.Read
45−import Text.XML
46−import Text.XML.DOM.Parser.Types
47−import Text.XML.Lens
48−
49−
50−-- | 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.
5135traverseElems
5236 :: (Monad m, Foldable g, Traversable f)
5337 => ([Element] -> DomParserT g m (f (DomPath, Element)))
5438 -- ^ Takes list of current elements and returns container with
55− -- pairs of subpath (relatively to current element) and element
39+ -- pairs of subpath (relatively to current elements) and element
5640 -- to run parser in
5741 -> DomParserT Identity m a
58− -- ^ Parser will be runned for each element found in traversable
42+ -- ^ Parser to run for each element found in traversable 'f'
5943 -> DomParserT g m (f a)
6044traverseElems trav parser = do
6145 pd <- ask
@@ -65,68 +49,73 @@ traverseElems trav parser = do
6549 newpd = ParserData
6650 { _pdElements = Identity e
6751 , _pdPath = pd ^. pdPath <> subpath }
68− -- type of reader has been changed, local won't work here
69− magnify (to $ const newpd) parser
52+ lift $ runReaderT parser newpd
7053
71−-- | Takes function filtering
54+-- | Traverses elements located in same path using filtering function
7255inFilteredTrav
73− :: (Monad m, Foldable g, DomTraversable f)
56+ :: (Monad m, Foldable g, Buildable f)
7457 => ([Element] -> (DomPath, [Element]))
75− -- ^ Function returning some filtered elements with path suffixes which will
76− -- 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
7761 -> DomParserT Identity m a
7862 -> DomParserT g m (f a)
7963inFilteredTrav deeper = traverseElems trav
8064 where
8165 trav e = do
8266 let (path, elems) = deeper e
83− case buildDomTraversable elems of
67+ case build elems of
8468 Nothing -> throwParserError $ PENotFound . (<> path)
8569 Just tr -> return $ fmap (path,) tr
8670
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.
8775inElemTrav
88− :: (Monad m, Foldable g, DomTraversable f)
89− => Text
76+ :: (Monad m, Foldable g, Buildable f)
77+ => ElemMatcher -- ^ Tag(s) matcher to traverse in
9078 -> DomParserT Identity m a
9179 -> DomParserT g m (f a)
9280inElemTrav n = inFilteredTrav deeper
9381 where
94− deeper = ([n],) . toListOf (folded . nodes . folded . _Element . ell n)
82+ elemsFold = folded . nodes . folded . _Element . elMatch n
83+ deeper = (DomPath [_emShow n],) . toListOf elemsFold
9584
96−-- | Runs parser inside first children element with given name
85+-- | Runs parser inside first children element matched by macher
9786inElem
9887 :: (Monad m, Foldable g)
99− => Text
88+ => ElemMatcher
10089 -> DomParserT Identity m a
10190 -> DomParserT g m a
10291inElem n = fmap runIdentity . inElemTrav n
10392
10493inElemAll
10594 :: (Monad m, Foldable g)
106− => Text
95+ => ElemMatcher
10796 -> DomParserT Identity m a
10897 -> DomParserT g m [a]
10998inElemAll = inElemTrav
11099
111100inElemMay
112101 :: (Monad m, Foldable g)
113− => Text
102+ => ElemMatcher
114103 -> DomParserT Identity m a
115104 -> DomParserT g m (Maybe a)
116105inElemMay = inElemTrav
117106
118107inElemNe
119108 :: (Monad m, Foldable g)
120− => Text
109+ => ElemMatcher
121110 -> DomParserT Identity m a
122111 -> DomParserT g m (NonEmpty a)
123112inElemNe = inElemTrav
124113
125114{- | Dive given parser's current tags set into the given path. The @divePath
126−["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
127116will not fail if occured tag "a" which does not contains tag "b". This
128117behaviour is desireable when you dont want to parse whole XML and just want
129−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
130119elements. Consider this code
131120
132121@
@@ -144,26 +133,31 @@ which translates like: @a > b > c > fromDom@
144133As you can see, inElem always takes first element and runs inner parser in this
145134single element, unlike 'divePath' which runs inner parser @in all@ descendants
146135in 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.
147141-}
148142
149143divePath
150144 :: forall m g a
151145 . (Monad m, Foldable g)
152− => [Text]
146+ => [ElemMatcher]
153147 -> DomParserT [] m a
154148 -> DomParserT g m a
155149divePath path = magnify $ to modElems
156150 where
157151 modElems
158152 = over pdElements (toListOf $ folded . diver)
159− . over pdPath (<> path)
153+ . over pdPath (<> DomPath (L.map _emShow path))
160154 diver :: Fold Element Element
161− diver = foldr (.) id $ map toDive path
162− toDive n = nodes . folded . _Element . ell n
155+ diver = F.foldr (.) id $ L.map toDive path
156+ toDive n = nodes . folded . _Element . elMatch n
163157
164158diveElem
165159 :: (Monad m, Foldable g)
166− => Text
160+ => ElemMatcher
167161 -> DomParserT [] m a
168162 -> DomParserT g m a
169163diveElem p = divePath [p]
@@ -190,7 +184,7 @@ ignoreEmpty
190184 -> DomParserT Identity m (Maybe a)
191185ignoreEmpty = ignoreElem test
192186 where
193− test e = null $ e ^. nodes
187+ test e = L.null $ e ^. nodes
194188
195189-- | If all current elements contains blank content, or contains nothing at all
196190-- , then returns Nothing, else runs parser.
@@ -204,130 +198,6 @@ ignoreBlank = ignoreElem test
204198 let
205199 elems = e ^.. nodes . folded . _Element
206200 cont = mconcat $ e ^.. nodes . folded . _Content
207− in if | not $ null elems -> False
201+ in if | not $ L.null elems -> False
208202 | T.null $ T.strip cont -> True
209203 | otherwise -> False
210−
211−-- | Returns name of current element.
212−--
213−-- @since 1.0.0
214−getCurrentName :: (Monad m) => DomParserT Identity m Text
215−getCurrentName = view $ pdElements . to runIdentity . localName
216−
217−-- | If name of current tag differs from first argument throws 'PENotFound' with
218−-- tag name replaced in last path's segment. Useful for checking root
219−-- document's element name.
220−checkCurrentName
221− :: (Monad m)
222− => Text
223− -> DomParserT Identity m ()
224−checkCurrentName n = do
225− cn <- getCurrentName
226− unless (cn == n) $ do
227− p <- view pdPath
228− let pinit = if null p then [] else init p
229− throwError $ ParserErrors [PENotFound $ pinit ++ [n]]
230− return ()
231−
232−-- | Get current content. If current element contains no content or
233−-- have inner elements then Nothing returned
234−--
235−-- @since 1.0.0
236−getCurrentContent :: (Monad m) => DomParserT Identity m (Maybe Text)
237−getCurrentContent = do
238− nds <- view $ pdElements . to runIdentity . nodes
239− let
240− els :: [Element]
241− els = nds ^.. folded . _Element
242− conts :: [Text]
243− conts = nds ^.. folded . _Content
244− return $ if
245− | not $ null els -> Nothing
246− | null conts -> Nothing
247− | otherwise -> Just $ mconcat conts
248−
249−-- | Parses content inside current tag. It expects current element set
250−-- consists of exactly ONE element. If current element does not
251−-- contains content or have other elements as childs then throws error
252−parseContent
253− :: (Monad m)
254− => (Text -> Either Text a)
255− -- ^ Content parser, return error msg if value is not parsed
256− -> DomParserT Identity m a
257−parseContent parse = getCurrentContent >>= \case
258− Nothing -> throwParserError PEContentNotFound
259− Just c -> case parse c of
260− Left e -> throwParserError $ PEWrongFormat e
261− Right a -> return a
262−
263−-- | If reader returns 'Nothing' then resulting function returns 'Left
264−-- "error message"'
265−--
266−-- @since 1.0.0
267−maybeReadContent
268− :: forall a
269− . (Typeable a)
270− => (Text -> Maybe a)
271− -- ^ Content or attribute reader
272− -> Text
273− -- ^ Content or attribute value
274− -> Either Text a
275−maybeReadContent f t = maybe (Left msg) Right $ f t
276− where
277− msg = "Not readable " <> n <> ": " <> t
278− n = T.pack $ show $ typeRep (Proxy :: Proxy a)
279−
280−-- | Tries to read given text to value using 'Read'. Useful to use
281−-- with 'parseContent' and 'parseAttribute'
282−readContent
283− :: (Read a, Typeable a)
284− => Text
285− -> Either Text a
286−readContent = maybeReadContent $ readMaybe . T.unpack . T.strip
287−
288−-- | Retuns map of attributes of current element
289−--
290−-- @since 1.0.0
291−getCurrentAttributes :: (Monad m) => DomParserT Identity m (M.Map Name Text)
292−getCurrentAttributes = view $ pdElements . to runIdentity . attrs
293−
294−-- | Returns element with given name or 'Nothing'
295−--
296−-- @since 1.0.0
297−getCurrentAttribute :: (Monad m) => Text -> DomParserT Identity m (Maybe Text)
298−getCurrentAttribute attrName'
299− = preview $ pdElements . to runIdentity . attr attrName
300− where
301− attrName = Name attrName' Nothing Nothing
302−
303−-- | Parses attribute with given name, throws error if attribute is not found.
304−--
305−-- @since 1.0.0
306−parseAttribute
307− :: (Monad m)
308− => Text
309− -- ^ Attribute name
310− -> (Text -> Either Text a)
311− -- ^ Attribute content parser
312− -> DomParserT Identity m a
313−parseAttribute attrName parser =
314− parseAttributeMaybe attrName parser >>= \case
315− Nothing -> throwParserError $ PEAttributeNotFound attrName
316− Just a -> return a
317−
318−-- | Parses attribute with given name.
319−--
320−-- @since 1.0.0
321−parseAttributeMaybe
322− :: (Monad m)
323− => Text
324− -- ^ Attribute name
325− -> (Text -> Either Text a)
326− -- ^ Attribute content parser
327− -> DomParserT Identity m (Maybe a)
328−parseAttributeMaybe attrName parser =
329− getCurrentAttribute attrName >>= \case
330− Nothing -> return Nothing
331− Just aval -> case parser aval of
332− Left err -> throwParserError $ PEAttributeWrongFormat attrName err
333− Right a -> return $ Just a