@@ -1,4 +1,4 @@
1−{-# LANGUAGE Rank2Types #-}
1+{-# LANGUAGE Rank2Types, FlexibleContexts #-}
22-----------------------------------------------------------------------------
33-- |
44-- Module : Text.XML.Lens
@@ -8,22 +8,26 @@
88-- Maintainer : Fumiaki Kinoshita <fumiexcel@gmail.com>
99-- Stability : experimental
1010-- Portability : non-portable
11−--
11+-- Useful traversals inspired by XPath
1212----------------------------------------------------------------------------
1313module Text.XML.Lens (
14− -- * Useful traversals inspired by XPath
14+ -- * Lenses, traversals for 'Element'
1515 (./)
16+ -- ** Names
17+ , name
1618 , el
19+ -- ** Attributes
1720 , attributeIs
1821 , attributeSatisfies
22+ , attr
23+ , attribute
24+ , attrs
25+ -- ** Contents
1926 , text
2027 , comment
21− -- * Lenses, traversals for 'Element'
22− , name
23− , attrs
28+ -- ** Children
29+ , entire
2430 , nodes
25− , attr
26− , attribute
2731 -- * Prisms for 'Node'
2832 , _Element
2933 , _Content
@@ -38,6 +42,9 @@ module Text.XML.Lens (
3842 , _nameLocalName
3943 , _nameNamespace
4044 , _namePrefix
45+ -- * Lenses for 'Instruction'
46+ , _instructionTarget
47+ , _instructionData
4148 ) where
4249import Text.XML
4350import Control.Lens
@@ -50,6 +57,7 @@ infixr 9 ./
5057prologue :: Lens' Document Prologue
5158prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc
5259
60+-- | The root element of the document.
5361root :: Lens' Document Element
5462root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc
5563
@@ -62,6 +70,12 @@ doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype d
6270class AsInstruction t where
6371 _Instruction :: Prism' t Instruction
6472
73+_instructionTarget :: Lens' Instruction Text
74+_instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d
75+
76+_instructionData :: Lens' Instruction Text
77+_instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d'
78+
6579instance AsInstruction Node where
6680 _Instruction = prism' NodeInstruction $ \s -> case s of
6781 NodeInstruction e -> Just e
@@ -113,12 +127,18 @@ attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
113127nodes :: Lens' Element [Node]
114128nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
115129
116−attr :: Name -> Traversal' Element Text
130+attr :: Name -> IndexedTraversal' Name Element Text
117131attr n = attrs . ix n
118132
119−attribute :: Name -> Lens' Element (Maybe Text)
133+attribute :: Name -> IndexedLens' Name Element (Maybe Text)
120134attribute n = attrs . at n
121135
136+-- | Traverse itself with its all children.
137+entire :: Traversal' Element Element
138+entire f e@(Element _ _ ns) = com <$> f e <*> traverse (_Element (entire f)) ns where
139+ com (Element n a _) ns = Element n a ns
140+
141+-- | Traverse elements which has the specified name.
122142el :: Name -> Traversal' Element Element
123143el n f s
124144 | elementName s == n = f s
@@ -130,14 +150,21 @@ attributeSatisfies n p = filtered (maybe False p . preview (attrs . ix n))
130150attributeIs :: Name -> Text -> Traversal' Element Element
131151attributeIs n v = attributeSatisfies n (==v)
132152
153+-- | Traverse all contents of the element.
133154text :: Traversal' Element Text
134155text = nodes . traverse . _Content
135156
157+-- | Traverse all comments of the element.
136158comment :: Traversal' Element Text
137159comment = nodes . traverse . _Comment
138160
139161instance Plated Element where
140162 plate = nodes . traverse . _Element
141163
164+-- | Combine two 'Traversal's just like XPath's slash.
165+--
166+-- @
167+-- l ./ m ≡ l . 'plate' . m
168+-- @
142169(./) :: Plated a => Traversal s t a a -> Traversal a a u v -> Traversal s t u v
143−l ./ m = l . plate . m
170+l ./ m = l . plate . m