@@ -3,18 +3,18 @@
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
@@ -24,8 +24,6 @@ module Text.XML.Lens (
2424 -- ** Attributes
2525 , attributeIs
2626 , attributeSatisfies
27− , attributeSatisfies'
28− , withoutAttribute
2927 , attr
3028 , attribute
3129 , attrs
@@ -33,6 +31,7 @@ module Text.XML.Lens (
3331 , text
3432 , comment
3533 -- ** Children
34+ , entire
3635 , nodes
3736 -- * Prisms for 'Node'
3837 , Node(..)
@@ -55,53 +54,48 @@ module Text.XML.Lens (
5554 , Instruction(..)
5655 , _instructionTarget
5756 , _instructionData
57+ -- * Reexport
58+ , module Control.Lens
5859 ) where
5960import Text.XML
6061import Control.Lens
6162import Data.Text (Text)
6263import Data.Map (Map)
63−import qualified Data.CaseInsensitive as CI
64−import Data.Maybe (isNothing)
64+import Control.Applicative
65+
66+infixr 9 ./
6567
6668prologue :: Lens' Document Prologue
6769prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc
68−{-# INLINE prologue #-}
6970
7071-- | The root element of the document.
7172root :: Lens' Document Element
7273root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc
73−{-# INLINE root #-}
7474
7575epilogue :: Lens' Document [Miscellaneous]
7676epilogue f doc = fmap (\p -> doc { documentEpilogue = p} ) $ f $ documentEpilogue doc
77−{-# INLINE epilogue #-}
7877
7978doctype :: Lens' Prologue (Maybe Doctype)
8079doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc
81−{-# INLINE doctype #-}
8280
8381class AsInstruction t where
8482 _Instruction :: Prism' t Instruction
8583
8684_instructionTarget :: Lens' Instruction Text
8785_instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d
88−{-# INLINE _instructionTarget #-}
8986
9087_instructionData :: Lens' Instruction Text
9188_instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d'
92−{-# INLINE _instructionData #-}
9389
9490instance AsInstruction Node where
9591 _Instruction = prism' NodeInstruction $ \s -> case s of
9692 NodeInstruction e -> Just e
9793 _ -> Nothing
98− {-# INLINE _Instruction #-}
9994
10095instance AsInstruction Miscellaneous where
10196 _Instruction = prism' MiscInstruction $ \s -> case s of
10297 MiscInstruction e -> Just e
10398 _ -> Nothing
104− {-# INLINE _Instruction #-}
10599
106100class AsComment t where
107101 _Comment :: Prism' t Text
@@ -110,41 +104,33 @@ instance AsComment Node where
110104 _Comment = prism' NodeComment $ \s -> case s of
111105 NodeComment e -> Just e
112106 _ -> Nothing
113− {-# INLINE _Comment #-}
114107
115108instance AsComment Miscellaneous where
116109 _Comment = prism' MiscComment $ \s -> case s of
117110 MiscComment e -> Just e
118111 _ -> Nothing
119− {-# INLINE _Comment #-}
120112
121113_nameLocalName :: Lens' Name Text
122114_nameLocalName f n = f (nameLocalName n) <&> \x -> n { nameLocalName = x }
123−{-# INLINE _nameLocalName #-}
124115
125116_nameNamespace :: Lens' Name (Maybe Text)
126117_nameNamespace f n = f (nameNamespace n) <&> \x -> n { nameNamespace = x }
127−{-# INLINE _nameNamespace #-}
128118
129119_namePrefix :: Lens' Name (Maybe Text)
130120_namePrefix f n = f (namePrefix n) <&> \x -> n { namePrefix = x }
131−{-# INLINE _namePrefix #-}
132121
133122_Element :: Prism' Node Element
134123_Element = prism' NodeElement $ \s -> case s of
135124 NodeElement e -> Just e
136125 _ -> Nothing
137−{-# INLINE _Element #-}
138126
139127_Content :: Prism' Node Text
140128_Content = prism' NodeContent $ \s -> case s of
141129 NodeContent e -> Just e
142130 _ -> Nothing
143−{-# INLINE _Content #-}
144131
145132name :: Lens' Element Name
146133name f e = f (elementName e) <&> \x -> e { elementName = x }
147−{-# INLINE name #-}
148134
149135localName :: Lens' Element Text
150136localName = name . _nameLocalName
@@ -152,65 +138,58 @@ localName = name . _nameLocalName
152138
153139attrs :: Lens' Element (Map Name Text)
154140attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
155−{-# INLINE attrs #-}
156141
157142nodes :: Lens' Element [Node]
158143nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
159−{-# INLINE nodes #-}
160144
161145attr :: Name -> Traversal' Element Text
162146attr n = attrs . ix n
163−{-# INLINE attr #-}
164147
165148attribute :: Name -> Lens' Element (Maybe Text)
166149attribute n = attrs . at n
167−{-# INLINE attribute #-}
168150
169−-- | Traverse elements which has the specified *local* name (case-insensitive).
170−named :: CI.CI Text -> Traversal' Element Element
151+-- | Traverse itself with its all children. Rewriting subnodes of each children will break a traversal law.
152+entire :: Traversal' Element Element
153+entire f e@(Element _ _ ns) = com <$> f e <*> traverse (_Element (entire f)) ns where
154+ com (Element n a _) = Element n a
155+
156+-- | Traverse elements which has the specified *local* name.
157+named :: Text -> Traversal' Element Element
171158named n f s
172− | CI.mk (nameLocalName (elementName s)) == n = f s
159+ | nameLocalName (elementName s) == n = f s
173160 | otherwise = pure s
174−{-# INLINE named #-}
175161
176−-- | Old name for 'named'
177162ell :: Text -> Traversal' Element Element
178−ell n = named $ CI.mk n
163+ell = named
179164
180165-- | Traverse elements which has the specified name.
181166el :: Name -> Traversal' Element Element
182167el n f s
183168 | elementName s == n = f s
184169 | otherwise = pure s
185−{-# DEPRECATED el "Use named instead" #-}
186170
187171attributeSatisfies :: 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' #-}
194−
195−withoutAttribute :: Name -> Traversal' Element Element
196−withoutAttribute n = attributeSatisfies' n isNothing
197−{-# INLINE withoutAttribute #-}
172+attributeSatisfies n p = filtered (maybe False p . preview (attrs . ix n))
198173
199174attributeIs :: Name -> Text -> Traversal' Element Element
200175attributeIs n v = attributeSatisfies n (==v)
201−{-# INLINE attributeIs #-}
202176
203177-- | Traverse all contents of the element.
204178text :: Traversal' Element Text
205179text = nodes . traverse . _Content
206−{-# INLINE text #-}
207180
208181-- | Traverse all comments of the element.
209182comment :: Traversal' Element Text
210183comment = nodes . traverse . _Comment
211−{-# INLINE comment #-}
212184
213−-- | 'plate' traverses over its sub-elements.
214185instance Plated Element where
215186 plate = nodes . traverse . _Element
216− {-# INLINE plate #-}
187+
188+-- | Combine two 'Traversal's just like XPath's slash.
189+--
190+-- @
191+-- l ./ m ≡ l . 'plate' . m
192+-- @
193+(./) :: (Applicative f, Plated c) => LensLike f s t c c -> Over p f c c a b -> Over p f s t a b
194+(./) = (...)
195+{-# INLINE (./) #-}