module Text.XML.DOM.Parser.Combinators
  ( -- * Generic combinators to traverse descendants
    traverseElems
  , inFilteredTrav
    -- * Using 'Buildable'
  , inElemTrav
  , inElem
  , inElemAll
  , inElemMay
  , inElemNe
    -- * Dive combinators
  , divePath
  , diveElem
    -- * Explicit ignoring elements
  , ignoreElem
  , ignoreEmpty
  , ignoreBlank
  ) where

import Control.Lens
import Control.Monad.Reader
import Data.Foldable as F
import Data.List as L
import Data.List.NonEmpty (NonEmpty(..))
import Data.Monoid
import Data.Text as T
import Data.Traversable
import Text.XML
import Text.XML.DOM.Parser.Buildable
import Text.XML.DOM.Parser.Types
import Text.XML.Lens


-- | Generic function to traverse arbitrary inner elements.
traverseElems
  :: (Monad m, Foldable g, Traversable f)
  => ([Element] -> DomParserT g m (f (DomPath, Element)))
     -- ^ Takes list of current elements and returns container with
     -- pairs of subpath (relatively to current elements) and element
     -- to run parser in
  -> DomParserT Identity m a
     -- ^ Parser to run for each element found in traversable 'f'
  -> DomParserT g m (f a)
traverseElems :: forall (m :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Monad m, Foldable g, Traversable f) =>
([Element] -> DomParserT g m (f (DomPath, Element)))
-> DomParserT Identity m a -> DomParserT g m (f a)
traverseElems [Element] -> DomParserT g m (f (DomPath, Element))
trav DomParserT Identity m a
parser = do
  ParserData g
pd <- ReaderT (ParserData g) (ExceptT ParserErrors m) (ParserData g)
forall r (m :: * -> *). MonadReader r m => m r
ask
  f (DomPath, Element)
inner <- [Element] -> DomParserT g m (f (DomPath, Element))
trav ([Element] -> DomParserT g m (f (DomPath, Element)))
-> [Element] -> DomParserT g m (f (DomPath, Element))
forall a b. (a -> b) -> a -> b
$ ParserData g
pd ParserData g
-> Getting (Endo [Element]) (ParserData g) Element -> [Element]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (g Element -> Const (Endo [Element]) (g Element))
-> ParserData g -> Const (Endo [Element]) (ParserData g)
forall (f1 :: * -> *) (f2 :: * -> *) (f3 :: * -> *).
Functor f3 =>
(f1 Element -> f3 (f2 Element))
-> ParserData f1 -> f3 (ParserData f2)
pdElements ((g Element -> Const (Endo [Element]) (g Element))
 -> ParserData g -> Const (Endo [Element]) (ParserData g))
-> ((Element -> Const (Endo [Element]) Element)
    -> g Element -> Const (Endo [Element]) (g Element))
-> Getting (Endo [Element]) (ParserData g) Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Const (Endo [Element]) Element)
-> g Element -> Const (Endo [Element]) (g Element)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (g Element) Element
folded
  f (DomPath, Element)
-> ((DomPath, Element)
    -> ReaderT (ParserData g) (ExceptT ParserErrors m) a)
-> DomParserT g m (f a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for f (DomPath, Element)
inner (((DomPath, Element)
  -> ReaderT (ParserData g) (ExceptT ParserErrors m) a)
 -> DomParserT g m (f a))
-> ((DomPath, Element)
    -> ReaderT (ParserData g) (ExceptT ParserErrors m) a)
-> DomParserT g m (f a)
forall a b. (a -> b) -> a -> b
$ \(DomPath
subpath, Element
e) -> do
    let
      newpd :: ParserData Identity
newpd = ParserData
        { _pdElements :: Identity Element
_pdElements = Element -> Identity Element
forall a. a -> Identity a
Identity Element
e
        , _pdPath :: DomPath
_pdPath     = ParserData g
pd ParserData g -> Getting DomPath (ParserData g) DomPath -> DomPath
forall s a. s -> Getting a s a -> a
^. Getting DomPath (ParserData g) DomPath
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(DomPath -> f2 DomPath) -> ParserData f1 -> f2 (ParserData f1)
pdPath DomPath -> DomPath -> DomPath
forall a. Semigroup a => a -> a -> a
<> DomPath
subpath }
    ExceptT ParserErrors m a
-> ReaderT (ParserData g) (ExceptT ParserErrors m) a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (ParserData g) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT ParserErrors m a
 -> ReaderT (ParserData g) (ExceptT ParserErrors m) a)
