{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Scrappy.Elem.ElemHeadParse where
import Scrappy.Links (Link, LastUrl, CurrentUrl)
import Scrappy.Elem.Types (Elem, Elem', ElemHead, Attrs, AttrsError(IncorrectAttrs), getHrefAttrs)
import Control.Applicative (some)
import Text.Parsec (Stream, ParsecT, (<|>), string, try, noneOf, parserZero, char, option, space,
alphaNum, many1, between, many, letter, parserFail, optional, manyTill)
import Data.Map as Map (Map, fromList, lookup, toList)
import Data.Maybe (fromMaybe)
import Scrappy.Types
href :: Stream s m Char => Bool -> LastUrl -> ParsecT s u m Link
href :: forall s (m :: * -> *) u.
Stream s m Char =>
Bool -> LastUrl -> ParsecT s u m LastUrl
href Bool
booly LastUrl
cUrl = ((Bool -> LastUrl -> Map String String -> Maybe LastUrl
getHrefAttrs Bool
booly LastUrl
cUrl) (Map String String -> Maybe LastUrl)
-> ((String, Map String String) -> Map String String)
-> (String, Map String String)
-> Maybe LastUrl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Map String String) -> Map String String
forall a b. (a, b) -> b
snd) ((String, Map String String) -> Maybe LastUrl)
-> ParsecT s u m (String, Map String String)
-> ParsecT s u m LastUrl
forall a b s u (m :: * -> *).
(a -> Maybe b) -> ParsecT s u m a -> ParsecT s u m b
`mapMaybe` (Maybe [String]
-> [(String, Maybe String)]
-> ParsecT s u m (String, Map String String)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String]
-> [(String, Maybe String)]
-> ParsecT s u m (String, Map String String)
parseOpeningTag ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"a"]) [])
href' :: Stream s m Char => Maybe CurrentUrl -> ParsecT s u m Link
href' :: forall s (m :: * -> *) u.
Stream s m Char =>
Maybe String -> ParsecT s u m LastUrl
href' = Maybe String -> ParsecT s u m LastUrl
forall a. HasCallStack => a
undefined
parseAttrSafe :: Stream s m Char => String -> ParsecT s u m String
parseAttrSafe :: forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
parseAttrSafe String
attrName = do
(String, Map String String)
tag <- Maybe [String]
-> [(String, Maybe String)]
-> ParsecT s u m (String, Map String String)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String]
-> [(String, Maybe String)]
-> ParsecT s u m (String, Map String String)
parseOpeningTag Maybe [String]
forall a. Maybe a
Nothing [(String
attrName, Maybe String
forall a. Maybe a
Nothing)]
case (String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
attrName (Map String String -> Maybe String)
-> ((String, Map String String) -> Map String String)
-> (String, Map String String)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Map String String) -> Map String String
forall a b. (a, b) -> b
snd) (String, Map String String)
tag of
Maybe String
Nothing -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
Just String
a -> String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
a
hrefParser :: Stream s m Char => ParsecT s u m String
hrefParser :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
hrefParser = do
(String, Map String String)
tag <- Maybe [String]
-> [(String, Maybe String)]
-> ParsecT s u m (String, Map String String)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String]
-> [(String, Maybe String)]
-> ParsecT s u m (String, Map String String)
parseOpeningTag Maybe [String]
forall a. Maybe a
Nothing [(String
"href", Maybe String
forall a. Maybe a
Nothing)]
case (String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"href" (Map String String -> Maybe String)
-> ((String, Map String String) -> Map String String)
-> (String, Map String String)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Map String String) -> Map String String
forall a b. (a, b) -> b
snd) (String, Map String String)
tag of
Maybe String
Nothing -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
Just String
a -> String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
a
parseOpeningTagF :: Stream s m Char => String -> (String -> Bool) -> ParsecT s u m ElemHead
parseOpeningTagF :: forall s (m :: * -> *) u.
Stream s m Char =>
String
-> (String -> Bool) -> ParsecT s u m (String, Map String String)
parseOpeningTagF String
attrib String -> Bool
predicate = do
(String
e, Map String String
as) <- Maybe [String]
-> [(String, Maybe String)]
-> ParsecT s u m (String, Map String String)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String]
-> [(String, Maybe String)]
-> ParsecT s u m (String, Map String String)
parseOpeningTag Maybe [String]
forall a. Maybe a
Nothing [(String
attrib, Maybe String
forall a. Maybe a
Nothing)]
case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
attrib Map String String
as of
Maybe String
Nothing -> ParsecT s u m (String, Map String String)
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
Just String
a -> if String -> Bool
predicate String
a then (String, Map String String)
-> ParsecT s u m (String, Map String String)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
e,Map String String
as) else String -> ParsecT s u m (String, Map String String)
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail String
"couldnt find match parseOpeningTagF"
parseOpeningTagWhere :: Stream s m Char
=> Maybe [Elem]
-> String
-> (String -> Bool)
-> ParsecT s u m ElemHead
parseOpeningTagWhere :: forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String]
-> String
-> (String -> Bool)
-> ParsecT s u m (String, Map String String)
parseOpeningTagWhere Maybe [String]
es String
attrib String -> Bool
predicate = do
(String
e, Map String String
as) <- Maybe [String]
-> [(String, Maybe String)]
-> ParsecT s u m (String, Map String String)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String]
-> [(String, Maybe String)]
-> ParsecT s u m (String, Map String String)
parseOpeningTag Maybe [String]
es [(String
attrib, Maybe String
forall a. Maybe a
Nothing)]
case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
attrib Map String String
as of
Maybe String
Nothing -> ParsecT s u m (String, Map String String)
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
Just String
a -> if String -> Bool
predicate String
a then (String, Map String String)
-> ParsecT s u m (String, Map String String)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
e,Map String String
as) else String -> ParsecT s u m (String, Map String String)
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail String
"couldnt find match parseOpeningTagF"
hrefParser' :: Stream s m Char => (String -> Bool) -> ParsecT s u m String
hrefParser' :: forall s (m :: * -> *) u.
Stream s m Char =>
(String -> Bool) -> ParsecT s u m String
hrefParser' String -> Bool
predicate = do
(String, Map String String)
tag <- Maybe [String]
-> [(String, Maybe String)]
-> ParsecT s u m (String, Map String String)
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String]
-> [(String, Maybe String)]
-> ParsecT s u m (String, Map String String)
parseOpeningTag Maybe [String]
forall a. Maybe a
Nothing [(String
"href", Maybe String
forall a. Maybe a
Nothing)]
case (String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"href" (Map String String -> Maybe String)
-> ((String, Map String String) -> Map String String)
-> (String, Map String String)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Map String String) -> Map String String
forall a b. (a, b) -> b
snd) (String, Map String String)
tag of
Maybe String
Nothing -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
Just String
a -> if String -> Bool
predicate String
a then String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
a else ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
attrValue :: Stream s m Char => ParsecT s u m [Char]
attrValue :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
attrValue = (ParsecT s u m Char
-> ParsecT s u m Char
-> ParsecT s u m String
-> ParsecT s u m String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"') (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
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'"'])))
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
<|> (ParsecT s u m Char
-> ParsecT s u m Char
-> ParsecT s u m String
-> ParsecT s u m String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'') (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
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'\''])))
attrValuesExist :: [(String, String)] -> [(String, Maybe String)] -> Bool
attrValuesExist :: [(String, String)] -> [(String, Maybe String)] -> Bool
attrValuesExist [(String, String)]
_ [] = Bool
True
attrValuesExist [(String, String)]
attrsOut ((String, Maybe String)
nextAttr:[(String, Maybe String)]
attrsIn)
| [(String, String)] -> (String, Maybe String) -> Bool
attrValueExists [(String, String)]
attrsOut (String, Maybe String)
nextAttr = Bool
True Bool -> Bool -> Bool
&& ([(String, String)] -> [(String, Maybe String)] -> Bool
attrValuesExist [(String, String)]
attrsOut [(String, Maybe String)]
attrsIn)
| Bool
otherwise = Bool
False
attrValueExists :: [(String, String)] -> (String, Maybe String) -> Bool
attrValueExists :: [(String, String)] -> (String, Maybe String) -> Bool
attrValueExists [] (String, Maybe String)
_ = Bool
False
attrValueExists ((String, String)
attrF:[(String, String)]
attrsOut) (String, Maybe String)
nextAttr
| (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
attrF String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String, Maybe String) -> String
forall a b. (a, b) -> a
fst (String, Maybe String)
nextAttr Bool -> Bool -> Bool
&& (String, Maybe String) -> Maybe String
forall a b. (a, b) -> b
snd (String, Maybe String)
nextAttr Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
forall a. Maybe a
Nothing = Bool
True
| (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
attrF String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String, Maybe String) -> String
forall a b. (a, b) -> a
fst (String, Maybe String)
nextAttr Bool -> Bool -> Bool
&& (String, Maybe String) -> Maybe String
forall a b. (a, b) -> b
snd (String, Maybe String)
nextAttr Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== (String -> Maybe String
forall a. a -> Maybe a
Just ((String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
attrF)) = Bool
True
| Bool
otherwise = [(String, String)] -> (String, Maybe String) -> Bool
attrValueExists [(String, String)]
attrsOut (String, Maybe String)
nextAttr
attrName :: Stream s m Char => ParsecT s u m String
attrName :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
attrName = 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 ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
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 Char -> ParsecT s u m Char
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
'_')
attrParser :: Stream s m Char => ParsecT s u m (String, String)
attrParser :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (String, String)
attrParser = do
String
_ <- ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
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
'\n' ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
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
'\t')
String
attrName' <- ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
attrName
String
content <- String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (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 String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
attrValue)
(String, String) -> ParsecT s u m (String, String)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
attrName', String
content)
attrsParser :: Stream s m Char =>
[(String, Maybe String)]
-> ParsecT s u m (Either AttrsError (Map String String))
attrsParser :: forall s (m :: * -> *) u.
Stream s m Char =>
[(String, Maybe String)]
-> ParsecT s u m (Either AttrsError (Map String String))
attrsParser [(String, Maybe String)]
attrs = do
[(String, String)]
attrPairs <- ParsecT s u m (String, String) -> ParsecT s u m [(String, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m (String, String)
-> ParsecT s u m [(String, String)])
-> ParsecT s u m (String, String)
-> ParsecT s u m [(String, String)]
forall a b. (a -> b) -> a -> b
$ ParsecT s u m (String, String) -> ParsecT s u m (String, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m (String, String)
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (String, String)
attrParser
let
attrPairsMap :: Map String String
attrPairsMap = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(String, String)]
attrPairs
case Map String String -> [(String, Maybe String)] -> Bool
isAttrsMatch Map String String
attrPairsMap [(String, Maybe String)]
attrs of
Bool
True -> Either AttrsError (Map String String)
-> ParsecT s u m (Either AttrsError (Map String String))
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AttrsError (Map String String)
-> ParsecT s u m (Either AttrsError (Map String String)))
-> Either AttrsError (Map String String)
-> ParsecT s u m (Either AttrsError (Map String String))
forall a b. (a -> b) -> a -> b
$ Map String String -> Either AttrsError (Map String String)
forall a b. b -> Either a b
Right Map String String
attrPairsMap
Bool
False -> Either AttrsError (Map String String)
-> ParsecT s u m (Either AttrsError (Map String String))
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AttrsError (Map String String)
-> ParsecT s u m (Either AttrsError (Map String String)))
-> Either AttrsError (Map String String)
-> ParsecT s u m (Either AttrsError (Map String String))
forall a b. (a -> b) -> a -> b
$ AttrsError -> Either AttrsError (Map String String)
forall a b. a -> Either a b
Left AttrsError
IncorrectAttrs
isAttrsMatch' :: Map String String -> [(String, Maybe String)] -> Bool
isAttrsMatch' :: Map String String -> [(String, Maybe String)] -> Bool
isAttrsMatch' Map String String
_ [] = Bool
True
isAttrsMatch' Map String String
mapAttr ((String
name, Maybe String
maybeVal):[(String, Maybe String)]
desired)
| String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String String
mapAttr Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
forall a. Maybe a
Nothing = Bool
False
| (String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String String
mapAttr Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
maybeVal) Bool -> Bool -> Bool
|| (Maybe String
maybeVal Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
forall a. Maybe a
Nothing) = Map String String -> [(String, Maybe String)] -> Bool
isAttrsMatch Map String String
mapAttr [(String, Maybe String)]
desired
isAttrsMatch :: Map String String -> [(String, Maybe String)] -> Bool
isAttrsMatch :: Map String String -> [(String, Maybe String)] -> Bool
isAttrsMatch Map String String
_ [] = Bool
True
isAttrsMatch Map String String
mapAttr ((String
name, Maybe String
maybeVal): [(String, Maybe String)]
desired) = case Maybe String
maybeVal of
Just String
val ->
case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String String
mapAttr of
Just String
valFromKey -> if String
val String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
valFromKey then Bool
False else Map String String -> [(String, Maybe String)] -> Bool
isAttrsMatch Map String String
mapAttr [(String, Maybe String)]
desired
Maybe String
Nothing -> Bool
False
Maybe String
Nothing ->
case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String String
mapAttr of
Just String
irrValFromKey -> Map String String -> [(String, Maybe String)] -> Bool
isAttrsMatch Map String String
mapAttr [(String, Maybe String)]
desired
Maybe String
Nothing -> Bool
False
attrsFit :: Map String String -> [(String, (String -> Bool))] -> Bool
attrsFit :: Map String String -> [(String, String -> Bool)] -> Bool
attrsFit Map String String
_ [] = Bool
True
attrsFit Map String String
mapppy ((String
name, String -> Bool
test): [(String, String -> Bool)]
rest) =
(Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> Maybe String -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Bool
test (Maybe String -> Maybe Bool) -> Maybe String -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String String
mapppy) Bool -> Bool -> Bool
&& Map String String -> [(String, String -> Bool)] -> Bool
attrsFit Map String String
mapppy [(String, String -> Bool)]
rest
attrsMatch' :: Map String String -> Map String String -> Bool
attrsMatch' :: Map String String -> Map String String -> Bool
attrsMatch' Map String String
a Map String String
b = [(String, String)] -> Map String String -> Bool
attrsMatch (Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
toList Map String String
a) Map String String
b
attrsMatch :: [(String, String)] -> Map String String -> Bool
attrsMatch :: [(String, String)] -> Map String String -> Bool
attrsMatch [] Map String String
_ = Bool
True
attrsMatch ((String
k,String
v):[(String, String)]
kvs) Map String String
mappy = case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
k Map String String
mappy of
Just String
val ->
if String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
k [String
"title", String
"alt", String
"href"] then Bool
True Bool -> Bool -> Bool
&& [(String, String)] -> Map String String -> Bool
attrsMatch [(String, String)]
kvs Map String String
mappy
else String -> String -> Bool
digitEqFree String
v String
val Bool -> Bool -> Bool
&& [(String, String)] -> Map String String -> Bool
attrsMatch [(String, String)]
kvs Map String String
mappy
Maybe String
Nothing -> Bool
False
attrsParserDesc :: Stream s m Char =>
[(String, String)]
-> ParsecT s u m (Map String String)
attrsParserDesc :: forall s (m :: * -> *) u.
Stream s m Char =>
[(String, String)] -> ParsecT s u m (Map String String)
attrsParserDesc [(String, String)]
attrs = do
[(String, String)]
attrPairs <- ParsecT s u m (String, String) -> ParsecT s u m [(String, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s u m (String, String)
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (String, String)
attrParser
let
attrPairsMap :: Map String String
attrPairsMap = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(String, String)]
attrPairs
if [(String, String)] -> Map String String -> Bool
attrsMatch [(String, String)]
attrs Map String String
attrPairsMap
then Map String String -> ParsecT s u m (Map String String)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map String String
attrPairsMap
else String -> ParsecT s u m (Map String String)
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail (String -> ParsecT s u m (Map String String))
-> String -> ParsecT s u m (Map String String)
forall a b. (a -> b) -> a -> b
$ String
"incorrect attrs:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ([(String, String)] -> String
forall a. Show a => a -> String
show ([(String, String)] -> String) -> [(String, String)] -> String
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> Map String String -> [(String, String)]
unfit [(String, String)]
attrs Map String String
attrPairsMap)
parseOpeningTagDesc :: Stream s m Char => Maybe [Elem] -> [(String, String)] -> ParsecT s u m (Elem, Attrs)
parseOpeningTagDesc :: forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String]
-> [(String, String)] -> ParsecT s u m (String, Map String String)
parseOpeningTagDesc Maybe [String]
elemOpts [(String, String)]
attrs = do
Char
_ <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
String
elem <- Maybe [String] -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String] -> ParsecT s u m String
mkElemtagParser Maybe [String]
elemOpts
Map String String
attrs <- [(String, String)] -> ParsecT s u m (Map String String)
forall s (m :: * -> *) u.
Stream s m Char =>
[(String, String)] -> ParsecT s u m (Map String String)
attrsParserDesc [(String, String)]
attrs
(String, Map String String)
-> ParsecT s u m (String, Map String String)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
elem, Map String String
attrs)
digitEq :: String -> String -> Bool
digitEq :: String -> String -> Bool
digitEq [] [] = Bool
True
digitEq [] (Char
y:String
ys) = Bool
False
digitEq (Char
x:String
xs) [] = Bool
False
digitEq (Char
charA:String
xs) (Char
charB:String
ys) =
if Char
charA Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
charB
then Bool
True Bool -> Bool -> Bool
&& String -> String -> Bool
digitEq String
xs String
ys
else
if Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
charA [Char
'0'..Char
'9'] Bool -> Bool -> Bool
&& Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
charB [Char
'0'..Char
'9']
then String -> String -> Bool
digitEq String
xs String
ys
else
String -> String -> Bool
saveDigitEq (Char
charAChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs) (Char
charBChar -> String -> String
forall a. a -> [a] -> [a]
:String
ys)
saveDigitEq :: String -> String -> Bool
saveDigitEq :: String -> String -> Bool
saveDigitEq String
as String
bs =
if Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ((String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
as) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
bs)) [Int
1,-Int
1]
then
if (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> Char
forall a. HasCallStack => [a] -> a
head String
as) [Char
'0'..Char
'9']) Bool -> Bool -> Bool
|| (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> Char
forall a. HasCallStack => [a] -> a
head String
bs) [Char
'0'..Char
'9'])
then String -> String -> Bool
svDigEq String
as String
bs
else Bool
False
else Bool
False
svDigEq :: String -> String -> Bool
svDigEq :: String -> String -> Bool
svDigEq (Char
charA:String
as) (Char
charB:String
bs) =
if String -> Char
forall a. HasCallStack => [a] -> a
head String
as Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
charB
then String -> String -> Bool
digitEq (String -> String
forall a. HasCallStack => [a] -> [a]
tail String
as) String
bs
else
if String -> Char
forall a. HasCallStack => [a] -> a
head String
bs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
charA
then String -> String -> Bool
digitEq String
as (String -> String
forall a. HasCallStack => [a] -> [a]
tail String
bs)
else Bool
False Bool -> Bool -> Bool
|| String -> String -> Bool
saveDigitEq (Char
charAChar -> String -> String
forall a. a -> [a] -> [a]
:String
as) String
bs Bool -> Bool -> Bool
|| String -> String -> Bool
saveDigitEq String
as (Char
charBChar -> String -> String
forall a. a -> [a] -> [a]
:String
bs)
digitEqFree :: [Char] -> [Char] -> Bool
digitEqFree :: String -> String -> Bool
digitEqFree [] [] = Bool
True
digitEqFree String
as [] = if Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> Char
forall a. HasCallStack => [a] -> a
head String
as) [Char
'0'..Char
'9'] then String -> String -> Bool
digitEqFree (String -> String
forall a. HasCallStack => [a] -> [a]
tail String
as) [] else Bool
False
digitEqFree [] String
bs = if Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> Char
forall a. HasCallStack => [a] -> a
head String
bs) [Char
'0'..Char
'9'] then String -> String -> Bool
digitEqFree [] (String -> String
forall a. HasCallStack => [a] -> [a]
tail String
bs) else Bool
False
digitEqFree String
as String
bs =
if Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> Char
forall a. HasCallStack => [a] -> a
head String
as) [Char
'0'..Char
'9'] then String -> String -> Bool
digitEqFree (String -> String
forall a. HasCallStack => [a] -> [a]
tail String
as) String
bs
else
if Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> Char
forall a. HasCallStack => [a] -> a
head String
bs) [Char
'0'..Char
'9'] then String -> String -> Bool
digitEqFree String
as (String -> String
forall a. HasCallStack => [a] -> [a]
tail String
bs)
else
if String -> Char
forall a. HasCallStack => [a] -> a
head String
as Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== (String -> Char
forall a. HasCallStack => [a] -> a
head String
bs) then String -> String -> Bool
digitEqFree (String -> String
forall a. HasCallStack => [a] -> [a]
tail String
as) (String -> String
forall a. HasCallStack => [a] -> [a]
tail String
bs)
else Bool
False
unfit :: [(String, String)] -> Map String String -> [(String, String)]
unfit :: [(String, String)] -> Map String String -> [(String, String)]
unfit [] Map String String
_ = []
unfit ((String
n,String
v):[(String, String)]
ns) Map String String
map = case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
n Map String String
map of
Maybe String
Nothing -> (String
n, String
"no attr") (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)] -> Map String String -> [(String, String)]
unfit [(String, String)]
ns Map String String
map
Just String
val -> if String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
n [String
"href", String
"alt", String
"title"] then [(String, String)] -> Map String String -> [(String, String)]
unfit [(String, String)]
ns Map String String
map
else if String -> String -> Bool
digitEq String
v String
val
then [(String, String)] -> Map String String -> [(String, String)]
unfit [(String, String)]
ns Map String String
map
else (String
nString -> 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
valString -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
"|"String -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
vString -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
")", String
"failed test") (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)] -> Map String String -> [(String, String)]
unfit [(String, String)]
ns Map String String
map
mkAttrsDesc :: [(String, String)] -> [(String, (String -> Bool))]
mkAttrsDesc :: [(String, String)] -> [(String, String -> Bool)]
mkAttrsDesc [(String, String)]
atrs = (((String, String) -> (String, String -> Bool))
-> [(String, String)] -> [(String, String -> Bool)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((String, String) -> (String, String -> Bool))
-> [(String, String)] -> [(String, String -> Bool)])
-> ((String -> String -> Bool)
-> (String, String) -> (String, String -> Bool))
-> (String -> String -> Bool)
-> [(String, String)]
-> [(String, String -> Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> Bool)
-> (String, String) -> (String, String -> Bool)
forall a b. (a -> b) -> (String, a) -> (String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) String -> String -> Bool
digitEqFree [(String, String)]
atrs
parseOpeningTag :: Stream s m Char => Maybe [Elem] -> [(String, Maybe String)] -> ParsecT s u m (Elem, Attrs)
parseOpeningTag :: forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String]
-> [(String, Maybe String)]
-> ParsecT s u m (String, Map String String)
parseOpeningTag Maybe [String]
elemOpts [(String, Maybe String)]
attrsSubset = do
Char
_ <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
String
elem <- Maybe [String] -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String] -> ParsecT s u m String
mkElemtagParser Maybe [String]
elemOpts
Either AttrsError (Map String String)
attrs <- [(String, Maybe String)]
-> ParsecT s u m (Either AttrsError (Map String String))
forall s (m :: * -> *) u.
Stream s m Char =>
[(String, Maybe String)]
-> ParsecT s u m (Either AttrsError (Map String String))
attrsParser [(String, Maybe String)]
attrsSubset
ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space)
case Either AttrsError (Map String String)
attrs of
Left AttrsError
IncorrectAttrs -> ParsecT s u m (String, Map String String)
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
Right Map String String
whateva -> (String, Map String String)
-> ParsecT s u m (String, Map String String)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
elem, Map String String
whateva)
mkElemtagParser :: Stream s m Char => Maybe [Elem] -> ParsecT s u m String
mkElemtagParser :: forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String] -> ParsecT s u m String
mkElemtagParser Maybe [String]
x = case Maybe [String]
x of
Maybe [String]
Nothing -> 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 ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
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
'-')
Just [String]
elemsOpts -> [String] -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
[String] -> ParsecT s u m String
buildElemsOpts [String]
elemsOpts
buildElemsOpts :: Stream s m Char => [Elem] -> ParsecT s u m String
buildElemsOpts :: forall s (m :: * -> *) u.
Stream s m Char =>
[String] -> ParsecT s u m String
buildElemsOpts [] = ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
buildElemsOpts (String
x:[String]
elemsAllow) = 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
x) 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
buildElemsOpts [String]
elemsAllow)