diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,6 @@ +## 0.3 (2021/01) + +* Deprecated `el` +* Removed `./` and `entire` + + 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/Text/XML/Lens.hs b/Text/XML/Lens.hs --- a/Text/XML/Lens.hs +++ b/Text/XML/Lens.hs @@ -14,7 +14,6 @@ module Text.XML.Lens ( -- * Lenses, traversals for 'Element' Element(..) - , (./) , (...) -- ** Names , name @@ -25,6 +24,8 @@ -- ** Attributes , attributeIs , attributeSatisfies + , attributeSatisfies' + , withoutAttribute , attr , attribute , attrs @@ -32,7 +33,6 @@ , text , comment -- ** Children - , entire , nodes -- * Prisms for 'Node' , Node(..) @@ -60,42 +60,48 @@ import Control.Lens import Data.Text (Text) import Data.Map (Map) -import Control.Applicative import qualified Data.CaseInsensitive as CI - -infixr 9 ./ +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 @@ -104,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 @@ -138,27 +152,26 @@ 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 -{-# DEPRECATED entire "Use cosmos or deep instead" #-} +{-# 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 @@ -169,32 +182,35 @@ 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 (./) #-} - -{-# DEPRECATED (./) "Use (...) instead" #-} + {-# 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.2 +version: 0.3 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) 2019 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 @@ -25,5 +28,5 @@ , lens >= 4.0 && < 5 , containers >= 0.4.0 && < 0.7 , text >= 0.7 && <2 - , xml-conduit >= 1.1 && < 1.9 + , xml-conduit >= 1.1 && < 1.10 , case-insensitive