{-# LANGUAGE OverloadedStrings #-}
module Text.HTML.Onama
( Tag(..)
, Position
, parseTags
, tag
, satisfy
, TagOpenSelector(..)
, TagCloseSelector(..)
, AttrName(..)
, AttrValue(..)
, AttrSelector(..)
, (@:), (@=)
, tagOpen_, tagOpen
, tagClose_, tagClose
, tagText
, voidElement
, balancedTags
, anyOpenTag, anyCloseTag, anyValue
, innerText
, skip
)
where
import qualified Text.HTML.TagSoup as TS
import Text.StringLike
import qualified Text.Parsec as P
import Text.Parsec
( (<|>), (<?>), label, labels
, try, unexpected
, choice
, count, skipMany1, many1
, sepBy, sepBy1, endBy, endBy1, sepEndBy, sepEndBy1
, chainl, chainl1, chainr, chainr1
, eof
, notFollowedBy
, manyTill
, lookAhead
, anyToken
, between
, option, optionMaybe, optional
, unknownError, sysUnExpectError, mergeErrorReply
)
import qualified Data.Sequence as S
import Data.Sequence
( (<|), (|>), (><) )
import Data.String (IsString, fromString)
import Data.Foldable (toList)
type Position = (TS.Row, TS.Column)
data Tag str
= TagOpen str [TS.Attribute str] Position
| TagClose str Position
| TagText str Position
deriving (Tag str -> Tag str -> Bool
(Tag str -> Tag str -> Bool)
-> (Tag str -> Tag str -> Bool) -> Eq (Tag str)
forall str. Eq str => Tag str -> Tag str -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall str. Eq str => Tag str -> Tag str -> Bool
== :: Tag str -> Tag str -> Bool
$c/= :: forall str. Eq str => Tag str -> Tag str -> Bool
/= :: Tag str -> Tag str -> Bool
Eq, Int -> Tag str -> ShowS
[Tag str] -> ShowS
Tag str -> String
(Int -> Tag str -> ShowS)
-> (Tag str -> String) -> ([Tag str] -> ShowS) -> Show (Tag str)
forall str. Show str => Int -> Tag str -> ShowS
forall str. Show str => [Tag str] -> ShowS
forall str. Show str => Tag str -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall str. Show str => Int -> Tag str -> ShowS
showsPrec :: Int -> Tag str -> ShowS
$cshow :: forall str. Show str => Tag str -> String
show :: Tag str -> String
$cshowList :: forall str. Show str => [Tag str] -> ShowS
showList :: [Tag str] -> ShowS
Show)
parseOptions :: StringLike str => TS.ParseOptions str
parseOptions :: forall str. StringLike str => ParseOptions str
parseOptions = ParseOptions str
forall str. StringLike str => ParseOptions str
TS.parseOptions { TS.optTagPosition = True }
type CurrentPos str = (Position, [Tag str])
startPos :: CurrentPos str
startPos :: forall str. CurrentPos str
startPos = ((Int
1, Int
1), [])
parseTags :: StringLike str => str -> [Tag str]
parseTags :: forall str. StringLike str => str -> [Tag str]
parseTags str
str =
[Tag str] -> [Tag str]
forall a. [a] -> [a]
reverse ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ (Position, [Tag str]) -> [Tag str]
forall a b. (a, b) -> b
snd ((Position, [Tag str]) -> [Tag str])
-> (Position, [Tag str]) -> [Tag str]
forall a b. (a -> b) -> a -> b
$ ((Position, [Tag str]) -> Tag str -> (Position, [Tag str]))
-> (Position, [Tag str]) -> [Tag str] -> (Position, [Tag str])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Position, [Tag str]) -> Tag str -> (Position, [Tag str])
forall {str}.
(Position, [Tag str]) -> Tag str -> (Position, [Tag str])
attachPos (Position, [Tag str])
forall str. CurrentPos str
startPos ([Tag str] -> (Position, [Tag str]))
-> [Tag str] -> (Position, [Tag str])
forall a b. (a -> b) -> a -> b
$
[Tag str] -> [Tag str]
forall str. StringLike str => [Tag str] -> [Tag str]
TS.canonicalizeTags ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall a b. (a -> b) -> a -> b
$ ParseOptions str -> str -> [Tag str]
forall str. StringLike str => ParseOptions str -> str -> [Tag str]
TS.parseTagsOptions ParseOptions str
forall str. StringLike str => ParseOptions str
parseOptions str
str
where attachPos :: (Position, [Tag str]) -> Tag str -> (Position, [Tag str])
attachPos (Position
pos, [Tag str]
tags) Tag str
tag =
case Tag str
tag of
TS.TagOpen str
name [Attribute str]
attrs -> (Position
pos, str -> [Attribute str] -> Position -> Tag str
forall str. str -> [Attribute str] -> Position -> Tag str
TagOpen str
name [Attribute str]
attrs Position
pos Tag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
: [Tag str]
tags)
TS.TagClose str
name -> (Position
pos, str -> Position -> Tag str
forall str. str -> Position -> Tag str
TagClose str
name Position
pos Tag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
: [Tag str]
tags)
TS.TagText str
text -> (Position
pos, str -> Position -> Tag str
forall str. str -> Position -> Tag str
TagText str
text Position
pos Tag str -> [Tag str] -> [Tag str]
forall a. a -> [a] -> [a]
: [Tag str]
tags)
TS.TagComment str
_ -> (Position
pos, [Tag str]
tags)
TS.TagWarning str
_ -> (Position
pos, [Tag str]
tags)
TS.TagPosition Int
row Int
col -> ((Int
row, Int
col), [Tag str]
tags)
updatePos :: P.SourcePos -> Tag str -> [Tag str] -> P.SourcePos
updatePos :: forall str. SourcePos -> Tag str -> [Tag str] -> SourcePos
updatePos SourcePos
pos Tag str
tok [Tag str]
_ =
let (Int
row, Int
col) = case Tag str
tok of
TagOpen str
_ [Attribute str]
_ Position
pos -> Position
pos
TagClose str
_ Position
pos -> Position
pos
TagText str
_ Position
pos -> Position
pos
in (SourcePos -> Int -> SourcePos) -> Int -> SourcePos -> SourcePos
forall a b c. (a -> b -> c) -> b -> a -> c
flip SourcePos -> Int -> SourcePos
P.setSourceLine Int
row (SourcePos -> SourcePos) -> SourcePos -> SourcePos
forall a b. (a -> b) -> a -> b
$ (SourcePos -> Int -> SourcePos) -> Int -> SourcePos -> SourcePos
forall a b c. (a -> b -> c) -> b -> a -> c
flip SourcePos -> Int -> SourcePos
P.setSourceColumn Int
col (SourcePos -> SourcePos) -> SourcePos -> SourcePos
forall a b. (a -> b) -> a -> b
$ SourcePos
pos
tagName :: Tag str -> Maybe str
tagName :: forall str. Tag str -> Maybe str
tagName (TagOpen str
name [Attribute str]
_ Position
_) = str -> Maybe str
forall a. a -> Maybe a
Just str
name
tagName (TagClose str
name Position
_ ) = str -> Maybe str
forall a. a -> Maybe a
Just str
name
tagName Tag str
_other = Maybe str
forall a. Maybe a
Nothing
data TagOpenSelector
= AnyOpenTag [AttrSelector]
| TagOpenSelector String [AttrSelector]
data TagCloseSelector
= AnyCloseTag
| TagCloseSelector String
instance IsString TagOpenSelector where
fromString :: String -> TagOpenSelector
fromString String
str = String -> [AttrSelector] -> TagOpenSelector
TagOpenSelector String
str []
instance IsString TagCloseSelector where
fromString :: String -> TagCloseSelector
fromString = String -> TagCloseSelector
TagCloseSelector
tagSelectorAttrs :: TagOpenSelector -> [AttrSelector]
tagSelectorAttrs :: TagOpenSelector -> [AttrSelector]
tagSelectorAttrs (AnyOpenTag [AttrSelector]
attrs) = [AttrSelector]
attrs
tagSelectorAttrs (TagOpenSelector String
_ [AttrSelector]
attrs) = [AttrSelector]
attrs
newtype AttrName = AttrName String
instance IsString AttrName where
fromString :: String -> AttrName
fromString = String -> AttrName
AttrName
data AttrValue
= AnyAttr
| AttrValue String
instance IsString AttrValue where
fromString :: String -> AttrValue
fromString = String -> AttrValue
AttrValue
data AttrSelector = AttrSelector AttrName AttrValue
instance IsString AttrSelector where
fromString :: String -> AttrSelector
fromString String
str = AttrName -> AttrValue -> AttrSelector
AttrSelector (String -> AttrName
AttrName String
str) AttrValue
AnyAttr
(@:) :: TagOpenSelector -> [AttrSelector] -> TagOpenSelector
@: :: TagOpenSelector -> [AttrSelector] -> TagOpenSelector
(@:) TagOpenSelector
tagS [AttrSelector]
attrS =
case TagOpenSelector
tagS of
AnyOpenTag [AttrSelector]
_ -> [AttrSelector] -> TagOpenSelector
AnyOpenTag [AttrSelector]
attrS
TagOpenSelector String
name [AttrSelector]
_ -> String -> [AttrSelector] -> TagOpenSelector
TagOpenSelector String
name [AttrSelector]
attrS
(@=) :: AttrName -> AttrValue -> AttrSelector
@= :: AttrName -> AttrValue -> AttrSelector
(@=) = AttrName -> AttrValue -> AttrSelector
AttrSelector
tag :: (Monad m, Show str) => P.ParsecT [Tag str] u m (Tag str)
tag :: forall (m :: * -> *) str u.
(Monad m, Show str) =>
ParsecT [Tag str] u m (Tag str)
tag = (Tag str -> String)
-> (SourcePos -> Tag str -> [Tag str] -> SourcePos)
-> (Tag str -> Maybe (Tag str))
-> ParsecT [Tag str] u m (Tag str)
forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
P.tokenPrim Tag str -> String
forall a. Show a => a -> String
show SourcePos -> Tag str -> [Tag str] -> SourcePos
forall str. SourcePos -> Tag str -> [Tag str] -> SourcePos
updatePos Tag str -> Maybe (Tag str)
forall a. a -> Maybe a
Just
satisfy :: (Monad m, Show str) => (Tag str -> Bool) -> P.ParsecT [Tag str] u m (Tag str)
satisfy :: forall (m :: * -> *) str u.
(Monad m, Show str) =>
(Tag str -> Bool) -> ParsecT [Tag str] u m (Tag str)
satisfy Tag str -> Bool
f = (Tag str -> String)
-> (SourcePos -> Tag str -> [Tag str] -> SourcePos)
-> (Tag str -> Maybe (Tag str))
-> ParsecT [Tag str] u m (Tag str)
forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
P.tokenPrim Tag str -> String
forall a. Show a => a -> String
show SourcePos -> Tag str -> [Tag str] -> SourcePos
forall str. SourcePos -> Tag str -> [Tag str] -> SourcePos
updatePos ((Tag str -> Maybe (Tag str)) -> ParsecT [Tag str] u m (Tag str))
-> (Tag str -> Maybe (Tag str)) -> ParsecT [Tag str] u m (Tag str)
forall a b. (a -> b) -> a -> b
$ \Tag str
tag ->
if Tag str -> Bool
f Tag str
tag then Tag str -> Maybe (Tag str)
forall a. a -> Maybe a
Just Tag str
tag else Maybe (Tag str)
forall a. Maybe a
Nothing
matchAttrValue :: StringLike str => str -> AttrValue -> Bool
matchAttrValue :: forall str. StringLike str => str -> AttrValue -> Bool
matchAttrValue str
val AttrValue
attrS = case AttrValue
attrS of
AttrValue
AnyAttr -> Bool
True
AttrValue String
val' -> str -> String
forall a. StringLike a => a -> String
toString str
val String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
val'
tagOpen_ :: (Monad m, StringLike str, Show str)
=> TagOpenSelector
-> P.ParsecT [Tag str] u m (Tag str)
tagOpen_ :: forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagOpenSelector -> ParsecT [Tag str] u m (Tag str)
tagOpen_ TagOpenSelector
tagS =
(Tag str -> Bool) -> ParsecT [Tag str] u m (Tag str)
forall (m :: * -> *) str u.
(Monad m, Show str) =>
(Tag str -> Bool) -> ParsecT [Tag str] u m (Tag str)
satisfy (\Tag str
tag -> case Tag str
tag of
TagOpen str
name [Attribute str]
attrs Position
_ ->
let attrS :: [AttrSelector]
attrS = TagOpenSelector -> [AttrSelector]
tagSelectorAttrs TagOpenSelector
tagS in
case TagOpenSelector
tagS of
AnyOpenTag [AttrSelector]
_ -> [AttrSelector] -> [Attribute str] -> Bool
forall {t :: * -> *} {str} {a}.
(Foldable t, StringLike str, Eq a, IsString a) =>
t AttrSelector -> [(a, str)] -> Bool
matchAttrs [AttrSelector]
attrS [Attribute str]
attrs
TagOpenSelector String
name' [AttrSelector]
_ ->
str -> String
forall a. StringLike a => a -> String
toString str
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name' Bool -> Bool -> Bool
&& [AttrSelector] -> [Attribute str] -> Bool
forall {t :: * -> *} {str} {a}.
(Foldable t, StringLike str, Eq a, IsString a) =>
t AttrSelector -> [(a, str)] -> Bool
matchAttrs [AttrSelector]
attrS [Attribute str]
attrs
Tag str
_other -> Bool
False)
ParsecT [Tag str] u m (Tag str)
-> String -> ParsecT [Tag str] u m (Tag str)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Couldn't parse an open tag."
where matchAttrs :: t AttrSelector -> [(a, str)] -> Bool
matchAttrs t AttrSelector
attrS [(a, str)]
attrs =
(AttrSelector -> Bool) -> t AttrSelector -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(AttrSelector (AttrName String
name) AttrValue
attrValS) ->
case a -> [(a, str)] -> Maybe str
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> a
forall a. IsString a => String -> a
fromString String
name) [(a, str)]
attrs of
Just str
val -> str -> AttrValue -> Bool
forall str. StringLike str => str -> AttrValue -> Bool
matchAttrValue str
val AttrValue
attrValS
Maybe str
Nothing -> Bool
False)
t AttrSelector
attrS
tagOpen :: (Monad m, StringLike str, Show str)
=> TagOpenSelector
-> P.ParsecT [Tag str] u m (Tag str)
tagOpen :: forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagOpenSelector -> ParsecT [Tag str] u m (Tag str)
tagOpen TagOpenSelector
tagS = ParsecT [Tag str] u m (Tag str) -> ParsecT [Tag str] u m (Tag str)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag str] u m str -> ParsecT [Tag str] u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tag str] u m str
forall (m :: * -> *) str u.
(Monad m, Show str) =>
ParsecT [Tag str] u m str
tagText ParsecT [Tag str] u m ()
-> ParsecT [Tag str] u m (Tag str)
-> ParsecT [Tag str] u m (Tag str)
forall a b.
ParsecT [Tag str] u m a
-> ParsecT [Tag str] u m b -> ParsecT [Tag str] u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TagOpenSelector -> ParsecT [Tag str] u m (Tag str)
forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagOpenSelector -> ParsecT [Tag str] u m (Tag str)
tagOpen_ TagOpenSelector
tagS)
tagClose_ :: (Monad m, StringLike str, Show str)
=> TagCloseSelector
-> P.ParsecT [Tag str] u m (Tag str)
tagClose_ :: forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagCloseSelector -> ParsecT [Tag str] u m (Tag str)
tagClose_ TagCloseSelector
tagS =
(Tag str -> Bool) -> ParsecT [Tag str] u m (Tag str)
forall (m :: * -> *) str u.
(Monad m, Show str) =>
(Tag str -> Bool) -> ParsecT [Tag str] u m (Tag str)
satisfy (\Tag str
tag -> case Tag str
tag of
TagClose str
name Position
_ ->
case TagCloseSelector
tagS of
TagCloseSelector
AnyCloseTag -> Bool
True
TagCloseSelector String
name' -> str -> String
forall a. StringLike a => a -> String
toString str
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name'
Tag str
_other -> Bool
False)
tagClose :: (Monad m, StringLike str, Show str)
=> TagCloseSelector
-> P.ParsecT [Tag str] u m (Tag str)
tagClose :: forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagCloseSelector -> ParsecT [Tag str] u m (Tag str)
tagClose TagCloseSelector
tagS = ParsecT [Tag str] u m (Tag str) -> ParsecT [Tag str] u m (Tag str)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag str] u m str -> ParsecT [Tag str] u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tag str] u m str
forall (m :: * -> *) str u.
(Monad m, Show str) =>
ParsecT [Tag str] u m str
tagText ParsecT [Tag str] u m ()
-> ParsecT [Tag str] u m (Tag str)
-> ParsecT [Tag str] u m (Tag str)
forall a b.
ParsecT [Tag str] u m a
-> ParsecT [Tag str] u m b -> ParsecT [Tag str] u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TagCloseSelector -> ParsecT [Tag str] u m (Tag str)
forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagCloseSelector -> ParsecT [Tag str] u m (Tag str)
tagClose_ TagCloseSelector
tagS)
notParse :: P.Stream s m t => P.ParsecT s u m t -> P.ParsecT s u m ()
notParse :: forall s (m :: * -> *) t u.
Stream s m t =>
ParsecT s u m t -> ParsecT s u m ()
notParse ParsecT s u m t
parser = do
Maybe t
parsed <- ParsecT s u m (Maybe t) -> ParsecT s u m (Maybe t)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m (Maybe t) -> ParsecT s u m (Maybe t))
-> ParsecT s u m (Maybe t) -> ParsecT s u m (Maybe t)
forall a b. (a -> b) -> a -> b
$ t -> Maybe t
forall a. a -> Maybe a
Just (t -> Maybe t) -> ParsecT s u m t -> ParsecT s u m (Maybe t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m t
parser
ParsecT s u m (Maybe t)
-> ParsecT s u m (Maybe t) -> ParsecT s u m (Maybe t)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe t -> ParsecT s u m (Maybe t)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe t
forall a. Maybe a
Nothing
case Maybe t
parsed of
Maybe t
Nothing -> () -> ParsecT s u m ()
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just t
_ -> String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected String
"parser given to notParse succeeded"
tagText :: (Monad m, Show str) => P.ParsecT [Tag str] u m str
tagText :: forall (m :: * -> *) str u.
(Monad m, Show str) =>
ParsecT [Tag str] u m str
tagText = (Tag str -> String)
-> (SourcePos -> Tag str -> [Tag str] -> SourcePos)
-> (Tag str -> Maybe str)
-> ParsecT [Tag str] u m str
forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
P.tokenPrim Tag str -> String
forall a. Show a => a -> String
show SourcePos -> Tag str -> [Tag str] -> SourcePos
forall str. SourcePos -> Tag str -> [Tag str] -> SourcePos
updatePos ((Tag str -> Maybe str) -> ParsecT [Tag str] u m str)
-> (Tag str -> Maybe str) -> ParsecT [Tag str] u m str
forall a b. (a -> b) -> a -> b
$ \Tag str
tag -> case Tag str
tag of
TagText str
text Position
_ -> str -> Maybe str
forall a. a -> Maybe a
Just str
text
Tag str
_other -> Maybe str
forall a. Maybe a
Nothing
voidElement :: (Monad m, StringLike str, Show str) => P.ParsecT [Tag str] u m (Tag str)
voidElement :: forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
ParsecT [Tag str] u m (Tag str)
voidElement = [ParsecT [Tag str] u m (Tag str)]
-> ParsecT [Tag str] u m (Tag str)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT [Tag str] u m (Tag str)]
-> ParsecT [Tag str] u m (Tag str))
-> [ParsecT [Tag str] u m (Tag str)]
-> ParsecT [Tag str] u m (Tag str)
forall a b. (a -> b) -> a -> b
$ (TagOpenSelector -> ParsecT [Tag str] u m (Tag str))
-> [TagOpenSelector] -> [ParsecT [Tag str] u m (Tag str)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TagOpenSelector -> ParsecT [Tag str] u m (Tag str)
forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagOpenSelector -> ParsecT [Tag str] u m (Tag str)
tagOpen_ [ TagOpenSelector
"area", TagOpenSelector
"base", TagOpenSelector
"br", TagOpenSelector
"col", TagOpenSelector
"command"
, TagOpenSelector
"embed", TagOpenSelector
"hr", TagOpenSelector
"img", TagOpenSelector
"input", TagOpenSelector
"keygen"
, TagOpenSelector
"link", TagOpenSelector
"meta", TagOpenSelector
"param", TagOpenSelector
"source", TagOpenSelector
"track"
, TagOpenSelector
"wbr"
]
balancedTags_ :: (Monad m, StringLike str, Show str)
=> TagOpenSelector
-> P.ParsecT [Tag str] u m (S.Seq (Tag str))
balancedTags_ :: forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagOpenSelector -> ParsecT [Tag str] u m (Seq (Tag str))
balancedTags_ TagOpenSelector
tagS = do
Tag str
openTag <- TagOpenSelector -> ParsecT [Tag str] u m (Tag str)
forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagOpenSelector -> ParsecT [Tag str] u m (Tag str)
tagOpen_ TagOpenSelector
tagS
Seq (Tag str)
tailTags <- Tag str -> ParsecT [Tag str] u m (Seq (Tag str))
forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
Tag str -> ParsecT [Tag str] u m (Seq (Tag str))
tagTail Tag str
openTag
Seq (Tag str) -> ParsecT [Tag str] u m (Seq (Tag str))
forall a. a -> ParsecT [Tag str] u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq (Tag str) -> ParsecT [Tag str] u m (Seq (Tag str)))
-> Seq (Tag str) -> ParsecT [Tag str] u m (Seq (Tag str))
forall a b. (a -> b) -> a -> b
$ Tag str
openTag Tag str -> Seq (Tag str) -> Seq (Tag str)
forall a. a -> Seq a -> Seq a
<| Seq (Tag str)
tailTags
tagTail :: (Monad m, StringLike str, Show str)
=> Tag str
-> P.ParsecT [Tag str] u m (S.Seq (Tag str))
tagTail :: forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
Tag str -> ParsecT [Tag str] u m (Seq (Tag str))
tagTail (TagOpen str
name [Attribute str]
_ Position
_) = do
[Seq (Tag str)]
innerTags <- ParsecT [Tag str] u m (Seq (Tag str))
-> ParsecT [Tag str] u m [Seq (Tag str)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (ParsecT [Tag str] u m (Seq (Tag str))
-> ParsecT [Tag str] u m [Seq (Tag str)])
-> ParsecT [Tag str] u m (Seq (Tag str))
-> ParsecT [Tag str] u m [Seq (Tag str)]
forall a b. (a -> b) -> a -> b
$ ParsecT [Tag str] u m (Seq (Tag str))
-> ParsecT [Tag str] u m (Seq (Tag str))
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT [Tag str] u m (Seq (Tag str))
forall {u}. ParsecT [Tag str] u m (Seq (Tag str))
notMatchingClose
Tag str
matchingClose <- TagCloseSelector -> ParsecT [Tag str] u m (Tag str)
forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagCloseSelector -> ParsecT [Tag str] u m (Tag str)
tagClose_ TagCloseSelector
closeS
Seq (Tag str) -> ParsecT [Tag str] u m (Seq (Tag str))
forall a. a -> ParsecT [Tag str] u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq (Tag str) -> ParsecT [Tag str] u m (Seq (Tag str)))
-> Seq (Tag str) -> ParsecT [Tag str] u m (Seq (Tag str))
forall a b. (a -> b) -> a -> b
$ [Seq (Tag str)] -> Seq (Tag str)
forall a. Monoid a => [a] -> a
mconcat [Seq (Tag str)]
innerTags Seq (Tag str) -> Tag str -> Seq (Tag str)
forall a. Seq a -> a -> Seq a
|> Tag str
matchingClose
where closeS :: TagCloseSelector
closeS = String -> TagCloseSelector
TagCloseSelector (String -> TagCloseSelector) -> String -> TagCloseSelector
forall a b. (a -> b) -> a -> b
$ str -> String
forall a. StringLike a => a -> String
toString str
name
notMatchingClose :: ParsecT [Tag str] u m (Seq (Tag str))
notMatchingClose = ( Tag str -> Seq (Tag str)
forall a. a -> Seq a
S.singleton (Tag str -> Seq (Tag str))
-> ParsecT [Tag str] u m (Tag str)
-> ParsecT [Tag str] u m (Seq (Tag str))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Tag str] u m (Tag str) -> ParsecT [Tag str] u m ()
forall s (m :: * -> *) t u.
Stream s m t =>
ParsecT s u m t -> ParsecT s u m ()
notParse (TagCloseSelector -> ParsecT [Tag str] u m (Tag str)
forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagCloseSelector -> ParsecT [Tag str] u m (Tag str)
tagClose_ TagCloseSelector
closeS) ParsecT [Tag str] u m ()
-> ParsecT [Tag str] u m (Tag str)
-> ParsecT [Tag str] u m (Tag str)
forall a b.
ParsecT [Tag str] u m a
-> ParsecT [Tag str] u m b -> ParsecT [Tag str] u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tag str] u m (Tag str)
forall (m :: * -> *) str u.
(Monad m, Show str) =>
ParsecT [Tag str] u m (Tag str)
tag)
ParsecT [Tag str] u m (Seq (Tag str))
-> ParsecT [Tag str] u m (Seq (Tag str))
-> ParsecT [Tag str] u m (Seq (Tag str))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Tag str -> Seq (Tag str)
forall a. a -> Seq a
S.singleton (Tag str -> Seq (Tag str))
-> ParsecT [Tag str] u m (Tag str)
-> ParsecT [Tag str] u m (Seq (Tag str))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tag str] u m (Tag str)
forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
ParsecT [Tag str] u m (Tag str)
voidElement
ParsecT [Tag str] u m (Seq (Tag str))
-> ParsecT [Tag str] u m (Seq (Tag str))
-> ParsecT [Tag str] u m (Seq (Tag str))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (TagOpenSelector -> ParsecT [Tag str] u m (Seq (Tag str))
forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagOpenSelector -> ParsecT [Tag str] u m (Seq (Tag str))
balancedTags_ TagOpenSelector
anyOpenTag)
)
balancedTags :: (Monad m, StringLike str, Show str)
=> TagOpenSelector
-> P.ParsecT [Tag str] u m [Tag str]
balancedTags :: forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagOpenSelector -> ParsecT [Tag str] u m [Tag str]
balancedTags TagOpenSelector
tagS = ParsecT [Tag str] u m str -> ParsecT [Tag str] u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tag str] u m str
forall (m :: * -> *) str u.
(Monad m, Show str) =>
ParsecT [Tag str] u m str
tagText ParsecT [Tag str] u m ()
-> ParsecT [Tag str] u m [Tag str]
-> ParsecT [Tag str] u m [Tag str]
forall a b.
ParsecT [Tag str] u m a
-> ParsecT [Tag str] u m b -> ParsecT [Tag str] u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Seq (Tag str) -> [Tag str]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (Tag str) -> [Tag str])
-> ParsecT [Tag str] u m (Seq (Tag str))
-> ParsecT [Tag str] u m [Tag str]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TagOpenSelector -> ParsecT [Tag str] u m (Seq (Tag str))
forall (m :: * -> *) str u.
(Monad m, StringLike str, Show str) =>
TagOpenSelector -> ParsecT [Tag str] u m (Seq (Tag str))
balancedTags_ TagOpenSelector
tagS
anyOpenTag :: TagOpenSelector
anyOpenTag :: TagOpenSelector
anyOpenTag = [AttrSelector] -> TagOpenSelector
AnyOpenTag []
anyCloseTag :: TagCloseSelector
anyCloseTag :: TagCloseSelector
anyCloseTag = TagCloseSelector
AnyCloseTag
anyValue :: AttrValue
anyValue :: AttrValue
anyValue = AttrValue
AnyAttr
skip :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m ()
skip :: forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skip ParsecT s u m a
p = ParsecT s u m a
p ParsecT s u m a -> 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 ()
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
innerText :: StringLike str => [Tag str] -> str
innerText :: forall str. StringLike str => [Tag str] -> str
innerText [Tag str]
tags = String -> str
forall a. IsString a => String -> a
fromString (String -> str) -> String -> str
forall a b. (a -> b) -> a -> b
$ Seq Char -> String
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Char -> String) -> Seq Char -> String
forall a b. (a -> b) -> a -> b
$ [Seq Char] -> Seq Char
forall a. Monoid a => [a] -> a
mconcat ([Seq Char] -> Seq Char) -> [Seq Char] -> Seq Char
forall a b. (a -> b) -> a -> b
$ (Tag str -> Seq Char) -> [Tag str] -> [Seq Char]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tag str -> Seq Char
forall {a}. StringLike a => Tag a -> Seq Char
tagInner [Tag str]
tags
where tagInner :: Tag a -> Seq Char
tagInner (TagOpen a
"br" [Attribute a]
_ Position
_) = Char -> Seq Char
forall a. a -> Seq a
S.singleton Char
'\n'
tagInner (TagText a
text Position
_) = String -> Seq Char
forall a. [a] -> Seq a
S.fromList (String -> Seq Char) -> String -> Seq Char
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. StringLike a => a -> String
toString a
text
tagInner Tag a
_other = Seq Char
forall a. Seq a
S.empty