@@ -3,18 +3,18 @@
3-----------------------------------------------------------------------------
3-----------------------------------------------------------------------------
5-- Module : Text.XML.Lens
5-- Module : Text.XML.Lens
6−-- Copyright : (C) 2015 Fumiaki Kinoshita
6+-- Copyright : (C) 2013 Fumiaki Kinoshita
7-- License : BSD-style (see the file LICENSE)
7-- License : BSD-style (see the file LICENSE)
9-- Maintainer : Fumiaki Kinoshita <fumiexcel@gmail.com>
9-- Maintainer : Fumiaki Kinoshita <fumiexcel@gmail.com>
10−-- Stability : provisional
10+-- Stability : experimental
11-- Portability : non-portable
11-- Portability : non-portable
12−--
12+-- Useful traversals inspired by XPath
13----------------------------------------------------------------------------
13----------------------------------------------------------------------------
14module Text.XML.Lens (
14module Text.XML.Lens (
15 -- * Lenses, traversals for 'Element'
15 -- * Lenses, traversals for 'Element'
16 Element(..)
16 Element(..)
18 -- ** Names
18 -- ** Names
20 , localName
20 , localName
@@ -24,8 +24,6 @@ module Text.XML.Lens (
24 -- ** Attributes
24 -- ** Attributes
25 , attributeIs
25 , attributeIs
26 , attributeSatisfies
26 , attributeSatisfies
27− , attributeSatisfies'
30 , attribute
28 , attribute
@@ -33,6 +31,7 @@ module Text.XML.Lens (
35 -- ** Children
33 -- ** Children
37 -- * Prisms for 'Node'
36 -- * Prisms for 'Node'
38 , Node(..)
37 , Node(..)
@@ -55,53 +54,48 @@ module Text.XML.Lens (
55 , Instruction(..)
54 , Instruction(..)
56 , _instructionTarget
55 , _instructionTarget
57 , _instructionData
56 , _instructionData
58+ , module Control.Lens
59import Text.XML
60import Text.XML
60import Control.Lens
61import Control.Lens
61import Data.Text (Text)
62import Data.Text (Text)
62import Data.Map (Map)
63import Data.Map (Map)
63−import qualified Data.CaseInsensitive as CI
64+import Control.Applicative
64−import Data.Maybe (isNothing)
65+
66prologue :: Lens' Document Prologue
68prologue :: Lens' Document Prologue
67prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc
69prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc
68−{-# INLINE prologue #-}
70-- | The root element of the document.
71-- | The root element of the document.
71root :: Lens' Document Element
72root :: Lens' Document Element
72root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc
73root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc
75epilogue :: Lens' Document [Miscellaneous]
75epilogue :: Lens' Document [Miscellaneous]
76epilogue f doc = fmap (\p -> doc { documentEpilogue = p} ) $ f $ documentEpilogue doc
76epilogue f doc = fmap (\p -> doc { documentEpilogue = p} ) $ f $ documentEpilogue doc
77−{-# INLINE epilogue #-}
79doctype :: Lens' Prologue (Maybe Doctype)
78doctype :: Lens' Prologue (Maybe Doctype)
80doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc
79doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc
81−{-# INLINE doctype #-}
83class AsInstruction t where
81class AsInstruction t where
84 _Instruction :: Prism' t Instruction
82 _Instruction :: Prism' t Instruction
86_instructionTarget :: Lens' Instruction Text
84_instructionTarget :: Lens' Instruction Text
87_instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d
85_instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d
88−{-# INLINE _instructionTarget #-}
90_instructionData :: Lens' Instruction Text
87_instructionData :: Lens' Instruction Text
91_instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d'
88_instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d'
92−{-# INLINE _instructionData #-}
94instance AsInstruction Node where
90instance AsInstruction Node where
95 _Instruction = prism' NodeInstruction $ \s -> case s of
91 _Instruction = prism' NodeInstruction $ \s -> case s of
96 NodeInstruction e -> Just e
92 NodeInstruction e -> Just e
97 _ -> Nothing
93 _ -> Nothing
98− {-# INLINE _Instruction #-}
100instance AsInstruction Miscellaneous where
95instance AsInstruction Miscellaneous where
101 _Instruction = prism' MiscInstruction $ \s -> case s of
96 _Instruction = prism' MiscInstruction $ \s -> case s of
102 MiscInstruction e -> Just e
97 MiscInstruction e -> Just e
103 _ -> Nothing
98 _ -> Nothing
104− {-# INLINE _Instruction #-}
106class AsComment t where
100class AsComment t where
107 _Comment :: Prism' t Text
101 _Comment :: Prism' t Text
@@ -110,41 +104,33 @@ instance AsComment Node where
110 _Comment = prism' NodeComment $ \s -> case s of
104 _Comment = prism' NodeComment $ \s -> case s of
111 NodeComment e -> Just e
105 NodeComment e -> Just e
112 _ -> Nothing
106 _ -> Nothing
113− {-# INLINE _Comment #-}
115instance AsComment Miscellaneous where
108instance AsComment Miscellaneous where
116 _Comment = prism' MiscComment $ \s -> case s of
109 _Comment = prism' MiscComment $ \s -> case s of
117 MiscComment e -> Just e
110 MiscComment e -> Just e
118 _ -> Nothing
111 _ -> Nothing
119− {-# INLINE _Comment #-}
121_nameLocalName :: Lens' Name Text
113_nameLocalName :: Lens' Name Text
122_nameLocalName f n = f (nameLocalName n) <&> \x -> n { nameLocalName = x }
114_nameLocalName f n = f (nameLocalName n) <&> \x -> n { nameLocalName = x }
123−{-# INLINE _nameLocalName #-}
125_nameNamespace :: Lens' Name (Maybe Text)
116_nameNamespace :: Lens' Name (Maybe Text)
126_nameNamespace f n = f (nameNamespace n) <&> \x -> n { nameNamespace = x }
117_nameNamespace f n = f (nameNamespace n) <&> \x -> n { nameNamespace = x }
127−{-# INLINE _nameNamespace #-}
129_namePrefix :: Lens' Name (Maybe Text)
119_namePrefix :: Lens' Name (Maybe Text)
130_namePrefix f n = f (namePrefix n) <&> \x -> n { namePrefix = x }
120_namePrefix f n = f (namePrefix n) <&> \x -> n { namePrefix = x }
131−{-# INLINE _namePrefix #-}
133_Element :: Prism' Node Element
122_Element :: Prism' Node Element
134_Element = prism' NodeElement $ \s -> case s of
123_Element = prism' NodeElement $ \s -> case s of
135 NodeElement e -> Just e
124 NodeElement e -> Just e
136 _ -> Nothing
125 _ -> Nothing
137−{-# INLINE _Element #-}
139_Content :: Prism' Node Text
127_Content :: Prism' Node Text
140_Content = prism' NodeContent $ \s -> case s of
128_Content = prism' NodeContent $ \s -> case s of
141 NodeContent e -> Just e
129 NodeContent e -> Just e
142 _ -> Nothing
130 _ -> Nothing
143−{-# INLINE _Content #-}
145name :: Lens' Element Name
132name :: Lens' Element Name
146name f e = f (elementName e) <&> \x -> e { elementName = x }
133name f e = f (elementName e) <&> \x -> e { elementName = x }
149localName :: Lens' Element Text
135localName :: Lens' Element Text
150localName = name . _nameLocalName
136localName = name . _nameLocalName
@@ -152,65 +138,58 @@ localName = name . _nameLocalName
153attrs :: Lens' Element (Map Name Text)
139attrs :: Lens' Element (Map Name Text)
154attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
140attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
157nodes :: Lens' Element [Node]
142nodes :: Lens' Element [Node]
158nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
143nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
161attr :: Name -> Traversal' Element Text
145attr :: Name -> Traversal' Element Text
162attr n = attrs . ix n
146attr n = attrs . ix n
165attribute :: Name -> Lens' Element (Maybe Text)
148attribute :: Name -> Lens' Element (Maybe Text)
166attribute n = attrs . at n
149attribute n = attrs . at n
167−{-# INLINE attribute #-}
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
169−-- | Traverse elements which has the specified *local* name (case-insensitive).
156+-- | Traverse elements which has the specified *local* name.
170−named :: CI.CI Text -> Traversal' Element Element
157+named :: Text -> Traversal' Element Element
171named n f s
158named n f s
172− | CI.mk (nameLocalName (elementName s)) == n = f s
159+ | nameLocalName (elementName s) == n = f s
173 | otherwise = pure s
160 | otherwise = pure s
176−-- | Old name for 'named'
177ell :: Text -> Traversal' Element Element
162ell :: Text -> Traversal' Element Element
178−ell n = named $ CI.mk n
163+ell = named
180-- | Traverse elements which has the specified name.
165-- | Traverse elements which has the specified name.
181el :: Name -> Traversal' Element Element
166el :: Name -> Traversal' Element Element
183 | elementName s == n = f s
168 | elementName s == n = f s
184 | otherwise = pure s
169 | otherwise = pure s
185−{-# DEPRECATED el "Use named instead" #-}
187attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
171attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
188−attributeSatisfies n p = attributeSatisfies' n (maybe False p)
172+attributeSatisfies n p = filtered (maybe False p . preview (attrs . ix n))
189−{-# INLINE attributeSatisfies #-}
191−attributeSatisfies' :: Name -> (Maybe Text -> Bool) -> Traversal' Element Element
192−attributeSatisfies' n p = filtered (p . preview (attrs . ix n))
193−{-# INLINE attributeSatisfies' #-}
195−withoutAttribute :: Name -> Traversal' Element Element
196−withoutAttribute n = attributeSatisfies' n isNothing
197−{-# INLINE withoutAttribute #-}
199attributeIs :: Name -> Text -> Traversal' Element Element
174attributeIs :: Name -> Text -> Traversal' Element Element
200attributeIs n v = attributeSatisfies n (==v)
175attributeIs n v = attributeSatisfies n (==v)
201−{-# INLINE attributeIs #-}
203-- | Traverse all contents of the element.
177-- | Traverse all contents of the element.
204text :: Traversal' Element Text
178text :: Traversal' Element Text
205text = nodes . traverse . _Content
179text = nodes . traverse . _Content
208-- | Traverse all comments of the element.
181-- | Traverse all comments of the element.
209comment :: Traversal' Element Text
182comment :: Traversal' Element Text
210comment = nodes . traverse . _Comment
183comment = nodes . traverse . _Comment
211−{-# INLINE comment #-}
213−-- | 'plate' traverses over its sub-elements.
214instance Plated Element where
185instance Plated Element where
215 plate = nodes . traverse . _Element
186 plate = nodes . traverse . _Element
188+-- | Combine two 'Traversal's just like XPath's slash.
191+-- l ./ m ≡ l . 'plate' . m
193+(./) :: Plated a => Traversal s t a a -> Traversal a a u v -> Traversal s t u v
194+l ./ m = l . plate . m
216− {-# INLINE plate #-}
195+{-# INLINE (./) #-}