module Text.XML.Lens (
Element(..)
, (./)
, name
, localName
, el
, ell
, attributeIs
, attributeSatisfies
, attr
, attribute
, attrs
, text
, comment
, entire
, nodes
, Node(..)
, _Element
, _Content
, AsInstruction(..)
, AsComment(..)
, Document(..)
, root
, prologue
, epilogue
, doctype
, Name(..)
, _nameLocalName
, _nameNamespace
, _namePrefix
, Instruction(..)
, _instructionTarget
, _instructionData
, module Control.Lens
) where
import Text.XML
import Control.Lens
import Data.Text (Text)
import Data.Map (Map)
import Control.Applicative
infixr 9 ./
prologue :: Lens' Document Prologue
prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc
root :: Lens' Document Element
root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc
epilogue :: Lens' Document [Miscellaneous]
epilogue f doc = fmap (\p -> doc { documentEpilogue = p} ) $ f $ documentEpilogue doc
doctype :: Lens' Prologue (Maybe Doctype)
doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc
class AsInstruction t where
_Instruction :: Prism' t Instruction
_instructionTarget :: Lens' Instruction Text
_instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d
_instructionData :: Lens' Instruction Text
_instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d'
instance AsInstruction Node where
_Instruction = prism' NodeInstruction $ \s -> case s of
NodeInstruction e -> Just e
_ -> Nothing
instance AsInstruction Miscellaneous where
_Instruction = prism' MiscInstruction $ \s -> case s of
MiscInstruction e -> Just e
_ -> Nothing
class AsComment t where
_Comment :: Prism' t Text
instance AsComment Node where
_Comment = prism' NodeComment $ \s -> case s of
NodeComment e -> Just e
_ -> Nothing
instance AsComment Miscellaneous where
_Comment = prism' MiscComment $ \s -> case s of
MiscComment e -> Just e
_ -> Nothing
_nameLocalName :: Lens' Name Text
_nameLocalName f n = f (nameLocalName n) <&> \x -> n { nameLocalName = x }
_nameNamespace :: Lens' Name (Maybe Text)
_nameNamespace f n = f (nameNamespace n) <&> \x -> n { nameNamespace = x }
_namePrefix :: Lens' Name (Maybe Text)
_namePrefix f n = f (namePrefix n) <&> \x -> n { namePrefix = x }
_Element :: Prism' Node Element
_Element = prism' NodeElement $ \s -> case s of
NodeElement e -> Just e
_ -> Nothing
_Content :: Prism' Node Text
_Content = prism' NodeContent $ \s -> case s of
NodeContent e -> Just e
_ -> Nothing
name :: Lens' Element Name
name f e = f (elementName e) <&> \x -> e { elementName = x }
localName :: Lens' Element Text
localName = name . _nameLocalName
attrs :: Lens' Element (Map Name Text)
attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e
nodes :: Lens' Element [Node]
nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e
attr :: Name -> IndexedTraversal' Name Element Text
attr n = attrs . ix n
attribute :: Name -> IndexedLens' Name Element (Maybe Text)
attribute n = attrs . at n
entire :: Traversal' Element Element
entire f e@(Element _ _ ns) = com <$> f e <*> traverse (_Element (entire f)) ns where
com (Element n a _) = Element n a
el :: Name -> Traversal' Element Element
el n f s
| elementName s == n = f s
| otherwise = pure s
ell :: Text -> Traversal' Element Element
ell n f s
| nameLocalName (elementName s) == n = f s
| otherwise = pure s
attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
attributeSatisfies n p = filtered (maybe False p . preview (attrs . ix n))
attributeIs :: Name -> Text -> Traversal' Element Element
attributeIs n v = attributeSatisfies n (==v)
text :: Traversal' Element Text
text = nodes . traverse . _Content
comment :: Traversal' Element Text
comment = nodes . traverse . _Comment
instance Plated Element where
plate = nodes . traverse . _Element
(./) :: Plated a => Traversal s t a a -> Traversal a a u v -> Traversal s t u v
l ./ m = l . plate . m