xml-html-conduit-lens-0.3.2.4: Optics for xml-conduit and html-conduit

Safe HaskellNone
LanguageHaskell2010

Text.Xml.Lens

Contents

Description

Optics for xml-conduit and html-conduit

Synopsis

Document

data Document :: * #

Instances

Eq Document 
Data Document 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Document -> c Document #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Document #

toConstr :: Document -> Constr #

dataTypeOf :: Document -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Document) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Document) #

gmapT :: (forall b. Data b => b -> b) -> Document -> Document #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Document -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Document -> r #

gmapQ :: (forall d. Data d => d -> u) -> Document -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Document -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Document -> m Document #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Document -> m Document #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Document -> m Document #

Show Document 
ToMarkup Document 
NFData Document 

Methods

rnf :: Document -> () #

AsHtmlDocument Document Source # 
AsXmlDocument Document Source # 

xml :: AsXmlDocument t => Traversal' t Element Source #

A Traversal into XML document root node

>>> ("<foo/>" :: TL.Text) ^? xml.name
Just "foo"
>>> ("<foo><bar/><baz/></foo>" :: TL.Text) ^? xml.name
Just "foo"
>>> ("<foo/>" :: TL.Text) & xml.name .~ "boo"
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><boo/>"

html :: AsHtmlDocument t => Fold t Element Source #

A Fold into HTML document root node

Not every parseable HTML document is a valid XML document:

>>> let quasiXml = "<html><br><br></html>" :: BL.ByteString
>>> quasiXml ^.. html...name
["br","br"]
>>> quasiXml ^? xml...name
Nothing

renderWith :: (Functor f, Contravariant f, AsXmlDocument t) => (RenderSettings -> RenderSettings) -> LensLike' f Element t Source #

Fold Element into the XML document

Convenience function mostly useful because xml-conduit does not provide handy method to convert Element into text. Assumes empty XML prolog

See also render

>>> :{
  let
    bare l   = (l, Data.Map.empty, [])
    tag l    = _Element # bare l
    subtag l = _NodeElement._Element # bare l
    doc      = tag "root"
        & elementNodes <>~ [subtag "child1", subtag "child2", subtag "child3"]
        & elementNodes %~ (subtag "child0" <|)
:}
>>> Data.Text.Lazy.IO.putStr $ doc ^. render
<?xml version="1.0" encoding="UTF-8"?><root><child0/><child1/><child2/><child3/></root>
>>> Data.Text.Lazy.IO.putStr $ doc ^. renderWith (rsPretty .~ True)
<?xml version="1.0" encoding="UTF-8"?>
<root>
    <child0/>
    <child1/>
    <child2/>
    <child3/>
</root>

render :: (Functor f, Contravariant f, AsXmlDocument t) => LensLike' f Element t Source #

Fold Element into the XML document with the default rendering settings

data Prologue :: * #

Instances

Eq Prologue 
Data Prologue 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Prologue -> c Prologue #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Prologue #

toConstr :: Prologue -> Constr #

dataTypeOf :: Prologue -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Prologue) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prologue) #

gmapT :: (forall b. Data b => b -> b) -> Prologue -> Prologue #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Prologue -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Prologue -> r #

gmapQ :: (forall d. Data d => d -> u) -> Prologue -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Prologue -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Prologue -> m Prologue #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Prologue -> m Prologue #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Prologue -> m Prologue #

Ord Prologue 
Show Prologue 
Generic Prologue 

Associated Types

type Rep Prologue :: * -> * #

Methods

from :: Prologue -> Rep Prologue x #

to :: Rep Prologue x -> Prologue #

NFData Prologue 

Methods

rnf :: Prologue -> () #