-> ExceptT ParserErrors m a
-> ReaderT (ParserData g) (ExceptT ParserErrors m) a
forall a b. (a -> b) -> a -> b
$ DomParserT Identity m a
-> ParserData Identity -> ExceptT ParserErrors m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT DomParserT Identity m a
parser ParserData Identity
newpd

-- | Traverses elements located in same path using filtering function
inFilteredTrav
  :: (Monad m, Foldable g, Buildable f)
  => ([Element] -> (DomPath, [Element]))
  -- ^ Takes list of current elements and returns some descendants
  -- subset and path this descendants located at. Path is should be
  -- same for all descendants and required for error message
  -> DomParserT Identity m a
  -> DomParserT g m (f a)
inFilteredTrav :: forall (m :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Monad m, Foldable g, Buildable f) =>
([Element] -> (DomPath, [Element]))
-> DomParserT Identity m a -> DomParserT g m (f a)
inFilteredTrav [Element] -> (DomPath, [Element])
deeper = ([Element] -> DomParserT g m (f (DomPath, Element)))
-> DomParserT Identity m a -> DomParserT g m (f a)
forall (m :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Monad m, Foldable g, Traversable f) =>
([Element] -> DomParserT g m (f (DomPath, Element)))
-> DomParserT Identity m a -> DomParserT g m (f a)
traverseElems [Element] -> DomParserT g m (f (DomPath, Element))
trav
  where
    trav :: [Element] -> DomParserT g m (f (DomPath, Element))
trav [Element]
e = do
      let (DomPath
path, [Element]
elems) = [Element] -> (DomPath, [Element])
deeper [Element]
e
      case [Element] -> Maybe (f Element)
forall a. [a] -> Maybe (f a)
forall (f :: * -> *) a. Buildable f => [a] -> Maybe (f a)
build [Element]
elems of
        Maybe (f Element)
Nothing -> (DomPath -> ParserError) -> DomParserT g m (f (DomPath, Element))
forall (m :: * -> *) (f :: * -> *) a.
(MonadError ParserErrors m, MonadReader (ParserData f) m) =>
(DomPath -> ParserError) -> m a
throwParserError ((DomPath -> ParserError) -> DomParserT g m (f (DomPath, Element)))
-> (DomPath -> ParserError)
-> DomParserT g m (f (DomPath, Element))
forall a b. (a -> b) -> a -> b
$ DomPath -> ParserError
PENotFound (DomPath -> ParserError)
-> (DomPath -> DomPath) -> DomPath -> ParserError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DomPath -> DomPath -> DomPath
forall a. Semigroup a => a -> a -> a
<> DomPath
path)
        Just f Element
tr -> f (DomPath, Element) -> DomParserT g m (f (DomPath, Element))
forall a. a -> ReaderT (ParserData g) (ExceptT ParserErrors m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (f (DomPath, Element) -> DomParserT g m (f (DomPath, Element)))
-> f (DomPath, Element) -> DomParserT g m (f (DomPath, Element))
forall a b. (a -> b) -> a -> b
$ (Element -> (DomPath, Element))
-> f Element -> f (DomPath, Element)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DomPath
path,) f Element
tr

-- | Runs parser arbitrary times, depending on 'Buildable' instance of
-- 'f'. For example if 'f' becomes 'NonEmpty' then 'inElemTrav' finds
-- @one or more@ elements matched by given 'ElemMatcher' and run
-- parser in each found element, then returns @NonEmpty a@ of results.
inElemTrav
  :: (Monad m, Foldable g, Buildable f)
  => ElemMatcher                -- ^ Tag(s) matcher to traverse in
  -> DomParserT Identity m a
  -> DomParserT g m (f a)
inElemTrav :: forall (m :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Monad m, Foldable g, Buildable f) =>
ElemMatcher -> DomParserT Identity m a -> DomParserT g m (f a)
inElemTrav ElemMatcher
n = ([Element] -> (DomPath, [Element]))
-> DomParserT Identity m a -> DomParserT g m (f a)
forall (m :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Monad m, Foldable g, Buildable f) =>
([Element] -> (DomPath, [Element]))
-> DomParserT Identity m a -> DomParserT g m (f a)
inFilteredTrav [Element] -> (DomPath, [Element])
deeper
  where
    elemsFold :: (Element -> Const (Endo [Element]) Element)
