packages feed

xml-html-conduit-lens (empty) → 0.1.0.0

raw patch · 9 files changed

+812/−0 lines, 9 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, doctest, hspec, hspec-expectations-lens, html-conduit, lens, text, xml-conduit, xml-html-conduit-lens

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2013, Fumiaki Kinoshita+Copyright (c) 2014, Matvey Aksenov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Fumiaki Kinoshita nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,9 @@+xml-html-conduit-lens+=====================+[![Hackage](https://budueba.com/hackage/xml-html-conduit-lens)](http://hackage.haskell.org/package/xml-html-conduit-lens)+[![Build Status](https://secure.travis-ci.org/supki/xml-html-conduit-lens.png?branch=master)](http://travis-ci.org/supki/xml-html-conduit-lens)++Optics for [xml-conduit][0] and [html-conduit][1]++  [0]: http://hackage.haskell.org/package/xml-conduit+  [1]: http://hackage.haskell.org/package/html-conduit
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Text/Xml/Lens.hs view
@@ -0,0 +1,524 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | Optics for xml-conduit and html-conduit+module Text.Xml.Lens+  ( -- * Document+    Document+  , xml+  , html+  , root+  , prolog+  , epilog+  , AsXmlDocument(..)+  , _XmlDocument+  , AsHtmlDocument(..)+    -- * Doctype+  , Doctype+  , doctype+  , beforeDoctype+  , afterDoctype+    -- * Element+  , Element+  , node+  , named+  , attrs+  , attr+  , attributed+  , text+  , HasComments(..)+  , HasInstructions(..)+    -- * Name+  , Name+  , name+  , namespace+  , prefix+  , HasName(..)+    -- * Instruction+  , Instruction+  , target+  , data_+    -- * exceptions+  , UnresolvedEntityException+  , XMLException+  , _MissingRootElement+  , _ContentAfterRoot+  , _InvalidInlineDoctype+  , _MissingEndElement+  , _UnterminatedInlineDoctype+  , AsUnresolvedEntityException(..)+  , AsXMLException(..)+  , AsInvalidEventStream(..)+  , module Text.Xml.Lens.LowLevel+  ) where++import           Control.Applicative+import           Control.Exception (SomeException)+import           Control.Exception.Lens (exception)+import           Control.Lens+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text.Lazy as TL+import           Data.Text (Text)+import           Data.Map (Map)+import           Text.XML+  ( ParseSettings, RenderSettings+  , Document, Doctype, Prologue+  , Element, Instruction, Name, Miscellaneous(..)+  , XMLException(..), UnresolvedEntityException(..)+  , parseLBS, parseText, renderLBS, renderText, def+  )+import           Text.XML.Stream.Parse (EventPos)+import           Text.XML.Unresolved (InvalidEventStream(..))+import qualified Text.HTML.DOM as Html++import Text.Xml.Lens.LowLevel++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import           Data.List.Lens (prefixed)+-- >>> import           Data.Text.Lens (unpacked)+-- >>> import qualified Data.Text as Text+-- >>> import qualified Text.XML as XML++-- | XML document parsing and rendering overloading+--+-- This is a general version; for parsing/rendering with the+-- default options see '_XmlDocument'+class AsXmlDocument t where+  _XmlDocumentWith :: ParseSettings -> RenderSettings -> Prism' t Document++instance AsXmlDocument Document where+  _XmlDocumentWith _ _ = id+  {-# INLINE _XmlDocumentWith #-}++instance AsXmlDocument BL.ByteString where+  _XmlDocumentWith ps rs = prism' (renderLBS rs) (either (const Nothing) Just . parseLBS ps)+  {-# INLINE _XmlDocumentWith #-}++instance AsXmlDocument TL.Text where+  _XmlDocumentWith ps rs = prism' (renderText rs) (either (const Nothing) Just . parseText ps)+  {-# INLINE _XmlDocumentWith #-}++-- | XML document parsing and rendering with the default settings+_XmlDocument :: AsXmlDocument t => Prism' t Document+_XmlDocument = _XmlDocumentWith def def+{-# INLINE _XmlDocument #-}++-- | HTML document parsing overloading+class AsHtmlDocument t where+  _HtmlDocument :: Fold t Document++instance AsHtmlDocument Document where+  _HtmlDocument = id+  {-# INLINE _HtmlDocument #-}++instance AsHtmlDocument BL.ByteString where+  _HtmlDocument = to Html.parseLBS+  {-# INLINE _HtmlDocument #-}++-- | 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/>"+xml :: AsXmlDocument t => Traversal' t Element+xml = _XmlDocument . documentRoot+{-# INLINE xml #-}++-- | 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.plate.name+-- ["br","br"]+--+-- >>> quasiXml ^? xml.plate.name+-- Nothing+html :: AsHtmlDocument t => Fold t Element+html = _HtmlDocument . documentRoot+{-# INLINE html #-}++-- | An alias for 'xml'+root :: AsXmlDocument t => Traversal' t Element+root = xml+{-# INLINE root #-}++-- | A Traversal into XML prolog+prolog :: AsXmlDocument t => Traversal' t Prologue+prolog = _XmlDocument . documentPrologue+{-# INLINE prolog #-}++-- | 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/>"+doctype :: Lens' Prologue (Maybe Doctype)+doctype = prologueDoctype+{-# INLINE doctype #-}++-- | 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/>"+beforeDoctype :: Lens' Prologue [Miscellaneous]+beforeDoctype = prologueBefore+{-# INLINE beforeDoctype #-}++-- | 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/>"+afterDoctype :: Lens' Prologue [Miscellaneous]+afterDoctype = prologueAfter+{-# INLINE afterDoctype #-}++-- | 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/>"+epilog :: AsXmlDocument t => Traversal' t [Miscellaneous]+epilog = _XmlDocument . documentEpilogue+{-# INLINE epilog #-}++type instance Index Element = Name+type instance IxValue Element = Text++instance At Element where+  at n = elementAttributes . at n+  {-# INLINE at #-}++instance Applicative f => Ixed f Element where+  ix n = elementAttributes . ix n+  {-# INLINE ix #-}++-- | Traverse immediate children+--+-- >>> let doc = "<root><foo>4</foo><foo>7</foo><bar>11</bar></root>" :: TL.Text+--+-- >>> doc ^.. xml.plate.name+-- ["foo","foo","bar"]+--+-- >>> doc & partsOf (root.plate.name) .~ ["boo", "hoo", "moo"]+-- "<?xml version=\"1.0\" encoding=\"UTF-8\"?><root><boo>4</boo><hoo>7</hoo><moo>11</moo></root>"+instance Plated Element where+  plate = elementNodes . traverse . _NodeElement+  {-# INLINE plate #-}++-- | 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+node :: Name -> Traversal' Element Element+node n = elementNodes . traverse . _NodeElement . named (only n)+{-# INLINE node #-}++-- | 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.plate.named (only "foo").name+-- ["foo","foo"]+--+-- >>> doc ^? xml.plate.named (namespace.traverse.only "zap").text+-- Just "28"+--+-- >>> doc ^? xml.plate.named (only "baz").name+-- Nothing+named :: Fold Name a -> Traversal' Element Element+named l = filtered (has (elementName . l))+{-# INLINE named #-}++-- | Traverse node attributes+--+-- >>> let doc = "<root><foo bar=\"baz\" qux=\"zap\"/><foo quux=\"xyzzy\"/></root>" :: TL.Text+--+-- >>> doc ^.. xml.plate.attrs.indices (has (name.unpacked.prefixed "qu"))+-- ["zap","xyzzy"]+--+-- >>> doc & xml.plate.attrs %~ Text.toUpper+-- "<?xml version=\"1.0\" encoding=\"UTF-8\"?><root><foo bar=\"BAZ\" qux=\"ZAP\"/><foo quux=\"XYZZY\"/></root>"+attrs :: IndexedTraversal' Name Element Text+attrs = elementAttributes . itraversed+{-# INLINE attrs #-}++-- | Traverse node attributes with a specific name+--+-- >>> let doc = "<root><foo bar=\"baz\" qux=\"quux\"/><foo qux=\"xyzzy\"/></root>" :: TL.Text+--+-- >>> doc ^.. xml.plate.attr "qux"+-- ["quux","xyzzy"]+--+-- >>> doc ^.. xml.plate.attr "bar"+-- ["baz"]+--+-- >>> doc & xml.plate.attr "qux" %~ Text.reverse+-- "<?xml version=\"1.0\" encoding=\"UTF-8\"?><root><foo bar=\"baz\" qux=\"xuuq\"/><foo qux=\"yzzyx\"/></root>"+attr :: Name -> IndexedTraversal' Name Element Text+attr n = elementAttributes . ix n+{-# INLINE attr #-}++-- | 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.plate.attributed (ix "bar".only "baz").text+-- ["4","11"]+--+-- >>> doc ^? xml.plate.attributed (folded.to Text.length.only 4).text+-- Just "7"+attributed :: Fold (Map Name Text) a -> Traversal' Element Element+attributed p = filtered (has (elementAttributes . p))+{-# INLINE attributed #-}++-- | 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>"+text :: Traversal' Element Text+text = elementNodes . traverse . _NodeContent+{-# INLINE text #-}++-- | Anything that has comments+class HasComments t where+  comments :: Traversal' t Text++instance HasComments Element where+  -- | Traverse node comments+  --+  -- >>> let doc = "<root><!-- qux --><foo>bar</foo><!-- quux --></root>" :: TL.Text+  --+  -- >>> doc ^.. xml.comments+  -- [" qux "," quux "]+  --+  -- >>> doc & xml.partsOf comments .~ [" xyz ", " xyzzy "]+  -- "<?xml version=\"1.0\" encoding=\"UTF-8\"?><root><!-- xyz --><foo>bar</foo><!-- xyzzy --></root>"+  comments = elementNodes . traverse . _NodeComment+  {-# INLINE comments #-}++instance HasComments Miscellaneous where+  -- | Traverse node comments+  comments = _MiscComment+  {-# INLINE comments #-}++-- | Anything that has processing instructions+class HasInstructions t where+  instructions :: Traversal' t Instruction++  -- | Traverse node instructions+  --+  -- >>> let doc = "<root><!-- foo --><?foo bar?><qux/><?xyz xyzzy?><quux/></root>" :: TL.Text+  --+  -- >>> doc ^.. xml.instructions.target+  -- ["foo","xyz"]+  --+  -- >>> doc & xml.instructions.data_ %~ Text.toUpper+  -- "<?xml version=\"1.0\" encoding=\"UTF-8\"?><root><!-- foo --><?foo BAR?><qux/><?xyz XYZZY?><quux/></root>"+instance HasInstructions Element where+  instructions = elementNodes . traverse . _NodeInstruction+  {-# INLINE instructions #-}++instance HasInstructions Miscellaneous where+  -- | Traverse node instructions+  instructions = _MiscInstruction+  {-# INLINE instructions #-}++-- | 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>"+target :: Traversal' Instruction Text+target = instructionTarget+{-# INLINE target #-}++-- | 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>"+data_ :: Traversal' Instruction Text+data_ = instructionData+{-# INLINE data_ #-}++-- | Anything that has a name+class HasName t where+  _Name :: Lens' t Name++instance HasName Name where+  _Name = id+  {-# INLINE _Name #-}++instance HasName Element where+  _Name = elementName+  {-# INLINE _Name #-}++-- | A Lens into node name+--+-- >>> ("<root/>" :: TL.Text) ^. xml.name+-- "root"+--+-- >>> ("<root><foo/><bar/><baz/></root>" :: TL.Text) ^.. xml.plate.name+-- ["foo","bar","baz"]+--+-- >>> ("<root><foo/><bar/><baz></root>" :: TL.Text) & xml.partsOf (plate.name) .~ ["boo", "hoo", "moo"]+-- "<root><foo/><bar/><baz></root>"+name :: HasName t => Lens' t Text+name = _Name . nameLocalName+{-# INLINE name #-}++-- | 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/>"+namespace :: HasName t => Lens' t (Maybe Text)+namespace = _Name . nameNamespace+{-# INLINE namespace #-}++-- | 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\"/>"+prefix :: HasName t => Lens' t (Maybe Text)+prefix = _Name . namePrefix+{-# INLINE prefix #-}++-- | @xml-conduit@ entity resolving exceptions overloading+class AsUnresolvedEntityException t where+  _UnresolvedEntityException :: Prism' t UnresolvedEntityException++instance AsUnresolvedEntityException UnresolvedEntityException where+  _UnresolvedEntityException = id+  {-# INLINE _UnresolvedEntityException #-}++instance AsUnresolvedEntityException SomeException where+  _UnresolvedEntityException = exception+  {-# INLINE _UnresolvedEntityException #-}++-- | @xml-conduit@ general XML exception overloading+class AsXMLException t where+  _XMLException :: Prism' t XMLException++instance AsXMLException XMLException where+  _XMLException = id+  {-# INLINE _XMLException #-}++instance AsXMLException SomeException where+  _XMLException = exception+  {-# INLINE _XMLException #-}++-- | @xml-conduit@ XML parsing exceptions overloading+class AsInvalidEventStream t where+  _InvalidEventStream :: Prism' t InvalidEventStream++instance AsInvalidEventStream InvalidEventStream where+  _InvalidEventStream = id+  {-# INLINE _InvalidEventStream #-}++instance AsInvalidEventStream SomeException where+  _InvalidEventStream = exception+  {-# INLINE _InvalidEventStream #-}++-- | A Prism into 'ContentAfterRoot'+_ContentAfterRoot :: AsInvalidEventStream t => Prism' t EventPos+_ContentAfterRoot = _InvalidEventStream+  . prism' ContentAfterRoot (\s -> case s of ContentAfterRoot e -> Just e; _ -> Nothing)+{-# INLINE _ContentAfterRoot #-}++-- | A Prism into 'MissingRootElement'+_MissingRootElement :: AsInvalidEventStream t => Prism' t ()+_MissingRootElement = _InvalidEventStream+  . prism' (const MissingRootElement) (\s -> case s of MissingRootElement -> Just (); _ -> Nothing)+{-# INLINE _MissingRootElement #-}++-- | A Prism into 'InvalidInlineDoctype'+_InvalidInlineDoctype :: AsInvalidEventStream t => Prism' t EventPos+_InvalidInlineDoctype = _InvalidEventStream+  . prism' InvalidInlineDoctype (\s -> case s of InvalidInlineDoctype e -> Just e; _ -> Nothing)+{-# INLINE _InvalidInlineDoctype #-}++-- | A Prism into 'MissingEndElement'+_MissingEndElement :: AsInvalidEventStream t => Prism' t (Name, Maybe EventPos)+_MissingEndElement = _InvalidEventStream+  . prism' (uncurry MissingEndElement) (\s -> case s of MissingEndElement e p -> Just (e, p); _ -> Nothing)+{-# INLINE _MissingEndElement #-}++-- | A Prism into 'UnterminatedInlineDoctype'+_UnterminatedInlineDoctype :: AsInvalidEventStream t => Prism' t ()+_UnterminatedInlineDoctype = _InvalidEventStream+  . prism' (const UnterminatedInlineDoctype) (\s -> case s of UnterminatedInlineDoctype -> Just (); _ -> Nothing)+{-# INLINE _UnterminatedInlineDoctype #-}
+ src/Text/Xml/Lens/LowLevel.hs view
@@ -0,0 +1,153 @@+-- | Lenses and Prisms Template Haskell could handle+module Text.Xml.Lens.LowLevel where++import           Control.Lens+import           Data.Map (Map)+import           Data.Text (Text)+import           Text.XML+  ( ParseSettings, RenderSettings+  , Document, Doctype, Prologue, ExternalID+  , Node(..), Element, Instruction, Name, Miscellaneous(..)+  )+import           Text.XML.Stream.Parse (DecodeEntities)+import qualified Text.XML as XML++-- | A Lens into 'XML.rsPretty'+psDecodeEntities :: Lens' ParseSettings DecodeEntities+psDecodeEntities f ps = f (XML.psDecodeEntities ps) <&> \p -> ps { XML.psDecodeEntities = p }+{-# INLINE psDecodeEntities #-}++-- | A Lens into 'XML.rsPretty'+rsPretty :: Lens' RenderSettings Bool+rsPretty f rs = f (XML.rsPretty rs) <&> \p -> rs { XML.rsPretty = p }+{-# INLINE rsPretty #-}++-- | A Lens into 'XML.rsNamespaces'+rsNamespaces :: Lens' RenderSettings [(Text, Text)]+rsNamespaces f rs = f (XML.rsNamespaces rs) <&> \p -> rs { XML.rsNamespaces = p }+{-# INLINE rsNamespaces #-}++-- | A Lens into 'XML.rsAttrOrder'+rsAttrOrder :: Lens' RenderSettings (Name -> Map Name Text -> [(Name, Text)])+rsAttrOrder f rs = f (XML.rsAttrOrder rs) <&> \p -> rs { XML.rsAttrOrder = p }+{-# INLINE rsAttrOrder #-}++-- | A Lens into 'XML.documentPrologue'+documentPrologue :: Lens' Document Prologue+documentPrologue f doc = f (XML.documentPrologue doc) <&> \p -> doc { XML.documentPrologue = p }+{-# INLINE documentPrologue #-}++-- | A Lens into 'XML.documentRoot'+documentRoot :: Lens' Document Element+documentRoot f doc = f (XML.documentRoot doc) <&> \p -> doc { XML.documentRoot = p }+{-# INLINE documentRoot #-}++-- | A Lens into 'XML.documentEpilogue'+documentEpilogue :: Lens' Document [Miscellaneous]+documentEpilogue f doc =  f (XML.documentEpilogue doc) <&> \p -> doc { XML.documentEpilogue = p }+{-# INLINE documentEpilogue #-}++-- | A Lens into 'XML.prologueBefore'+prologueBefore :: Lens' Prologue [Miscellaneous]+prologueBefore f doc =  f (XML.prologueBefore doc) <&> \p -> doc { XML.prologueBefore = p }+{-# INLINE prologueBefore #-}++-- | A Lens into 'XML.prologueDoctype'+prologueDoctype :: Lens' Prologue (Maybe Doctype)+prologueDoctype f doc =  f (XML.prologueDoctype doc) <&> \p -> doc { XML.prologueDoctype = p }+{-# INLINE prologueDoctype #-}++-- | A Lens into 'XML.prologueAfter'+prologueAfter :: Lens' Prologue [Miscellaneous]+prologueAfter f doc =  f (XML.prologueAfter doc) <&> \p -> doc { XML.prologueAfter = p }+{-# INLINE prologueAfter #-}++-- | A Lens into 'XML.doctypeName'+doctypeName :: Lens' Doctype Text+doctypeName f doc =  f (XML.doctypeName doc) <&> \p -> doc { XML.doctypeName = p }+{-# INLINE doctypeName #-}++-- | A Lens into 'XML.doctypeID'+doctypeID :: Lens' Doctype (Maybe ExternalID)+doctypeID f doc =  f (XML.doctypeID doc) <&> \p -> doc { XML.doctypeID = p }+{-# INLINE doctypeID #-}++-- | A Prism into 'XML.SystemID'+_SystemID :: Prism' ExternalID Text+_SystemID = prism' XML.SystemID (\s -> case s of XML.SystemID e -> Just e; _ -> Nothing)+{-# INLINE _SystemID #-}++-- | A Prism into 'XML.SystemID'+_PublicID :: Prism' ExternalID (Text, Text)+_PublicID = prism' (uncurry XML.PublicID) (\s -> case s of XML.PublicID e e' -> Just (e, e'); _ -> Nothing)+{-# INLINE _PublicID #-}++-- | A Lens into 'XML.elementName'+elementName :: Lens' Element Name+elementName f e = f (XML.elementName e) <&> \p -> e { XML.elementName = p }+{-# INLINE elementName #-}++-- | A Lens into 'XML.elementAttributes'+elementAttributes :: Lens' Element (Map Name Text)+elementAttributes f e = f (XML.elementAttributes e) <&> \p -> e { XML.elementAttributes = p }+{-# INLINE elementAttributes #-}++-- | A Lens into 'XML.elementNodes'+elementNodes :: Lens' Element [Node]+elementNodes f e = f (XML.elementNodes e) <&> \p -> e { XML.elementNodes = p }+{-# INLINE elementNodes #-}++-- | A Lens into 'XML.nameLocalName'+nameLocalName :: Lens' Name Text+nameLocalName f n = f (XML.nameLocalName n) <&> \p -> n { XML.nameLocalName = p }+{-# INLINE nameLocalName #-}++-- | A Lens into 'XML.nameNamespace'+nameNamespace :: Lens' Name (Maybe Text)+nameNamespace f n = f (XML.nameNamespace n) <&> \p -> n { XML.nameNamespace = p }+{-# INLINE nameNamespace #-}++-- | A Lens into 'XML.namePrefix'+namePrefix :: Lens' Name (Maybe Text)+namePrefix f n = f (XML.namePrefix n) <&> \p -> n { XML.namePrefix = p }+{-# INLINE namePrefix #-}++-- | A Lens into 'XML.instructionTarget'+instructionTarget :: Lens' Instruction Text+instructionTarget f i = f (XML.instructionTarget i) <&> \p -> i { XML.instructionTarget = p }+{-# INLINE instructionTarget #-}++-- | A Lens into 'XML.instructionData'+instructionData :: Lens' Instruction Text+instructionData f i = f (XML.instructionData i) <&> \p -> i { XML.instructionData = p }+{-# INLINE instructionData #-}++-- | A Prism into 'XML.NodeElement'+_NodeElement :: Prism' Node Element+_NodeElement = prism' NodeElement (\s -> case s of NodeElement e -> Just e; _ -> Nothing)+{-# INLINE _NodeElement #-}++-- | A Prism into 'XML.NodeContent'+_NodeContent :: Prism' Node Text+_NodeContent = prism' NodeContent (\s -> case s of NodeContent e -> Just e; _ -> Nothing)+{-# INLINE _NodeContent #-}++-- | A Prism into 'XML.NodeInstruction'+_NodeInstruction :: Prism' Node Instruction+_NodeInstruction = prism' NodeInstruction (\s -> case s of NodeInstruction e -> Just e; _ -> Nothing)+{-# INLINE _NodeInstruction #-}++-- | A Prism into 'XML.NodeComment'+_NodeComment :: Prism' Node Text+_NodeComment = prism' NodeComment (\s -> case s of NodeComment e -> Just e; _ -> Nothing)+{-# INLINE _NodeComment #-}++-- | A Prism into 'XML.MiscComment'+_MiscComment :: Prism' Miscellaneous Text+_MiscComment = prism' MiscComment (\s -> case s of MiscComment e -> Just e; _ -> Nothing)+{-# INLINE _MiscComment #-}++-- | A Prism into 'XML.MiscInstruction'+_MiscInstruction :: Prism' Miscellaneous Instruction+_MiscInstruction = prism' MiscInstruction (\s -> case s of MiscInstruction e -> Just e; _ -> Nothing)+{-# INLINE _MiscInstruction #-}
+ test/Doctest.hs view
@@ -0,0 +1,7 @@+module Main (main) where++import Test.DocTest (doctest)+++main :: IO ()+main = doctest ["-isrc", "src/Text/Xml/Lens.hs", "example/queries.hs"]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Text/Xml/LensSpec.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}+module Text.Xml.LensSpec (spec) where++import Control.Lens+import Control.Exception (evaluate)+import Test.Hspec.Lens++import Text.XML (parseText_, def)+import Text.Xml.Lens+++spec :: Spec+spec =+  describe "AsInvalidEventStream" $ do+    it "catches missing root element" $+      evaluate (parseText_ def "") `shouldThrow` _MissingRootElement++    it "catches content after root" $+      evaluate (parseText_ def "<root/><foo>") `shouldThrow` _ContentAfterRoot++    it "catches missing end element" $+      evaluate (parseText_ def "<root>") `shouldThrow` _MissingEndElement._1.only "root"+
+ xml-html-conduit-lens.cabal view
@@ -0,0 +1,62 @@+name:                xml-html-conduit-lens+version:             0.1.0.0+synopsis:            Optics for xml-conduit and html-conduit+description:         Optics for xml-conduit and html-conduit+homepage:            https://github.com/supki/xml-html-conduit-lens#readme+license:             BSD3+license-file:        LICENSE+author:              Fumiaki Kinoshita, Matvey Aksenov+maintainer:          Matvey Aksenov <matvey.aksenov@gmail.com>+copyright:           Copyright (C) 2013 Fumiaki Kinoshita, 2014 Matvey Aksenov+category:            Control+build-type:          Simple+cabal-version:       >= 1.10+extra-source-files:+  README.md++source-repository head+  type: git+  location: https://github.com/supki/xml-html-conduit-lens.git++library+  default-language:+    Haskell2010+  build-depends:+      base                    >= 4     && < 5+    , bytestring+    , lens                    >= 3.8   && < 4.2+    , containers              >= 0.4.0 && < 0.6+    , text                    >= 0.11  && < 1.2+    , xml-conduit             >= 1.1   && < 1.3+    , html-conduit            >= 1.1   && < 1.3+  hs-source-dirs:+    src+  ghc-options:+    -Wall+  exposed-modules:+    Text.Xml.Lens+    Text.Xml.Lens.LowLevel++test-suite doctest+  type:                exitcode-stdio-1.0+  default-language:    Haskell2010+  hs-source-dirs:      test+  main-is:             Doctest.hs+  build-depends:+      base                    == 4.*+    , doctest                 >= 0.9.10++test-suite hspec+  type:                exitcode-stdio-1.0+  default-language:    Haskell2010+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:+      base                    == 4.*+    , hspec+    , hspec-expectations-lens >= 0.2+    , lens                    >= 3.8   && < 4.2+    , xml-conduit             >= 1.1   && < 1.3+    , xml-html-conduit-lens+  other-modules:+    Text.Xml.LensSpec