{-# LANGUAGE OverloadedStrings #-}

{-|
  Module: Text.HTML.Onama
  Description: Parsec extended with functions to handle HTML parsing.
  Copyright: (c) William Yao, 2017-2024
  License: BSD-3
  Maintainer: williamyaoh@gmail.com
  Stability: experimental

  Some extra primitives to parse HTMl with Parsec.

  You'll still need to import "Text.Parsec" along with this library. These
  primitives will work with all the combinators from Parsec. Note that you'll
  need to override Parsec's @satisfies@, since that one only works on
  character streams (for some reason).

  > testParser = dp
  >   tagOpen "b"
  >   bolded <- text
  >   tagClose "b"

  > testParser2 = do
  >   tagClose "div"
  >   tagOpen "p"
  >   inner <- text
  >   tagClose "p"
 -}
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), [])

-- | Return a list of tags parsed from some sort of string.
--   This list should then get fed into an Onama parser.
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

-- | Primitive. Return the next input tag.
--   All other primitive parsers should be implemented in terms of this.
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

-- | Create a parser which parses a single HTML tag if it passes
--   the given predicate. Return the parsed tag.
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)

-- | Take a parser, return a parser which only succeeds if the given parser
--   fails. Consumes no input.
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

-- | Certain HTML elements are self closing. In addition, they can show
--   up /without/ their closing slash. For these, we just want to go over
--   their opening tag.
--   These elements are void, according to the W3C spec:
--   <https://www.w3.org/TR/2012/WD-html-markup-20121025/syntax.html#syntax-elements>
--
--   * area
--   * base
--   * br
--   * col
--   * command
--   * embed
--   * hr
--   * img
--   * input
--   * keygen
--   * link
--   * meta
--   * param
--   * source
--   * track
--   * wbr
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@ produces a parser which will ignore the output of @p@.
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