-> [Element] -> Const (Endo [Element]) [Element]
elemsFold = (Element -> Const (Endo [Element]) Element)
-> [Element] -> Const (Endo [Element]) [Element]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [Element] Element
folded ((Element -> Const (Endo [Element]) Element)
 -> [Element] -> Const (Endo [Element]) [Element])
-> ((Element -> Const (Endo [Element]) Element)
    -> Element -> Const (Endo [Element]) Element)
-> (Element -> Const (Endo [Element]) Element)
-> [Element]
-> Const (Endo [Element]) [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Node] -> Const (Endo [Element]) [Node])
-> Element -> Const (Endo [Element]) Element
Lens' Element [Node]
nodes (([Node] -> Const (Endo [Element]) [Node])
 -> Element -> Const (Endo [Element]) Element)
-> ((Element -> Const (Endo [Element]) Element)
    -> [Node] -> Const (Endo [Element]) [Node])
-> (Element -> Const (Endo [Element]) Element)
-> Element
-> Const (Endo [Element]) Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Const (Endo [Element]) Node)
-> [Node] -> Const (Endo [Element]) [Node]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [Node] Node
folded ((Node -> Const (Endo [Element]) Node)
 -> [Node] -> Const (Endo [Element]) [Node])
-> ((Element -> Const (Endo [Element]) Element)
    -> Node -> Const (Endo [Element]) Node)
-> (Element -> Const (Endo [Element]) Element)
-> [Node]
-> Const (Endo [Element]) [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Const (Endo [Element]) Element)
-> Node -> Const (Endo [Element]) Node
Prism' Node Element
_Element ((Element -> Const (Endo [Element]) Element)
 -> Node -> Const (Endo [Element]) Node)
-> ((Element -> Const (Endo [Element]) Element)
    -> Element -> Const (Endo [Element]) Element)
-> (Element -> Const (Endo [Element]) Element)
-> Node
-> Const (Endo [Element]) Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElemMatcher -> Traversal' Element Element
elMatch ElemMatcher
n
    deeper :: [Element] -> (DomPath, [Element])
deeper = ([Text] -> DomPath
DomPath [ElemMatcher -> Text
_emShow ElemMatcher
n],) ([Element] -> (DomPath, [Element]))
-> ([Element] -> [Element]) -> [Element] -> (DomPath, [Element])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Element -> Const (Endo [Element]) Element)
 -> [Element] -> Const (Endo [Element]) [Element])
-> [Element] -> [Element]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Element -> Const (Endo [Element]) Element)
-> [Element] -> Const (Endo [Element]) [Element]
elemsFold

-- | Runs parser inside first children element matched by macher
inElem
  :: (Monad m, Foldable g)
  => ElemMatcher
  -> DomParserT Identity m a
  -> DomParserT g m a