type Rep Prologue 
type Rep Prologue = D1 * (MetaData "Prologue" "Data.XML.Types" "xml-types-0.3.6-BKHFN0QDiAC9D7pCgqpQYj" False) (C1 * (MetaCons "Prologue" PrefixI True) ((:*:) * (S1 * (MetaSel (Just Symbol "prologueBefore") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * [Miscellaneous])) ((:*:) * (S1 * (MetaSel (Just Symbol "prologueDoctype") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Maybe Doctype))) (S1 * (MetaSel (Just Symbol "prologueAfter") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * [Miscellaneous])))))

prolog :: AsXmlDocument t => Traversal' t Prologue Source #

A Traversal into XML prolog

epilog :: AsXmlDocument t => Traversal' t [Miscellaneous] Source #

A Traversal into XML epilog

>>> let doc = "<root/><!--qux--><?foo bar?><!--quux-->" :: TL.Text
>>> doc ^.. epilog.folded.comments
["qux","quux"]
>>> doc ^.. epilog.folded.instructions.target
["foo"]
>>> doc & epilog .~ []
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><root/>"

data ParseSettings :: * #

Instances

_XmlDocument :: AsXmlDocument t => Prism' t Document Source #

XML document parsing and rendering with the default settings

class AsHtmlDocument t where Source #

HTML document parsing overloading

Minimal complete definition

_HtmlDocument

Doctype

data Doctype :: * #

Note: due to the incredible complexity of DTDs, this type only supports external subsets. I've tried adding internal subset types, but they quickly gain more code than the rest of this module put together.

It is possible that some future version of this library might support internal subsets, but I am no longer actively working on adding them.

Instances

Eq Doctype 

Methods

(==) :: Doctype -> Doctype -> Bool #

(/=) :: Doctype -> Doctype -> Bool #

Data Doctype 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Doctype -> c Doctype #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Doctype #

toConstr :: Doctype -> Constr #

dataTypeOf :: Doctype -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Doctype) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Doctype) #

gmapT :: (forall b. Data b => b -> b) -> Doctype -> Doctype #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doctype -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doctype -> r #

gmapQ :: (forall d. Data d => d -> u) -> Doctype -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Doctype -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Doctype -> m Doctype #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Doctype -> m Doctype #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Doctype -> m Doctype #

Ord Doctype 
Show Doctype 
Generic Doctype 

Associated Types

type Rep Doctype :: * -> * #

Methods

from :: Doctype -> Rep Doctype x #

to :: Rep Doctype x -> Doctype #

NFData Doctype 

Methods

rnf :: Doctype -> () #

type Rep Doctype 
type Rep Doctype = D1 * (MetaData "Doctype" "Data.XML.Types" "xml-types-0.3.6-BKHFN0QDiAC9D7pCgqpQYj" False) (C1 * (MetaCons "Doctype" PrefixI True) ((:*:) * (S1 * (MetaSel (Just Symbol "doctypeName") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Text)) (S1 * (MetaSel (Just Symbol "doctypeID") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Maybe ExternalID)))))

doctype :: Lens' Prologue (Maybe Doctype) Source #

A Lens into XML DOCTYPE declaration

>>> let doc = "<!DOCTYPE foo><root/>" :: TL.Text
>>> doc ^? prolog.doctype.folded.doctypeName
Just "foo"
>>> doc & prolog.doctype.traverse.doctypeName .~ "moo"
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><!DOCTYPE moo><root/>"

Since doctype's a Lens, it's possible to attach DOCTYPE declaration to an XML document which didn't have it before:

>>> ("<root/>" :: TL.Text) & prolog.doctype ?~ XML.Doctype "moo" Nothing
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><!DOCTYPE moo><root/>"

beforeDoctype :: Lens' Prologue [Miscellaneous] Source #

A Lens into nodes before XML DOCTYPE declaration

>>> let doc = "<!--foo--><!DOCTYPE bar><!--baz--><root/>" :: TL.Text
>>> doc ^? prolog.beforeDoctype.folded.comments
Just "foo"
>>> doc & prolog.beforeDoctype.traverse.comments %~ Text.toUpper
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><!--FOO--><!DOCTYPE bar><!--baz--><root/>"

