xml-conduit-microlens (empty) → 0.1.0.0
raw patch · 6 files changed
+292/−0 lines, 6 filesdep +basedep +case-insensitivedep +containerssetup-changed
Dependencies added: base, case-insensitive, containers, microlens, microlens-ghc, text, xml-conduit
Files
- CHANGELOG.md +11/−0
- LICENSE +30/−0
- README.md +5/−0
- Setup.hs +2/−0
- src/Text/XML/Lens/Micro.hs +190/−0
- xml-conduit-microlens.cabal +54/−0
+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Changelog for `xml-conduit-microlens`++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/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2023++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 Author name here 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,5 @@+# xml-conduit-microlens++[](https://travis-ci.org/ocramz/xml-conduit-microlens)++TODO Description.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Text/XML/Lens/Micro.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# language ExistentialQuantification #-}+{-# language OverloadedStrings #-}+{-# language RecordWildCards #-}+{-# language Rank2Types #-}+-- {-# options_ghc -Wno-unused-imports #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.XML.Lens.Micro+-- Copyright : (c) 2015-2023 Fumiaki Kinoshita, 2023 Marco Zocca+-- License : BSD-style+--+-- Maintainer : ocramz+-- Stability : experimental+-- Portability : portable+--+--+-----------------------------------------------------------------------------+module Text.XML.Lens.Micro (+ root,+ epilogue,+ named,+ nodes,+ subtree,+ -- ** node attribute combinators+ attrs,+ attributeSatisfies,+ attributeIs,+ withoutAttribute,+ ) where+++import Data.Maybe (isNothing)+import Data.Monoid (First(..), Any(..))++-- case-insensitive+import qualified Data.CaseInsensitive as CI+-- containers+import qualified Data.Map as M (Map, foldrWithKey)+-- microlens+import Lens.Micro.GHC (to, Getting, Lens', Traversal', ix, filtered)+import Lens.Micro.Extras (preview)+-- text+import Data.Text (Text)+-- xml-conduit+import Text.XML (Document(..), Element(..), Name(..), Node(..), Miscellaneous(..))+++++-- | The root element of the document.+root :: Lens' Document Element+root f doc = fmap (\p -> doc { documentRoot = p} ) $ f $ documentRoot doc+{-# INLINE root #-}++epilogue :: Lens' Document [Miscellaneous]+epilogue f doc = fmap (\p -> doc { documentEpilogue = p} ) $ f $ documentEpilogue doc+{-# INLINE epilogue #-}++-- | Traverse elements which has the specified *local* name (case-insensitive).+named :: CI.CI Text -> Traversal' Element Element+named n f s+ | CI.mk (nameLocalName (elementName s)) == n = f s+ | otherwise = pure s+{-# INLINE named #-}++-- | All 'Node's of an 'Element'+nodes :: Lens' Element [Node]+nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e+{-# INLINE nodes #-}++-- | Node attributes+attrs :: Lens' Element (M.Map Name Text)+attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e+{-# INLINE attrs #-}++attributeSatisfies :: Name -- ^ attribute name+ -> (Text -> Bool) -- ^ predicate on the value of the attribute+ -> Traversal' Element Element+attributeSatisfies n p = attributeSatisfies' n (maybe False p)+{-# INLINE attributeSatisfies #-}++attributeSatisfies' :: Name -> (Maybe Text -> Bool) -> Traversal' Element Element+attributeSatisfies' n p = filtered (p . preview (attrs . ix n))+{-# INLINE attributeSatisfies' #-}++-- nodesSatisfy :: ([Node] -> Bool) -> Traversal' Element Element+-- nodesSatisfy p = nodesSatisfy' (maybe False p)++-- nodesSatisfy' :: (Maybe [Node] -> Bool) -> Traversal' Element Element+-- nodesSatisfy' p = filtered (p . preview (nodes))+++withoutAttribute :: Name -> Traversal' Element Element+withoutAttribute n = attributeSatisfies' n isNothing+{-# INLINE withoutAttribute #-}++attributeIs :: Name -- ^ attribute name+ -> Text -- ^ value of the attribute+ -> Traversal' Element Element+attributeIs n v = attributeSatisfies n (==v)+{-# INLINE attributeIs #-}+++-- | Isolate a DOM subtree that satisfies the given predicates+subtree :: (Text -> Bool) -- ^ predicate on element name+ -> (Text -> Text -> Bool) -- ^ predicate on attribute name, value+ -> Getting r Element (Maybe Element)+subtree f h = to (_subtree f h)++_subtree :: (Text -> Bool)+ -> (Text -> Text -> Bool) -> Element -> Maybe Element+_subtree f h el@(Element n ats nds) = case f (nameLocalName n) && (getAny $ M.foldrWithKey (\k v acc -> Any (h (nameLocalName k) v) <> acc) mempty ats) of+ True -> Just el+ False -> getFirst $ foldMap (First . g) nds+ where+ g = \case+ NodeElement e -> _subtree f h e+ _ -> Nothing+++++++-- t0 :: TL.Text+-- t0 = "<!DOCTYPE html><html><head><title>Page Title</title></head><body><h1>My First Heading</h1><p>My first paragraph.</p><div id=\'z42\'></div></body></html>"+-- t0e :: Either SomeException Document+-- t0e = parseText def t0++-- dok :: Document+-- dok = Document {documentPrologue = Prologue {prologueBefore = [], prologueDoctype = Just (Doctype {doctypeName = "html", doctypeID = Nothing}), prologueAfter = []}, documentRoot = Element {elementName = Name {nameLocalName = "html", nameNamespace = Nothing, namePrefix = Nothing}, elementAttributes = M.fromList [], elementNodes = [NodeElement (Element {elementName = Name {nameLocalName = "head", nameNamespace = Nothing, namePrefix = Nothing}, elementAttributes = M.fromList [], elementNodes = [NodeElement (Element {elementName = Name {nameLocalName = "title", nameNamespace = Nothing, namePrefix = Nothing}, elementAttributes = M.fromList [], elementNodes = [NodeContent "Page Title"]})]}),NodeElement (Element {elementName = Name {nameLocalName = "body", nameNamespace = Nothing, namePrefix = Nothing}, elementAttributes = M.fromList [], elementNodes = [NodeElement (Element {elementName = Name {nameLocalName = "h1", nameNamespace = Nothing, namePrefix = Nothing}, elementAttributes = M.fromList [], elementNodes = [NodeContent "My First Heading"]}),NodeElement (Element {elementName = Name {nameLocalName = "p", nameNamespace = Nothing, namePrefix = Nothing}, elementAttributes = M.fromList [], elementNodes = [NodeContent "My first paragraph."]}),NodeElement (Element {elementName = Name {nameLocalName = "div", nameNamespace = Nothing, namePrefix = Nothing}, elementAttributes = M.fromList [(Name {nameLocalName = "id", nameNamespace = Nothing, namePrefix = Nothing},"z42")], elementNodes = []})]})]}, documentEpilogue = []}+++++++++++++-- nodeElement :: (Element -> Maybe Element) -> Node -> Maybe Node+-- nodeElement f = \case+-- NodeElement e -> NodeElement <$> f e+-- _ -> Nothing++-- nodeContent :: (Text -> Maybe Text) -> Node -> Maybe Node+-- nodeContent f = \case+-- NodeContent c -> NodeContent <$> f c+-- _ -> Nothing++-- -- from https://blog.jle.im/entry/lenses-products-prisms-sums.html#through-the-looking-prism+-- data Prism' s a = forall q. Prism'+-- { match :: s -> Either a q+-- , inject :: Either a q -> s+-- }++-- -- | Focus on node elements+-- _Element :: Prism' Node Element+-- _Element = Prism' {+-- match = \case+-- NodeElement e -> Left e+-- i -> Right i+-- , inject = \case+-- Left e -> NodeElement e+-- Right i -> i+-- }++-- -- | Focus on the text content of nodes+-- _Content :: Prism' Node Text+-- _Content = Prism' {+-- match = \case+-- NodeContent c -> Left c+-- i -> Right i+-- , inject = \case+-- Left c -> NodeContent c+-- Right i -> i+-- }+++-- -- | 'preview' for 'Prism''+-- previewP :: Prism' s a -> (s -> Maybe a)+-- previewP Prism'{..} x = case match x of+-- Left y -> Just y+-- Right _ -> Nothing+
+ xml-conduit-microlens.cabal view
@@ -0,0 +1,54 @@+name: xml-conduit-microlens+version: 0.1.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+homepage: https://github.com/ocramz/xml-conduit-microlens+license: BSD3+license-file: LICENSE+author: Marco Zocca+maintainer: ocramz+copyright: (c) 2015-2023 Fumiaki Kinoshita, 2023 Marco Zocca+category: Web XML+build-type: Simple+extra-source-files: README.md+ CHANGELOG.md+cabal-version: >=1.10+tested-with: GHC == 9.2.7++library+ default-language: Haskell2010+ hs-source-dirs: src+ exposed-modules: Text.XML.Lens.Micro+ build-depends: base >= 4.7 && < 5+ , case-insensitive+ , containers+ , microlens+ , microlens-ghc+ , text+ , xml-conduit+ ghc-options: -Wall+ -Wcompat++-- test-suite spec+-- default-language: Haskell2010+-- type: exitcode-stdio-1.0+-- hs-source-dirs: test+-- main-is: Spec.hs+-- other-modules: LibSpec+-- build-depends: base+-- , xml-conduit-microlens+-- , hspec+-- , QuickCheck+-- ghc-options: -Wall+-- -Wcompat+-- -Widentities+-- -Wincomplete-record-updates+-- -Wincomplete-uni-patterns+-- -Wmissing-export-lists+-- -Wmissing-home-modules+-- -Wpartial-fields+-- -Wredundant-constraints++source-repository head+ type: git+ location: https://github.com/ocramz/xml-conduit-microlens