inElem :: forall (m :: * -> *) (g :: * -> *) a.
(Monad m, Foldable g) =>
ElemMatcher -> DomParserT Identity m a -> DomParserT g m a
inElem ElemMatcher
n = (Identity a -> a)
-> ReaderT (ParserData g) (ExceptT ParserErrors m) (Identity a)
-> ReaderT (ParserData g) (ExceptT ParserErrors m) a
forall a b.
(a -> b)
-> ReaderT (ParserData g) (ExceptT ParserErrors m) a
-> ReaderT (ParserData g) (ExceptT ParserErrors m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity a -> a
forall a. Identity a -> a
runIdentity (ReaderT (ParserData g) (ExceptT ParserErrors m) (Identity a)
 -> ReaderT (ParserData g) (ExceptT ParserErrors m) a)
-> (DomParserT Identity m a
    -> ReaderT (ParserData g) (ExceptT ParserErrors m) (Identity a))
-> DomParserT Identity m a
-> ReaderT (ParserData g) (ExceptT ParserErrors m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElemMatcher
-> DomParserT Identity m a
-> ReaderT (ParserData g) (ExceptT ParserErrors m) (Identity a)
forall (m :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Monad m, Foldable g, Buildable f) =>
ElemMatcher -> DomParserT Identity m a -> DomParserT g m (f a)
inElemTrav ElemMatcher
n

inElemAll
  :: (Monad m, Foldable g)
  => ElemMatcher
  -> DomParserT Identity m a
  -> DomParserT g m [a]
inElemAll :: forall (m :: * -> *) (g :: * -> *) a.
(Monad m, Foldable g) =>
ElemMatcher -> DomParserT Identity m a -> DomParserT g m [a]
inElemAll = ElemMatcher -> DomParserT Identity m a -> DomParserT g m [a]
forall (m :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Monad m, Foldable g, Buildable f) =>
ElemMatcher -> DomParserT Identity m a -> DomParserT g m (f a)
inElemTrav

inElemMay
  :: (Monad m, Foldable g)
  => ElemMatcher
  -> DomParserT Identity m a
  -> DomParserT g m (Maybe a)
inElemMay :: forall (m :: * -> *) (g :: * -> *) a.
(Monad m, Foldable g) =>
ElemMatcher -> DomParserT Identity m a -> DomParserT g m (Maybe a)
inElemMay = ElemMatcher -> DomParserT Identity m a -> DomParserT g m (Maybe a)
forall (m :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Monad m, Foldable g, Buildable f) =>
ElemMatcher -> DomParserT Identity m a -> DomParserT g m (f a)
inElemTrav

inElemNe
  :: (Monad m, Foldable g)
  => ElemMatcher
  -> DomParserT Identity m a
  -> DomParserT g m (NonEmpty a)
inElemNe :: forall (m :: * -> *) (g :: * -> *) a.
(Monad m, Foldable g) =>
ElemMatcher
-> DomParserT Identity m a -> DomParserT g m (NonEmpty a)
inElemNe = ElemMatcher
-> DomParserT Identity m a -> DomParserT g m (NonEmpty a)
forall (m :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Monad m, Foldable g, Buildable f) =>
ElemMatcher -> DomParserT Identity m a -> DomParserT g m (f a)
inElemTrav

{- | Dive given parser's current tags set into the given path. The @divePath
["a", "b"]@ differs from @inElem "a" $ inElem "b"@. Namely the first variant
will not fail if occured tag "a" which does not contains tag "b". This
behaviour is desireable when you dont want to parse whole XML and just want
to pull tags located in some path. The other difference is in traversing inner
elements. Consider this code

@
inElem "a" $ inElem "b" $ inElemAll "c" fromDom
@

which translates to pseudo-CSS query like: @a:nth(1) > b:nth(1) > c > fromDom@

@
divePath ["a", "b"] $ inElemAll "c" fromDom
@

which translates like: @a > b > c > fromDom@

As you can see, inElem always takes first element and runs inner parser in this
single element, unlike 'divePath' which runs inner parser @in all@ descendants
in given path.

Note also that 'divePath' takes parser parameterized by @[]@ not by
'Identity'. This because when you dive using some path you will get a
list of found elements and all these elements will be @current@ for
parser.
-}

divePath
  :: forall m g a
   . (Monad m, Foldable g)
  => [ElemMatcher]
  -> DomParserT [] m a
  -> DomParserT g m a
divePath :: forall (m :: * -> *) (g :: * -> *) a.
(Monad m, Foldable g) =>
[ElemMatcher] -> DomParserT [] m a -> DomParserT g m a
divePath [ElemMatcher]
path = ((Functor
    (Magnified (ReaderT (ParserData []) (ExceptT ParserErrors m)) a),
  Contravariant
    (Magnified
       (ReaderT (ParserData []) (ExceptT ParserErrors m)) a)) =>
 LensLike'
   (Magnified (ReaderT (ParserData []) (ExceptT ParserErrors m)) a)
   (ParserData g)
   (ParserData []))
-> ReaderT (ParserData []) (ExceptT ParserErrors m) a
-> ReaderT (ParserData g) (ExceptT ParserErrors m) a
forall c.
((Functor
    (Magnified (ReaderT (ParserData []) (ExceptT ParserErrors m)) c),
  Contravariant
    (Magnified
       (ReaderT (ParserData []) (ExceptT ParserErrors m)) c)) =>
 LensLike'
   (Magnified (ReaderT (ParserData []) (ExceptT ParserErrors m)) c)
   (ParserData g)
   (ParserData []))
-> ReaderT (ParserData []) (ExceptT ParserErrors m) c
-> ReaderT (ParserData g) (ExceptT ParserErrors m) c
forall (m :: * -> *) (n :: * -> *) b a c.
Magnify m n b a =>
((Functor (Magnified m c), Contravariant (Magnified m c)) =>
 LensLike' (Magnified m c) a b)
-> m c -> n c
magnify (((Functor
     (Magnified (ReaderT (ParserData []) (ExceptT ParserErrors m)) a),
   Contravariant
     (Magnified
        (ReaderT (ParserData []) (ExceptT ParserErrors m)) a)) =>
  LensLike'
    (Magnified (ReaderT (ParserData []) (ExceptT ParserErrors m)) a)
    (ParserData g)
    (ParserData []))
 -> ReaderT (ParserData []) (ExceptT ParserErrors m) a
 -> ReaderT (ParserData g) (ExceptT ParserErrors m) a)
-> ((Functor
       (Magnified (ReaderT (ParserData []) (ExceptT ParserErrors m)) a),
     Contravariant
       (Magnified
          (ReaderT (ParserData []) (ExceptT ParserErrors m)) a)) =>
    LensLike'
      (Magnified (ReaderT (ParserData []) (ExceptT ParserErrors m)) a)
      (ParserData g)
      (ParserData []))
-> ReaderT (ParserData []) (ExceptT ParserErrors m) a
-> ReaderT (ParserData g) (ExceptT ParserErrors m) a
forall a b. (a -> b) -> a -> b
$ (ParserData g -> ParserData [])
-> Optic'
     (->)
     (Effect (ExceptT ParserErrors m) a)
     (ParserData g)
     (ParserData [])
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ParserData g -> ParserData []
modElems
  where
    modElems :: ParserData g -> ParserData []
modElems
      = ASetter (ParserData g) (ParserData []) (g Element) [Element]
-> (g Element -> [Element]) -> ParserData g -> ParserData []
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (ParserData g) (ParserData []) (g Element) [Element]
forall (f1 :: * -> *) (f2 :: * -> *) (f3 :: * -> *).
Functor f3 =>
(f1 Element -> f3 (f2 Element))
-> ParserData f1 -> f3 (ParserData f2)
pdElements (Getting (Endo [Element]) (g Element) Element
-> g Element -> [Element]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Getting (Endo [Element]) (g Element) Element
 -> g Element -> [Element])
-> Getting (Endo [Element]) (g Element) Element
-> g Element
-> [Element]
forall a b. (a -> b) -> a -> b
$ Getting (Endo [Element]) (g Element) Element
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (g Element) Element
folded Getting (Endo [Element]) (g Element) Element
-> ((Element -> Const (Endo [Element]) Element)
    -> Element -> Const (Endo [Element]) Element)
-> Getting (Endo [Element]) (g Element) Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Const (Endo [Element]) Element)
-> Element -> Const (Endo [Element]) Element
Fold Element Element
diver)
      (ParserData g -> ParserData [])
-> (ParserData g -> ParserData g) -> ParserData g -> ParserData []
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter (ParserData g) (ParserData g) DomPath DomPath
-> (DomPath -> DomPath) -> ParserData g -> ParserData g
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (ParserData g) (ParserData g) DomPath DomPath
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(DomPath -> f2 DomPath) -> ParserData f1 -> f2 (ParserData f1)
pdPath (DomPath -> DomPath -> DomPath
forall a. Semigroup a => a -> a -> a
<> [Text] -> DomPath
DomPath ((ElemMatcher -> Text) -> [ElemMatcher] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
L.map ElemMatcher -> Text
_emShow [ElemMatcher]
path))
    diver :: Fold Element Element
    diver :: Fold Element Element
diver    = (((Element -> f Element) -> Element -> f Element)
 -> ((Element -> f Element) -> Element -> f Element)
 -> (Element -> f Element)
 -> Element
 -> f Element)
-> ((Element -> f Element) -> Element -> f Element)
-> [(Element -> f Element) -> Element -> f Element]
-> (Element -> f Element)
-> Element
-> f Element
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr ((Element -> f Element) -> Element -> f Element)
-> ((Element -> f Element) -> Element -> f Element)
-> (Element -> f Element)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (Element -> f Element) -> Element -> f Element
forall a. a -> a
id ([(Element -> f Element) -> Element -> f Element]
 -> (Element -> f Element) -> Element -> f Element)
-> [(Element -> f Element) -> Element -> f Element]
-> (Element -> f Element)
-> Element
-> f Element
forall a b. (a -> b) -> a -> b
$ (ElemMatcher -> (Element -> f Element) -> Element -> f Element)
-> [ElemMatcher]
-> [(Element -> f Element) -> Element -> f Element]
forall a b. (a -> b) -> [a] -> [b]
L.map ElemMatcher -> (Element -> f Element) -> Element -> f Element
forall {f :: * -> *}.
(Contravariant f, Applicative f) =>
ElemMatcher -> (Element -> f Element) -> Element -> f Element
toDive [ElemMatcher]
path
    toDive :: ElemMatcher -> (Element -> f Element) -> Element -> f Element
toDive ElemMatcher
n = ([Node] -> f [Node]) -> Element -> f Element
Lens' Element [Node]
nodes (([Node] -> f [Node]) -> Element -> f Element)
-> ((Element -> f Element) -> [Node] -> f [Node])
-> (Element -> f Element)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> f Node) -> [Node] -> f [Node]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [Node] Node
folded ((Node -> f Node) -> [Node] -> f [Node])
-> ((Element -> f Element) -> Node -> f Node)
-> (Element -> f Element)
-> [Node]
-> f [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> f Element) -> Node -> f Node
Prism' Node Element
_Element ((Element -> f Element) -> Node -> f Node)
-> ((Element -> f Element) -> Element -> f Element)
-> (Element -> f Element)
-> Node
-> f Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElemMatcher -> Traversal' Element Element
elMatch ElemMatcher
n

