diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,11 +2,13 @@ All notable changes to this project will be documented in this file. -The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), -and this project adheres to the -[Haskell Package Versioning Policy](https://pvp.haskell.org/). +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/). ## Unreleased + +## 0.3.0.0 + +Change the signature of `remapAttributes` to use the DOM element name as well and to consider all attribute name-value pairs as a whole. This should cater to a broader range of use cases (e.g. editing HTML trees to add HTMX attributes, and the like) ## 0.2.0.0 - 2023-04-16 diff --git a/src/Text/XML/Lens/Micro.hs b/src/Text/XML/Lens/Micro.hs --- a/src/Text/XML/Lens/Micro.hs +++ b/src/Text/XML/Lens/Micro.hs @@ -15,30 +15,39 @@ -- Stability : experimental -- Portability : portable -- +-- XML (and HTML) DOM selectors for `xml-conduit` based on `microlens`. -- +-- This library provides combinators for traversing and folding over XML trees. +-- It could be useful for editing trees, adding attributes selectively (e.g. refactoring CSS, +-- adding HTMX attributes etc.) +-- +-- Some definitions are taken from 'xml-lens' but we import 'microlens' to achieve +-- a smaller dependency footprint. ----------------------------------------------------------------------------- module Text.XML.Lens.Micro ( + subtree, + remapAttributes, + -- * From 'xml-lens' root, + prologue, epilogue, named, nodes, - subtree, - -- ** node attribute combinators attrs, attributeSatisfies, attributeIs, withoutAttribute, - remapAttributes, + ) where -import Data.Maybe (isNothing) +import Data.Maybe (fromMaybe, isNothing) import Data.Monoid (First(..), Any(..)) -- case-insensitive import qualified Data.CaseInsensitive as CI -- containers -import qualified Data.Map as M (Map, singleton, fromList, foldrWithKey) +import qualified Data.Map as M (Map, insert, lookup, singleton, fromList, foldrWithKey) -- microlens import Lens.Micro.GHC (to, Getting, Lens', (^.), Traversal', ix, filtered) import Lens.Micro.Extras (preview) @@ -50,11 +59,17 @@ --- | The root element of the document. +-- | The root element of the 'Document'. root :: Lens' Document Element root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc {-# INLINE root #-} +-- | 'Prologue' of the 'Document' +prologue :: Lens' Document Prologue +prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc +{-# INLINE prologue #-} + +-- | Epilogue, i.e. the last elements, of the 'Document' epilogue :: Lens' Document [Miscellaneous] epilogue f doc = fmap (\p -> doc { documentEpilogue = p} ) $ f $ documentEpilogue doc {-# INLINE epilogue #-} @@ -76,6 +91,7 @@ attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e {-# INLINE attrs #-} +-- | Traverse over only the elements such that the value of the given attribute satisfy a predicate attributeSatisfies :: Name -- ^ attribute name -> (Text -> Bool) -- ^ predicate on the value of the attribute -> Traversal' Element Element @@ -97,14 +113,15 @@ withoutAttribute n = attributeSatisfies' n isNothing {-# INLINE withoutAttribute #-} +-- | Traverse over only the elements with a given attribute name and value attributeIs :: Name -- ^ attribute name -> Text -- ^ value of the attribute -> Traversal' Element Element -attributeIs n v = attributeSatisfies n (==v) +attributeIs n v = attributeSatisfies n (== v) {-# INLINE attributeIs #-} --- | Isolate a DOM subtree that satisfies the given predicates +-- | Extract a DOM subtree whose root element satisfies the given predicates subtree :: (Text -> Bool) -- ^ predicate on element name -> (Text -> Text -> Bool) -- ^ predicate on attribute name, value -> Getting r Element (Maybe Element) @@ -120,23 +137,24 @@ NodeElement e -> _subtree f h e _ -> Nothing - --- | Handy for editing HREF targets etc. -remapAttributes :: (Name -> Text -> Maybe (Name, Text)) -- ^ operate on element attribute (name, value) - -> Getting r Element Element +-- | Remap all attributes. Handy for editing HREF or SRC targets, adding HTMX attributes to certain elements only, etc. +-- +-- If the callback returns Nothing, the element attributes are left unchanged +remapAttributes :: + (Name -> M.Map Name Text -> Maybe (M.Map Name Text)) -- ^ element name, element attributes + -> Getting r Element Element remapAttributes f = to (_remapAttributes f) -_remapAttributes :: (Name -> Text -> Maybe (Name, Text)) - -> Element -> Element -_remapAttributes p el@(Element _ ats _) = - el{ elementAttributes = M.foldrWithKey (\k v acc -> case p k v of - Nothing -> M.singleton k v <> acc - Just (k', v') -> M.singleton k' v' <> acc - ) mempty ats, +_remapAttributes :: (Name -> M.Map Name Text -> Maybe (M.Map Name Text)) + -> Element -> Element +_remapAttributes f el@(Element n ats _) = + el{ elementAttributes = fromMaybe ats (f n ats), elementNodes = map (\nn -> case nn of - NodeElement e -> NodeElement (_remapAttributes p e) + NodeElement e -> NodeElement (_remapAttributes f e) x -> x ) $ elementNodes el } + + diff --git a/xml-conduit-microlens.cabal b/xml-conduit-microlens.cabal --- a/xml-conduit-microlens.cabal +++ b/xml-conduit-microlens.cabal @@ -1,7 +1,14 @@ name: xml-conduit-microlens -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Lenses and traversals for xml-conduit based on microlens -description: This package provides DOM selectors based on lenses, using microlens instead of lens for a smaller dependency footprint +description: XML (and HTML) DOM selectors for `xml-conduit` based on `microlens`. + . + This library provides combinators for traversing and folding over XML trees. + It could be useful for editing trees, adding attributes selectively (e.g. refactoring CSS, + adding HTMX attributes etc.) + . + Some definitions are taken from 'xml-lens' but we import 'microlens' to achieve + a smaller dependency footprint. homepage: https://github.com/ocramz/xml-conduit-microlens license: BSD3 license-file: LICENSE