afterDoctype :: Lens' Prologue [Miscellaneous] Source #

A Lens into nodes after XML DOCTYPE declaration

>>> let doc = "<!--foo--><!DOCTYPE bar><!--baz--><root/>" :: TL.Text
>>> doc ^? prolog.afterDoctype.folded.comments
Just "baz"
>>> doc & prolog.afterDoctype.traverse.comments %~ Text.toUpper
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><!--foo--><!DOCTYPE bar><!--BAZ--><root/>"

Element

data Element :: * #

Instances

Eq Element 

Methods

(==) :: Element -> Element -> Bool #

(/=) :: Element -> Element -> Bool #

Data Element 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Element -> c Element #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Element #

toConstr :: Element -> Constr #

dataTypeOf :: Element -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Element) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Element) #

gmapT :: (forall b. Data b => b -> b) -> Element -> Element #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Element -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Element -> r #

gmapQ :: (forall d. Data d => d -> u) -> Element -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Element -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Element -> m Element #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Element -> m Element #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Element -> m Element #

Ord Element 
Show Element 
ToMarkup Element

Note that the special element name {http:/www.snoyman.comxml2html}ie-cond with the single attribute cond is used to indicate an IE conditional comment.

NFData Element 

Methods

rnf :: Element -> () #

HasName Element Source # 
HasInstructions Element Source # 
HasComments Element Source # 
type Index Element # 
type IxValue Element # 

ixOf :: Traversal' Node a -> Index Element -> Traversal' Element a Source #

Index subnodes selected with a Traversal by an Int

>>> let doc = "<root>zero<foo>one</foo><bar>two</bar>three<baz/>four</root>" :: TL.Text
>>> doc ^? xml.ixOf _NodeContent 2
Just "four"

node :: Name -> Traversal' Element Element Source #

Traverse immediate children with a specific name

>>> let doc = "<root><foo>boo</foo><foo>hoo</foo><bar>moo</bar></root>" :: TL.Text
>>> doc ^. xml.node "foo".text
"boohoo"
>>> doc ^? xml.node "bar".text
Just "moo"
>>> doc ^? xml.node "baz".text
Nothing

named :: Fold Name a -> Traversal' Element Element Source #

Select nodes by name

>>> let doc = "<root><foo>4</foo><foo>7</foo><bar>11</bar><bar xmlns=\"zap\">28</bar></root>" :: TL.Text
>>> doc ^.. xml...named (only "foo").name
["foo","foo"]
>>> doc ^? xml...named (namespace.traverse.only "zap").text
Just "28"
>>> doc ^? xml...named (only "baz").name
Nothing

attrs :: IndexedTraversal' Name Element Text Source #

Traverse node attributes

>>> let doc = "<root><foo bar=\"baz\" qux=\"zap\"/><foo quux=\"xyzzy\"/></root>" :: TL.Text
>>> doc ^.. xml...attrs.indices (has (name.unpacked.prefixed "qu"))
["zap","xyzzy"]
>>> doc & xml...attrs %~ Text.toUpper
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><root><foo bar=\"BAZ\" qux=\"ZAP\"/><foo quux=\"XYZZY\"/></root>"

attr :: Name -> Lens' Element (Maybe Text) Source #

Traverse node attributes with a specific name

>>> let doc = "<root><foo bar=\"baz\" qux=\"quux\"/><foo qux=\"xyzzy\"/></root>" :: TL.Text
>>> doc ^.. xml...attr "qux".traverse
["quux","xyzzy"]
>>> doc ^.. xml...attr "bar"
[Just "baz",Nothing]
>>> doc & xml...attr "qux".traverse %~ Text.reverse
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><root><foo bar=\"baz\" qux=\"xuuq\"/><foo qux=\"yzzyx\"/></root>"
>>> doc & xml.ix 1.attr "bar" ?~ "bazzy"
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><root><foo bar=\"baz\" qux=\"quux\"/><foo bar=\"bazzy\" qux=\"xyzzy\"/></root>"