diveElem
  :: (Monad m, Foldable g)
  => ElemMatcher
  -> DomParserT [] m a
  -> DomParserT g m a
diveElem :: forall (m :: * -> *) (g :: * -> *) a.
(Monad m, Foldable g) =>
ElemMatcher -> DomParserT [] m a -> DomParserT g m a
diveElem ElemMatcher
p = [ElemMatcher] -> DomParserT [] m a -> DomParserT g m a
forall (m :: * -> *) (g :: * -> *) a.
(Monad m, Foldable g) =>
[ElemMatcher] -> DomParserT [] m a -> DomParserT g m a
divePath [ElemMatcher
p]

-- | Ignore arbitrary current element if it conforms to predicate.
ignoreElem
  :: (Monad m)
  => (Element -> Bool)
     -- ^ Predicate checking that we must ignore some current tag. If returns
     -- 'True' then parser will not be runned and combinator just returns Nothing.
  -> DomParserT Identity m a
  -> DomParserT Identity m (Maybe a)
ignoreElem :: forall (m :: * -> *) a.
Monad m =>
(Element -> Bool)
-> DomParserT Identity m a -> DomParserT Identity m (Maybe a)
ignoreElem Element -> Bool
test DomParserT Identity m a
parser = do
  Bool
ign <- Getting Bool (ParserData Identity) Bool
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool (ParserData Identity) Bool
 -> ReaderT (ParserData Identity) (ExceptT ParserErrors m) Bool)
