@@ -3,26 +3,29 @@
33-----------------------------------------------------------------------------
44-- |
55-- Module : Text.XML.Lens
6−-- Copyright : (C) 2013 Fumiaki Kinoshita
6+-- Copyright : (C) 2015 Fumiaki Kinoshita
77-- License : BSD-style (see the file LICENSE)
88--
99-- Maintainer : Fumiaki Kinoshita <fumiexcel@gmail.com>
10−-- Stability : experimental
10+-- Stability : provisional
1111-- Portability : non-portable
12−-- Useful traversals inspired by XPath
12+--
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
2324 -- ** Attributes
2425 , attributeIs
2526 , attributeSatisfies
27+ , attributeSatisfies'
28+ , withoutAttribute
2629 , attr
2730 , attribute
2831 , attrs
@@ -30,7 +33,6 @@ module Text.XML.Lens (
3033 , text
3134 , comment
3235 -- ** Children
33− , entire
3436 , nodes
3537 -- * Prisms for 'Node'
3638 , Node(..)
@@ -53,48 +55,53 @@ module Text.XML.Lens (
5355 , Instruction(..)
5456 , _instructionTarget
5557 , _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 Control.Applicative
64−
65−infixr 9 ./
63+import qualified Data.CaseInsensitive as CI
64+import Data.Maybe (isNothing)
6665
6766prologue :: Lens' Document Prologue
6867prologue 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 #-}
7374
7475epilogue :: Lens' Document [Miscellaneous]
7576epilogue f doc = fmap (\p -> doc { documentEpilogue = p} ) $ f $ documentEpilogue doc
77+{-# INLINE epilogue #-}
7678
7779doctype :: Lens' Prologue (Maybe Doctype)
7880doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc
81+{-# INLINE doctype #-}
7982
8083class AsInstruction t where
8184 _Instruction :: Prism' t Instruction
8285
8386_instructionTarget :: Lens' Instruction Text
8487_instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d
88+{-# INLINE _instructionTarget #-}
8589
8690_instructionData :: Lens' Instruction Text
8791_instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d'
92+{-# INLINE _instructionData #-}
8893
8994instance AsInstruction Node where
9095 _Instruction = prism' NodeInstruction $ \s -> case s of
9196 NodeInstruction e -> Just e
9297 _ -> Nothing
98+ {-# INLINE _Instruction #-}
9399
94100instance AsInstruction Miscellaneous where
95101 _Instruction = prism' MiscInstruction $ \s -> case s of
96102 MiscInstruction e -> Just e
97103 _ -> Nothing
104+ {-# INLINE _Instruction #-}
98105
99106class AsComment t where
100107 _Comment :: Prism' t Text
@@ -103,33 +110,41 @@ instance AsComment Node where
103110 _Comment = prism' NodeComment $ \s -> case s of
104111 NodeComment e -> Just e
105112 _ -> Nothing
113+ {-# INLINE _Comment #-}
106114
107115instance AsComment Miscellaneous where
108116 _Comment = prism' MiscComment $ \s -> case s of
109117 MiscComment e -> Just e
110118 _ -> Nothing
119+ {-# INLINE _Comment #-}
111120
112121_nameLocalName :: Lens' Name Text
113122_nameLocalName f n = f (nameLocalName n) <&> \x -> n { nameLocalName = x }
123+{-# INLINE _nameLocalName #-}
114124
115125_nameNamespace :: Lens' Name (Maybe Text)
116126_nameNamespace f n = f (nameNamespace n) <&> \x -> n { nameNamespace = x }
127+{-# INLINE _nameNamespace #-}
117128
118129_namePrefix :: Lens' Name (Maybe Text)
119130_namePrefix f n = f (namePrefix n) <&> \x -> n { namePrefix = x }
131+{-# INLINE _namePrefix #-}
120132
121133_Element :: Prism' Node Element
122134_Element = prism' NodeElement $ \s -> case s of
123135 NodeElement e -> Just e
124136 _ -> Nothing
137+{-# INLINE _Element #-}
125138
126139_Content :: Prism' Node Text
127140_Content = prism' NodeContent $ \s -> case s of
128141 NodeContent e -> Just e
129142 _ -> Nothing
143+{-# INLINE _Content #-}
130144
131145name :: Lens' Element Name
132146name f e = f (elementName e) <&> \x -> e { elementName = x }
147+{-# INLINE name #-}
133148
134149localName :: Lens' Element Text
135150localName = name . _nameLocalName
@@ -137,55 +152,65 @@ localName = name . _nameLocalName
137152
138153attrs :: Lens' Element (Map Name Text)
139154attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
155+{-# INLINE attrs #-}
140156
141157nodes :: Lens' Element [Node]
142158nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
159+{-# INLINE nodes #-}
143160
144161attr :: Name -> Traversal' Element Text
145162attr n = attrs . ix n
163+{-# INLINE attr #-}
146164
147165attribute :: Name -> Lens' Element (Maybe Text)
148166attribute 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 #-}
149175
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
176+-- | Old name for 'named'
177+ell :: Text -> Traversal' Element Element
178+ell n = named $ CI.mk n
154179
155180-- | Traverse elements which has the specified name.
156181el :: Name -> Traversal' Element Element
157182el n f s
158183 | elementName s == n = f s
159184 | otherwise = pure s
160−
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
185+{-# DEPRECATED el "Use named instead" #-}
166186
167187attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
168−attributeSatisfies n p = filtered (maybe False p . preview (attrs . ix n))
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 #-}
169198
170199attributeIs :: Name -> Text -> Traversal' Element Element
171200attributeIs n v = attributeSatisfies n (==v)
201+{-# INLINE attributeIs #-}
172202
173203-- | Traverse all contents of the element.
174204text :: Traversal' Element Text
175205text = nodes . traverse . _Content
206+{-# INLINE text #-}
176207
177208-- | Traverse all comments of the element.
178209comment :: Traversal' Element Text
179210comment = nodes . traverse . _Comment
211+{-# INLINE comment #-}
180212
213+-- | 'plate' traverses over its sub-elements.
181214instance Plated Element where
182215 plate = nodes . traverse . _Element
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 (./) #-}
216+ {-# INLINE plate #-}