@@ -3,29 +3,26 @@
33-----------------------------------------------------------------------------
44-- |
55-- Module : Text.XML.Lens
6−-- Copyright : (C) 2015 Fumiaki Kinoshita
6+-- Copyright : (C) 2013 Fumiaki Kinoshita
77-- License : BSD-style (see the file LICENSE)
88--
99-- Maintainer : Fumiaki Kinoshita <fumiexcel@gmail.com>
10−-- Stability : provisional
10+-- Stability : experimental
1111-- Portability : non-portable
12−--
12+-- Useful traversals inspired by XPath
1313----------------------------------------------------------------------------
1414module Text.XML.Lens (
1515 -- * Lenses, traversals for 'Element'
1616 Element(..)
17− , (...)
17+ , (./)
1818 -- ** Names
1919 , name
2020 , localName
2121 , el
2222 , ell
23− , named
2423 -- ** Attributes
2524 , attributeIs
2625 , attributeSatisfies
27− , attributeSatisfies'
28− , withoutAttribute
2926 , attr
3027 , attribute
3128 , attrs
@@ -33,6 +30,7 @@ module Text.XML.Lens (
3330 , text
3431 , comment
3532 -- ** Children
33+ , entire
3634 , nodes
3735 -- * Prisms for 'Node'
3836 , Node(..)
@@ -55,53 +53,48 @@ module Text.XML.Lens (
5553 , Instruction(..)
5654 , _instructionTarget
5755 , _instructionData
56+ -- * Reexport
57+ , module Control.Lens
5858 ) where
5959import Text.XML
6060import Control.Lens
6161import Data.Text (Text)
6262import Data.Map (Map)
63−import qualified Data.CaseInsensitive as CI
64−import Data.Maybe (isNothing)
63+import Control.Applicative
64+
65+infixr 9 ./
6566
6667prologue :: Lens' Document Prologue
6768prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc
68−{-# INLINE prologue #-}
6969
7070-- | The root element of the document.
7171root :: Lens' Document Element
7272root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc
73−{-# INLINE root #-}
7473
7574epilogue :: Lens' Document [Miscellaneous]
7675epilogue f doc = fmap (\p -> doc { documentEpilogue = p} ) $ f $ documentEpilogue doc
77−{-# INLINE epilogue #-}
7876
7977doctype :: Lens' Prologue (Maybe Doctype)
8078doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc
81−{-# INLINE doctype #-}
8279
8380class AsInstruction t where
8481 _Instruction :: Prism' t Instruction
8582
8683_instructionTarget :: Lens' Instruction Text
8784_instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d
88−{-# INLINE _instructionTarget #-}
8985
9086_instructionData :: Lens' Instruction Text
9187_instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d'
92−{-# INLINE _instructionData #-}
9388
9489instance AsInstruction Node where
9590 _Instruction = prism' NodeInstruction $ \s -> case s of
9691 NodeInstruction e -> Just e
9792 _ -> Nothing
98− {-# INLINE _Instruction #-}
9993
10094instance AsInstruction Miscellaneous where
10195 _Instruction = prism' MiscInstruction $ \s -> case s of
10296 MiscInstruction e -> Just e
10397 _ -> Nothing
104− {-# INLINE _Instruction #-}
10598
10699class AsComment t where
107100 _Comment :: Prism' t Text
@@ -110,41 +103,33 @@ instance AsComment Node where
110103 _Comment = prism' NodeComment $ \s -> case s of
111104 NodeComment e -> Just e
112105 _ -> Nothing
113− {-# INLINE _Comment #-}
114106
115107instance AsComment Miscellaneous where
116108 _Comment = prism' MiscComment $ \s -> case s of
117109 MiscComment e -> Just e
118110 _ -> Nothing
119− {-# INLINE _Comment #-}
120111
121112_nameLocalName :: Lens' Name Text
122113_nameLocalName f n = f (nameLocalName n) <&> \x -> n { nameLocalName = x }
123−{-# INLINE _nameLocalName #-}
124114
125115_nameNamespace :: Lens' Name (Maybe Text)
126116_nameNamespace f n = f (nameNamespace n) <&> \x -> n { nameNamespace = x }
127−{-# INLINE _nameNamespace #-}
128117
129118_namePrefix :: Lens' Name (Maybe Text)
130119_namePrefix f n = f (namePrefix n) <&> \x -> n { namePrefix = x }
131−{-# INLINE _namePrefix #-}
132120
133121_Element :: Prism' Node Element
134122_Element = prism' NodeElement $ \s -> case s of
135123 NodeElement e -> Just e
136124 _ -> Nothing
137−{-# INLINE _Element #-}
138125
139126_Content :: Prism' Node Text
140127_Content = prism' NodeContent $ \s -> case s of
141128 NodeContent e -> Just e
142129 _ -> Nothing
143−{-# INLINE _Content #-}
144130
145131name :: Lens' Element Name
146132name f e = f (elementName e) <&> \x -> e { elementName = x }
147−{-# INLINE name #-}
148133
149134localName :: Lens' Element Text
150135localName = name . _nameLocalName
@@ -152,65 +137,55 @@ localName = name . _nameLocalName
152137
153138attrs :: Lens' Element (Map Name Text)
154139attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
155−{-# INLINE attrs #-}
156140
157141nodes :: Lens' Element [Node]
158142nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
159−{-# INLINE nodes #-}
160143
161144attr :: Name -> Traversal' Element Text
162145attr n = attrs . ix n
163−{-# INLINE attr #-}
164146
165147attribute :: Name -> Lens' Element (Maybe Text)
166148attribute n = attrs . at n
167−{-# INLINE attribute #-}
168−
169−-- | Traverse elements which has the specified *local* name (case-insensitive).
170−named :: CI.CI Text -> Traversal' Element Element
171−named n f s
172− | CI.mk (nameLocalName (elementName s)) == n = f s
173− | otherwise = pure s
174−{-# INLINE named #-}
175149
176−-- | Old name for 'named'
177−ell :: Text -> Traversal' Element Element
178−ell n = named $ CI.mk n
150+-- | Traverse itself with its all children. Rewriting subnodes of each children will break a traversal law.
151+entire :: Traversal' Element Element
152+entire f e@(Element _ _ ns) = com <$> f e <*> traverse (_Element (entire f)) ns where
153+ com (Element n a _) = Element n a
179154
180155-- | Traverse elements which has the specified name.
181156el :: Name -> Traversal' Element Element
182157el n f s
183158 | elementName s == n = f s
184159 | otherwise = pure s
185−{-# DEPRECATED el "Use named instead" #-}
186160
187−attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
188−attributeSatisfies n p = attributeSatisfies' n (maybe False p)
189−{-# INLINE attributeSatisfies #-}
190−
191−attributeSatisfies' :: Name -> (Maybe Text -> Bool) -> Traversal' Element Element
192−attributeSatisfies' n p = filtered (p . preview (attrs . ix n))
193−{-# INLINE attributeSatisfies' #-}
161+-- | Traverse elements which has the specified *local* name.
162+ell :: Text -> Traversal' Element Element
163+ell n f s
164+ | nameLocalName (elementName s) == n = f s
165+ | otherwise = pure s
194166
195−withoutAttribute :: Name -> Traversal' Element Element
196−withoutAttribute n = attributeSatisfies' n isNothing
197−{-# INLINE withoutAttribute #-}
167+attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
168+attributeSatisfies n p = filtered (maybe False p . preview (attrs . ix n))
198169
199170attributeIs :: Name -> Text -> Traversal' Element Element
200171attributeIs n v = attributeSatisfies n (==v)
201−{-# INLINE attributeIs #-}
202172
203173-- | Traverse all contents of the element.
204174text :: Traversal' Element Text
205175text = nodes . traverse . _Content
206−{-# INLINE text #-}
207176
208177-- | Traverse all comments of the element.
209178comment :: Traversal' Element Text
210179comment = nodes . traverse . _Comment
211−{-# INLINE comment #-}
212180
213−-- | 'plate' traverses over its sub-elements.
214181instance Plated Element where
215182 plate = nodes . traverse . _Element
216− {-# INLINE plate #-}
183+
184+-- | Combine two 'Traversal's just like XPath's slash.
185+--
186+-- @
187+-- l ./ m ≡ l . 'plate' . m
188+-- @
189+(./) :: Plated a => Traversal s t a a -> Traversal a a u v -> Traversal s t u v
190+l ./ m = l . plate . m
191+{-# INLINE (./) #-}