attributed :: Fold (Map Name Text) a -> Traversal' Element Element Source #

Select nodes by attributes' values

>>> let doc = "<root><foo bar=\"baz\">4</foo><foo bar=\"quux\">7</foo><bar bar=\"baz\">11</bar></root>" :: TL.Text
>>> doc ^.. xml...attributed (ix "bar".only "baz").text
["4","11"]
>>> doc ^? xml...attributed (folded.to Text.length.only 4).text
Just "7"

text :: Traversal' Element Text Source #

Traverse node text contents

>>> let doc = "<root>boo</root>" :: TL.Text
>>> doc ^? xml.text
Just "boo"
>>> doc & xml.text <>~ "hoo"
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><root>boohoo</root>"

texts :: Traversal' Element Text Source #

Traverse node text contents recursively

>>> let doc = "<root>qux<foo>boo</foo><bar><baz>hoo</baz>quux</bar></root>" :: TL.Text
>>> doc ^.. xml.texts
["qux","boo","hoo","quux"]
>>> doc & xml.texts %~ Text.toUpper
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><root>QUX<foo>BOO</foo><bar><baz>HOO</baz>QUUX</bar></root>"

class HasComments t where Source #

Anything that has comments

Minimal complete definition

comments

Name

data Name :: * #

A fully qualified name.

Prefixes are not semantically important; they are included only to simplify pass-through parsing. When comparing names with Eq or Ord methods, prefixes are ignored.

The IsString instance supports Clark notation; see http://www.jclark.com/xml/xmlns.htm and http://infohost.nmt.edu/tcc/help/pubs/pylxml/etree-QName.html. Use the OverloadedStrings language extension for very simple Name construction:

myname :: Name
myname = "{http://example.com/ns/my-namespace}my-name"

Instances

Eq Name 

Methods

(==) :: Name -> Name -> Bool #

(/=) :: Name -> Name -> Bool #

Data Name 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Name -> c Name #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Name #

toConstr :: Name -> Constr #

dataTypeOf :: Name -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Name) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Name) #

gmapT :: (forall b. Data b => b -> b) -> Name -> Name #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r #

gmapQ :: (forall d. Data d => d -> u) -> Name -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Name -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Name -> m Name #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Name -> m Name #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Name -> m Name #

Ord Name 

Methods

compare :: Name -> Name -> Ordering #

(<) :: Name -> Name -> Bool #

(<=) :: Name -> Name -> Bool #

(>) :: Name -> Name -> Bool #

(>=) :: Name -> Name -> Bool #

max :: Name -> Name -> Name #

min :: Name -> Name -> Name #

Show Name 

Methods

showsPrec :: Int -> Name -> ShowS #

show :: Name -> String #

showList :: [Name] -> ShowS #

IsString Name 

Methods

fromString :: String -> Name #

Generic Name 

Associated Types

type Rep Name :: * -> * #

Methods

from :: Name -> Rep Name x #

to :: Rep Name x -> Name #

NFData Name 

Methods

rnf :: Name -> () #

HasName Name Source # 
type Rep Name 
type Rep Name = D1 * (MetaData "Name" "Data.XML.Types" "xml-types-0.3.6-BKHFN0QDiAC9D7pCgqpQYj" False) (C1 * (MetaCons "Name" PrefixI True) ((:*:) * (S1 * (MetaSel (Just Symbol "nameLocalName") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Text)) ((:*:) * (S1 * (MetaSel (Just Symbol "nameNamespace") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Maybe Text))) (S1 * (MetaSel (Just Symbol "namePrefix") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Maybe Text))))))

name :: HasName t => Lens' t Text Source #

A Lens into node name

>>> ("<root/>" :: TL.Text) ^. xml.name
"root"
>>> ("<root><foo/><bar/><baz/></root>" :: TL.Text) ^.. xml...name
["foo","bar","baz"]
>>> ("<root><foo/><bar/><baz></root>" :: TL.Text) & xml.partsOf (plate.name) .~ ["boo", "hoo", "moo"]
"<root><foo/><bar/><baz></root>"

