hexpat-lens 0.0.4 → 0.0.5

raw patch · 3 files changed

+172/−87 lines, 3 files

Files

hexpat-lens.cabal +5/−4
src/Text/XML/Expat/Lens/Generic.hs +144/−0
src/Text/XML/Expat/Lens/Unqualified.hs +23/−83

hexpat-lens.cabal view

@@ -1,5 +1,5 @@ name:                hexpat-lens-version:             0.0.4+version:             0.0.5 synopsis:            Lenses for Hexpat. license:             MIT license-file:        LICENSE@@ -13,13 +13,14 @@ library   exposed-modules:     Text.XML.Expat.Lens-    Text.XML.Expat.Lens.Unqualified-    Text.XML.Expat.Lens.Parse+    Text.XML.Expat.Lens.Generic     Text.XML.Expat.Lens.Names+    Text.XML.Expat.Lens.Parse+    Text.XML.Expat.Lens.Unqualified   build-depends:              base            >= 4.6      && < 4.7-    , bytestring      >= 0.10.0.2 && < 0.10.1     , deepseq         >= 1.3      && < 1.4+    , bytestring      >= 0.10.0.2 && < 0.10.1     , hexpat          >= 0.20     && < 0.21     , lens            >= 3.9      && < 3.10     , hexpat-tagsoup  == 0.1.*

+ src/Text/XML/Expat/Lens/Generic.hs view

