xml-html-conduit-lens 0.2.0.0 → 0.3.0.0
raw patch · 5 files changed
+149/−36 lines, 5 filesdep ~lens
Dependency ranges changed: lens
Files
- CHANGELOG.md +15/−0
- README.md +4/−4
- src/Text/Xml/Lens.hs +89/−26
- src/Text/Xml/Lens/LowLevel.hs +39/−4
- xml-html-conduit-lens.cabal +2/−2
CHANGELOG.md view
@@ -1,3 +1,18 @@+0.3.0.0+=======++ * Helpers to render values of `Element` type++ * Complete set of isos/prisms for types in Text.XML++ * `attr` is now a Lens, not a Traversal, so it can add and remove attributes from the node++ * `Ixed` instance for `Element` traverses child `Element`s instead of attributes++ * Avoid working with `def` directly, instead take settings endomorphisms as arguments in `*With` functions++ * Add `ixOf` to aid indexing subnodes chosen by a `Traversal`+ 0.2.0.0 =======
README.md view
@@ -1,9 +1,9 @@ xml-html-conduit-lens =====================-[](http://hackage.haskell.org/package/xml-html-conduit-lens)-[](http://travis-ci.org/supki/xml-html-conduit-lens)+[](https://hackage.haskell.org/package/xml-html-conduit-lens)+[](https://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+ [0]: https://hackage.haskell.org/package/xml-conduit+ [1]: https://hackage.haskell.org/package/html-conduit
src/Text/Xml/Lens.hs view
@@ -11,6 +11,9 @@ , xml , html , root+ , renderWith+ , render+ , Prologue , prolog , epilog , AsXmlDocument(..)@@ -23,6 +26,7 @@ , afterDoctype -- * Element , Element+ , ixOf , node , named , attrs@@ -64,8 +68,8 @@ import Data.Map (Map) import Text.XML ( ParseSettings, RenderSettings- , Document, Doctype, Prologue- , Element, Instruction, Name, Miscellaneous(..)+ , Document(Document), Doctype, Prologue(Prologue)+ , Node, Element, Instruction, Name, Miscellaneous(..) , XMLException(..), UnresolvedEntityException(..) , parseLBS, parseText, renderLBS, renderText, def )@@ -87,18 +91,19 @@ -- This is a general version; for parsing/rendering with the -- default options see '_XmlDocument' class AsXmlDocument t where- _XmlDocumentWith :: ParseSettings -> RenderSettings -> Prism' t Document+ _XmlDocumentWith+ :: (ParseSettings -> ParseSettings) -> (RenderSettings -> 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)+ _XmlDocumentWith p r = prism' (renderLBS (r def)) (either (const Nothing) Just . parseLBS (p def)) {-# INLINE _XmlDocumentWith #-} instance AsXmlDocument TL.Text where- _XmlDocumentWith ps rs = prism' (renderText rs) (either (const Nothing) Just . parseText ps)+ _XmlDocumentWith p r = prism' (renderText (r def)) (either (const Nothing) Just . parseText (p def)) {-# INLINE _XmlDocumentWith #-} -- | XML document parsing and rendering with the default settings@@ -157,6 +162,43 @@ prolog = _XmlDocument . documentPrologue {-# INLINE prolog #-} +-- | 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>+renderWith :: AsXmlDocument t => (RenderSettings -> RenderSettings) -> Fold Element t+renderWith r = to (\e -> Document (Prologue [] Nothing []) e []) . re (_XmlDocumentWith id r)+{-# INLINE renderWith #-}++-- | Fold 'Element' into the XML document with the default rendering settings+render :: AsXmlDocument t => Fold Element t+render = renderWith id+{-# INLINE render #-}+ -- | A Lens into XML DOCTYPE declaration -- -- >>> let doc = "<!DOCTYPE foo><root/>" :: TL.Text@@ -218,17 +260,31 @@ 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 #-}+type instance Index Element = Int+type instance IxValue Element = Element +-- | Index child 'Element's 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' instance Ixed Element where- ix n = elementAttributes . ix n+ ix n = parts . ix n {-# INLINE ix #-} +-- | 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"+ixOf :: Traversal' Node a -> Index Element -> Traversal' Element a+ixOf p n = partsOf (insideOf p) . ix n+{-# INLINE ixOf #-}+ -- | Traverse immediate children -- -- >>> let doc = "<root><foo>4</foo><foo>7</foo><bar>11</bar></root>" :: TL.Text@@ -239,9 +295,13 @@ -- >>> 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>" instance Plated Element where- plate = elementNodes . traverse . _NodeElement+ plate = insideOf _NodeElement {-# INLINE plate #-} +insideOf :: Traversal Node Node a b -> Traversal Element Element a b+insideOf p = elementNodes . traverse . p+{-# INLINE insideOf #-}+ -- | Traverse immediate children with a specific name -- -- >>> let doc = "<root><foo>boo</foo><foo>hoo</foo><bar>moo</bar></root>" :: TL.Text@@ -291,16 +351,19 @@ -- -- >>> let doc = "<root><foo bar=\"baz\" qux=\"quux\"/><foo qux=\"xyzzy\"/></root>" :: TL.Text ----- >>> doc ^.. xml...attr "qux"+-- >>> doc ^.. xml...attr "qux".traverse -- ["quux","xyzzy"] -- -- >>> doc ^.. xml...attr "bar"--- ["baz"]+-- [Just "baz",Nothing] ----- >>> doc & xml...attr "qux" %~ Text.reverse+-- >>> doc & xml...attr "qux".traverse %~ Text.reverse -- "<?xml version=\"1.0\" encoding=\"UTF-8\"?><root><foo bar=\"baz\" qux=\"xuuq\"/><foo qux=\"yzzyx\"/></root>"-attr :: Name -> Traversal' Element Text-attr n = elementAttributes . ix n+--+-- >>> 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>"+attr :: Name -> Lens' Element (Maybe Text)+attr n = elementAttributes . at n {-# INLINE attr #-} -- | Select nodes by attributes' values@@ -401,15 +464,15 @@ -- | Anything that has a name class HasName t where- _Name :: Lens' t Name+ fullName :: Lens' t Name instance HasName Name where- _Name = id- {-# INLINE _Name #-}+ fullName = id+ {-# INLINE fullName #-} instance HasName Element where- _Name = elementName- {-# INLINE _Name #-}+ fullName = elementName+ {-# INLINE fullName #-} -- | A Lens into node name --@@ -422,7 +485,7 @@ -- >>> ("<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+name = fullName . nameLocalName {-# INLINE name #-} -- | A Lens into node namespace@@ -436,7 +499,7 @@ -- >>> ("<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+namespace = fullName . nameNamespace {-# INLINE namespace #-} -- | A Lens into node namespace@@ -453,7 +516,7 @@ -- >>> ("<?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+prefix = fullName . namePrefix {-# INLINE prefix #-} -- | @xml-conduit@ entity resolving exceptions overloading
src/Text/Xml/Lens/LowLevel.hs view
@@ -1,4 +1,4 @@--- | Lenses and Prisms Template Haskell could handle+-- | Optics Template Haskell could generate, but didn't module Text.Xml.Lens.LowLevel where import Control.Lens@@ -6,13 +6,13 @@ import Data.Text (Text) import Text.XML ( ParseSettings, RenderSettings- , Document, Doctype, Prologue, ExternalID- , Node(..), Element, Instruction, Name, Miscellaneous(..)+ , 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'+-- | A Lens into 'XML.psDecodeEntities' psDecodeEntities :: Lens' ParseSettings DecodeEntities psDecodeEntities f ps = f (XML.psDecodeEntities ps) <&> \p -> ps { XML.psDecodeEntities = p } {-# INLINE psDecodeEntities #-}@@ -122,6 +122,36 @@ instructionData f i = f (XML.instructionData i) <&> \p -> i { XML.instructionData = p } {-# INLINE instructionData #-} +-- | An Iso into 'XML.Document'+_Document :: Iso' Document (Prologue, Element, [Miscellaneous])+_Document = iso (\(Document p r e) -> (p, r, e)) (uncurry3 Document)+{-# INLINE _Document #-}++-- | An Iso into 'XML.Prologue'+_Prologue :: Iso' Prologue ([Miscellaneous], Maybe Doctype, [Miscellaneous])+_Prologue = iso (\(Prologue xs d ys) -> (xs, d, ys)) (uncurry3 Prologue)+{-# INLINE _Prologue #-}++-- | An Iso into 'XML.Instruction'+_Instruction :: Iso' Instruction (Text, Text)+_Instruction = iso (\(Instruction t d) -> (t, d)) (uncurry Instruction)+{-# INLINE _Instruction #-}++-- | An Iso into 'XML.Element'+_Element :: Iso' Element (Name, Map Name Text, [Node])+_Element = iso (\(Element n as ns) -> (n, as, ns)) (uncurry3 Element)+{-# INLINE _Element #-}++-- | An Iso into 'XML.Name'+_Name :: Iso' Name (Text, Maybe Text, Maybe Text)+_Name = iso (\(Name ln ns p) -> (ln, ns, p)) (uncurry3 Name)+{-# INLINE _Name #-}++-- | An Iso into 'XML.Doctype'+_Doctype :: Iso' Doctype (Text, Maybe ExternalID)+_Doctype = iso (\(Doctype n i) -> (n, i)) (uncurry Doctype)+{-# INLINE _Doctype #-}+ -- | A Prism into 'XML.NodeElement' _NodeElement :: Prism' Node Element _NodeElement = prism' NodeElement (\s -> case s of NodeElement e -> Just e; _ -> Nothing)@@ -151,3 +181,8 @@ _MiscInstruction :: Prism' Miscellaneous Instruction _MiscInstruction = prism' MiscInstruction (\s -> case s of MiscInstruction e -> Just e; _ -> Nothing) {-# INLINE _MiscInstruction #-}++-- A version of 'uncurry' for functions of \"3 argumentso\"+uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d+uncurry3 f ~(a, b, c) = f a b c+{-# INLINE uncurry3 #-}
xml-html-conduit-lens.cabal view
@@ -1,5 +1,5 @@ name: xml-html-conduit-lens-version: 0.2.0.0+version: 0.3.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@@ -30,7 +30,7 @@ build-depends: base >= 4 && < 5 , bytestring- , lens >= 4.0+ , lens >= 4.0.1 , containers >= 0.4.0 && < 0.6 , text >= 0.11 && < 1.2 , xml-conduit >= 1.1 && < 1.3