@@ -14,6 +14,7 @@
1414module Text.XML.Lens (
1515 -- * Lenses, traversals for 'Element'
1616 Element(..)
17+ , (./)
1718 , (...)
1819 -- ** Names
1920 , name
@@ -33,6 +34,7 @@ module Text.XML.Lens (
3334 , text
3435 , comment
3536 -- ** Children
37+ , entire
3638 , nodes
3739 -- * Prisms for 'Node'
3840 , Node(..)
@@ -60,48 +62,43 @@ import Text.XML
6062import Control.Lens
6163import Data.Text (Text)
6264import Data.Map (Map)
65+import Control.Applicative
6366import qualified Data.CaseInsensitive as CI
6467import Data.Maybe (isNothing)
6568
69+infixr 9 ./
70+
6671prologue :: Lens' Document Prologue
6772prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc
68−{-# INLINE prologue #-}
6973
7074-- | The root element of the document.
7175root :: Lens' Document Element
7276root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc
73−{-# INLINE root #-}
7477
7578epilogue :: Lens' Document [Miscellaneous]
7679epilogue f doc = fmap (\p -> doc { documentEpilogue = p} ) $ f $ documentEpilogue doc
77−{-# INLINE epilogue #-}
7880
7981doctype :: Lens' Prologue (Maybe Doctype)
8082doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc
81−{-# INLINE doctype #-}
8283
8384class AsInstruction t where
8485 _Instruction :: Prism' t Instruction
8586
8687_instructionTarget :: Lens' Instruction Text
8788_instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d
88−{-# INLINE _instructionTarget #-}
8989
9090_instructionData :: Lens' Instruction Text
9191_instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d'
92−{-# INLINE _instructionData #-}
9392
9493instance AsInstruction Node where
9594 _Instruction = prism' NodeInstruction $ \s -> case s of
9695 NodeInstruction e -> Just e
9796 _ -> Nothing
98− {-# INLINE _Instruction #-}
9997
10098instance AsInstruction Miscellaneous where
10199 _Instruction = prism' MiscInstruction $ \s -> case s of
102100 MiscInstruction e -> Just e
103101 _ -> Nothing
104− {-# INLINE _Instruction #-}
105102
106103class AsComment t where
107104 _Comment :: Prism' t Text
@@ -110,41 +107,33 @@ instance AsComment Node where
110107 _Comment = prism' NodeComment $ \s -> case s of
111108 NodeComment e -> Just e
112109 _ -> Nothing
113− {-# INLINE _Comment #-}
114110
115111instance AsComment Miscellaneous where
116112 _Comment = prism' MiscComment $ \s -> case s of
117113 MiscComment e -> Just e
118114 _ -> Nothing
119− {-# INLINE _Comment #-}
120115
121116_nameLocalName :: Lens' Name Text
122117_nameLocalName f n = f (nameLocalName n) <&> \x -> n { nameLocalName = x }
123−{-# INLINE _nameLocalName #-}
124118
125119_nameNamespace :: Lens' Name (Maybe Text)
126120_nameNamespace f n = f (nameNamespace n) <&> \x -> n { nameNamespace = x }
127−{-# INLINE _nameNamespace #-}
128121
129122_namePrefix :: Lens' Name (Maybe Text)
130123_namePrefix f n = f (namePrefix n) <&> \x -> n { namePrefix = x }
131−{-# INLINE _namePrefix #-}
132124
133125_Element :: Prism' Node Element
134126_Element = prism' NodeElement $ \s -> case s of
135127 NodeElement e -> Just e
136128 _ -> Nothing
137−{-# INLINE _Element #-}
138129
139130_Content :: Prism' Node Text
140131_Content = prism' NodeContent $ \s -> case s of
141132 NodeContent e -> Just e
142133 _ -> Nothing
143−{-# INLINE _Content #-}
144134
145135name :: Lens' Element Name
146136name f e = f (elementName e) <&> \x -> e { elementName = x }
147−{-# INLINE name #-}
148137
149138localName :: Lens' Element Text
150139localName = name . _nameLocalName
@@ -152,65 +141,69 @@ localName = name . _nameLocalName
152141
153142attrs :: Lens' Element (Map Name Text)
154143attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
155−{-# INLINE attrs #-}
156144
157145nodes :: Lens' Element [Node]
158146nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
159−{-# INLINE nodes #-}
160147
161148attr :: Name -> Traversal' Element Text
162149attr n = attrs . ix n
163−{-# INLINE attr #-}
164150
165151attribute :: Name -> Lens' Element (Maybe Text)
166152attribute n = attrs . at n
167−{-# INLINE attribute #-}
153+
154+-- | Traverse itself with its all children. Rewriting subnodes of each children will break a traversal law.
155+entire :: Traversal' Element Element
156+entire f e@(Element _ _ ns) = com <$> f e <*> traverse (_Element (entire f)) ns where
157+ com (Element n a _) = Element n a
158+{-# DEPRECATED entire "Use cosmos or deep instead" #-}
168159
169160-- | Traverse elements which has the specified *local* name (case-insensitive).
170161named :: CI.CI Text -> Traversal' Element Element
171162named n f s
172163 | CI.mk (nameLocalName (elementName s)) == n = f s
173164 | otherwise = pure s
174−{-# INLINE named #-}
175165
176166-- | Old name for 'named'
177167ell :: Text -> Traversal' Element Element
178−ell n = named $ CI.mk n
168+ell = named . CI.mk
179169
180170-- | Traverse elements which has the specified name.
181171el :: Name -> Traversal' Element Element
182172el n f s
183173 | elementName s == n = f s
184174 | otherwise = pure s
185−{-# DEPRECATED el "Use named instead" #-}
186175
187176attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
188177attributeSatisfies n p = attributeSatisfies' n (maybe False p)
189−{-# INLINE attributeSatisfies #-}
190178
191179attributeSatisfies' :: Name -> (Maybe Text -> Bool) -> Traversal' Element Element
192180attributeSatisfies' n p = filtered (p . preview (attrs . ix n))
193−{-# INLINE attributeSatisfies' #-}
194181
195182withoutAttribute :: Name -> Traversal' Element Element
196183withoutAttribute n = attributeSatisfies' n isNothing
197−{-# INLINE withoutAttribute #-}
198184
199185attributeIs :: Name -> Text -> Traversal' Element Element
200186attributeIs n v = attributeSatisfies n (==v)
201−{-# INLINE attributeIs #-}
202187
203188-- | Traverse all contents of the element.
204189text :: Traversal' Element Text
205190text = nodes . traverse . _Content
206−{-# INLINE text #-}
207191
208192-- | Traverse all comments of the element.
209193comment :: Traversal' Element Text
210194comment = nodes . traverse . _Comment
211−{-# INLINE comment #-}
212195
213196-- | 'plate' traverses over its sub-elements.
214197instance Plated Element where
215198 plate = nodes . traverse . _Element
216− {-# INLINE plate #-}
199+
200+-- | Combine two 'Traversal's just like XPath's slash. Identical to ('...').
201+--
202+-- @
203+-- l ./ m ≡ l . 'plate' . m
204+-- @
205+(./) :: (Applicative f, Plated c) => LensLike f s t c c -> Over p f c c a b -> Over p f s t a b
206+(./) = (...)
207+{-# INLINE (./) #-}
208+
209+{-# DEPRECATED (./) "Use (...) instead" #-}