-> Getting Bool (ParserData Identity) Bool
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) Bool
forall a b. (a -> b) -> a -> b
$ (Identity Element -> Const Bool (Identity Element))
-> ParserData Identity -> Const Bool (ParserData Identity)
forall (f1 :: * -> *) (f2 :: * -> *) (f3 :: * -> *).
Functor f3 =>
(f1 Element -> f3 (f2 Element))
-> ParserData f1 -> f3 (ParserData f2)
pdElements ((Identity Element -> Const Bool (Identity Element))
 -> ParserData Identity -> Const Bool (ParserData Identity))
-> ((Bool -> Const Bool Bool)
    -> Identity Element -> Const Bool (Identity Element))
-> Getting Bool (ParserData Identity) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identity Element -> Bool)
-> (Bool -> Const Bool Bool)
-> Identity Element
-> Const Bool (Identity Element)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Element -> Bool
test (Element -> Bool)
-> (Identity Element -> Element) -> Identity Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity Element -> Element
forall a. Identity a -> a
runIdentity)
  if Bool
ign then Maybe a -> DomParserT Identity m (Maybe a)
forall a.
a -> ReaderT (ParserData Identity) (ExceptT ParserErrors m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> DomParserT Identity m a -> DomParserT Identity m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DomParserT Identity m a
parser

-- | If current element has no children nodes does not run parser and returns
-- Nothing. Otherwise runs parser inside current element. Useful when you got
-- XML with strange empty elements which must be just ignored, but `inElem` runs
-- parser inside of this elements which causes to parser error.
ignoreEmpty
  :: (Monad m)
  => DomParserT Identity m a
  -> DomParserT Identity m (Maybe a)
ignoreEmpty :: forall (m :: * -> *) a.
Monad m =>
DomParserT Identity m a -> DomParserT Identity m (Maybe a)
ignoreEmpty = (Element -> Bool)
-> DomParserT Identity m a -> DomParserT Identity m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(Element -> Bool)
-> DomParserT Identity m a -> DomParserT Identity m (Maybe a)
ignoreElem Element -> Bool
test
  where
    test :: Element -> Bool
test Element
e = [Node] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null ([Node] -> Bool) -> [Node] -> Bool
forall a b. (a -> b) -> a -> b
$ Element
e Element -> Getting [Node] Element [Node] -> [Node]
forall s a. s -> Getting a s a -> a
^. Getting [Node] Element [Node]
Lens' Element [Node]
nodes

-- | If all current elements contains blank content, or contains nothing at all
-- , then returns Nothing, else runs parser.
ignoreBlank
  :: (Monad m)
  => DomParserT Identity m a
  -> DomParserT Identity m (Maybe a)
ignoreBlank :: forall (m :: * -> *) a.
Monad m =>
DomParserT Identity m a -> DomParserT Identity m (Maybe a)
ignoreBlank = (Element -> Bool)
-> DomParserT Identity m a -> DomParserT Identity m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(Element -> Bool)
-> DomParserT Identity m a -> DomParserT Identity m (Maybe a)
ignoreElem Element -> Bool
test
  where
    test :: Element -> Bool
test Element
e =
      let
        elems :: [Element]
elems = Element
e Element
-> ((Element -> Const (Endo [Element]) Element)
    -> Element -> Const (Endo [Element]) Element)
-> [Element]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([Node] -> Const (Endo [Element]) [Node])
-> Element -> Const (Endo [Element]) Element
Lens' Element [Node]
nodes (([Node] -> Const (Endo [Element]) [Node])
 -> Element -> Const (Endo [Element]) Element)
-> ((Element -> Const (Endo [Element]) Element)
    -> [Node] -> Const (Endo [Element]) [Node])
-> (Element -> Const (Endo [Element]) Element)
-> Element
-> Const (Endo [Element]) Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Const (Endo [Element]) Node)
-> [Node] -> Const (Endo [Element]) [Node]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [Node] Node
folded ((Node -> Const (Endo [Element]) Node)
 -> [Node] -> Const (Endo [Element]) [Node])
