@@ -1,76 +1,107 @@
1−{-# LANGUAGE Rank2Types #-}
1+{-# LANGUAGE Rank2Types, FlexibleContexts #-}
2+{-# OPTIONS_GHC -fno-warn-orphans #-}
23-----------------------------------------------------------------------------
34-- |
45-- Module : Text.XML.Lens
5−-- Copyright : (C) 2013 Fumiaki Kinoshita
6+-- Copyright : (C) 2015 Fumiaki Kinoshita
67-- License : BSD-style (see the file LICENSE)
78--
89-- Maintainer : Fumiaki Kinoshita <fumiexcel@gmail.com>
9−-- Stability : experimental
10+-- Stability : provisional
1011-- Portability : non-portable
1112--
1213----------------------------------------------------------------------------
1314module Text.XML.Lens (
14− -- * Useful traversals inspired by XPath
15− (./)
15+ -- * Lenses, traversals for 'Element'
16+ Element(..)
17+ , (...)
18+ -- ** Names
19+ , name
20+ , localName
1621 , el
22+ , ell
23+ , named
24+ -- ** Attributes
1725 , attributeIs
1826 , attributeSatisfies
27+ , attributeSatisfies'
28+ , withoutAttribute
29+ , attr
30+ , attribute
31+ , attrs
32+ -- ** Contents
1933 , text
2034 , comment
21− -- * Lenses, traversals for 'Element'
22− , name
23− , attrs
35+ -- ** Children
2436 , nodes
25− , attr
26− , attribute
2737 -- * Prisms for 'Node'
38+ , Node(..)
2839 , _Element
2940 , _Content
3041 , AsInstruction(..)
3142 , AsComment(..)
3243 -- * Lenses for 'Document'
44+ , Document(..)
3345 , root
3446 , prologue
3547 , epilogue
3648 , doctype
3749 -- * Lenses for 'Name'
50+ , Name(..)
3851 , _nameLocalName
3952 , _nameNamespace
4053 , _namePrefix
54+ -- * Lenses for 'Instruction'
55+ , Instruction(..)
56+ , _instructionTarget
57+ , _instructionData
4158 ) where
4259import Text.XML
4360import Control.Lens
4461import Data.Text (Text)
4562import Data.Map (Map)
46−import Control.Applicative
47−
48−infixr 9 ./
63+import qualified Data.CaseInsensitive as CI
64+import Data.Maybe (isNothing)
4965
5066prologue :: Lens' Document Prologue
5167prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc
68+{-# INLINE prologue #-}
5269
70+-- | The root element of the document.
5371root :: Lens' Document Element
5472root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc
73+{-# INLINE root #-}
5574
5675epilogue :: Lens' Document [Miscellaneous]
5776epilogue f doc = fmap (\p -> doc { documentEpilogue = p} ) $ f $ documentEpilogue doc
77+{-# INLINE epilogue #-}
5878
5979doctype :: Lens' Prologue (Maybe Doctype)
6080doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc
81+{-# INLINE doctype #-}
6182
6283class AsInstruction t where
6384 _Instruction :: Prism' t Instruction
6485
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+
6594instance AsInstruction Node where
6695 _Instruction = prism' NodeInstruction $ \s -> case s of
6796 NodeInstruction e -> Just e
6897 _ -> Nothing
98+ {-# INLINE _Instruction #-}
6999
70100instance AsInstruction Miscellaneous where
71101 _Instruction = prism' MiscInstruction $ \s -> case s of
72102 MiscInstruction e -> Just e
73103 _ -> Nothing
104+ {-# INLINE _Instruction #-}
74105
75106class AsComment t where
76107 _Comment :: Prism' t Text
@@ -79,65 +110,107 @@ instance AsComment Node where
79110 _Comment = prism' NodeComment $ \s -> case s of
80111 NodeComment e -> Just e
81112 _ -> Nothing
113+ {-# INLINE _Comment #-}
82114
83115instance AsComment Miscellaneous where
84116 _Comment = prism' MiscComment $ \s -> case s of
85117 MiscComment e -> Just e
86118 _ -> Nothing
119+ {-# INLINE _Comment #-}
87120
88121_nameLocalName :: Lens' Name Text
89−_nameLocalName f n = fmap (\x -> n { nameLocalName = x }) $ f $ nameLocalName n
122+_nameLocalName f n = f (nameLocalName n) <&> \x -> n { nameLocalName = x }
123+{-# INLINE _nameLocalName #-}
90124
91125_nameNamespace :: Lens' Name (Maybe Text)
92−_nameNamespace f n = fmap (\x -> n { nameNamespace = x }) $ f $ nameNamespace n
126+_nameNamespace f n = f (nameNamespace n) <&> \x -> n { nameNamespace = x }
127+{-# INLINE _nameNamespace #-}
93128
94129_namePrefix :: Lens' Name (Maybe Text)
95−_namePrefix f n = fmap (\x -> n { namePrefix = x }) $ f $ namePrefix n
130+_namePrefix f n = f (namePrefix n) <&> \x -> n { namePrefix = x }
131+{-# INLINE _namePrefix #-}
96132
97133_Element :: Prism' Node Element
98134_Element = prism' NodeElement $ \s -> case s of
99135 NodeElement e -> Just e
100136 _ -> Nothing
137+{-# INLINE _Element #-}
101138
102139_Content :: Prism' Node Text
103140_Content = prism' NodeContent $ \s -> case s of
104141 NodeContent e -> Just e
105142 _ -> Nothing
143+{-# INLINE _Content #-}
106144
107145name :: Lens' Element Name
108−name f e = fmap (\x -> e { elementName = x }) $ f $ elementName e
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 #-}
109152
110153attrs :: Lens' Element (Map Name Text)
111154attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
155+{-# INLINE attrs #-}
112156
113157nodes :: Lens' Element [Node]
114158nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
159+{-# INLINE nodes #-}
115160
116161attr :: Name -> Traversal' Element Text
117162attr n = attrs . ix n
163+{-# INLINE attr #-}
118164
119165attribute :: Name -> Lens' Element (Maybe Text)
120166attribute 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
121179
180+-- | Traverse elements which has the specified name.
122181el :: Name -> Traversal' Element Element
123182el n f s
124183 | elementName s == n = f s
125184 | otherwise = pure s
185+{-# DEPRECATED el "Use named instead" #-}
126186
127187attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
128−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 #-}
129198
130199attributeIs :: Name -> Text -> Traversal' Element Element
131200attributeIs n v = attributeSatisfies n (==v)
201+{-# INLINE attributeIs #-}
132202
203+-- | Traverse all contents of the element.
133204text :: Traversal' Element Text
134205text = nodes . traverse . _Content
206+{-# INLINE text #-}
135207
208+-- | Traverse all comments of the element.
136209comment :: Traversal' Element Text
137210comment = nodes . traverse . _Comment
211+{-# INLINE comment #-}
138212
213+-- | 'plate' traverses over its sub-elements.
139214instance Plated Element where
140215 plate = nodes . traverse . _Element
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
216+ {-# INLINE plate #-}