<commit_before>{-# LANGUAGE ImpredicativeTypes #-}
{-# OPTIONS_HADDOCK hide #-}
module Text.HTML.Scalpel.Internal.Select (
    select
) where

import Text.HTML.Scalpel.Internal.Select.Types

import Data.List

import qualified Text.HTML.TagSoup as TagSoup
import qualified Text.StringLike as TagSoup


-- | The 'select' function takes a 'Selectable' value and a list of
-- 'TagSoup.Tag's and returns a list of every subsequence of the given list of
-- Tags that matches the given selector.
select :: (TagSoup.StringLike str, Selectable s)
       => s -> [TagSoup.Tag str] -> [[TagSoup.Tag str]]
select s = selectNodes nodes
    where (MkSelector nodes) = toSelector s

selectNodes :: TagSoup.StringLike str
            => [SelectNode] -> [TagSoup.Tag str] -> [[TagSoup.Tag str]]
selectNodes nodes tags = head' $ reverse results
    where results = [concatMap (selectNode s) ts | s  <- nodes
                                                 | ts <- [tags] : results]
          head' []    = []
          head' (x:_) = x

selectNode :: TagSoup.StringLike str
           => SelectNode -> [TagSoup.Tag str] -> [[TagSoup.Tag str]]
selectNode (SelectNode node attributes) tags = concatMap extractTagBlock nodes
    where nodes = filter (checkTag node attributes) $ tails tags
selectNode (SelectAny attributes) tags = concatMap extractTagBlock nodes
    where nodes = filter (checkPreds attributes) $ tails tags

-- Given a tag name and a list of attribute predicates return a function that
-- returns true if a given tag matches the supplied name and predicates.
checkTag :: TagSoup.StringLike str
          => String -> [AttributePredicate] -> [TagSoup.Tag str] -> Bool
checkTag name preds tags@(TagSoup.TagOpen str _:_)
    = TagSoup.fromString name == str && checkPreds preds tags
checkTag _ _ _ = False

checkPreds :: TagSoup.StringLike str
            => [AttributePredicate] -> [TagSoup.Tag str] -> Bool
checkPreds preds (TagSoup.TagOpen _ attrs:_)
    = and [or [checkPred p attr | attr <- attrs] | p <- preds]
checkPreds _ _ = False

-- Given a list of tags, return the prefix of the tags up to the closing tag
-- that corresponds to the initial tag.
extractTagBlock :: TagSoup.StringLike str
                => [TagSoup.Tag str] -> [[TagSoup.Tag str]]
extractTagBlock [] = []
extractTagBlock (openTag : tags)
    | not $ TagSoup.isTagOpen openTag = []
    | otherwise                       = fakeClosingTag openTag
                                      $ map (openTag :)
                                      $ splitBlock (getTagName openTag) 0 tags
    where
        -- To handle tags that do not have a closing tag, fake an empty block by
        -- adding a closing tag.
        fakeClosingTag openTag@(TagSoup.TagOpen name _) []
            = [[openTag, TagSoup.TagClose name]]
        fakeClosingTag _ blocks = blocks

splitBlock _    _       []                          = []
splitBlock name depth  (tag : tags)
    | depth == 0 && TagSoup.isTagCloseName name tag = [[tag]]
    | TagSoup.isTagCloseName name tag = tag_ $ splitBlock name (depth - 1) tags
    | TagSoup.isTagOpenName name tag  = tag_ $ splitBlock name (depth + 1) tags
    | otherwise                       = tag_ $ splitBlock name depth tags
    where tag_ = map (tag :)

getTagName :: TagSoup.StringLike str => TagSoup.Tag str -> str
getTagName (TagSoup.TagOpen name _) = name
getTagName (TagSoup.TagClose name)  = name
getTagName _                        = undefined<commit_msg>Try to make Select.hs more efficient<commit_after>{-# LANGUAGE ImpredicativeTypes #-}
{-# OPTIONS_HADDOCK hide #-}
module Text.HTML.Scalpel.Internal.Select (
    select
) where

import Text.HTML.Scalpel.Internal.Select.Types

import Data.List

import qualified Text.HTML.TagSoup as TagSoup
import qualified Text.StringLike as TagSoup


-- | The 'select' function takes a 'Selectable' value and a list of
-- 'TagSoup.Tag's and returns a list of every subsequence of the given list of
-- Tags that matches the given selector.
select :: (TagSoup.StringLike str, Selectable s)
       => s -> [TagSoup.Tag str] -> [[TagSoup.Tag str]]
select s = selectNodes nodes
    where (MkSelector nodes) = toSelector s

selectNodes :: TagSoup.StringLike str
            => [SelectNode] -> [TagSoup.Tag str] -> [[TagSoup.Tag str]]
selectNodes nodes tags = head' $ reverse results
    where results = [concatMap (selectNode s) ts | s  <- nodes
                                                 | ts <- [tags] : results]
          head' []    = []
          head' (x:_) = x

selectNode :: TagSoup.StringLike str
           => SelectNode -> [TagSoup.Tag str] -> [[TagSoup.Tag str]]
selectNode (SelectNode node attributes) tags = concatMap extractTagBlock nodes
    where nodes = filter (checkTag node attributes) $ tails tags
selectNode (SelectAny attributes) tags = concatMap extractTagBlock nodes
    where nodes = filter (checkPreds attributes) $ tails tags

-- Given a tag name and a list of attribute predicates return a function that
-- returns true if a given tag matches the supplied name and predicates.
checkTag :: TagSoup.StringLike str
          => String -> [AttributePredicate] -> [TagSoup.Tag str] -> Bool
checkTag name preds tags@(TagSoup.TagOpen str _:_)
    = TagSoup.fromString name == str && checkPreds preds tags
checkTag _ _ _ = False

checkPreds :: TagSoup.StringLike str
            => [AttributePredicate] -> [TagSoup.Tag str] -> Bool
checkPreds preds (TagSoup.TagOpen _ attrs:_)
    = and [or [checkPred p attr | attr <- attrs] | p <- preds]
checkPreds _ _ = False

-- Given a list of tags, return the prefix of the tags up to the closing tag
-- that corresponds to the initial tag.
extractTagBlock :: TagSoup.StringLike str
                => [TagSoup.Tag str] -> [[TagSoup.Tag str]]
extractTagBlock [] = []
extractTagBlock (openTag : tags)
    | not $ TagSoup.isTagOpen openTag = []
    | otherwise                       = fakeClosingTag openTag
                                      $ map (openTag :)
                                      $ splitBlock (getTagName openTag) 0 tags
    where
        -- To handle tags that do not have a closing tag, fake an empty block by
        -- adding a closing tag.
        fakeClosingTag openTag@(TagSoup.TagOpen name _) []
            = [[openTag, TagSoup.TagClose name]]
        fakeClosingTag _ blocks = blocks

splitBlock :: TagSoup.StringLike str
           => str -> Int -> [TagSoup.Tag str] -> [[TagSoup.Tag str]]
splitBlock name = go id where
    isClose = TagSoup.isTagCloseName name
    isOpen = TagSoup.isTagOpenName name
    go _ _ [] = []
    go f depth (tag : tags)
        | depth == 0 && closing = [f [tag]]
        | otherwise = go (f . (tag :)) depth' tags
        where
            closing = isClose tag
            depth' | closing    = depth - 1
                   | isOpen tag = depth + 1
                   | otherwise  = depth

getTagName :: TagSoup.StringLike str => TagSoup.Tag str -> str
getTagName (TagSoup.TagOpen name _) = name
getTagName (TagSoup.TagClose name)  = name
getTagName _                        = undefined
{'fraction_non_alphanumeric': 0.0970625798212005, 'fraction_numerical': 0.0011352348517099475, 'mean_word_length': 2.4464547677261614, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 47, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 9, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7236348', 'n_tokens_mistral': 2061, 'n_tokens_neox': 2019, 'n_words': 693}