tagsoup-navigate 0.1.0.0 → 0.1.0.1

raw patch · 7 files changed

+225/−56 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• changelog.md +6/−0
• src/Text/HTML/TagSoup/Navigate/Types/Attribute.hs +9/−1
• src/Text/HTML/TagSoup/Navigate/Types/Tag.hs +77/−2
• src/Text/HTML/TagSoup/Navigate/Types/TagTree.hs +43/−21
• src/Text/HTML/TagSoup/Navigate/Types/TagTreePos.hs +8/−0
• src/Text/HTML/TagSoup/Navigate/Types/TagTreePosState.hs +81/−31
• tagsoup-navigate.cabal +1/−1

@@ -1,3 +1,9 @@+0.1.0.1++* more functions.+* more instances.+* fix bug in `Tag` prisms.+ 0.1.0.0  * The initial version of tagsoup-navigate.

@@ -16,7 +16,7 @@  import Control.Applicative(Applicative((<*>), pure), liftA2) import Control.Category((.), id)-import Control.Lens(Each(each), Reversing(reversing), Rewrapped, Wrapped(Unwrapped), _Wrapped', _Wrapped, Field1(_1), Field2(_2), Prism', Lens', Traversal, Iso, iso)+import Control.Lens(Each(each), Reversing(reversing), Rewrapped, Wrapped(Unwrapped), _Wrapped', _Wrapped, Field1(_1), Field2(_2), Prism', Lens', Traversal, Iso, iso, from) import Control.Monad(Monad((>>=), return)) import Control.Monad.Zip(MonadZip(mzipWith)) import Data.Bool((&&))@@ -144,6 +144,10 @@ instance AsAttribute (Attribute str) str where   _Attribute = id +instance AsAttribute (str, str) str where+  _Attribute =+    from tagsoupAttribute . _Attribute+ class HasAttribute s str | s -> str where   attribute ::     Lens' s (Attribute str)@@ -163,6 +167,10 @@     fmap (\s1' -> Attribute s1' s2) (f s1)   attributeValue f (Attribute s1 s2) =     fmap (\s2' -> Attribute s1 s2') (f s2)++instance HasAttribute (str, str) str where+  attribute =+    from tagsoupAttribute . attribute  bothAttributes ::   Traversal (Attribute str) (Attribute str') str str'

