@@ -1,25 +1,31 @@
11{-# 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
11−-- Useful traversals inspired by XPath
12+--
1213----------------------------------------------------------------------------
1314module Text.XML.Lens (
1415 -- * Lenses, traversals for 'Element'
15− (./)
16+ Element(..)
17+ , (...)
1618 -- ** Names
1719 , name
20+ , localName
1821 , el
1922 , ell
23+ , named
2024 -- ** Attributes
2125 , attributeIs
2226 , attributeSatisfies
27+ , attributeSatisfies'
28+ , withoutAttribute
2329 , attr
2430 , attribute
2531 , attrs
@@ -27,68 +33,75 @@ module Text.XML.Lens (
2733 , text
2834 , comment
2935 -- ** Children
30− , entire
3136 , nodes
3237 -- * Prisms for 'Node'
38+ , Node(..)
3339 , _Element
3440 , _Content
3541 , AsInstruction(..)
3642 , AsComment(..)
3743 -- * Lenses for 'Document'
44+ , Document(..)
3845 , root
3946 , prologue
4047 , epilogue
4148 , doctype
4249 -- * Lenses for 'Name'
50+ , Name(..)
4351 , _nameLocalName
4452 , _nameNamespace
4553 , _namePrefix
4654 -- * Lenses for 'Instruction'
55+ , Instruction(..)
4756 , _instructionTarget
4857 , _instructionData
49− -- * Reexports
50− , module Control.Lens
51− , module Text.XML
5258 ) where
5359import Text.XML
5460import Control.Lens
5561import Data.Text (Text)
5662import Data.Map (Map)
57−import Control.Applicative
58−
59−infixr 9 ./
63+import qualified Data.CaseInsensitive as CI
64+import Data.Maybe (isNothing)
6065
6166prologue :: Lens' Document Prologue
6267prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc
68+{-# INLINE prologue #-}
6369
6470-- | The root element of the document.
6571root :: Lens' Document Element
6672root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc
73+{-# INLINE root #-}
6774
6875epilogue :: Lens' Document [Miscellaneous]
6976epilogue f doc = fmap (\p -> doc { documentEpilogue = p} ) $ f $ documentEpilogue doc
77+{-# INLINE epilogue #-}
7078
7179doctype :: Lens' Prologue (Maybe Doctype)
7280doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc
81+{-# INLINE doctype #-}
7382
7483class AsInstruction t where
7584 _Instruction :: Prism' t Instruction
7685
7786_instructionTarget :: Lens' Instruction Text
7887_instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d
88+{-# INLINE _instructionTarget #-}
7989
8090_instructionData :: Lens' Instruction Text
8191_instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d'
92+{-# INLINE _instructionData #-}
8293
8394instance AsInstruction Node where
8495 _Instruction = prism' NodeInstruction $ \s -> case s of
8596 NodeInstruction e -> Just e
8697 _ -> Nothing
98+ {-# INLINE _Instruction #-}
8799
88100instance AsInstruction Miscellaneous where
89101 _Instruction = prism' MiscInstruction $ \s -> case s of
90102 MiscInstruction e -> Just e
91103 _ -> Nothing
104+ {-# INLINE _Instruction #-}
92105
93106class AsComment t where
94107 _Comment :: Prism' t Text
@@ -97,84 +110,107 @@ instance AsComment Node where
97110 _Comment = prism' NodeComment $ \s -> case s of
98111 NodeComment e -> Just e
99112 _ -> Nothing
113+ {-# INLINE _Comment #-}
100114
101115instance AsComment Miscellaneous where
102116 _Comment = prism' MiscComment $ \s -> case s of
103117 MiscComment e -> Just e
104118 _ -> Nothing
119+ {-# INLINE _Comment #-}
105120
106121_nameLocalName :: Lens' Name Text
107−_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 #-}
108124
109125_nameNamespace :: Lens' Name (Maybe Text)
110−_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 #-}
111128
112129_namePrefix :: Lens' Name (Maybe Text)
113−_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 #-}
114132
115133_Element :: Prism' Node Element
116134_Element = prism' NodeElement $ \s -> case s of
117135 NodeElement e -> Just e
118136 _ -> Nothing
137+{-# INLINE _Element #-}
119138
120139_Content :: Prism' Node Text
121140_Content = prism' NodeContent $ \s -> case s of
122141 NodeContent e -> Just e
123142 _ -> Nothing
143+{-# INLINE _Content #-}
124144
125145name :: Lens' Element Name
126−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 #-}
127152
128153attrs :: Lens' Element (Map Name Text)
129154attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
155+{-# INLINE attrs #-}
130156
131157nodes :: Lens' Element [Node]
132158nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
159+{-# INLINE nodes #-}
133160
134−attr :: Name -> IndexedTraversal' Name Element Text
161+attr :: Name -> Traversal' Element Text
135162attr n = attrs . ix n
163+{-# INLINE attr #-}
136164
137−attribute :: Name -> IndexedLens' Name Element (Maybe Text)
165+attribute :: Name -> Lens' Element (Maybe Text)
138166attribute n = attrs . at n
167+{-# INLINE attribute #-}
139168
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
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
144179
145180-- | Traverse elements which has the specified name.
146181el :: Name -> Traversal' Element Element
147182el n f s
148183 | elementName s == n = f s
149184 | otherwise = pure s
150−
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
185+{-# DEPRECATED el "Use named instead" #-}
156186
157187attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
158−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 #-}
159198
160199attributeIs :: Name -> Text -> Traversal' Element Element
161200attributeIs n v = attributeSatisfies n (==v)
201+{-# INLINE attributeIs #-}
162202
163203-- | Traverse all contents of the element.
164204text :: Traversal' Element Text
165205text = nodes . traverse . _Content
206+{-# INLINE text #-}
166207
167208-- | Traverse all comments of the element.
168209comment :: Traversal' Element Text
169210comment = nodes . traverse . _Comment
211+{-# INLINE comment #-}
170212
213+-- | 'plate' traverses over its sub-elements.
171214instance Plated Element where
172215 plate = nodes . traverse . _Element
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
216+ {-# INLINE plate #-}