@@ -1,31 +1,25 @@
11{-# LANGUAGE Rank2Types, FlexibleContexts #-}
2−{-# OPTIONS_GHC -fno-warn-orphans #-}
32-----------------------------------------------------------------------------
43-- |
54-- Module : Text.XML.Lens
6−-- Copyright : (C) 2015 Fumiaki Kinoshita
5+-- Copyright : (C) 2013 Fumiaki Kinoshita
76-- License : BSD-style (see the file LICENSE)
87--
98-- Maintainer : Fumiaki Kinoshita <fumiexcel@gmail.com>
10−-- Stability : provisional
9+-- Stability : experimental
1110-- Portability : non-portable
12−--
11+-- Useful traversals inspired by XPath
1312----------------------------------------------------------------------------
1413module Text.XML.Lens (
1514 -- * Lenses, traversals for 'Element'
16− Element(..)
17− , (...)
15+ (./)
1816 -- ** Names
1917 , name
20− , localName
2118 , el
2219 , ell
23− , named
2420 -- ** Attributes
2521 , attributeIs
2622 , attributeSatisfies
27− , attributeSatisfies'
28− , withoutAttribute
2923 , attr
3024 , attribute
3125 , attrs
@@ -33,75 +27,68 @@ module Text.XML.Lens (
3327 , text
3428 , comment
3529 -- ** Children
30+ , entire
3631 , nodes
3732 -- * Prisms for 'Node'
38− , Node(..)
3933 , _Element
4034 , _Content
4135 , AsInstruction(..)
4236 , AsComment(..)
4337 -- * Lenses for 'Document'
44− , Document(..)
4538 , root
4639 , prologue
4740 , epilogue
4841 , doctype
4942 -- * Lenses for 'Name'
50− , Name(..)
5143 , _nameLocalName
5244 , _nameNamespace
5345 , _namePrefix
5446 -- * Lenses for 'Instruction'
55− , Instruction(..)
5647 , _instructionTarget
5748 , _instructionData
49+ -- * Reexports
50+ , module Control.Lens
51+ , module Text.XML
5852 ) where
5953import Text.XML
6054import Control.Lens
6155import Data.Text (Text)
6256import Data.Map (Map)
63−import qualified Data.CaseInsensitive as CI
64−import Data.Maybe (isNothing)
57+import Control.Applicative
58+
59+infixr 9 ./
6560
6661prologue :: Lens' Document Prologue
6762prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc
68−{-# INLINE prologue #-}
6963
7064-- | The root element of the document.
7165root :: Lens' Document Element
7266root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc
73−{-# INLINE root #-}
7467
7568epilogue :: Lens' Document [Miscellaneous]
7669epilogue f doc = fmap (\p -> doc { documentEpilogue = p} ) $ f $ documentEpilogue doc
77−{-# INLINE epilogue #-}
7870
7971doctype :: Lens' Prologue (Maybe Doctype)
8072doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc
81−{-# INLINE doctype #-}
8273
8374class AsInstruction t where
8475 _Instruction :: Prism' t Instruction
8576
8677_instructionTarget :: Lens' Instruction Text
8778_instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d
88−{-# INLINE _instructionTarget #-}
8979
9080_instructionData :: Lens' Instruction Text
9181_instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d'
92−{-# INLINE _instructionData #-}
9382
9483instance AsInstruction Node where
9584 _Instruction = prism' NodeInstruction $ \s -> case s of
9685 NodeInstruction e -> Just e
9786 _ -> Nothing
98− {-# INLINE _Instruction #-}
9987
10088instance AsInstruction Miscellaneous where
10189 _Instruction = prism' MiscInstruction $ \s -> case s of
10290 MiscInstruction e -> Just e
10391 _ -> Nothing
104− {-# INLINE _Instruction #-}
10592
10693class AsComment t where
10794 _Comment :: Prism' t Text
@@ -110,107 +97,84 @@ instance AsComment Node where
11097 _Comment = prism' NodeComment $ \s -> case s of
11198 NodeComment e -> Just e
11299 _ -> Nothing
113− {-# INLINE _Comment #-}
114100
115101instance AsComment Miscellaneous where
116102 _Comment = prism' MiscComment $ \s -> case s of
117103 MiscComment e -> Just e
118104 _ -> Nothing
119− {-# INLINE _Comment #-}
120105
121106_nameLocalName :: Lens' Name Text
122−_nameLocalName f n = f (nameLocalName n) <&> \x -> n { nameLocalName = x }
123−{-# INLINE _nameLocalName #-}
107+_nameLocalName f n = fmap (\x -> n { nameLocalName = x }) $ f $ nameLocalName n
124108
125109_nameNamespace :: Lens' Name (Maybe Text)
126−_nameNamespace f n = f (nameNamespace n) <&> \x -> n { nameNamespace = x }
127−{-# INLINE _nameNamespace #-}
110+_nameNamespace f n = fmap (\x -> n { nameNamespace = x }) $ f $ nameNamespace n
128111
129112_namePrefix :: Lens' Name (Maybe Text)
130−_namePrefix f n = f (namePrefix n) <&> \x -> n { namePrefix = x }
131−{-# INLINE _namePrefix #-}
113+_namePrefix f n = fmap (\x -> n { namePrefix = x }) $ f $ namePrefix n
132114
133115_Element :: Prism' Node Element
134116_Element = prism' NodeElement $ \s -> case s of
135117 NodeElement e -> Just e
136118 _ -> Nothing
137−{-# INLINE _Element #-}
138119
139120_Content :: Prism' Node Text
140121_Content = prism' NodeContent $ \s -> case s of
141122 NodeContent e -> Just e
142123 _ -> Nothing
143−{-# INLINE _Content #-}
144124
145125name :: Lens' Element Name
146−name f e = f (elementName e) <&> \x -> e { elementName = x }
147−{-# INLINE name #-}
148−
149−localName :: Lens' Element Text
150−localName = name . _nameLocalName
151−{-# INLINE localName #-}
126+name f e = fmap (\x -> e { elementName = x }) $ f $ elementName e
152127
153128attrs :: Lens' Element (Map Name Text)
154129attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
155−{-# INLINE attrs #-}
156130
157131nodes :: Lens' Element [Node]
158132nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
159−{-# INLINE nodes #-}
160133
161−attr :: Name -> Traversal' Element Text
134+attr :: Name -> IndexedTraversal' Name Element Text
162135attr n = attrs . ix n
163−{-# INLINE attr #-}
164136
165−attribute :: Name -> Lens' Element (Maybe Text)
137+attribute :: Name -> IndexedLens' Name Element (Maybe Text)
166138attribute n = attrs . at n
167−{-# INLINE attribute #-}
168139
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 #-}
175−
176−-- | Old name for 'named'
177−ell :: Text -> Traversal' Element Element
178−ell n = named $ CI.mk n
140+-- | Traverse itself with its all children.
141+entire :: Traversal' Element Element
142+entire f e@(Element _ _ ns) = com <$> f e <*> traverse (_Element (entire f)) ns where
143+ com (Element n a _) = Element n a
179144
180145-- | Traverse elements which has the specified name.
181146el :: Name -> Traversal' Element Element
182147el n f s
183148 | elementName s == n = f s
184149 | otherwise = pure s
185−{-# DEPRECATED el "Use named instead" #-}
186150
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' #-}
151+-- | Traverse elements which has the specified *local* name.
152+ell :: Text -> Traversal' Element Element
153+ell n f s
154+ | nameLocalName (elementName s) == n = f s
155+ | otherwise = pure s
194156
195−withoutAttribute :: Name -> Traversal' Element Element
196−withoutAttribute n = attributeSatisfies' n isNothing
197−{-# INLINE withoutAttribute #-}
157+attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
158+attributeSatisfies n p = filtered (maybe False p . preview (attrs . ix n))
198159
199160attributeIs :: Name -> Text -> Traversal' Element Element
200161attributeIs n v = attributeSatisfies n (==v)
201−{-# INLINE attributeIs #-}
202162
203163-- | Traverse all contents of the element.
204164text :: Traversal' Element Text
205165text = nodes . traverse . _Content
206−{-# INLINE text #-}
207166
208167-- | Traverse all comments of the element.
209168comment :: Traversal' Element Text
210169comment = nodes . traverse . _Comment
211−{-# INLINE comment #-}
212170
213−-- | 'plate' traverses over its sub-elements.
214171instance Plated Element where
215172 plate = nodes . traverse . _Element
216− {-# INLINE plate #-}
173+
174+-- | Combine two 'Traversal's just like XPath's slash.
175+--
176+-- @
177+-- l ./ m ≡ l . 'plate' . m
178+-- @
179+(./) :: Plated a => Traversal s t a a -> Traversal a a u v -> Traversal s t u v
180+l ./ m = l . plate . m