@@ -1,107 +1,76 @@
1−{-# LANGUAGE Rank2Types, FlexibleContexts #-}
2−{-# OPTIONS_GHC -fno-warn-orphans #-}
1+{-# LANGUAGE Rank2Types #-}
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
1211--
1312----------------------------------------------------------------------------
1413module Text.XML.Lens (
15− -- * Lenses, traversals for 'Element'
16− Element(..)
17− , (...)
18− -- ** Names
19− , name
20− , localName
14+ -- * Useful traversals inspired by XPath
15+ (./)
2116 , el
22− , ell
23− , named
24− -- ** Attributes
2517 , attributeIs
2618 , attributeSatisfies
27− , attributeSatisfies'
28− , withoutAttribute
29− , attr
30− , attribute
31− , attrs
32− -- ** Contents
3319 , text
3420 , comment
35− -- ** Children
21+ -- * Lenses, traversals for 'Element'
22+ , name
23+ , attrs
3624 , nodes
25+ , attr
26+ , attribute
3727 -- * Prisms for 'Node'
38− , Node(..)
3928 , _Element
4029 , _Content
4130 , AsInstruction(..)
4231 , AsComment(..)
4332 -- * Lenses for 'Document'
44− , Document(..)
4533 , root
4634 , prologue
4735 , epilogue
4836 , doctype
4937 -- * Lenses for 'Name'
50− , Name(..)
5138 , _nameLocalName
5239 , _nameNamespace
5340 , _namePrefix
54− -- * Lenses for 'Instruction'
55− , Instruction(..)
56− , _instructionTarget
57− , _instructionData
5841 ) where
5942import Text.XML
6043import Control.Lens
6144import Data.Text (Text)
6245import Data.Map (Map)
63−import qualified Data.CaseInsensitive as CI
64−import Data.Maybe (isNothing)
46+import Control.Applicative
47+
48+infixr 9 ./
6549
6650prologue :: Lens' Document Prologue
6751prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc
68−{-# INLINE prologue #-}
6952
70−-- | The root element of the document.
7153root :: Lens' Document Element
7254root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc
73−{-# INLINE root #-}
7455
7556epilogue :: Lens' Document [Miscellaneous]
7657epilogue f doc = fmap (\p -> doc { documentEpilogue = p} ) $ f $ documentEpilogue doc
77−{-# INLINE epilogue #-}
7858
7959doctype :: Lens' Prologue (Maybe Doctype)
8060doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc
81−{-# INLINE doctype #-}
8261
8362class AsInstruction t where
8463 _Instruction :: Prism' t Instruction
8564
86−_instructionTarget :: Lens' Instruction Text
87−_instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d
88−{-# INLINE _instructionTarget #-}
89−
90−_instructionData :: Lens' Instruction Text
91−_instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d'
92−{-# INLINE _instructionData #-}
93−
9465instance AsInstruction Node where
9566 _Instruction = prism' NodeInstruction $ \s -> case s of
9667 NodeInstruction e -> Just e
9768 _ -> Nothing
98− {-# INLINE _Instruction #-}
9969
10070instance AsInstruction Miscellaneous where
10171 _Instruction = prism' MiscInstruction $ \s -> case s of
10272 MiscInstruction e -> Just e
10373 _ -> Nothing
104− {-# INLINE _Instruction #-}
10574
10675class AsComment t where
10776 _Comment :: Prism' t Text
@@ -110,107 +79,65 @@ instance AsComment Node where
11079 _Comment = prism' NodeComment $ \s -> case s of
11180 NodeComment e -> Just e
11281 _ -> Nothing
113− {-# INLINE _Comment #-}
11482
11583instance AsComment Miscellaneous where
11684 _Comment = prism' MiscComment $ \s -> case s of
11785 MiscComment e -> Just e
11886 _ -> Nothing
119− {-# INLINE _Comment #-}
12087
12188_nameLocalName :: Lens' Name Text
122−_nameLocalName f n = f (nameLocalName n) <&> \x -> n { nameLocalName = x }
123−{-# INLINE _nameLocalName #-}
89+_nameLocalName f n = fmap (\x -> n { nameLocalName = x }) $ f $ nameLocalName n
12490
12591_nameNamespace :: Lens' Name (Maybe Text)
126−_nameNamespace f n = f (nameNamespace n) <&> \x -> n { nameNamespace = x }
127−{-# INLINE _nameNamespace #-}
92+_nameNamespace f n = fmap (\x -> n { nameNamespace = x }) $ f $ nameNamespace n
12893
12994_namePrefix :: Lens' Name (Maybe Text)
130−_namePrefix f n = f (namePrefix n) <&> \x -> n { namePrefix = x }
131−{-# INLINE _namePrefix #-}
95+_namePrefix f n = fmap (\x -> n { namePrefix = x }) $ f $ namePrefix n
13296
13397_Element :: Prism' Node Element
13498_Element = prism' NodeElement $ \s -> case s of
13599 NodeElement e -> Just e
136100 _ -> Nothing
137−{-# INLINE _Element #-}
138101
139102_Content :: Prism' Node Text
140103_Content = prism' NodeContent $ \s -> case s of
141104 NodeContent e -> Just e
142105 _ -> Nothing
143−{-# INLINE _Content #-}
144106
145107name :: 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 #-}
108+name f e = fmap (\x -> e { elementName = x }) $ f $ elementName e
152109
153110attrs :: Lens' Element (Map Name Text)
154111attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
155−{-# INLINE attrs #-}
156112
157113nodes :: Lens' Element [Node]
158114nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
159−{-# INLINE nodes #-}
160115
161116attr :: Name -> Traversal' Element Text
162117attr n = attrs . ix n
163−{-# INLINE attr #-}
164118
165119attribute :: Name -> Lens' Element (Maybe Text)
166120attribute 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 #-}
175−
176−-- | Old name for 'named'
177−ell :: Text -> Traversal' Element Element
178−ell n = named $ CI.mk n
179121
180−-- | Traverse elements which has the specified name.
181122el :: Name -> Traversal' Element Element
182123el n f s
183124 | elementName s == n = f s
184125 | otherwise = pure s
185−{-# DEPRECATED el "Use named instead" #-}
186126
187127attributeSatisfies :: 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 #-}
128+attributeSatisfies n p = plate . filtered (maybe False p . preview (attrs . ix n))
198129
199130attributeIs :: Name -> Text -> Traversal' Element Element
200131attributeIs n v = attributeSatisfies n (==v)
201−{-# INLINE attributeIs #-}
202132
203−-- | Traverse all contents of the element.
204133text :: Traversal' Element Text
205134text = nodes . traverse . _Content
206−{-# INLINE text #-}
207135
208−-- | Traverse all comments of the element.
209136comment :: Traversal' Element Text
210137comment = nodes . traverse . _Comment
211−{-# INLINE comment #-}
212138
213−-- | 'plate' traverses over its sub-elements.
214139instance Plated Element where
215140 plate = nodes . traverse . _Element
216− {-# INLINE plate #-}
141+
142+(./) :: Plated a => Traversal s t a a -> Traversal a a u v -> Traversal s t u v
143+l ./ m = l . plate . m