@@ -14,7 +14,7 @@
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,6 +24,8 @@ module Text.XML.Lens (
24 -- ** Attributes
24 -- ** Attributes
25 , attributeIs
25 , attributeIs
26 , attributeSatisfies
26 , attributeSatisfies
27+ , attributeSatisfies'
28 , attribute
30 , attribute
@@ -31,7 +33,6 @@ module Text.XML.Lens (
33 -- ** Children
35 -- ** Children
36 -- * Prisms for 'Node'
37 -- * Prisms for 'Node'
37 , Node(..)
38 , Node(..)
@@ -54,49 +55,53 @@ module Text.XML.Lens (
54 , Instruction(..)
55 , Instruction(..)
55 , _instructionTarget
56 , _instructionTarget
56 , _instructionData
57 , _instructionData
58− , module Control.Lens
60import Text.XML
59import Text.XML
61import Control.Lens
60import Control.Lens
62import Data.Text (Text)
61import Data.Text (Text)
63import Data.Map (Map)
62import Data.Map (Map)
64−import Control.Applicative
65import qualified Data.CaseInsensitive as CI
63import qualified Data.CaseInsensitive as CI
66−
64+import Data.Maybe (isNothing)
69prologue :: Lens' Document Prologue
66prologue :: Lens' Document Prologue
70prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc
67prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc
68+{-# INLINE prologue #-}
72-- | The root element of the document.
70-- | The root element of the document.
73root :: Lens' Document Element
71root :: Lens' Document Element
74root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc
72root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc
76epilogue :: Lens' Document [Miscellaneous]
75epilogue :: Lens' Document [Miscellaneous]
77epilogue 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)
79doctype :: Lens' Prologue (Maybe Doctype)
80doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc
80doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc
81+{-# INLINE doctype #-}
82class AsInstruction t where
83class AsInstruction t where
83 _Instruction :: Prism' t Instruction
84 _Instruction :: Prism' t Instruction
85_instructionTarget :: Lens' Instruction Text
86_instructionTarget :: Lens' Instruction Text
86_instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d
87_instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d
88+{-# INLINE _instructionTarget #-}
88_instructionData :: Lens' Instruction Text
90_instructionData :: Lens' Instruction Text
89_instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d'
91_instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d'
92+{-# INLINE _instructionData #-}
91instance AsInstruction Node where
94instance AsInstruction Node where
92 _Instruction = prism' NodeInstruction $ \s -> case s of
95 _Instruction = prism' NodeInstruction $ \s -> case s of
93 NodeInstruction e -> Just e
96 NodeInstruction e -> Just e
94 _ -> Nothing
97 _ -> Nothing
98+ {-# INLINE _Instruction #-}
96instance AsInstruction Miscellaneous where
100instance AsInstruction Miscellaneous where
97 _Instruction = prism' MiscInstruction $ \s -> case s of
101 _Instruction = prism' MiscInstruction $ \s -> case s of
98 MiscInstruction e -> Just e
102 MiscInstruction e -> Just e
99 _ -> Nothing
103 _ -> Nothing
104+ {-# INLINE _Instruction #-}
101class AsComment t where
106class AsComment t where
102 _Comment :: Prism' t Text
107 _Comment :: Prism' t Text
@@ -105,33 +110,41 @@ instance AsComment Node where
105 _Comment = prism' NodeComment $ \s -> case s of
110 _Comment = prism' NodeComment $ \s -> case s of
106 NodeComment e -> Just e
111 NodeComment e -> Just e
107 _ -> Nothing
112 _ -> Nothing
113+ {-# INLINE _Comment #-}
109instance AsComment Miscellaneous where
115instance AsComment Miscellaneous where
110 _Comment = prism' MiscComment $ \s -> case s of
116 _Comment = prism' MiscComment $ \s -> case s of
111 MiscComment e -> Just e
117 MiscComment e -> Just e
112 _ -> Nothing
118 _ -> Nothing
119+ {-# INLINE _Comment #-}
114_nameLocalName :: Lens' Name Text
121_nameLocalName :: Lens' Name Text
115_nameLocalName f n = f (nameLocalName n) <&> \x -> n { nameLocalName = x }
122_nameLocalName f n = f (nameLocalName n) <&> \x -> n { nameLocalName = x }
123+{-# INLINE _nameLocalName #-}
117_nameNamespace :: Lens' Name (Maybe Text)
125_nameNamespace :: Lens' Name (Maybe Text)
118_nameNamespace f n = f (nameNamespace n) <&> \x -> n { nameNamespace = x }
126_nameNamespace f n = f (nameNamespace n) <&> \x -> n { nameNamespace = x }
127+{-# INLINE _nameNamespace #-}
120_namePrefix :: Lens' Name (Maybe Text)
129_namePrefix :: Lens' Name (Maybe Text)
121_namePrefix f n = f (namePrefix n) <&> \x -> n { namePrefix = x }
130_namePrefix f n = f (namePrefix n) <&> \x -> n { namePrefix = x }
131+{-# INLINE _namePrefix #-}
123_Element :: Prism' Node Element
133_Element :: Prism' Node Element
124_Element = prism' NodeElement $ \s -> case s of
134_Element = prism' NodeElement $ \s -> case s of
125 NodeElement e -> Just e
135 NodeElement e -> Just e
126 _ -> Nothing
136 _ -> Nothing
137+{-# INLINE _Element #-}
128_Content :: Prism' Node Text
139_Content :: Prism' Node Text
129_Content = prism' NodeContent $ \s -> case s of
140_Content = prism' NodeContent $ \s -> case s of
130 NodeContent e -> Just e
141 NodeContent e -> Just e
131 _ -> Nothing
142 _ -> Nothing
143+{-# INLINE _Content #-}
133name :: Lens' Element Name
145name :: Lens' Element Name
134name f e = f (elementName e) <&> \x -> e { elementName = x }
146name f e = f (elementName e) <&> \x -> e { elementName = x }
136localName :: Lens' Element Text
149localName :: Lens' Element Text
137localName = name . _nameLocalName
150localName = name . _nameLocalName
@@ -139,60 +152,65 @@ localName = name . _nameLocalName
140attrs :: Lens' Element (Map Name Text)
153attrs :: Lens' Element (Map Name Text)
141attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
154attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
143nodes :: Lens' Element [Node]
157nodes :: Lens' Element [Node]
144nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
158nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
146attr :: Name -> Traversal' Element Text
161attr :: Name -> Traversal' Element Text
147attr n = attrs . ix n
162attr n = attrs . ix n
149attribute :: Name -> Lens' Element (Maybe Text)
165attribute :: Name -> Lens' Element (Maybe Text)
150attribute n = attrs . at n
166attribute n = attrs . at n
151−
167+{-# INLINE attribute #-}
152−-- | Traverse itself with its all children. Rewriting subnodes of each children will break a traversal law.
153−entire :: Traversal' Element Element
154−entire f e@(Element _ _ ns) = com <$> f e <*> traverse (_Element (entire f)) ns where
155− com (Element n a _) = Element n a
157-- | Traverse elements which has the specified *local* name (case-insensitive).
169-- | Traverse elements which has the specified *local* name (case-insensitive).
158named :: CI.CI Text -> Traversal' Element Element
170named :: CI.CI Text -> Traversal' Element Element
159named n f s
171named n f s
160 | CI.mk (nameLocalName (elementName s)) == n = f s
172 | CI.mk (nameLocalName (elementName s)) == n = f s
161 | otherwise = pure s
173 | otherwise = pure s
163-- | Old name for 'named'
176-- | Old name for 'named'
164ell :: Text -> Traversal' Element Element
177ell :: Text -> Traversal' Element Element
165−ell = named . CI.mk
178+ell n = named $ CI.mk n
167-- | Traverse elements which has the specified name.
180-- | Traverse elements which has the specified name.
168el :: Name -> Traversal' Element Element
181el :: Name -> Traversal' Element Element
170 | elementName s == n = f s
183 | elementName s == n = f s
171 | otherwise = pure s
184 | otherwise = pure s
185+{-# DEPRECATED el "Use named instead" #-}
173attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
187attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
174−attributeSatisfies n p = filtered (maybe False p . preview (attrs . ix n))
188+attributeSatisfies n p = attributeSatisfies' n (maybe False p)
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 #-}
176attributeIs :: Name -> Text -> Traversal' Element Element
199attributeIs :: Name -> Text -> Traversal' Element Element
177attributeIs n v = attributeSatisfies n (==v)
200attributeIs n v = attributeSatisfies n (==v)
201+{-# INLINE attributeIs #-}
179-- | Traverse all contents of the element.
203-- | Traverse all contents of the element.
180text :: Traversal' Element Text
204text :: Traversal' Element Text
181text = nodes . traverse . _Content
205text = nodes . traverse . _Content
183-- | Traverse all comments of the element.
208-- | Traverse all comments of the element.
184comment :: Traversal' Element Text
209comment :: Traversal' Element Text
185comment = nodes . traverse . _Comment
210comment = nodes . traverse . _Comment
211+{-# INLINE comment #-}
187-- | 'plate' traverses over its sub-elements.
213-- | 'plate' traverses over its sub-elements.
188instance Plated Element where
214instance Plated Element where
189 plate = nodes . traverse . _Element
215 plate = nodes . traverse . _Element
191−-- | Combine two 'Traversal's just like XPath's slash. Identical to ('...').
194−-- l ./ m ≡ l . 'plate' . m
196−(./) :: (Applicative f, Plated c) => LensLike f s t c c -> Over p f c c a b -> Over p f s t a b
198−{-# INLINE (./) #-}
216+ {-# INLINE plate #-}