namespace :: HasName t => Lens' t (Maybe Text) Source #

A Lens into node namespace

>>> ("<root/>" :: TL.Text) ^. xml.namespace
Nothing
>>> ("<root/>" :: TL.Text) & xml.namespace ?~ "foo"
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><root xmlns=\"foo\"/>"
>>> ("<root xmlns=\"foo\"/>" :: TL.Text) & xml.namespace .~ Nothing
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><root/>"

prefix :: HasName t => Lens' t (Maybe Text) Source #

A Lens into node namespace

>>> ("<root/>" :: TL.Text) ^. xml.prefix
Nothing
>>> ("<root/>" :: TL.Text) & xml.prefix ?~ "foo"
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><root/>"
>>> ("<root xmlns=\"foo\"/>" :: TL.Text) & xml.prefix ?~ "foo"
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><foo:root xmlns:foo=\"foo\"/>"
>>> ("<?xml version=\"1.0\" encoding=\"UTF-8\"?><foo:root xmlns:foo=\"foo\"/>" :: TL.Text) & xml.prefix .~ Nothing
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><root xmlns=\"foo\"/>"

class HasName t where Source #

Anything that has a name

Minimal complete definition

fullName

Methods

fullName :: Lens' t Name Source #

Instruction

data Instruction :: * #

Instances

Eq Instruction 
Data Instruction 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Instruction -> c Instruction #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Instruction #

toConstr :: Instruction -> Constr #

dataTypeOf :: Instruction -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Instruction) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Instruction) #

gmapT :: (forall b. Data b => b -> b) -> Instruction -> Instruction #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Instruction -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Instruction -> r #

gmapQ :: (forall d. Data d => d -> u) -> Instruction -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Instruction -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Instruction -> m Instruction #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Instruction -> m Instruction #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Instruction -> m Instruction #

Ord Instruction 
Show Instruction 
Generic Instruction 

Associated Types

type Rep Instruction :: * -> * #

NFData Instruction 

Methods

rnf :: Instruction -> () #

type Rep Instruction 
type Rep Instruction = D1 * (MetaData "Instruction" "Data.XML.Types" "xml-types-0.3.6-BKHFN0QDiAC9D7pCgqpQYj" False) (C1 * (MetaCons "Instruction" PrefixI True) ((:*:) * (S1 * (MetaSel (Just Symbol "instructionTarget") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Text)) (S1 * (MetaSel (Just Symbol "instructionData") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Text))))

target :: Traversal' Instruction Text Source #

Processing instruction target

>>> let doc = "<root><?foo bar?></root>" :: TL.Text
>>> doc ^? xml.instructions.target
Just "foo"
>>> doc & xml.instructions.target .~ "boo"
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><root><?boo bar?></root>"

data_ :: Traversal' Instruction Text Source #

Processing instruction data

>>> let doc = "<root><?foo bar?></root>" :: TL.Text
>>> doc ^? xml.instructions.data_
Just "bar"
>>> doc & xml.instructions.data_ .~ "hoo"
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><root><?foo hoo?></root>"

exceptions

Orphan instances

Ixed Element Source #

Index child Elements by an Int

>>> let doc = "<root>zero<foo>one</foo><bar>two</bar>three<baz/>four</root>" :: TL.Text
>>> doc ^? xml.parts.ix 1.text
Just "two"

To index subnodes indexed by a Traversal', use ixOf

Plated Element Source #

Traverse immediate children

>>> let doc = "<root><foo>4</foo><foo>7</foo><bar>11</bar></root>" :: TL.Text
>>> doc ^.. xml...name
["foo","foo","bar"]
>>> doc & partsOf (root...name) .~ ["boo", "hoo", "moo"]
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><root><boo>4</boo><hoo>7</hoo><moo>11</moo></root>"