diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,10 @@ +## 0.3.1 + +* Supported GHC 9 + +## 0.3 (2021/01) + +* Deprecated `el` +* Removed `./` and `entire` + + diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,30 @@ -Copyright (c) 2013, Fumiaki Kinoshita - -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. +Copyright (c) 2013, Fumiaki Kinoshita + +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,50 @@ +xml-lens +======== + +Lenses and traversals for [xml-conduit](http://hackage.haskell.org/package/xml-conduit). + +Example +======== + +```haskell +> doc <- Text.XML.readFile def "examples/books.xml" + +> doc ^.. root . named "books" ... named "book" . attributeIs "category" "Textbooks" ... named "title" . text +["Learn You a Haskell for Great Good!","Programming in Haskell","Real World Haskell"] + +> lengthOf ?? doc $ root . named "books" ... named "book" +7 + +> doc ^? root . named "books" ... attributeIs "category" "Joke" ... named "title" . text +Just "Functional Ikamusume" + +> doc & root . named "books" ... named "book" ... named "pages" . text <>~ " pages" & renderLBS def & BL.putStrLn +``` + +```xml + + + + Haskell 98 language and libraries: the Revised Report + Simon Peyton Jones + 272 pages + £45.00 + + + Learn You a Haskell for Great Good! + Miran Lipovaca + 360 pages + + + Programming in Haskell + Graham Hutton + 200 pages + +… +``` + +Tips +---- + +* Use [cosmos](http://hackage.haskell.org/package/lens-4.19.2/docs/Control-Lens-Plated.html) to traverse over all children +* You can do or-composition of traversals with [failing](http://hackage.haskell.org/package/lens-4.19.2/docs/Control-Lens-Traversal.html#v:failing) diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/Text/XML/Lens.hs b/Text/XML/Lens.hs --- a/Text/XML/Lens.hs +++ b/Text/XML/Lens.hs @@ -14,7 +14,7 @@ module Text.XML.Lens ( -- * Lenses, traversals for 'Element' Element(..) - , (./) + , (...) -- ** Names , name , localName @@ -24,6 +24,8 @@ -- ** Attributes , attributeIs , attributeSatisfies + , attributeSatisfies' + , withoutAttribute , attr , attribute , attrs @@ -31,7 +33,6 @@ , text , comment -- ** Children - , entire , nodes -- * Prisms for 'Node' , Node(..) @@ -54,49 +55,53 @@ , Instruction(..) , _instructionTarget , _instructionData - -- * Reexport - , module Control.Lens ) where import Text.XML import Control.Lens import Data.Text (Text) import Data.Map (Map) -import Control.Applicative -import Data.CaseInsensitive as CI - -infixr 9 ./ +import qualified Data.CaseInsensitive as CI +import Data.Maybe (isNothing) prologue :: Lens' Document Prologue prologue f doc = fmap (\p -> doc { documentPrologue = p} ) $ f $ documentPrologue doc +{-# INLINE prologue #-} -- | 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 #-} doctype :: Lens' Prologue (Maybe Doctype) doctype f doc = fmap (\p -> doc { prologueDoctype = p} ) $ f $ prologueDoctype doc +{-# INLINE doctype #-} class AsInstruction t where _Instruction :: Prism' t Instruction _instructionTarget :: Lens' Instruction Text _instructionTarget f (Instruction t d) = f t <&> \t' -> Instruction t' d +{-# INLINE _instructionTarget #-} _instructionData :: Lens' Instruction Text _instructionData f (Instruction t d) = f d <&> \d' -> Instruction t d' +{-# INLINE _instructionData #-} instance AsInstruction Node where _Instruction = prism' NodeInstruction $ \s -> case s of NodeInstruction e -> Just e _ -> Nothing + {-# INLINE _Instruction #-} instance AsInstruction Miscellaneous where _Instruction = prism' MiscInstruction $ \s -> case s of MiscInstruction e -> Just e _ -> Nothing + {-# INLINE _Instruction #-} class AsComment t where _Comment :: Prism' t Text @@ -105,33 +110,41 @@ _Comment = prism' NodeComment $ \s -> case s of NodeComment e -> Just e _ -> Nothing + {-# INLINE _Comment #-} instance AsComment Miscellaneous where _Comment = prism' MiscComment $ \s -> case s of MiscComment e -> Just e _ -> Nothing + {-# INLINE _Comment #-} _nameLocalName :: Lens' Name Text _nameLocalName f n = f (nameLocalName n) <&> \x -> n { nameLocalName = x } +{-# INLINE _nameLocalName #-} _nameNamespace :: Lens' Name (Maybe Text) _nameNamespace f n = f (nameNamespace n) <&> \x -> n { nameNamespace = x } +{-# INLINE _nameNamespace #-} _namePrefix :: Lens' Name (Maybe Text) _namePrefix f n = f (namePrefix n) <&> \x -> n { namePrefix = x } +{-# INLINE _namePrefix #-} _Element :: Prism' Node Element _Element = prism' NodeElement $ \s -> case s of NodeElement e -> Just e _ -> Nothing +{-# INLINE _Element #-} _Content :: Prism' Node Text _Content = prism' NodeContent $ \s -> case s of NodeContent e -> Just e _ -> Nothing +{-# INLINE _Content #-} name :: Lens' Element Name name f e = f (elementName e) <&> \x -> e { elementName = x } +{-# INLINE name #-} localName :: Lens' Element Text localName = name . _nameLocalName @@ -139,60 +152,65 @@ attrs :: Lens' Element (Map Name Text) attrs f e = fmap (\x -> e { elementAttributes = x }) $ f $ elementAttributes e +{-# INLINE attrs #-} nodes :: Lens' Element [Node] nodes f e = fmap (\x -> e { elementNodes = x }) $ f $ elementNodes e +{-# INLINE nodes #-} attr :: Name -> Traversal' Element Text attr n = attrs . ix n +{-# INLINE attr #-} attribute :: Name -> Lens' Element (Maybe Text) attribute n = attrs . at n - --- | Traverse itself with its all children.　Rewriting subnodes of each children will break a traversal law. -entire :: Traversal' Element Element -entire f e@(Element _ _ ns) = com <$> f e <*> traverse (_Element (entire f)) ns where - com (Element n a _) = Element n a +{-# INLINE attribute #-} -- | 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 #-} -- | Old name for 'named' ell :: Text -> Traversal' Element Element -ell = named . CI.mk +ell n = named $ CI.mk n -- | Traverse elements which has the specified name. el :: Name -> Traversal' Element Element el n f s | elementName s == n = f s | otherwise = pure s +{-# DEPRECATED el "Use named instead" #-} attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element -attributeSatisfies n p = filtered (maybe False p . preview (attrs . ix n)) +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' #-} + +withoutAttribute :: Name -> Traversal' Element Element +withoutAttribute n = attributeSatisfies' n isNothing +{-# INLINE withoutAttribute #-} + attributeIs :: Name -> Text -> Traversal' Element Element attributeIs n v = attributeSatisfies n (==v) +{-# INLINE attributeIs #-} -- | Traverse all contents of the element. text :: Traversal' Element Text text = nodes . traverse . _Content +{-# INLINE text #-} -- | Traverse all comments of the element. comment :: Traversal' Element Text comment = nodes . traverse . _Comment +{-# INLINE comment #-} -- | 'plate' traverses over its sub-elements. instance Plated Element where plate = nodes . traverse . _Element - --- | Combine two 'Traversal's just like XPath's slash. Identical to ('...'). --- --- @ --- l ./ m ≡ l . 'plate' . m --- @ -(./) :: (Applicative f, Plated c) => LensLike f s t c c -> Over p f c c a b -> Over p f s t a b -(./) = (...) -{-# INLINE (./) #-} + {-# INLINE plate #-} diff --git a/xml-lens.cabal b/xml-lens.cabal --- a/xml-lens.cabal +++ b/xml-lens.cabal @@ -1,17 +1,20 @@ +cabal-version: 2.4 name: xml-lens -version: 0.1.6.3 +version: 0.3.1 synopsis: Lenses, traversals, and prisms for xml-conduit -description: Lens-based DOM selector +description: This package provides DOM selectors based on lenses and prisms. See README.md for examples homepage: https://github.com/fumieval/xml-lens bug-reports: https://github.com/fumieval/xml-lens/issues -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Fumiaki Kinoshita maintainer: Fumiaki Kinoshita -copyright: Copyright (C) 2015 Fumiaki Kinoshita +copyright: Copyright (C) 2021 Fumiaki Kinoshita category: XML build-type: Simple -cabal-version: >=1.10 +extra-source-files: + README.md + CHANGELOG.md source-repository head type: git @@ -21,4 +24,9 @@ default-language: Haskell2010 ghc-options: -Wall exposed-modules: Text.XML.Lens - build-depends: base ==4.*, lens >= 4.0 && < 5, containers >= 0.4.0 && < 0.7, text >= 0.7 && <2, xml-conduit >= 1.1 && < 1.4, case-insensitive + build-depends: base ==4.* + , lens >= 4.0 && < 5.2 + , containers >= 0.4.0 && < 0.7 + , text >= 0.7 && <2 + , xml-conduit >= 1.1 && < 1.10 + , case-insensitive