{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Scrappy.Elem.SimpleElemParser where
import Scrappy.Elem.Types
import Scrappy.Elem.ElemHeadParse (parseOpeningTag, parseOpeningTagWhere)
import Scrappy.Links (LastUrl)
import Scrappy.Types
import Control.Monad (when)
import Control.Applicative (Alternative, liftA2, some, (<|>))
import Text.Parsec (ParsecT, Stream, string, try, parserZero, anyChar, char, optional, anyToken, parserFail
, many, space, manyTill)
import Text.URI (URI, render)
import Data.Text (Text, unpack)
import Data.Map (Map, toList)
import Data.Maybe (fromMaybe)
import Control.Monad.IO.Class
eitherP :: Alternative m => m a -> m b -> m (Either a b)
eitherP :: forall (m :: * -> *) a b.
Alternative m =>
m a -> m b -> m (Either a b)
eitherP m a
a m b
b = (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> m a -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
a) m (Either a b) -> m (Either a b) -> m (Either a b)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> m b -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
b)
manyTill_ :: ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m ([a], end)
manyTill_ :: forall s u (m :: * -> *) a end.
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m ([a], end)
manyTill_ ParsecT s u m a
p ParsecT s u m end
end = ParsecT s u m ([a], end)
go
where
go :: ParsecT s u m ([a], end)
go = (([],) (end -> ([a], end))
-> ParsecT s u m end -> ParsecT s u m ([a], end)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m end
end) ParsecT s u m ([a], end)
-> ParsecT s u m ([a], end) -> ParsecT s u m ([a], end)
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> ([a], end) -> ([a], end))
-> ParsecT s u m a
-> ParsecT s u m ([a], end)
-> ParsecT s u m ([a], end)
forall a b c.
(a -> b -> c)
-> ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\a
x ([a]
xs, end
y) -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs, end
y)) ParsecT s u m a
p ParsecT s u m ([a], end)
go
el :: Stream s m Char => Elem -> [(String, String)] -> ParsecT s u m (Elem' String)
el :: forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> [(Elem, Elem)] -> ParsecT s u m (Elem' Elem)
el Elem
element [(Elem, Elem)]
attrss = Maybe [Elem]
-> Maybe (ParsecT s u m Elem)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' Elem)
forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' a)
elemParser ([Elem] -> Maybe [Elem]
forall a. a -> Maybe a
Just (Elem
elementElem -> [Elem] -> [Elem]
forall a. a -> [a] -> [a]
:[])) Maybe (ParsecT s u m Elem)
forall a. Maybe a
Nothing ((((Elem, Elem) -> (Elem, Maybe Elem))
-> [(Elem, Elem)] -> [(Elem, Maybe Elem)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Elem, Elem) -> (Elem, Maybe Elem))
-> [(Elem, Elem)] -> [(Elem, Maybe Elem)])
-> ((Elem -> Maybe Elem) -> (Elem, Elem) -> (Elem, Maybe Elem))
-> (Elem -> Maybe Elem)
-> [(Elem, Elem)]
-> [(Elem, Maybe Elem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Elem -> Maybe Elem) -> (Elem, Elem) -> (Elem, Maybe Elem)
forall a b. (a -> b) -> (Elem, a) -> (Elem, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Elem -> Maybe Elem
forall a. a -> Maybe a
Just [(Elem, Elem)]
attrss)
elemParser :: (ShowHTML a, Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(String, Maybe String)]
-> ParsecT s u m (Elem' a)
elemParser :: forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' a)
elemParser Maybe [Elem]
elemList Maybe (ParsecT s u m a)
innerSpec [(Elem, Maybe Elem)]
attrs = do
(Elem
elem', Attrs
attrs') <- Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
parseOpeningTag Maybe [Elem]
elemList [(Elem, Maybe Elem)]
attrs
case Elem -> [Elem] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Elem
elem' [Elem]
selfClosing of
Bool
True -> do
(ParsecT s u m Elem -> ParsecT s u m Elem
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
string Elem
">") ParsecT s u m Elem -> ParsecT s u m Elem -> ParsecT s u m Elem
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
string Elem
"/>")
case Maybe (ParsecT s u m a)
innerSpec of
Maybe (ParsecT s u m a)
Nothing -> Elem' a -> ParsecT s u m (Elem' a)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem' a -> ParsecT s u m (Elem' a))
-> Elem' a -> ParsecT s u m (Elem' a)
forall a b. (a -> b) -> a -> b
$ Elem -> Attrs -> [a] -> Elem -> Elem' a
forall a. Elem -> Attrs -> [a] -> Elem -> Elem' a
Elem' Elem
elem' Attrs
attrs' [a]
forall a. Monoid a => a
mempty Elem
forall a. Monoid a => a
mempty
Just ParsecT s u m a
_ -> ParsecT s u m (Elem' a)
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
Bool
False -> do
(Elem
asString, [a]
matches) <- ([HTMLMatcher Elem' a] -> (Elem, [a]))
-> ParsecT s u m [HTMLMatcher Elem' a] -> ParsecT s u m (Elem, [a])
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HTMLMatcher Elem' a -> (Elem, [a]) -> (Elem, [a]))
-> (Elem, [a]) -> [HTMLMatcher Elem' a] -> (Elem, [a])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr HTMLMatcher Elem' a -> (Elem, [a]) -> (Elem, [a])
forall (e :: * -> *) a.
(ShowHTML (e a), ShowHTML a, ElementRep e) =>
HTMLMatcher e a -> (Elem, [a]) -> (Elem, [a])
foldFuncTup (Elem, [a])
forall a. Monoid a => a
mempty)
(ParsecT s u m [HTMLMatcher Elem' a] -> ParsecT s u m (Elem, [a]))
-> ParsecT s u m [HTMLMatcher Elem' a] -> ParsecT s u m (Elem, [a])
forall a b. (a -> b) -> a -> b
$ (ParsecT s u m Elem -> ParsecT s u m Elem
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
string Elem
"/>") ParsecT s u m Elem
-> ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [HTMLMatcher Elem' a] -> ParsecT s u m [HTMLMatcher Elem' a]
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a])
-> ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall a b. (a -> b) -> a -> b
$ Elem
-> Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher Elem' a]
forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Elem
-> Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher Elem' a]
innerElemParser Elem
elem' Maybe (ParsecT s u m a)
innerSpec)
ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher Elem' a]
forall a s (m :: * -> *) u (e :: * -> *).
(ShowHTML a, Stream s m Char) =>
Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher e a]
selfClosingTextful Maybe (ParsecT s u m a)
innerSpec)
Elem' a -> ParsecT s u m (Elem' a)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem' a -> ParsecT s u m (Elem' a))
-> Elem' a -> ParsecT s u m (Elem' a)
forall a b. (a -> b) -> a -> b
$ Elem -> Attrs -> [a] -> Elem -> Elem' a
forall a. Elem -> Attrs -> [a] -> Elem -> Elem' a
Elem' Elem
elem' Attrs
attrs' [a]
matches Elem
asString
elemParserWhere :: (ShowHTML a, Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> String -> (String -> Bool)
-> ParsecT s u m (Elem' a)
elemParserWhere :: forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> Elem
-> (Elem -> Bool)
-> ParsecT s u m (Elem' a)
elemParserWhere Maybe [Elem]
elemList Maybe (ParsecT s u m a)
innerSpec Elem
attr Elem -> Bool
pred = do
(Elem
elem', Attrs
attrs') <- Maybe [Elem]
-> Elem -> (Elem -> Bool) -> ParsecT s u m (Elem, Attrs)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [Elem]
-> Elem -> (Elem -> Bool) -> ParsecT s u m (Elem, Attrs)
parseOpeningTagWhere Maybe [Elem]
elemList Elem
attr Elem -> Bool
pred
case Elem -> [Elem] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Elem
elem' [Elem]
selfClosing of
Bool
True -> do
(ParsecT s u m Elem -> ParsecT s u m Elem
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
string Elem
">") ParsecT s u m Elem -> ParsecT s u m Elem -> ParsecT s u m Elem
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
string Elem
"/>")
case Maybe (ParsecT s u m a)
innerSpec of
Maybe (ParsecT s u m a)
Nothing -> Elem' a -> ParsecT s u m (Elem' a)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem' a -> ParsecT s u m (Elem' a))
-> Elem' a -> ParsecT s u m (Elem' a)
forall a b. (a -> b) -> a -> b
$ Elem -> Attrs -> [a] -> Elem -> Elem' a
forall a. Elem -> Attrs -> [a] -> Elem -> Elem' a
Elem' Elem
elem' Attrs
attrs' [a]
forall a. Monoid a => a
mempty Elem
forall a. Monoid a => a
mempty
Just ParsecT s u m a
_ -> ParsecT s u m (Elem' a)
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
Bool
False -> do
(Elem
asString, [a]
matches) <- ([HTMLMatcher Elem' a] -> (Elem, [a]))
-> ParsecT s u m [HTMLMatcher Elem' a] -> ParsecT s u m (Elem, [a])
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HTMLMatcher Elem' a -> (Elem, [a]) -> (Elem, [a]))
-> (Elem, [a]) -> [HTMLMatcher Elem' a] -> (Elem, [a])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr HTMLMatcher Elem' a -> (Elem, [a]) -> (Elem, [a])
forall (e :: * -> *) a.
(ShowHTML (e a), ShowHTML a, ElementRep e) =>
HTMLMatcher e a -> (Elem, [a]) -> (Elem, [a])
foldFuncTup (Elem, [a])
forall a. Monoid a => a
mempty)
(ParsecT s u m [HTMLMatcher Elem' a] -> ParsecT s u m (Elem, [a]))
-> ParsecT s u m [HTMLMatcher Elem' a] -> ParsecT s u m (Elem, [a])
forall a b. (a -> b) -> a -> b
$ (ParsecT s u m Elem -> ParsecT s u m Elem
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
string Elem
"/>") ParsecT s u m Elem
-> ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [HTMLMatcher Elem' a] -> ParsecT s u m [HTMLMatcher Elem' a]
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a])
-> ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall a b. (a -> b) -> a -> b
$ Elem
-> Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher Elem' a]
forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Elem
-> Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher Elem' a]
innerElemParser Elem
elem' Maybe (ParsecT s u m a)
innerSpec)
ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher Elem' a]
forall a s (m :: * -> *) u (e :: * -> *).
(ShowHTML a, Stream s m Char) =>
Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher e a]
selfClosingTextful Maybe (ParsecT s u m a)
innerSpec)
Elem' a -> ParsecT s u m (Elem' a)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem' a -> ParsecT s u m (Elem' a))
-> Elem' a -> ParsecT s u m (Elem' a)
forall a b. (a -> b) -> a -> b
$ Elem -> Attrs -> [a] -> Elem -> Elem' a
forall a. Elem -> Attrs -> [a] -> Elem -> Elem' a
Elem' Elem
elem' Attrs
attrs' [a]
matches Elem
asString
clickableHref :: Stream s m Char => Bool -> LastUrl -> ParsecT s u m Clickable
clickableHref :: forall s (m :: * -> *) u.
Stream s m Char =>
Bool -> LastUrl -> ParsecT s u m Clickable
clickableHref Bool
booly LastUrl
cUrl = do
(Elem, Attrs)
elA <- Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
parseOpeningTag Maybe [Elem]
forall a. Maybe a
Nothing [(Elem
"href", Maybe Elem
forall a. Maybe a
Nothing)]
LastUrl
href <- (Attrs -> Maybe LastUrl)
-> ParsecT s u m Attrs -> ParsecT s u m LastUrl
forall a b s u (m :: * -> *).
(a -> Maybe b) -> ParsecT s u m a -> ParsecT s u m b
mapMaybe (Bool -> LastUrl -> Attrs -> Maybe LastUrl
getHrefAttrs Bool
booly LastUrl
cUrl) (Attrs -> ParsecT s u m Attrs
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attrs -> ParsecT s u m Attrs) -> Attrs -> ParsecT s u m Attrs
forall a b. (a -> b) -> a -> b
$ (Elem, Attrs) -> Attrs
forall a b. (a, b) -> b
snd (Elem, Attrs)
elA)
Clickable -> ParsecT s u m Clickable
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Clickable -> ParsecT s u m Clickable)
-> Clickable -> ParsecT s u m Clickable
forall a b. (a -> b) -> a -> b
$ (Elem, Attrs) -> LastUrl -> Clickable
Clickable (Elem, Attrs)
elA LastUrl
href
clickableHref' :: (Stream s m Char, ShowHTML a) =>
ParsecT s u m a
-> Bool
-> LastUrl
-> ParsecT s u m Clickable
clickableHref' :: forall s (m :: * -> *) a u.
(Stream s m Char, ShowHTML a) =>
ParsecT s u m a -> Bool -> LastUrl -> ParsecT s u m Clickable
clickableHref' ParsecT s u m a
innerPat Bool
booly LastUrl
cUrl = do
Elem' a
e <- Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' a)
forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' a)
elemParser Maybe [Elem]
forall a. Maybe a
Nothing (ParsecT s u m a -> Maybe (ParsecT s u m a)
forall a. a -> Maybe a
Just (ParsecT s u m a -> Maybe (ParsecT s u m a))
-> ParsecT s u m a -> Maybe (ParsecT s u m a)
forall a b. (a -> b) -> a -> b
$ ParsecT s u m a
innerPat) [(Elem
"href", Maybe Elem
forall a. Maybe a
Nothing)]
LastUrl
href <- (Elem' a -> Maybe LastUrl)
-> ParsecT s u m (Elem' a) -> ParsecT s u m LastUrl
forall a b s u (m :: * -> *).
(a -> Maybe b) -> ParsecT s u m a -> ParsecT s u m b
mapMaybe (Bool -> LastUrl -> Elem' a -> Maybe LastUrl
forall (e :: * -> *) a.
ElementRep e =>
Bool -> LastUrl -> e a -> Maybe LastUrl
getHrefEl Bool
booly LastUrl
cUrl) (Elem' a -> ParsecT s u m (Elem' a)
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Elem' a
e)
Clickable -> ParsecT s u m Clickable
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Clickable -> ParsecT s u m Clickable)
-> Clickable -> ParsecT s u m Clickable
forall a b. (a -> b) -> a -> b
$ (Elem, Attrs) -> LastUrl -> Clickable
Clickable (Elem' a -> Elem
forall b. Elem' b -> Elem
forall (a :: * -> *) b. ElementRep a => a b -> Elem
elTag Elem' a
e, Elem' a -> Attrs
forall b. Elem' b -> Attrs
forall (a :: * -> *) b. ElementRep a => a b -> Attrs
attrs Elem' a
e) LastUrl
href
sameElTag :: (ShowHTML a, Stream s m Char) => Elem -> Maybe (ParsecT s u m a) -> ParsecT s u m (Elem' a)
sameElTag :: forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Elem -> Maybe (ParsecT s u m a) -> ParsecT s u m (Elem' a)
sameElTag Elem
elem Maybe (ParsecT s u m a)
parser = Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' a)
forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' a)
elemParser ([Elem] -> Maybe [Elem]
forall a. a -> Maybe a
Just [Elem
elem]) Maybe (ParsecT s u m a)
parser []
matchesInSameElTag :: (ShowHTML a, Stream s m Char) => Elem -> Maybe (ParsecT s u m a) -> ParsecT s u m [a]
matchesInSameElTag :: forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Elem -> Maybe (ParsecT s u m a) -> ParsecT s u m [a]
matchesInSameElTag Elem
elem Maybe (ParsecT s u m a)
parser = do
Elem' a
el <- Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' a)
forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' a)
elemParser ([Elem] -> Maybe [Elem]
forall a. a -> Maybe a
Just [Elem
elem]) Maybe (ParsecT s u m a)
parser []
[a] -> ParsecT s u m [a]
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> ParsecT s u m [a]) -> [a] -> ParsecT s u m [a]
forall a b. (a -> b) -> a -> b
$ (Elem' a -> [a]
forall b. Elem' b -> [b]
forall (a :: * -> *) b. ElementRep a => a b -> [b]
matches' Elem' a
el)
selfClosing :: [String]
selfClosing :: [Elem]
selfClosing = [Elem
"area", Elem
"base", Elem
"br", Elem
"col", Elem
"embed", Elem
"hr", Elem
"img", Elem
"input", Elem
"link", Elem
"meta", Elem
"param", Elem
"source", Elem
"track", Elem
"wbr"]
elSelfC :: Stream s m Char => Maybe [Elem] -> [(String, Maybe String)] -> ParsecT s u m (Elem' a)
elSelfC :: forall s (m :: * -> *) u a.
Stream s m Char =>
Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem' a)
elSelfC Maybe [Elem]
elemOpts [(Elem, Maybe Elem)]
attrsSubset = do
(Elem
tag, Attrs
attrs) <- Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
parseOpeningTag Maybe [Elem]
elemOpts [(Elem, Maybe Elem)]
attrsSubset
Elem' a -> ParsecT s u m (Elem' a)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem' a -> ParsecT s u m (Elem' a))
-> Elem' a -> ParsecT s u m (Elem' a)
forall a b. (a -> b) -> a -> b
$ Elem -> Attrs -> [a] -> Elem -> Elem' a
forall a. Elem -> Attrs -> [a] -> Elem -> Elem' a
Elem' Elem
tag Attrs
attrs [a]
forall a. Monoid a => a
mempty Elem
forall a. Monoid a => a
mempty
elSelfClosing :: Stream s m Char => Maybe [Elem] -> Maybe (ParsecT s u m a) -> [(String, Maybe String)] -> ParsecT s u m (Elem' a)
elSelfClosing :: forall s (m :: * -> *) u a.
Stream s m Char =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' a)
elSelfClosing Maybe [Elem]
elemOpts Maybe (ParsecT s u m a)
innerSpec [(Elem, Maybe Elem)]
attrsSubset = do
(Elem
tag, Attrs
attrs) <- Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
parseOpeningTag Maybe [Elem]
elemOpts [(Elem, Maybe Elem)]
attrsSubset
case Maybe (ParsecT s u m a)
innerSpec of
Just ParsecT s u m a
_ -> ParsecT s u m (Elem' a)
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
Maybe (ParsecT s u m a)
Nothing -> Elem' a -> ParsecT s u m (Elem' a)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem' a -> ParsecT s u m (Elem' a))
-> Elem' a -> ParsecT s u m (Elem' a)
forall a b. (a -> b) -> a -> b
$ Elem -> Attrs -> [a] -> Elem -> Elem' a
forall a. Elem -> Attrs -> [a] -> Elem -> Elem' a
Elem' Elem
tag Attrs
attrs [a]
forall a. Monoid a => a
mempty Elem
forall a. Monoid a => a
mempty
elemWithBody :: (ShowHTML a, Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(String, Maybe String)]
-> ParsecT s u m (Elem' a)
elemWithBody :: forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' a)
elemWithBody Maybe [Elem]
elemList Maybe (ParsecT s u m a)
innerSpec [(Elem, Maybe Elem)]
attrs = do
Elem' a
e <- Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' a)
forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' a)
elemParserInternal Maybe [Elem]
elemList Maybe (ParsecT s u m a)
innerSpec [(Elem, Maybe Elem)]
attrs
Bool -> ParsecT s u m () -> ParsecT s u m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Elem' a -> [a]
forall b. Elem' b -> [b]
forall (a :: * -> *) b. ElementRep a => a b -> [b]
matches' Elem' a
e) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (case Maybe (ParsecT s u m a)
innerSpec of { Maybe (ParsecT s u m a)
Nothing -> Int
0; Maybe (ParsecT s u m a)
_ -> Int
1 })) (Elem -> ParsecT s u m ()
forall s u (m :: * -> *) a. Elem -> ParsecT s u m a
parserFail Elem
"not enough matches")
Elem' a -> ParsecT s u m (Elem' a)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return Elem' a
e
elemParserInternal :: (ShowHTML a, Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(String, Maybe String)]
-> ParsecT s u m (Elem' a)
elemParserInternal :: forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m a)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' a)
elemParserInternal Maybe [Elem]
elemList Maybe (ParsecT s u m a)
innerSpec [(Elem, Maybe Elem)]
attrs = do
(Elem
elem', Attrs
attrs') <- Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
parseOpeningTag Maybe [Elem]
elemList [(Elem, Maybe Elem)]
attrs
(Elem
asString, [a]
matches) <- ([HTMLMatcher Elem' a] -> (Elem, [a]))
-> ParsecT s u m [HTMLMatcher Elem' a] -> ParsecT s u m (Elem, [a])
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HTMLMatcher Elem' a -> (Elem, [a]) -> (Elem, [a]))
-> (Elem, [a]) -> [HTMLMatcher Elem' a] -> (Elem, [a])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr HTMLMatcher Elem' a -> (Elem, [a]) -> (Elem, [a])
forall (e :: * -> *) a.
(ShowHTML (e a), ShowHTML a, ElementRep e) =>
HTMLMatcher e a -> (Elem, [a]) -> (Elem, [a])
foldFuncTup (Elem, [a])
forall a. Monoid a => a
mempty)
(ParsecT s u m [HTMLMatcher Elem' a] -> ParsecT s u m (Elem, [a]))
-> ParsecT s u m [HTMLMatcher Elem' a] -> ParsecT s u m (Elem, [a])
forall a b. (a -> b) -> a -> b
$ (ParsecT s u m Elem -> ParsecT s u m Elem
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
string Elem
"/>") ParsecT s u m Elem
-> ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [HTMLMatcher Elem' a] -> ParsecT s u m [HTMLMatcher Elem' a]
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a])
-> ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall a b. (a -> b) -> a -> b
$ Elem
-> Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher Elem' a]
forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Elem
-> Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher Elem' a]
innerElemParser Elem
elem' Maybe (ParsecT s u m a)
innerSpec)
ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher Elem' a]
forall a s (m :: * -> *) u (e :: * -> *).
(ShowHTML a, Stream s m Char) =>
Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher e a]
selfClosingTextful Maybe (ParsecT s u m a)
innerSpec)
Elem' a -> ParsecT s u m (Elem' a)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem' a -> ParsecT s u m (Elem' a))
-> Elem' a -> ParsecT s u m (Elem' a)
forall a b. (a -> b) -> a -> b
$ Elem -> Attrs -> [a] -> Elem -> Elem' a
forall a. Elem -> Attrs -> [a] -> Elem -> Elem' a
Elem' Elem
elem' Attrs
attrs' [a]
matches Elem
asString
innerElemParser :: (ShowHTML a, Stream s m Char) =>
String
-> Maybe (ParsecT s u m a)
-> ParsecT s u m [HTMLMatcher Elem' a]
innerElemParser :: forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Elem
-> Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher Elem' a]
innerElemParser Elem
eTag Maybe (ParsecT s u m a)
innerSpec = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
ParsecT s u m Char
-> ParsecT s u m [HTMLMatcher Elem' a]
-> ParsecT s u m [HTMLMatcher Elem' a]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s u m (HTMLMatcher Elem' a)
-> ParsecT s u m Elem -> ParsecT s u m [HTMLMatcher Elem' a]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (ParsecT s u m (HTMLMatcher Elem' a)
-> ParsecT s u m (HTMLMatcher Elem' a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (a -> HTMLMatcher Elem' a
forall (a :: * -> *) b. b -> HTMLMatcher a b
Match (a -> HTMLMatcher Elem' a)
-> ParsecT s u m a -> ParsecT s u m (HTMLMatcher Elem' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT s u m a -> Maybe (ParsecT s u m a) -> ParsecT s u m a
forall a. a -> Maybe a -> a
fromMaybe ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero Maybe (ParsecT s u m a)
innerSpec))
ParsecT s u m (HTMLMatcher Elem' a)
-> ParsecT s u m (HTMLMatcher Elem' a)
-> ParsecT s u m (HTMLMatcher Elem' a)
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT s u m (HTMLMatcher Elem' a)
-> ParsecT s u m (HTMLMatcher Elem' a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Elem -> HTMLMatcher Elem' a
forall (a :: * -> *) b. Elem -> HTMLMatcher a b
IText (Elem -> HTMLMatcher Elem' a)
-> ParsecT s u m Elem -> ParsecT s u m (HTMLMatcher Elem' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m Elem
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Elem
stylingElem))
ParsecT s u m (HTMLMatcher Elem' a)
-> ParsecT s u m (HTMLMatcher Elem' a)
-> ParsecT s u m (HTMLMatcher Elem' a)
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT s u m (HTMLMatcher Elem' a)
-> ParsecT s u m (HTMLMatcher Elem' a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Elem' a -> HTMLMatcher Elem' a
forall (a :: * -> *) b. a b -> HTMLMatcher a b
Element (Elem' a -> HTMLMatcher Elem' a)
-> ParsecT s u m (Elem' a) -> ParsecT s u m (HTMLMatcher Elem' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elem -> Maybe (ParsecT s u m a) -> ParsecT s u m (Elem' a)
forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Elem -> Maybe (ParsecT s u m a) -> ParsecT s u m (Elem' a)
sameElTag Elem
eTag Maybe (ParsecT s u m a)
innerSpec)
ParsecT s u m (HTMLMatcher Elem' a)
-> ParsecT s u m (HTMLMatcher Elem' a)
-> ParsecT s u m (HTMLMatcher Elem' a)
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Elem -> HTMLMatcher Elem' a
forall (a :: * -> *) b. Elem -> HTMLMatcher a b
IText (Elem -> HTMLMatcher Elem' a)
-> (Char -> Elem) -> Char -> HTMLMatcher Elem' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Elem -> Elem
forall a. a -> [a] -> [a]
:[])) (Char -> HTMLMatcher Elem' a)
-> ParsecT s u m Char -> ParsecT s u m (HTMLMatcher Elem' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)) (Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
endTag Elem
eTag)
stylingTags :: [Elem]
stylingTags = [Elem
"abbr", Elem
"b", Elem
"big", Elem
"acronym", Elem
"dfn", Elem
"em", Elem
"font", Elem
"i", Elem
"mark", Elem
"q", Elem
"small", Elem
"strong"]
stylingElem :: Stream s m Char => ParsecT s u m String
stylingElem :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Elem
stylingElem = do
(Elem
e,Attrs
_) <- Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
parseOpeningTag ([Elem] -> Maybe [Elem]
forall a. a -> Maybe a
Just [Elem]
stylingTags) []
Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
((Elem, Elem) -> Elem)
-> ParsecT s u m (Elem, Elem) -> ParsecT s u m Elem
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Elem, Elem) -> Elem
forall a b. (a, b) -> a
fst (ParsecT s u m (Elem, Elem) -> ParsecT s u m Elem)
-> ParsecT s u m (Elem, Elem) -> ParsecT s u m Elem
forall a b. (a -> b) -> a -> b
$ ParsecT s u m Char
-> ParsecT s u m Elem -> ParsecT s u m (Elem, Elem)
forall s u (m :: * -> *) a end.
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m ([a], end)
manyTill_ ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
endTag Elem
e)
{-# DEPRECATED parseInnerHTMLAndEndTag "use new elem parser directly" #-}
parseInnerHTMLAndEndTag :: (Stream s m Char) =>
Elem
-> Maybe (ParsecT s u m String)
-> ParsecT s u m (InnerTextResult String)
parseInnerHTMLAndEndTag :: forall s (m :: * -> *) u.
Stream s m Char =>
Elem
-> Maybe (ParsecT s u m Elem)
-> ParsecT s u m (InnerTextResult Elem)
parseInnerHTMLAndEndTag Elem
elem Maybe (ParsecT s u m Elem)
innerPattern = do
let f :: Stream s m Char => Maybe (ParsecT s u m String) -> ParsecT s u m String
f :: forall s (m :: * -> *) u.
Stream s m Char =>
Maybe (ParsecT s u m Elem) -> ParsecT s u m Elem
f Maybe (ParsecT s u m Elem)
x = case Maybe (ParsecT s u m Elem)
x of
Just ParsecT s u m Elem
pat -> ParsecT s u m Elem
pat
Maybe (ParsecT s u m Elem)
Nothing -> Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
string Elem
""
sameElTag :: Stream s m Char => ParsecT s u m String
sameElTag :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Elem
sameElTag = do
Elem' Elem
el <- Maybe [Elem]
-> Maybe (ParsecT s u m Elem)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' Elem)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [Elem]
-> Maybe (ParsecT s u m Elem)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' Elem)
elemParserOld ([Elem] -> Maybe [Elem]
forall a. a -> Maybe a
Just [Elem
elem]) Maybe (ParsecT s u m Elem)
forall a. Maybe a
Nothing []
Elem -> ParsecT s u m Elem
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem -> ParsecT s u m Elem) -> Elem -> ParsecT s u m Elem
forall a b. (a -> b) -> a -> b
$ Elem' Elem -> Elem
forall a. ShowHTML a => a -> Elem
showH Elem' Elem
el
p :: Stream s m Char => ParsecT s u m String
p :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Elem
p = do
Char
a <- ParsecT s u m Char
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken
Elem -> ParsecT s u m Elem
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
a Char -> Elem -> Elem
forall a. a -> [a] -> [a]
: [])
baseParser :: Stream s m Char => Maybe (ParsecT s u m String) -> ParsecT s u m String -> ParsecT s u m (InnerTextResult String)
baseParser :: forall s (m :: * -> *) u.
Stream s m Char =>
Maybe (ParsecT s u m Elem)
-> ParsecT s u m Elem -> ParsecT s u m (InnerTextResult Elem)
baseParser Maybe (ParsecT s u m Elem)
innerPat ParsecT s u m Elem
endParse = do
Char
_ <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
([Elem]
pre, Elem
patternFound) <- ParsecT s u m Elem
-> ParsecT s u m Elem -> ParsecT s u m ([Elem], Elem)
forall s u (m :: * -> *) a end.
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m ([a], end)
manyTill_ (ParsecT s u m Elem -> ParsecT s u m Elem
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m Elem
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Elem
sameElTag ParsecT s u m Elem -> ParsecT s u m Elem -> ParsecT s u m Elem
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT s u m Elem
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Elem
p) (Maybe (ParsecT s u m Elem) -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe (ParsecT s u m Elem) -> ParsecT s u m Elem
f Maybe (ParsecT s u m Elem)
innerPat)
([Elem]
post, Elem
_) <- ParsecT s u m Elem
-> ParsecT s u m Elem -> ParsecT s u m ([Elem], Elem)
forall s u (m :: * -> *) a end.
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m ([a], end)
manyTill_ (ParsecT s u m Elem -> ParsecT s u m Elem
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m Elem
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Elem
sameElTag ParsecT s u m Elem -> ParsecT s u m Elem -> ParsecT s u m Elem
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT s u m Elem
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Elem
p) ParsecT s u m Elem
endParse
InnerTextResult Elem -> ParsecT s u m (InnerTextResult Elem)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (InnerTextResult Elem -> ParsecT s u m (InnerTextResult Elem))
-> InnerTextResult Elem -> ParsecT s u m (InnerTextResult Elem)
forall a b. (a -> b) -> a -> b
$ InnerTextResult { _matchesITR :: [Elem]
_matchesITR = [Elem
patternFound]
, _fullInner :: Elem
_fullInner = [Elem] -> Elem
forall a. Monoid a => [a] -> a
mconcat [Elem]
pre Elem -> Elem -> Elem
forall a. Semigroup a => a -> a -> a
<> Elem
patternFound Elem -> Elem -> Elem
forall a. Semigroup a => a -> a -> a
<> [Elem] -> Elem
forall a. Monoid a => [a] -> a
mconcat [Elem]
post }
anyTagInner :: Stream s m Char => Maybe (ParsecT s u m String) -> ParsecT s u m (InnerTextResult String)
anyTagInner :: forall s (m :: * -> *) u.
Stream s m Char =>
Maybe (ParsecT s u m Elem) -> ParsecT s u m (InnerTextResult Elem)
anyTagInner Maybe (ParsecT s u m Elem)
innerP = Maybe (ParsecT s u m Elem)
-> ParsecT s u m Elem -> ParsecT s u m (InnerTextResult Elem)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe (ParsecT s u m Elem)
-> ParsecT s u m Elem -> ParsecT s u m (InnerTextResult Elem)
baseParser Maybe (ParsecT s u m Elem)
innerP (ParsecT s u m Elem -> ParsecT s u m Elem
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
ParsecT s u m Char -> ParsecT s u m () -> ParsecT s u m ()
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsecT s u m Char -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'))
ParsecT s u m () -> ParsecT s u m Elem -> ParsecT s u m Elem
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s u m Char -> ParsecT s u m Elem
forall a. ParsecT s u m a -> ParsecT s u m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
ParsecT s u m Elem -> ParsecT s u m Elem -> ParsecT s u m Elem
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
string Elem
" " ParsecT s u m Elem -> ParsecT s u m Elem -> ParsecT s u m Elem
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
string Elem
">")))
normal :: Stream s m Char => Maybe (ParsecT s u m String) -> ParsecT s u m (InnerTextResult String)
normal :: forall s (m :: * -> *) u.
Stream s m Char =>
Maybe (ParsecT s u m Elem) -> ParsecT s u m (InnerTextResult Elem)
normal Maybe (ParsecT s u m Elem)
innerP = Maybe (ParsecT s u m Elem)
-> ParsecT s u m Elem -> ParsecT s u m (InnerTextResult Elem)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe (ParsecT s u m Elem)
-> ParsecT s u m Elem -> ParsecT s u m (InnerTextResult Elem)
baseParser Maybe (ParsecT s u m Elem)
innerP (ParsecT s u m Elem -> ParsecT s u m Elem
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
string (Elem
"</" Elem -> Elem -> Elem
forall a. Semigroup a => a -> a -> a
<> Elem
elem Elem -> Elem -> Elem
forall a. Semigroup a => a -> a -> a
<> Elem
">")))
Either Elem (InnerTextResult Elem)
x <- ParsecT s u m Elem
-> ParsecT s u m (InnerTextResult Elem)
-> ParsecT s u m (Either Elem (InnerTextResult Elem))
forall (m :: * -> *) a b.
Alternative m =>
m a -> m b -> m (Either a b)
eitherP (ParsecT s u m Elem -> ParsecT s u m Elem
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Elem -> ParsecT s u m Elem
forall s (m :: * -> *) u.
Stream s m Char =>
Elem -> ParsecT s u m Elem
string Elem
"/>")) (Maybe (ParsecT s u m Elem) -> ParsecT s u m (InnerTextResult Elem)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe (ParsecT s u m Elem) -> ParsecT s u m (InnerTextResult Elem)
normal Maybe (ParsecT s u m Elem)
innerPattern ParsecT s u m (InnerTextResult Elem)
-> ParsecT s u m (InnerTextResult Elem)
-> ParsecT s u m (InnerTextResult Elem)
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ParsecT s u m Elem) -> ParsecT s u m (InnerTextResult Elem)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe (ParsecT s u m Elem) -> ParsecT s u m (InnerTextResult Elem)
anyTagInner Maybe (ParsecT s u m Elem)
innerPattern)
case Either Elem (InnerTextResult Elem)
x of
Left Elem
a ->
case Maybe (ParsecT s u m Elem)
innerPattern of
Just ParsecT s u m Elem
a -> ParsecT s u m (InnerTextResult Elem)
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
Maybe (ParsecT s u m Elem)
Nothing ->
InnerTextResult Elem -> ParsecT s u m (InnerTextResult Elem)
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InnerTextResult { _matchesITR :: [Elem]
_matchesITR = [], _fullInner :: Elem
_fullInner = Elem
"" }
Right InnerTextResult Elem
b -> InnerTextResult Elem -> ParsecT s u m (InnerTextResult Elem)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return InnerTextResult Elem
b
{-# DEPRECATED elemParserOld "use elemParser" #-}
elemParserOld :: (Stream s m Char) =>
Maybe [Elem]
-> Maybe (ParsecT s u m String)
-> [(String, Maybe String)]
-> ParsecT s u m (Elem' String)
elemParserOld :: forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [Elem]
-> Maybe (ParsecT s u m Elem)
-> [(Elem, Maybe Elem)]
-> ParsecT s u m (Elem' Elem)
elemParserOld Maybe [Elem]
elemList Maybe (ParsecT s u m Elem)
innerSpec [(Elem, Maybe Elem)]
attrs = do
(Elem
elem', Attrs
attrs') <- Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [Elem] -> [(Elem, Maybe Elem)] -> ParsecT s u m (Elem, Attrs)
parseOpeningTag Maybe [Elem]
elemList [(Elem, Maybe Elem)]
attrs
InnerTextResult Elem
inner <- Elem
-> Maybe (ParsecT s u m Elem)
-> ParsecT s u m (InnerTextResult Elem)
forall s (m :: * -> *) u.
Stream s m Char =>
Elem
-> Maybe (ParsecT s u m Elem)
-> ParsecT s u m (InnerTextResult Elem)
parseInnerHTMLAndEndTag Elem
elem' Maybe (ParsecT s u m Elem)
innerSpec
Elem' Elem -> ParsecT s u m (Elem' Elem)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Elem' Elem -> ParsecT s u m (Elem' Elem))
-> Elem' Elem -> ParsecT s u m (Elem' Elem)
forall a b. (a -> b) -> a -> b
$ Elem -> Attrs -> [Elem] -> Elem -> Elem' Elem
forall a. Elem -> Attrs -> [a] -> Elem -> Elem' a
Elem' Elem
elem' Attrs
attrs' (InnerTextResult Elem -> [Elem]
forall a. InnerTextResult a -> [a]
_matchesITR InnerTextResult Elem
inner) (InnerTextResult Elem -> Elem
forall a. InnerTextResult a -> Elem
_fullInner InnerTextResult Elem
inner)