{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
module Scrappy.Elem.Types where
import Scrappy.Links
import Data.Aeson
import Text.URI (URI)
import Data.Text (Text, unpack)
import Data.Map (Map, toList)
import qualified Data.Map as Map
import Data.Graph (Tree (Node), Forest)
import Control.Applicative (some)
import Text.Parsec (ParsecT, Stream, parserZero, string, (<|>), anyChar, char, optional, try, manyTill, alphaNum
, parserFail)
import Data.Maybe (fromMaybe)
class HtmlMatcher a where
class ShowHTML a where
showH :: a -> String
instance ShowHTML Char where
showH :: Char -> String
showH = Char -> String
forall a. Show a => a -> String
show
instance Show a => ShowHTML [a] where
showH :: [a] -> String
showH [a]
x = [a] -> String
forall a. Show a => a -> String
show [a]
x
instance ShowHTML Text where
showH :: Text -> String
showH = Text -> String
unpack
class ElementRep (a :: * -> *) where
elTag :: a b -> Elem
attrs :: a b -> Attrs
innerText' :: a b -> String
matches' :: a b -> [b]
class (ShowHTML c, ElementRep a) => InnerHTMLRep (a :: * -> *) (b :: * -> *) c | a c -> b c where
foldHtmlMatcher :: [HTMLMatcher a c] -> b c
innerText :: b c -> String
matches :: b c -> [c]
noPat :: Maybe (ParsecT s u m String)
noPat :: forall s u (m :: * -> *). Maybe (ParsecT s u m String)
noPat = Maybe (ParsecT s u m String)
forall a. Maybe a
Nothing
coerceAttrs :: Attrs -> [(String, Maybe String)]
coerceAttrs :: Attrs -> [(String, Maybe String)]
coerceAttrs Attrs
as = (((String, String) -> (String, Maybe String))
-> [(String, String)] -> [(String, Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(((String, String) -> (String, Maybe String))
-> [(String, String)] -> [(String, Maybe String)])
-> ((String -> Maybe String)
-> (String, String) -> (String, Maybe String))
-> (String -> Maybe String)
-> [(String, String)]
-> [(String, Maybe String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String -> Maybe String)
-> (String, String) -> (String, Maybe String)
forall a b. (a -> b) -> (String, a) -> (String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) String -> Maybe String
f ([(String, String)] -> [(String, Maybe String)])
-> [(String, String)] -> [(String, Maybe String)]
forall a b. (a -> b) -> a -> b
$ Attrs -> [(String, String)]
forall k a. Map k a -> [(k, a)]
toList Attrs
as
f :: String -> Maybe String
f :: String -> Maybe String
f String
"" = Maybe String
forall a. Maybe a
Nothing
f String
s = String -> Maybe String
forall a. a -> Maybe a
Just String
s
instance Semigroup (InnerTextHTMLTree a) where
InnerTextHTMLTree [a]
a String
b Forest ElemHead
c <> :: InnerTextHTMLTree a -> InnerTextHTMLTree a -> InnerTextHTMLTree a
<> InnerTextHTMLTree [a]
d String
e Forest ElemHead
f = [a] -> String -> Forest ElemHead -> InnerTextHTMLTree a
forall a. [a] -> String -> Forest ElemHead -> InnerTextHTMLTree a
InnerTextHTMLTree ([a]
a [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
d) (String
b String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e) (Forest ElemHead
c Forest ElemHead -> Forest ElemHead -> Forest ElemHead
forall a. Semigroup a => a -> a -> a
<> Forest ElemHead
f)
instance Monoid (InnerTextHTMLTree a) where
mempty :: InnerTextHTMLTree a
mempty = InnerTextHTMLTree { _matches :: [a]
_matches = [], _innerText :: String
_innerText = String
"", innerTree :: Forest ElemHead
innerTree = [] }
instance Semigroup (InnerTextResult a) where
InnerTextResult [a]
a String
b <> :: InnerTextResult a -> InnerTextResult a -> InnerTextResult a
<> InnerTextResult [a]
a' String
b' = [a] -> String -> InnerTextResult a
forall a. [a] -> String -> InnerTextResult a
InnerTextResult ([a]
a [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
a') (String
b String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
b')
instance Monoid (InnerTextResult a) where
mempty :: InnerTextResult a
mempty = InnerTextResult { _matchesITR :: [a]
_matchesITR = [], _fullInner :: String
_fullInner = String
"" }
instance ShowHTML c => InnerHTMLRep TreeHTML InnerTextHTMLTree c where
foldHtmlMatcher :: [HTMLMatcher TreeHTML c] -> InnerTextHTMLTree c
foldHtmlMatcher = (HTMLMatcher TreeHTML c
-> InnerTextHTMLTree c -> InnerTextHTMLTree c)
-> InnerTextHTMLTree c
-> [HTMLMatcher TreeHTML c]
-> InnerTextHTMLTree c
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr HTMLMatcher TreeHTML c
-> InnerTextHTMLTree c -> InnerTextHTMLTree c
forall a.
(InnerHTMLRep TreeHTML InnerTextHTMLTree a, ShowHTML a) =>
HTMLMatcher TreeHTML a
-> InnerTextHTMLTree a -> InnerTextHTMLTree a
fHM_c InnerTextHTMLTree c
forall a. Monoid a => a
mempty
matches :: InnerTextHTMLTree c -> [c]
matches = InnerTextHTMLTree c -> [c]
forall a. InnerTextHTMLTree a -> [a]
_matches
innerText :: InnerTextHTMLTree c -> String
innerText = InnerTextHTMLTree c -> String
forall a. InnerTextHTMLTree a -> String
_innerText
instance ShowHTML c => InnerHTMLRep Elem' InnerTextResult c where
foldHtmlMatcher :: [HTMLMatcher Elem' c] -> InnerTextResult c
foldHtmlMatcher = (HTMLMatcher Elem' c -> InnerTextResult c -> InnerTextResult c)
-> InnerTextResult c -> [HTMLMatcher Elem' c] -> InnerTextResult c
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' c -> InnerTextResult c -> InnerTextResult c
forall a (e :: * -> *).
(ShowHTML a, ElementRep e) =>
HTMLMatcher e a -> InnerTextResult a -> InnerTextResult a
foldFuncITR InnerTextResult c
forall a. Monoid a => a
mempty
matches :: InnerTextResult c -> [c]
matches = InnerTextResult c -> [c]
forall a. InnerTextResult a -> [a]
_matchesITR
innerText :: InnerTextResult c -> String
innerText = InnerTextResult c -> String
forall a. InnerTextResult a -> String
_fullInner
instance ElementRep (Elem') where
elTag :: forall b. Elem' b -> String
elTag = Elem' b -> String
forall b. Elem' b -> String
_el
attrs :: forall b. Elem' b -> Attrs
attrs = Elem' b -> Attrs
forall b. Elem' b -> Attrs
_attrs
innerText' :: forall b. Elem' b -> String
innerText' = Elem' b -> String
forall b. Elem' b -> String
innerHtmlFull
matches' :: forall b. Elem' b -> [b]
matches' = Elem' b -> [b]
forall b. Elem' b -> [b]
innerMatches
instance ElementRep (TreeHTML) where
elTag :: forall b. TreeHTML b -> String
elTag = TreeHTML b -> String
forall b. TreeHTML b -> String
_topEl
attrs :: forall b. TreeHTML b -> Attrs
attrs = TreeHTML b -> Attrs
forall b. TreeHTML b -> Attrs
_topAttrs
innerText' :: forall b. TreeHTML b -> String
innerText' = TreeHTML b -> String
forall b. TreeHTML b -> String
_innerText'
matches' :: forall b. TreeHTML b -> [b]
matches' = TreeHTML b -> [b]
forall b. TreeHTML b -> [b]
_matches'
instance ShowHTML a => ShowHTML (Elem' a) where
showH :: Elem' a -> String
showH = Elem' a -> String
forall b. Elem' b -> String
elemToStr
instance ShowHTML a => ShowHTML (TreeHTML a) where
showH :: TreeHTML a -> String
showH = TreeHTML a -> String
forall a. ShowHTML a => TreeHTML a -> String
treeElemToStr
data TreeHTML a = TreeHTML { forall b. TreeHTML b -> String
_topEl :: Elem
, forall b. TreeHTML b -> Attrs
_topAttrs :: Map String String
, forall b. TreeHTML b -> [b]
_matches' :: [a]
, forall b. TreeHTML b -> String
_innerText' :: String
, forall a. TreeHTML a -> Forest ElemHead
_innerTree' :: Forest ElemHead
} deriving Int -> TreeHTML a -> String -> String
[TreeHTML a] -> String -> String
TreeHTML a -> String
(Int -> TreeHTML a -> String -> String)
-> (TreeHTML a -> String)
-> ([TreeHTML a] -> String -> String)
-> Show (TreeHTML a)
forall a. Show a => Int -> TreeHTML a -> String -> String
forall a. Show a => [TreeHTML a] -> String -> String
forall a. Show a => TreeHTML a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> TreeHTML a -> String -> String
showsPrec :: Int -> TreeHTML a -> String -> String
$cshow :: forall a. Show a => TreeHTML a -> String
show :: TreeHTML a -> String
$cshowList :: forall a. Show a => [TreeHTML a] -> String -> String
showList :: [TreeHTML a] -> String -> String
Show
data InnerTextHTMLTree a = InnerTextHTMLTree { forall a. InnerTextHTMLTree a -> [a]
_matches :: [a]
, forall a. InnerTextHTMLTree a -> String
_innerText :: String
, forall a. InnerTextHTMLTree a -> Forest ElemHead
innerTree :: Forest ElemHead
}
data Elem' a = Elem' { forall b. Elem' b -> String
_el :: Elem
, forall b. Elem' b -> Attrs
_attrs :: Map String String
, forall b. Elem' b -> [b]
innerMatches :: [a]
, forall b. Elem' b -> String
innerHtmlFull :: String
} deriving Int -> Elem' a -> String -> String
[Elem' a] -> String -> String
Elem' a -> String
(Int -> Elem' a -> String -> String)
-> (Elem' a -> String)
-> ([Elem' a] -> String -> String)
-> Show (Elem' a)
forall a. Show a => Int -> Elem' a -> String -> String
forall a. Show a => [Elem' a] -> String -> String
forall a. Show a => Elem' a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Elem' a -> String -> String
showsPrec :: Int -> Elem' a -> String -> String
$cshow :: forall a. Show a => Elem' a -> String
show :: Elem' a -> String
$cshowList :: forall a. Show a => [Elem' a] -> String -> String
showList :: [Elem' a] -> String -> String
Show
data InnerTextResult a = InnerTextResult { forall a. InnerTextResult a -> [a]
_matchesITR :: [a]
, forall a. InnerTextResult a -> String
_fullInner :: String
} deriving Int -> InnerTextResult a -> String -> String
[InnerTextResult a] -> String -> String
InnerTextResult a -> String
(Int -> InnerTextResult a -> String -> String)
-> (InnerTextResult a -> String)
-> ([InnerTextResult a] -> String -> String)
-> Show (InnerTextResult a)
forall a. Show a => Int -> InnerTextResult a -> String -> String
forall a. Show a => [InnerTextResult a] -> String -> String
forall a. Show a => InnerTextResult a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> InnerTextResult a -> String -> String
showsPrec :: Int -> InnerTextResult a -> String -> String
$cshow :: forall a. Show a => InnerTextResult a -> String
show :: InnerTextResult a -> String
$cshowList :: forall a. Show a => [InnerTextResult a] -> String -> String
showList :: [InnerTextResult a] -> String -> String
Show
type HMatcher' a b c = [HTMLMatcher b c] -> a c
data HTMLMatcher (a :: * -> *) b = IText String | Element (a b) | Match b deriving Int -> HTMLMatcher a b -> String -> String
[HTMLMatcher a b] -> String -> String
HTMLMatcher a b -> String
(Int -> HTMLMatcher a b -> String -> String)
-> (HTMLMatcher a b -> String)
-> ([HTMLMatcher a b] -> String -> String)
-> Show (HTMLMatcher a b)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall (a :: * -> *) b.
(Show b, Show (a b)) =>
Int -> HTMLMatcher a b -> String -> String
forall (a :: * -> *) b.
(Show b, Show (a b)) =>
[HTMLMatcher a b] -> String -> String
forall (a :: * -> *) b.
(Show b, Show (a b)) =>
HTMLMatcher a b -> String
$cshowsPrec :: forall (a :: * -> *) b.
(Show b, Show (a b)) =>
Int -> HTMLMatcher a b -> String -> String
showsPrec :: Int -> HTMLMatcher a b -> String -> String
$cshow :: forall (a :: * -> *) b.
(Show b, Show (a b)) =>
HTMLMatcher a b -> String
show :: HTMLMatcher a b -> String
$cshowList :: forall (a :: * -> *) b.
(Show b, Show (a b)) =>
[HTMLMatcher a b] -> String -> String
showList :: [HTMLMatcher a b] -> String -> String
Show
type HTMLMatcherM a = HTMLMatcher TreeHTML a
type Inner a = HTMLMatcher Elem' a
type HTMLMatcherList a = HTMLMatcher [] a
data HTMLBare e a = HTMLBare { forall (e :: * -> *) a. HTMLBare e a -> String
tag :: Elem
, :: Attrs
, forall (e :: * -> *) a. HTMLBare e a -> [HTMLMatcher e a]
htmlM :: [HTMLMatcher e a]
}
type ElemHead = (Elem, Attrs)
type Attrs = Map String String
type Elem = String
data AttrsError = IncorrectAttrs deriving Int -> AttrsError -> String -> String
[AttrsError] -> String -> String
AttrsError -> String
(Int -> AttrsError -> String -> String)
-> (AttrsError -> String)
-> ([AttrsError] -> String -> String)
-> Show AttrsError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> AttrsError -> String -> String
showsPrec :: Int -> AttrsError -> String -> String
$cshow :: AttrsError -> String
show :: AttrsError -> String
$cshowList :: [AttrsError] -> String -> String
showList :: [AttrsError] -> String -> String
Show
instance Eq (GroupHtml e a) where
GroupHtml [e a]
_ Int
gl1 Int
ml1 == :: GroupHtml e a -> GroupHtml e a -> Bool
== GroupHtml [e a]
_ Int
gl2 Int
ml2 = (Int
gl1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ml1) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
gl2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ml2)
instance Ord (GroupHtml e a) where
(GroupHtml [e a]
_ Int
gl1 Int
ml1) <= :: GroupHtml e a -> GroupHtml e a -> Bool
<= (GroupHtml [e a]
_ Int
gl2 Int
ml2) = (Int
gl1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ml1) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int
gl2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ml2)
data MessyTree a b = Noise b | Nodee a [MessyTree a b]
data MessyTreeMatch a b c = Noise' a | Match' b | Node' c [MessyTreeMatch a b c]
type TreeIndex = [Int]
data GroupHtml element a = GroupHtml [element a] Glength MaxLength
instance (ElementRep e, Show (e a), Show a, ShowHTML a) => Show (GroupHtml (e :: * -> *) a) where
show :: GroupHtml e a -> String
show (GroupHtml (e a
e:[e a]
_) Int
count Int
maxELen) =
String
"GroupHtml { count =" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Int -> String
forall a. Show a => a -> String
show Int
count) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", longestElem= " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
maxELen String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", elemStructure=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (e a -> String
forall a. Show a => a -> String
show e a
e)
type Glength = Int
type MaxLength = Int
ungroup :: ElementRep e => GroupHtml e a -> [e a]
ungroup :: forall (e :: * -> *) a. ElementRep e => GroupHtml e a -> [e a]
ungroup (GroupHtml [e a]
xs Int
_ Int
_) = [e a]
xs
mkGH :: ElementRep e => [e a] -> GroupHtml e a
mkGH :: forall (e :: * -> *) a. ElementRep e => [e a] -> GroupHtml e a
mkGH [e a]
result = [e a] -> Int -> Int -> GroupHtml e a
forall (element :: * -> *) a.
[element a] -> Int -> Int -> GroupHtml element a
GroupHtml [e a]
result ([e a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [e a]
result) ((String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (e a -> String
forall b. e b -> String
forall (a :: * -> *) b. ElementRep a => a b -> String
innerText' ([e a] -> e a
forall a. HasCallStack => [a] -> a
head [e a]
result))))
longestElem :: [Elem' a] -> Maybe (Elem' a)
longestElem :: forall a. [Elem' a] -> Maybe (Elem' a)
longestElem [] = Maybe (Elem' a)
forall a. Maybe a
Nothing
longestElem (Elem' a
a:[]) = Elem' a -> Maybe (Elem' a)
forall a. a -> Maybe a
Just Elem' a
a
longestElem (Elem' a
x:[Elem' a]
xs) = if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Elem' a -> String
forall b. Elem' b -> String
forall (a :: * -> *) b. ElementRep a => a b -> String
innerText' Elem' a
x) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Elem' a -> String
forall b. Elem' b -> String
forall (a :: * -> *) b. ElementRep a => a b -> String
innerText' (Elem' a -> String) -> Elem' a -> String
forall a b. (a -> b) -> a -> b
$ [Elem' a] -> Elem' a
forall a. HasCallStack => [a] -> a
head [Elem' a]
xs)
then [Elem' a] -> Maybe (Elem' a)
forall a. [Elem' a] -> Maybe (Elem' a)
longestElem (Elem' a
xElem' a -> [Elem' a] -> [Elem' a]
forall a. a -> [a] -> [a]
: ([Elem' a] -> [Elem' a]
forall a. HasCallStack => [a] -> [a]
tail [Elem' a]
xs))
else [Elem' a] -> Maybe (Elem' a)
forall a. [Elem' a] -> Maybe (Elem' a)
longestElem [Elem' a]
xs
maxLength :: [[a]] -> [a]
maxLength :: forall a. [[a]] -> [a]
maxLength ([a]
a:[]) = [a]
a
maxLength ([a]
x:[[a]]
xs) = if [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[a]] -> [a]
forall a. HasCallStack => [a] -> a
head [[a]]
xs) then [[a]] -> [a]
forall a. [[a]] -> [a]
maxLength ([a]
x[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: ([[a]] -> [[a]]
forall a. HasCallStack => [a] -> [a]
tail [[a]]
xs)) else [[a]] -> [a]
forall a. [[a]] -> [a]
maxLength [[a]]
xs
biggestHtmlGroup :: [GroupHtml e a] -> GroupHtml e a
biggestHtmlGroup :: forall (e :: * -> *) a. [GroupHtml e a] -> GroupHtml e a
biggestHtmlGroup [GroupHtml e a]
ghs = (GroupHtml e a -> GroupHtml e a -> GroupHtml e a)
-> GroupHtml e a -> [GroupHtml e a] -> GroupHtml e a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GroupHtml e a -> GroupHtml e a -> GroupHtml e a
forall (e :: * -> *) a.
GroupHtml e a -> GroupHtml e a -> GroupHtml e a
maxE ([e a] -> Int -> Int -> GroupHtml e a
forall (element :: * -> *) a.
[element a] -> Int -> Int -> GroupHtml element a
GroupHtml [] Int
0 Int
0) [GroupHtml e a]
ghs
where
maxE :: GroupHtml e a -> GroupHtml e a -> GroupHtml e a
maxE :: forall (e :: * -> *) a.
GroupHtml e a -> GroupHtml e a -> GroupHtml e a
maxE (GroupHtml [e a]
xs Int
cnt Int
lng) (GroupHtml [e a]
ys Int
cnt' Int
lng') =
if (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
lng) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
cnt' Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
lng')
then ([e a] -> Int -> Int -> GroupHtml e a
forall (element :: * -> *) a.
[element a] -> Int -> Int -> GroupHtml element a
GroupHtml [e a]
xs Int
cnt Int
lng)
else ([e a] -> Int -> Int -> GroupHtml e a
forall (element :: * -> *) a.
[element a] -> Int -> Int -> GroupHtml element a
GroupHtml [e a]
ys Int
cnt' Int
lng')
biggestGroup :: ElementRep e => [GroupHtml e a] -> GroupHtml e a
biggestGroup :: forall (e :: * -> *) a.
ElementRep e =>
[GroupHtml e a] -> GroupHtml e a
biggestGroup (GroupHtml e a
gh:[]) = GroupHtml e a
gh
biggestGroup (n0 :: GroupHtml e a
n0@(GroupHtml [e a]
a Int
x1 Int
y1) :n1 :: GroupHtml e a
n1@(GroupHtml [e a]
b Int
x2 Int
y2):[GroupHtml e a]
ghs) = case (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y1) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y2) of
Bool
True -> [GroupHtml e a] -> GroupHtml e a
forall (e :: * -> *) a.
ElementRep e =>
[GroupHtml e a] -> GroupHtml e a
biggestGroup (GroupHtml e a
n0GroupHtml e a -> [GroupHtml e a] -> [GroupHtml e a]
forall a. a -> [a] -> [a]
:[GroupHtml e a]
ghs)
Bool
False -> [GroupHtml e a] -> GroupHtml e a
forall (e :: * -> *) a.
ElementRep e =>
[GroupHtml e a] -> GroupHtml e a
biggestGroup (GroupHtml e a
n1GroupHtml e a -> [GroupHtml e a] -> [GroupHtml e a]
forall a. a -> [a] -> [a]
:[GroupHtml e a]
ghs)
getHrefEl :: ElementRep e => Bool -> LastUrl -> e a -> Maybe Link
getHrefEl :: forall (e :: * -> *) a.
ElementRep e =>
Bool -> LastUrl -> e a -> Maybe LastUrl
getHrefEl Bool
b LastUrl
cUrl e a
e = Bool -> LastUrl -> Attrs -> Maybe LastUrl
getHrefAttrs Bool
b LastUrl
cUrl (Attrs -> Maybe LastUrl) -> Attrs -> Maybe LastUrl
forall a b. (a -> b) -> a -> b
$ e a -> Attrs
forall b. e b -> Attrs
forall (a :: * -> *) b. ElementRep a => a b -> Attrs
attrs e a
e
getHrefAttrs :: Bool -> LastUrl -> Map String String -> Maybe Link
getHrefAttrs :: Bool -> LastUrl -> Attrs -> Maybe LastUrl
getHrefAttrs Bool
b LastUrl
cUrl Attrs
atribs = Bool -> LastUrl -> String -> Maybe LastUrl
parseLink Bool
b LastUrl
cUrl (String -> Maybe LastUrl) -> Maybe String -> Maybe LastUrl
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Attrs -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"href" Attrs
atribs
elemToStr :: Elem' a -> String
elemToStr :: forall b. Elem' b -> String
elemToStr Elem' a
elem = String
"<" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Elem' a -> String
forall b. Elem' b -> String
forall (a :: * -> *) b. ElementRep a => a b -> String
elTag Elem' a
elem String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [(String, String)] -> String
buildAttrs (Attrs -> [(String, String)]
forall k a. Map k a -> [(k, a)]
toList (Elem' a -> Attrs
forall b. Elem' b -> Attrs
forall (a :: * -> *) b. ElementRep a => a b -> Attrs
attrs Elem' a
elem)) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Elem' a -> String
forall b. Elem' b -> String
innerHtmlFull Elem' a
elem String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"</" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Elem' a -> String
forall b. Elem' b -> String
forall (a :: * -> *) b. ElementRep a => a b -> String
elTag Elem' a
elem String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">"
where
buildAttrs :: [(String, String)] -> String
buildAttrs [] = String
""
buildAttrs ((String, String)
attr:[(String, String)]
attrss) = String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
attr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
attr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [(String, String)] -> String
buildAttrs [(String, String)]
attrss
selfClosingElems :: [String]
selfClosingElems :: [String]
selfClosingElems = [String
"area", String
"base", String
"br", String
"col", String
"embed", String
"hr", String
"img", String
"input", String
"link", String
"meta", String
"param", String
"source", String
"track", String
"wbr"]
treeElemToStr :: (ShowHTML a) => TreeHTML a -> String
treeElemToStr :: forall a. ShowHTML a => TreeHTML a -> String
treeElemToStr (TreeHTML{[a]
String
Forest ElemHead
Attrs
_topEl :: forall b. TreeHTML b -> String
_topAttrs :: forall b. TreeHTML b -> Attrs
_innerText' :: forall b. TreeHTML b -> String
_matches' :: forall b. TreeHTML b -> [b]
_innerTree' :: forall a. TreeHTML a -> Forest ElemHead
_topEl :: String
_topAttrs :: Attrs
_matches' :: [a]
_innerText' :: String
_innerTree' :: Forest ElemHead
..}) =
if String
_topEl String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
selfClosingElems
then String
"<" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
_topEl String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Attrs -> String
mdToStringPairs Attrs
_topAttrs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">"
else String
"<" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
_topEl String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Attrs -> String
mdToStringPairs Attrs
_topAttrs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
_innerText' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"</" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
_topEl String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">"
where mdToStringPairs :: Attrs -> String
mdToStringPairs Attrs
attrsSet = case Attrs -> [(String, String)]
forall k a. Map k a -> [(k, a)]
toList Attrs
attrsSet of
[] -> String
""
[(String, String)]
attrs -> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [(String, String)] -> String
go [(String, String)]
attrs
go :: [(String, String)] -> String
go [] = String
""
go ((String, String)
atr:[]) = ((String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
atr) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
atr) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: [])
go ((String, String)
atr: [(String, String)]
attrsSet) = ((String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
atr) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
atr) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [(String, String)] -> String
go [(String, String)]
attrsSet
foldFuncMatchlist :: (ShowHTML a, ElementRep e) => HTMLMatcher e a -> InnerTextResult a -> InnerTextResult a
foldFuncMatchlist :: forall a (e :: * -> *).
(ShowHTML a, ElementRep e) =>
HTMLMatcher e a -> InnerTextResult a -> InnerTextResult a
foldFuncMatchlist HTMLMatcher e a
hMatcher InnerTextResult a
itr = InnerTextResult a
forall a. HasCallStack => a
undefined
foldFuncTup :: (ShowHTML (e a), ShowHTML a, ElementRep e) => HTMLMatcher e a -> (String, [a]) -> (String, [a])
foldFuncTup :: forall (e :: * -> *) a.
(ShowHTML (e a), ShowHTML a, ElementRep e) =>
HTMLMatcher e a -> (String, [a]) -> (String, [a])
foldFuncTup HTMLMatcher e a
hMatcher (String, [a])
itr = case HTMLMatcher e a
hMatcher of
IText String
str ->
(String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String, [a]) -> String
forall a b. (a, b) -> a
fst (String, [a])
itr, (String, [a]) -> [a]
forall a b. (a, b) -> b
snd (String, [a])
itr)
Match a
mat ->
(a -> String
forall a. ShowHTML a => a -> String
showH a
mat String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String, [a]) -> String
forall a b. (a, b) -> a
fst (String, [a])
itr, (String, [a]) -> [a]
forall a b. (a, b) -> b
snd (String, [a])
itr [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a
mat])
Element e a
elem ->
(e a -> String
forall a. ShowHTML a => a -> String
showH e a
elem String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String, [a]) -> String
forall a b. (a, b) -> a
fst (String, [a])
itr, (String, [a]) -> [a]
forall a b. (a, b) -> b
snd (String, [a])
itr [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> e a -> [a]
forall b. e b -> [b]
forall (a :: * -> *) b. ElementRep a => a b -> [b]
matches' e a
elem)
foldFuncTrup :: (ShowHTML a) => HTMLMatcher TreeHTML a -> (String, [a], Forest ElemHead) -> (String, [a], Forest ElemHead)
foldFuncTrup :: forall a.
ShowHTML a =>
HTMLMatcher TreeHTML a
-> (String, [a], Forest ElemHead) -> (String, [a], Forest ElemHead)
foldFuncTrup HTMLMatcher TreeHTML a
hMatcher (String, [a], Forest ElemHead)
itr = case HTMLMatcher TreeHTML a
hMatcher of
IText String
str ->
(String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String, [a], Forest ElemHead) -> String
forall a b c. (a, b, c) -> a
fst' (String, [a], Forest ElemHead)
itr, (String, [a], Forest ElemHead) -> [a]
forall a b c. (a, b, c) -> b
snd' (String, [a], Forest ElemHead)
itr, (String, [a], Forest ElemHead) -> Forest ElemHead
forall a b c. (a, b, c) -> c
thd' (String, [a], Forest ElemHead)
itr)
Match a
mat ->
(a -> String
forall a. ShowHTML a => a -> String
showH a
mat String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String, [a], Forest ElemHead) -> String
forall a b c. (a, b, c) -> a
fst' (String, [a], Forest ElemHead)
itr, (String, [a], Forest ElemHead) -> [a]
forall a b c. (a, b, c) -> b
snd' (String, [a], Forest ElemHead)
itr [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a
mat], (String, [a], Forest ElemHead) -> Forest ElemHead
forall a b c. (a, b, c) -> c
thd' (String, [a], Forest ElemHead)
itr)
Element TreeHTML a
elem ->
(TreeHTML a -> String
forall a. ShowHTML a => a -> String
showH TreeHTML a
elem String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String, [a], Forest ElemHead) -> String
forall a b c. (a, b, c) -> a
fst' (String, [a], Forest ElemHead)
itr, (String, [a], Forest ElemHead) -> [a]
forall a b c. (a, b, c) -> b
snd' (String, [a], Forest ElemHead)
itr [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> TreeHTML a -> [a]
forall b. TreeHTML b -> [b]
forall (a :: * -> *) b. ElementRep a => a b -> [b]
matches' TreeHTML a
elem, (String, [a], Forest ElemHead) -> Forest ElemHead
forall a b c. (a, b, c) -> c
thd' (String, [a], Forest ElemHead)
itr Forest ElemHead -> Forest ElemHead -> Forest ElemHead
forall a. Semigroup a => a -> a -> a
<> [TreeHTML a -> Tree ElemHead
forall a. TreeHTML a -> Tree ElemHead
makeBranch TreeHTML a
elem])
data Clickable = Clickable ElemHead Link deriving (Clickable -> Clickable -> Bool
(Clickable -> Clickable -> Bool)
-> (Clickable -> Clickable -> Bool) -> Eq Clickable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Clickable -> Clickable -> Bool
== :: Clickable -> Clickable -> Bool
$c/= :: Clickable -> Clickable -> Bool
/= :: Clickable -> Clickable -> Bool
Eq, Int -> Clickable -> String -> String
[Clickable] -> String -> String
Clickable -> String
(Int -> Clickable -> String -> String)
-> (Clickable -> String)
-> ([Clickable] -> String -> String)
-> Show Clickable
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Clickable -> String -> String
showsPrec :: Int -> Clickable -> String -> String
$cshow :: Clickable -> String
show :: Clickable -> String
$cshowList :: [Clickable] -> String -> String
showList :: [Clickable] -> String -> String
Show)
mkClickableEH :: Bool -> LastUrl -> ElemHead -> Maybe Clickable
mkClickableEH :: Bool -> LastUrl -> ElemHead -> Maybe Clickable
mkClickableEH Bool
booly LastUrl
cUrl (String
e, Attrs
ats) = do
LastUrl
h <- Bool -> LastUrl -> Attrs -> Maybe LastUrl
getHrefAttrs Bool
booly LastUrl
cUrl Attrs
ats
Clickable -> Maybe Clickable
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Clickable -> Maybe Clickable) -> Clickable -> Maybe Clickable
forall a b. (a -> b) -> a -> b
$ ElemHead -> LastUrl -> Clickable
Clickable (String
e, Attrs
ats) LastUrl
h
mkClickable :: ElementRep e => Bool -> LastUrl -> e a -> Maybe Clickable
mkClickable :: forall (e :: * -> *) a.
ElementRep e =>
Bool -> LastUrl -> e a -> Maybe Clickable
mkClickable Bool
booly LastUrl
cUrl e a
e = do
let ats :: Attrs
ats = e a -> Attrs
forall b. e b -> Attrs
forall (a :: * -> *) b. ElementRep a => a b -> Attrs
attrs e a
e
LastUrl
h <- Bool -> LastUrl -> Attrs -> Maybe LastUrl
getHrefAttrs Bool
booly LastUrl
cUrl Attrs
ats
Clickable -> Maybe Clickable
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Clickable -> Maybe Clickable) -> Clickable -> Maybe Clickable
forall a b. (a -> b) -> a -> b
$ ElemHead -> LastUrl -> Clickable
Clickable (e a -> String
forall b. e b -> String
forall (a :: * -> *) b. ElementRep a => a b -> String
elTag e a
e,Attrs
ats) LastUrl
h
getLink :: Clickable -> Link
getLink :: Clickable -> LastUrl
getLink (Clickable ElemHead
_ LastUrl
link) = LastUrl
link
getSrc :: a
getSrc = a
forall a. HasCallStack => a
undefined
fst' :: (a, b, c) -> a
fst' :: forall a b c. (a, b, c) -> a
fst' (a
a,b
_,c
_) = a
a
snd' :: (a,b,c) -> b
snd' :: forall a b c. (a, b, c) -> b
snd' (a
_,b
b,c
_) = b
b
thd' :: (a,b,c) -> c
thd' :: forall a b c. (a, b, c) -> c
thd' (a
_,b
_,c
c) = c
c
foldFuncITR :: (ShowHTML a, ElementRep e) => HTMLMatcher e a -> InnerTextResult a -> InnerTextResult a
foldFuncITR :: forall a (e :: * -> *).
(ShowHTML a, ElementRep e) =>
HTMLMatcher e a -> InnerTextResult a -> InnerTextResult a
foldFuncITR HTMLMatcher e a
hMatcher InnerTextResult a
itr = case HTMLMatcher e a
hMatcher of
IText String
str ->
[a] -> String -> InnerTextResult a
forall a. [a] -> String -> InnerTextResult a
InnerTextResult (InnerTextResult a -> [a]
forall a. InnerTextResult a -> [a]
_matchesITR InnerTextResult a
itr) (String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> InnerTextResult a -> String
forall a. InnerTextResult a -> String
_fullInner InnerTextResult a
itr)
Match a
mat ->
[a] -> String -> InnerTextResult a
forall a. [a] -> String -> InnerTextResult a
InnerTextResult (InnerTextResult a -> [a]
forall a. InnerTextResult a -> [a]
_matchesITR InnerTextResult a
itr [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a
mat]) (a -> String
forall a. ShowHTML a => a -> String
showH a
mat String -> String -> String
forall a. Semigroup a => a -> a -> a
<> InnerTextResult a -> String
forall a. InnerTextResult a -> String
_fullInner InnerTextResult a
itr)
Element e a
elem ->
[a] -> String -> InnerTextResult a
forall a. [a] -> String -> InnerTextResult a
InnerTextResult (InnerTextResult a -> [a]
forall a. InnerTextResult a -> [a]
_matchesITR InnerTextResult a
itr [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> e a -> [a]
forall b. e b -> [b]
forall (a :: * -> *) b. ElementRep a => a b -> [b]
matches' e a
elem) (e a -> String
forall b. e b -> String
forall (a :: * -> *) b. ElementRep a => a b -> String
innerText' e a
elem String -> String -> String
forall a. Semigroup a => a -> a -> a
<> InnerTextResult a -> String
forall a. InnerTextResult a -> String
_fullInner InnerTextResult a
itr)
fHM_c :: (InnerHTMLRep TreeHTML InnerTextHTMLTree a, ShowHTML a) =>
HTMLMatcher TreeHTML a
-> InnerTextHTMLTree a
-> InnerTextHTMLTree a
fHM_c :: forall a.
(InnerHTMLRep TreeHTML InnerTextHTMLTree a, ShowHTML a) =>
HTMLMatcher TreeHTML a
-> InnerTextHTMLTree a -> InnerTextHTMLTree a
fHM_c HTMLMatcher TreeHTML a
hMatcher InnerTextHTMLTree a
ithT = case HTMLMatcher TreeHTML a
hMatcher of
IText String
str ->
[a] -> String -> Forest ElemHead -> InnerTextHTMLTree a
forall a. [a] -> String -> Forest ElemHead -> InnerTextHTMLTree a
InnerTextHTMLTree (InnerTextHTMLTree a -> [a]
forall a. InnerTextHTMLTree a -> [a]
_matches InnerTextHTMLTree a
ithT) (String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> InnerTextHTMLTree a -> String
forall a. InnerTextHTMLTree a -> String
_innerText InnerTextHTMLTree a
ithT) (InnerTextHTMLTree a -> Forest ElemHead
forall a. InnerTextHTMLTree a -> Forest ElemHead
innerTree InnerTextHTMLTree a
ithT)
Match a
mat ->
[a] -> String -> Forest ElemHead -> InnerTextHTMLTree a
forall a. [a] -> String -> Forest ElemHead -> InnerTextHTMLTree a
InnerTextHTMLTree (InnerTextHTMLTree a -> [a]
forall a. InnerTextHTMLTree a -> [a]
_matches InnerTextHTMLTree a
ithT [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a
mat]) (a -> String
forall a. ShowHTML a => a -> String
showH a
mat String -> String -> String
forall a. Semigroup a => a -> a -> a
<> InnerTextHTMLTree a -> String
forall a. InnerTextHTMLTree a -> String
_innerText InnerTextHTMLTree a
ithT) (InnerTextHTMLTree a -> Forest ElemHead
forall a. InnerTextHTMLTree a -> Forest ElemHead
innerTree InnerTextHTMLTree a
ithT)
Element TreeHTML a
htmlTree ->
[a] -> String -> Forest ElemHead -> InnerTextHTMLTree a
forall a. [a] -> String -> Forest ElemHead -> InnerTextHTMLTree a
InnerTextHTMLTree (InnerTextHTMLTree a -> [a]
forall a. InnerTextHTMLTree a -> [a]
_matches InnerTextHTMLTree a
ithT [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> TreeHTML a -> [a]
forall b. TreeHTML b -> [b]
forall (a :: * -> *) b. ElementRep a => a b -> [b]
matches' TreeHTML a
htmlTree) (TreeHTML a -> String
forall a. ShowHTML a => a -> String
showH TreeHTML a
htmlTree String -> String -> String
forall a. Semigroup a => a -> a -> a
<> InnerTextHTMLTree a -> String
forall a. InnerTextHTMLTree a -> String
_innerText InnerTextHTMLTree a
ithT) (InnerTextHTMLTree a -> Forest ElemHead
forall a. InnerTextHTMLTree a -> Forest ElemHead
innerTree InnerTextHTMLTree a
ithT Forest ElemHead -> Forest ElemHead -> Forest ElemHead
forall a. Semigroup a => a -> a -> a
<> [TreeHTML a -> Tree ElemHead
forall a. TreeHTML a -> Tree ElemHead
makeBranch TreeHTML a
htmlTree])
makeBranch :: TreeHTML a -> Tree ElemHead
makeBranch :: forall a. TreeHTML a -> Tree ElemHead
makeBranch TreeHTML a
treeH = ElemHead -> Forest ElemHead -> Tree ElemHead
forall a. a -> [Tree a] -> Tree a
Node (TreeHTML a -> String
forall b. TreeHTML b -> String
forall (a :: * -> *) b. ElementRep a => a b -> String
elTag TreeHTML a
treeH, TreeHTML a -> Attrs
forall b. TreeHTML b -> Attrs
forall (a :: * -> *) b. ElementRep a => a b -> Attrs
attrs TreeHTML a
treeH) (TreeHTML a -> Forest ElemHead
forall a. TreeHTML a -> Forest ElemHead
_innerTree' TreeHTML a
treeH)
endTag :: Stream s m Char => String -> ParsecT s u m String
endTag :: forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
endTag String
elem = ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (String
"</" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
elem String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">"))
enoughMatches :: Int -> String -> Map String String -> (String, [a]) -> ParsecT s u m (Elem' a)
enoughMatches :: forall a s u (m :: * -> *).
Int -> String -> Attrs -> (String, [a]) -> ParsecT s u m (Elem' a)
enoughMatches Int
required String
e Attrs
a (String
asString, [a]
matches) =
if Int
required Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
matches)
then 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
$ String -> Attrs -> [a] -> String -> Elem' a
forall a. String -> Attrs -> [a] -> String -> Elem' a
Elem' String
e Attrs
a [a]
matches String
asString
else String -> ParsecT s u m (Elem' a)
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail String
"not enough matches"
enoughMatchesTree :: Int -> String -> Map String String -> (String, [a], Forest ElemHead) -> ParsecT s u m (TreeHTML a)
enoughMatchesTree :: forall a s u (m :: * -> *).
Int
-> String
-> Attrs
-> (String, [a], Forest ElemHead)
-> ParsecT s u m (TreeHTML a)
enoughMatchesTree Int
required String
e Attrs
a (String
asString, [a]
matches, Forest ElemHead
forest) =
if Int
required Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
matches)
then TreeHTML a -> ParsecT s u m (TreeHTML a)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TreeHTML a -> ParsecT s u m (TreeHTML a))
-> TreeHTML a -> ParsecT s u m (TreeHTML a)
forall a b. (a -> b) -> a -> b
$ String -> Attrs -> [a] -> String -> Forest ElemHead -> TreeHTML a
forall a.
String -> Attrs -> [a] -> String -> Forest ElemHead -> TreeHTML a
TreeHTML String
e Attrs
a [a]
matches String
asString Forest ElemHead
forest
else String -> ParsecT s u m (TreeHTML a)
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail String
"not enough matches"
selfClosingTextful :: (ShowHTML a, Stream s m Char) =>
Maybe (ParsecT s u m a)
-> ParsecT s u m [HTMLMatcher e a]
selfClosingTextful :: 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)
innerP = do
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 (HTMLMatcher e a)
-> ParsecT s u m String -> ParsecT s u m [HTMLMatcher e 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 e a) -> ParsecT s u m (HTMLMatcher e a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (a -> HTMLMatcher e a
forall (a :: * -> *) b. b -> HTMLMatcher a b
Match (a -> HTMLMatcher e a)
-> ParsecT s u m a -> ParsecT s u m (HTMLMatcher e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m a
innerP'))
ParsecT s u m (HTMLMatcher e a)
-> ParsecT s u m (HTMLMatcher e a)
-> ParsecT s u m (HTMLMatcher e a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT s u m (HTMLMatcher e a) -> ParsecT s u m (HTMLMatcher e a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((String -> HTMLMatcher e a
forall (a :: * -> *) b. String -> HTMLMatcher a b
IText (String -> HTMLMatcher e a)
-> (Char -> String) -> Char -> HTMLMatcher e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
:[])) (Char -> HTMLMatcher e a)
-> ParsecT s u m Char -> ParsecT s u m (HTMLMatcher e 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))
)
(
(ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m String
forall {u}. ParsecT s u m String
anyEndTag) ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (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 String -> ParsecT s u m String
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 String
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
alphaNum)
)
where anyEndTag :: ParsecT s u m String
anyEndTag = (ParsecT s u m String -> ParsecT s u m String
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 String -> ParsecT s u m String
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 String
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 String
-> ParsecT s u m String -> ParsecT s u m String
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
>> (String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
" " ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
">")))
innerP' :: ParsecT s u m a
innerP' = 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)
innerP
data = String String deriving (UrlPagination -> UrlPagination -> Bool
(UrlPagination -> UrlPagination -> Bool)
-> (UrlPagination -> UrlPagination -> Bool) -> Eq UrlPagination
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UrlPagination -> UrlPagination -> Bool
== :: UrlPagination -> UrlPagination -> Bool
$c/= :: UrlPagination -> UrlPagination -> Bool
/= :: UrlPagination -> UrlPagination -> Bool
Eq, Int -> UrlPagination -> String -> String
[UrlPagination] -> String -> String
UrlPagination -> String
(Int -> UrlPagination -> String -> String)
-> (UrlPagination -> String)
-> ([UrlPagination] -> String -> String)
-> Show UrlPagination
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> UrlPagination -> String -> String
showsPrec :: Int -> UrlPagination -> String -> String
$cshow :: UrlPagination -> String
show :: UrlPagination -> String
$cshowList :: [UrlPagination] -> String -> String
showList :: [UrlPagination] -> String -> String
Show)
type Tag = String