@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} @@ -20,9 +20,10 @@  import Control.Applicative((<*>), pure) import Control.Category(id, (.))-import Control.Lens(Lens', Prism', Traversal', Each(each), Iso, iso, _1, _2, (^.), ( # ))+import Control.Lens(Lens', Prism', Traversal', Each(each), Iso, iso, prism', view, from, _1, _2, (^.), ( # )) import Data.Eq(Eq) import Data.Eq.Deriving(deriveEq1)+import Data.Maybe(Maybe(Nothing, Just)) import Data.Ord(Ord) import Data.Ord.Deriving(deriveOrd1) import Data.Foldable(Foldable(foldMap))@@ -32,6 +33,7 @@ import Prelude(Show) import Text.HTML.TagSoup.Navigate.Types.Attribute(Attribute, Row, Column, attributeName, attributeValue, tagsoupAttribute) import qualified Text.HTML.TagSoup as TagSoup(Tag(TagOpen, TagClose, TagText, TagComment, TagWarning, TagPosition))+import qualified Text.HTML.TagSoup.Tree as TagSoup(TagTree(TagBranch, TagLeaf)) import Text.Show.Deriving(deriveShow1)  data Tag str@@ -111,6 +113,10 @@   tag =     id +instance HasTag (TagSoup.Tag str) str where+  tag =+    from tagsoupTag . tag+ class AsTag a str | a -> str where   _Tag ::     Prism' a (Tag str)@@ -142,6 +148,75 @@ instance AsTag (Tag str) str where   _Tag =     id+  _TagOpen =+    prism'+      (\(s, as) -> TagOpen s as)+      (\case+        TagOpen s as ->+          Just (s, as)+        _ ->+          Nothing+      )+  _TagClose =+    prism'+      TagClose+      (\case+        TagClose s ->+          Just s+        _ ->+          Nothing+      )+  _TagText =+    prism'+      TagText+      (\case+        TagText s ->+          Just s+        _ ->+          Nothing+      )+  _TagComment =+    prism'+      TagComment+      (\case+        TagComment s ->+          Just s+        _ ->+          Nothing+      )+  _TagWarning =+    prism'+      TagWarning+      (\case+        TagWarning s ->+          Just s+        _ ->+          Nothing+      )+  _TagPosition =+    prism'+      (\(r, c) -> TagPosition r c)+      (\case+        TagPosition r c ->+          Just (r, c)+        _ ->+          Nothing+      )++instance AsTag (TagSoup.Tag str) str where+  _Tag =+    from tagsoupTag . _Tag++instance AsTag (TagSoup.TagTree str) str where+  _Tag =+    prism'+      (\t -> TagSoup.TagLeaf (view tagsoupTag t))+      (\case+        TagSoup.TagLeaf x ->+          Just (view (from tagsoupTag) x)+        TagSoup.TagBranch _ _ _ ->+          Nothing+      )  tagOpen ::   AsTag a str =>

@@ -10,18 +10,20 @@ , HasTagTree(..) , AsTagTree(..) , tagsoupTagTree-, tagTreeBranchNames-, tagTreeChildren-, tagTreeAttributes-, tagTreeAttributeNames-, tagTreeAttributeValues+, _TagBranch_+, _TagBranchAttributeList_+, _TagBranchAttributes_+, _TagBranchChildrenList_+, _TagBranchChildren_+, _TagBranchAttributeNames_+, _TagBranchAttributeValues_ , tagTree' , flattenTree ) where  import Control.Applicative((<*>)) import Control.Category((.), id)-import Control.Lens(Plated(plate), Each(each), Lens', Prism', Iso, Traversal', prism', iso, (^.), ( # ), _1, _2, _3)+import Control.Lens(Plated(plate), Each(each), Lens', Prism', Iso, Traversal', prism', iso, from, (^.), ( # ), _1, _2, _3) import Data.Eq(Eq) import Data.Eq.Deriving(deriveEq1) import Data.Foldable(Foldable(foldMap))@@ -65,7 +67,7 @@  instance Plated (TagTree str) where   plate =-    tagTreeChildren+    _TagBranchChildren_  instance Each (TagTree str) (TagTree str') str str' where   each =@@ -79,6 +81,10 @@   tagTree =     id +instance HasTagTree (TagSoup.TagTree str) str where+  tagTree =+    from tagsoupTagTree . tagTree+ class AsTagTree a str | a -> str where   _TagTree ::     Prism' a (TagTree str)@@ -111,6 +117,10 @@                 TagLeaf x ->                   Just x) +instance AsTagTree (TagSoup.TagTree str) str where+  _TagTree =+    from tagsoupTagTree . _TagTree+ instance AsTag (TagTree str) str where   _Tag =     _TagLeaf . _Tag@@ -132,35 +142,47 @@         TagSoup.TagLeaf x ->           TagLeaf (tagsoupTag # x)) -tagTreeBranchNames ::+_TagBranch_ ::   AsTagTree a str =>   Traversal' a str-tagTreeBranchNames =+_TagBranch_ =   _TagBranch . _1 -tagTreeAttributes ::+_TagBranchAttributeList_ ::   AsTagTree a str =>+  Traversal' a [Attribute str]+_TagBranchAttributeList_ =+  _TagBranch . _2++_TagBranchAttributes_ ::+  AsTagTree a str =>   Traversal' a (Attribute str)-tagTreeAttributes =-  _TagBranch . _2 . traverse+_TagBranchAttributes_ =+  _TagBranchAttributeList_ . traverse -tagTreeChildren ::+_TagBranchChildrenList_ ::   AsTagTree a str =>+  Traversal' a [TagTree str]+_TagBranchChildrenList_ =+  _TagBranch . _3++_TagBranchChildren_ ::+  AsTagTree a str =>   Traversal' a (TagTree str)-tagTreeChildren =-  _TagBranch . _3 . traverse+_TagBranchChildren_ =+  _TagBranchChildrenList_ . traverse -tagTreeAttributeNames ::+_TagBranchAttributeNames_ ::   AsTagTree a str =>   Traversal' a str-tagTreeAttributeNames =-  tagTreeAttributes . attributeName+_TagBranchAttributeNames_ =+  _TagBranchAttributes_ . attributeName -tagTreeAttributeValues ::+_TagBranchAttributeValues_ ::   AsTagTree a str =>   Traversal' a str-tagTreeAttributeValues =-  tagTreeAttributes . attributeValue+_TagBranchAttributeValues_ =+  _TagBranchAttributes_ . attributeValue  deriveEq1 ''TagTree deriveOrd1 ''TagTree

@@ -123,6 +123,14 @@             (fmap (\(l', x', a', r') -> TagTreePosParent (fmap (view tagsoupTagTree') l') x' (fmap (view tagsoupAttribute') a') (fmap (view tagsoupTagTree') r')) p)     ) +instance AsTagTreePos (TagSoup.TagTreePos str) str where+  _TagTreePos =+    from tagsoupTagTreePos . _TagTreePos++instance HasTagTreePos (TagSoup.TagTreePos str) str where+  tagTreePos =+    from tagsoupTagTreePos . tagTreePos+ fromTagTree ::   TagTree str   -> TagTreePos str

@@ -23,7 +23,6 @@ , maybeTagTreePosState , putTagTreePosStateT , putTagTreePosState-, getTagTreePosT , getTagTreePos , root , parent@@ -37,27 +36,34 @@ , parents , liftTagTreePosState , putTagTree+, opticContent+, findContentUntil+, findUntil+, tagBranchLeafText ) where  import Control.Applicative(Applicative((<*>), pure), Alternative((<|>), empty), liftA2) import Control.Category((.))-import Control.Lens(Rewrapped, Wrapped, Unwrapped, _Wrapped', _Wrapped, iso, view, over, from, _1, _2)+import Control.Lens(Rewrapped, Wrapped, Unwrapped, _Wrapped', _Wrapped, iso, view, preview, over, from, _head, _1, _2, _3) import Control.Monad(Monad(return, (>>=)))-import Control.Monad.Morph-import Control.Monad.Reader.Class-import Control.Monad.State.Class+import Control.Monad.Morph(MFunctor(hoist))+import Control.Monad.Reader.Class(MonadReader(ask, local, reader))+import Control.Monad.State.Class(MonadState(state, get, put), gets, modify) import Control.Monad.Trans.Class(MonadTrans(lift)) import Control.Monad.IO.Class(MonadIO(liftIO))+import Data.Bool(Bool, bool) import Data.Functor(Functor(fmap)) import Data.Functor.Apply(Apply((<.>))) import Data.Functor.Alt(Alt((<!>))) import Data.Functor.Bind(Bind((>>-)))+import Data.Functor.Const(Const) import Data.Functor.Identity(Identity(Identity, runIdentity)) import Data.Maybe(Maybe(Nothing, Just)) import Data.Semigroup(Semigroup((<>)))-import Data.Monoid(Monoid(mempty, mappend))-import Text.HTML.TagSoup.Navigate.Types.TagTree(TagTree)-import Text.HTML.TagSoup.Navigate.Types.TagTreePos(TagTreePos, tagsoupTagTreePos, tagTreePosContent, tagTreePosBefore, tagTreePosAfter, tagTreePosParents, fromTagTree, toTagTree)+import Data.Monoid(Monoid(mempty, mappend), First)+import Text.HTML.TagSoup.Navigate.Types.Tag(_TagText)+import Text.HTML.TagSoup.Navigate.Types.TagTree(TagTree, _TagLeaf, _TagBranch, _TagBranch_)+import Text.HTML.TagSoup.Navigate.Types.TagTreePos(TagTreePos, tagsoupTagTreePos, tagTreePosContent, tagTreePosBefore, tagTreePosAfter, tagTreePosParents, fromTagTree) import Text.HTML.TagSoup.Navigate.Types.TagTreePosParent(TagTreePosParent) import qualified Text.HTML.TagSoup.Tree.Zipper as TagSoup(prevSibling, nextSibling, parent, firstChild, lastChild, root) @@ -225,8 +231,9 @@   TagTreePosStateT (fmap (fmap (\q -> (q, ()))) . k)  modifyTagTreePosState ::+  Applicative f =>   (TagTreePos x -> Maybe (TagTreePos x))-  -> TagTreePosState x ()+  -> TagTreePosStateT x f () modifyTagTreePosState k =   modifyTagTreePosStateT (pure . k) @@ -238,8 +245,9 @@   TagTreePosStateT (\p -> fmap (fmap (\a -> (p, a))) (k p))  getsTagTreePosState ::+  Applicative f =>   (TagTreePos x -> Maybe a)-  -> TagTreePosState x a+  -> TagTreePosStateT x f a getsTagTreePosState k =   getsTagTreePosStateT (pure . k) @@ -251,8 +259,9 @@   getsTagTreePosStateT . pure  maybeTagTreePosState ::+  Applicative f =>   Maybe a-  -> TagTreePosState x a+  -> TagTreePosStateT x f a maybeTagTreePosState =   getsTagTreePosState . pure @@ -264,69 +273,75 @@   TagTreePosStateT (pure (fmap (fmap (\p -> (p, ()))) x))  putTagTreePosState ::+  Applicative f =>   Maybe (TagTreePos x)-  -> TagTreePosState x ()+  -> TagTreePosStateT x f () putTagTreePosState =-  putTagTreePosStateT . Identity+  putTagTreePosStateT . pure -getTagTreePosT ::+getTagTreePos ::   Applicative f =>   TagTreePosStateT x f (TagTree x)-getTagTreePosT =-  liftTagTreePosState getTagTreePos--getTagTreePos ::-  TagTreePosState x (TagTree x) getTagTreePos =-  reader toTagTree+  liftTagTreePosState getTagTreePos  root ::-  TagTreePosState str ()+  Monad f =>+  TagTreePosStateT str f () root =   modify (view (from tagsoupTagTreePos) . TagSoup.root . view tagsoupTagTreePos)    parent ::-  TagTreePosState str ()+  Monad f =>+  TagTreePosStateT str f () parent =   modifyTagTreePosState (fmap (view (from tagsoupTagTreePos)) . TagSoup.parent . view tagsoupTagTreePos)    firstChild ::-  TagTreePosState str ()+  Monad f =>+  TagTreePosStateT str f () firstChild =   modifyTagTreePosState (fmap (view (from tagsoupTagTreePos)) . TagSoup.firstChild . view tagsoupTagTreePos)    lastChild ::-  TagTreePosState str ()+  Monad f =>+  TagTreePosStateT str f () lastChild =   modifyTagTreePosState (fmap (view (from tagsoupTagTreePos)) . TagSoup.lastChild . view tagsoupTagTreePos)    prevSibling ::-  TagTreePosState str ()+  Monad f =>+  TagTreePosStateT str f () prevSibling =   modifyTagTreePosState (fmap (view (from tagsoupTagTreePos)) . TagSoup.prevSibling . view tagsoupTagTreePos)    nextSibling ::-  TagTreePosState str ()+  Monad f =>+  TagTreePosStateT str f () nextSibling =   modifyTagTreePosState (fmap (view (from tagsoupTagTreePos)) . TagSoup.nextSibling . view tagsoupTagTreePos)    content ::-  TagTreePosState x (TagTree x)+  Monad f =>+  TagTreePosStateT x f (TagTree x) content =   gets (view tagTreePosContent)  before ::-  TagTreePosState x [TagTree x]+  Monad f =>+  TagTreePosStateT x f [TagTree x] before =   gets (view tagTreePosBefore)  after ::-  TagTreePosState x [TagTree x]+  Monad f =>+  TagTreePosStateT x f [TagTree x] after =   gets (view tagTreePosAfter)  parents ::-  TagTreePosState x [TagTreePosParent x]+  Monad f =>+  TagTreePosStateT x f [TagTreePosParent x] parents =   gets (view tagTreePosParents) @@ -338,7 +353,42 @@   TagTreePosStateT (pure . runIdentity . x)  putTagTree ::+  Monad f =>   TagTree str-  -> TagTreePosState str ()+  -> TagTreePosStateT str f () putTagTree =   put . fromTagTree++opticContent ::+  ((a -> Const (First a) a) -> TagTree str -> Const (First a) (TagTree str))+  -> TagTreePosState str a+opticContent k =+  getsTagTreePosState+    (preview (tagTreePosContent . k))++findContentUntil ::+  Monad f =>+  TagTreePosStateT str f a+  -> (TagTree str -> Bool)+  -> TagTreePosStateT str f ()+findContentUntil oper pr =+  findUntil oper (reader (pr . view tagTreePosContent) >>= bool empty (pure ()))++findUntil ::+  Monad f =>+  TagTreePosStateT str f a+  -> TagTreePosStateT str f b+  -> TagTreePosStateT str f b+findUntil oper pr =+  do  _ <- oper+      pr <|> findUntil oper pr++-- |+--+-- produces `(x, t)` in `TagBranch x _ [TagLeaf (TagText t)]`+tagBranchLeafText ::+  TagTreePosState a (a, a)+tagBranchLeafText =+  do  x <- opticContent _TagBranch_+      t <- opticContent (_TagBranch . _3 . _head . _TagLeaf . _TagText)+      pure (x, t)

@@ -1,5 +1,5 @@ name:                 tagsoup-navigate-version:              0.1.0.0+version:              0.1.0.1 synopsis:             Tagsoup Navigate description:          Lenses and data types for navigating tagsoup license:              BSD3