@@ -0,0 +1,144 @@++-- |+-- Module      : Text.XML.Expat.Lens.Generic+-- Copyright   : (c) 2013, Joseph Abrahamson+-- License     : MIT+-- +-- Maintainer  : me@jspha.com+-- Stability   : experimental+-- Portability : non-portable+-- +-- A Hexpat lens module for generic tags.+-- +-- Lenses provide power to do very concise XML tree diving. This+-- module provides a less general interface to the Hexpat datatypes+-- via lenses.++{-# OPTIONS -fno-warn-orphans #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}++module Text.XML.Expat.Lens.Generic (++  -- * Basic inspection+  name, attributes, text,++  -- * Recursive inspection+  children, allNodes,++  -- * Filters+  named, parameterized+         +  ) where++import Control.Applicative+import Control.Lens hiding (children)++import Text.XML.Expat.Tree++-- | Traverses the name of an 'Element'. This is as+-- an "Affine", or 0-or-1 target, 'Traversal'. In regex terms, you+-- can think of it like the @?@ suffix modifier.++name :: Traversal' (NodeG f tag text) tag+name inj (Element n a c) = (\n' -> Element n' a c) <$> inj n+name _   t               = pure t+{-# INLINE name #-}++-- | Traverses to the list of attributes of an 'Element'. This is as+-- an "Affine", or 0-or-1 target, 'Traversal'. In regex terms, you+-- can think of it like the @?@ suffix modifier.++attributes :: Traversal' (NodeG f tag text) (Attributes tag text)+attributes inj (Element n a c) = (\a' -> Element n a' c) <$> inj a+attributes _   t               = pure t+{-# INLINE attributes #-}++-- The @attributes@ form, effectively, a lookup table allowing us to+-- instantiate @At@. Then, we get @Ixed@, @Each@, and @Contains@ for+-- "free".++type instance Index   (NodeG f tag text) = tag+type instance IxValue (NodeG f tag text) = text++-- | This forms a valid 'At' instance under the assumption that+-- there are no repeated keys in the 'Attributes' list. Since+-- @hexpat@ won't parse invalid XML this holds after parsing, so+-- this 'At' instance is valid so long as the invariants aren't+-- subverted in some other way, such as by modify the 'Attributes'+-- list directly via the 'attributes' 'Traversal'.++instance (GenericXMLString tag, NodeClass NodeG f) => At (NodeG f tag text) where+  at k f e = indexed f k (getAttribute e k) <&> \r -> alterAttribute k r e++instance (GenericXMLString tag, Applicative g, NodeClass NodeG f)+         => Ixed g (NodeG f tag text) where+  ix = ixAt++instance ( GenericXMLString tag+         , Applicative g+         , Contravariant g+         , NodeClass NodeG f ) => Contains g (NodeG f tag text) where+  contains = containsAt++instance Traversable f => Plated (NodeG f tag text) where+  plate = children . traverse+  {-# INLINE plate #-}++-- | Traverses the children of an 'Element'. This is as+-- an "Affine", or 0-or-1 target, 'Traversal'. In regex terms, you+-- can think of it like the @?@ suffix modifier.++children :: Traversal' (NodeG f tag text) (f (NodeG f tag text))+children inj (Element n a c) = (\c' -> Element n a c') <$> inj c+children _   t               = pure t+{-# INLINE children #-}++-- | Prismatic access to the text of a 'Text' node. This is more+-- powerful than 'name', 'children', and 'attributes' since it can+-- be 'Review'ed.++text :: Prism' (NodeG f tag text) text+text = dimap go come . right' where+  go e@Element{} = Left e+  go (Text t)    = Right t+  {-# INLINE go #-}+  come (Left it) = pure it+  come (Right t) = Text <$> t+  {-# INLINE come #-}+{-# INLINE text #-}++-- We can use plated/uniplate lenses to traverse all of the elements of+-- the tree in a bottom up fashion.++-- | Produces a list of all 'UNode's in a XML tree. Synonym for+-- 'universe'.++allNodes :: Traversable c => NodeG c tag text -> [NodeG c tag text]+allNodes = universe+{-# INLINE allNodes #-}++-- And if we build one sort-of @Traversal@ then we'll have replicated+-- almost all of the functionality of @NodeClass@ in lenses. This uses+-- 'Control.Lens.Fold.filtered' so the caveats there apply.++-- | Traverses 'Element's which have a particular name.++named :: (Choice p, Applicative f, Eq t) => t -> Overloaded' p f (UNode t) (UNode t)+named n = filtered (isNamed n)+{-# INLINE named #-}++-- | @parameterized k v@ traverses 'Element's which match the value+-- @v@ at the key @k@ in their attributes.++parameterized :: (Choice p, Applicative f, Eq t, GenericXMLString t) =>+                 t -> t -> Overloaded' p f (UNode t) (UNode t)+parameterized k v = filtered check where+  check u = case u ^? ix k . to (==v) of+    Just True -> True+    _         -> False+  {-# INLINE check #-}+{-# INLINE parameterized #-}

src/Text/XML/Expat/Lens/Unqualified.hs view

@@ -8,7 +8,8 @@ -- Stability   : experimental -- Portability : non-portable -- --- A simple Hexpat lens module.+-- A simple Hexpat lens module. This is nothing more than a+-- type-specialized re-export of "Text.XML.Expat.Lens.Generic". --  -- Lenses provide power to do very concise XML tree diving. This -- module provides a less general interface to the Hexpat datatypes@@ -20,110 +21,49 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} -module Text.XML.Expat.Lens.Unqualified where+module Text.XML.Expat.Lens.Unqualified ( +  -- * Basic inspection+  name, attributes, text,++  -- * Recursive inspection+  children, allNodes,++  -- * Filters+  named, parameterized+  +  ) where+ import Control.Applicative import Control.Lens hiding (children)- import Text.XML.Expat.Tree---- | Traverses the name of an 'Element'. This is as--- an "Affine", or 0-or-1 target, 'Traversal'. In regex terms, you--- can think of it like the @?@ suffix modifier.+import qualified Text.XML.Expat.Lens.Generic as G  name :: Traversal' (UNode t) t-name inj (Element n a c) = (\n' -> Element n' a c) <$> inj n-name _   t               = pure t+name = G.name {-# INLINE name #-} --- | Traverses to the list of attributes of an 'Element'. This is as--- an "Affine", or 0-or-1 target, 'Traversal'. In regex terms, you--- can think of it like the @?@ suffix modifier.- attributes :: Traversal' (UNode t) (UAttributes t)-attributes inj (Element n a c) = (\a' -> Element n a' c) <$> inj a-attributes _   t               = pure t+attributes = G.attributes {-# INLINE attributes #-} --- The @attributes@ form, effectively, a lookup table allowing us to--- instantiate @At@. Then, we get @Ixed@, @Each@, and @Contains@ for--- "free".--type instance Index   (UNode a) = a-type instance IxValue (UNode a) = a---- | This forms a valid 'At' instance under the assumption that--- there are no repeated keys in the 'Attributes' list. Since--- @hexpat@ won't parse invalid XML this holds after parsing, so--- this 'At' instance is valid so long as the invariants aren't--- subverted in some other way, such as by modify the 'Attributes'--- list directly via the 'attributes' 'Traversal'.--instance (GenericXMLString a) => At (UNode a) where-  at k f e = indexed f k (getAttribute e k) <&> \r -> alterAttribute k r e--instance (GenericXMLString a, Applicative f) => Ixed f (UNode a) where-  ix = ixAt--instance ( GenericXMLString a-         , Applicative f-         , Contravariant f ) => Contains f (UNode a) where-  contains = containsAt--instance Plated (UNode a) where-  plate = children . traverse-  {-# INLINE plate #-}---- | Traverses the children of an 'Element'. This is as--- an "Affine", or 0-or-1 target, 'Traversal'. In regex terms, you--- can think of it like the @?@ suffix modifier.- children :: Traversal' (UNode t) [UNode t]-children inj (Element n a c) = (\c' -> Element n a c') <$> inj c-children _   t               = pure t+children = G.children {-# INLINE children #-} --- | Prismatic access to the text of a 'Text' node. This is more--- powerful than 'name', 'children', and 'attributes' since it can--- be 'Review'ed.- text :: Prism' (UNode t) t-text = dimap go come . right' where-  go e@Element{} = Left e-  go (Text t)    = Right t-  {-# INLINE go #-}-  come (Left it) = pure it-  come (Right t) = Text <$> t-  {-# INLINE come #-}+text = G.text {-# INLINE text #-} --- We can use plated/uniplate lenses to traverse all of the elements of--- the tree in a bottom up fashion.---- | Produces a list of all 'UNode's in a XML tree. Synonym for--- 'universe'.- allNodes :: UNode t -> [UNode t]-allNodes = universe+allNodes = G.allNodes {-# INLINE allNodes #-} --- And if we build one sort-of @Traversal@ then we'll have replicated--- almost all of the functionality of @NodeClass@ in lenses. This uses--- 'Control.Lens.Fold.filtered' so the caveats there apply.---- | Traverses 'Element's which have a particular name.- named :: (Choice p, Applicative f, Eq t) => t -> Overloaded' p f (UNode t) (UNode t)-named n = filtered (isNamed n)---- | @parameterized k v@ traverses 'Element's which match the value--- @v@ at the key @k@ in their attributes.+named = G.named+{-# INLINE named #-}  parameterized :: (Choice p, Applicative f, Eq t, GenericXMLString t) =>                  t -> t -> Overloaded' p f (UNode t) (UNode t)-parameterized k v = filtered check where-  check u = case u ^? ix k . to (==v) of-    Just True -> True-    _         -> False-  {-# INLINE check #-}+parameterized = G.parameterized {-# INLINE parameterized #-}