-> ((Element -> Const (Endo [Element]) Element)
    -> Node -> Const (Endo [Element]) Node)
-> (Element -> Const (Endo [Element]) Element)
-> [Node]
-> Const (Endo [Element]) [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Const (Endo [Element]) Element)
-> Node -> Const (Endo [Element]) Node
Prism' Node Element
_Element
        cont :: Text
cont = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Element
e Element -> Getting (Endo [Text]) Element Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([Node] -> Const (Endo [Text]) [Node])
-> Element -> Const (Endo [Text]) Element
Lens' Element [Node]
nodes (([Node] -> Const (Endo [Text]) [Node])
 -> Element -> Const (Endo [Text]) Element)
-> ((Text -> Const (Endo [Text]) Text)
    -> [Node] -> Const (Endo [Text]) [Node])
-> Getting (Endo [Text]) Element Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Const (Endo [Text]) Node)
-> [Node] -> Const (Endo [Text]) [Node]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [Node] Node
folded ((Node -> Const (Endo [Text]) Node)
 -> [Node] -> Const (Endo [Text]) [Node])
-> ((Text -> Const (Endo [Text]) Text)
    -> Node -> Const (Endo [Text]) Node)
-> (Text -> Const (Endo [Text]) Text)
-> [Node]
-> Const (Endo [Text]) [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> Node -> Const (Endo [Text]) Node
Prism' Node Text
_Content
      in if | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Element] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Element]
elems    -> Bool
False
            | Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
cont -> Bool
True
            | Bool
otherwise             -> Bool
False