diff --git a/scrappy-core.cabal b/scrappy-core.cabal --- a/scrappy-core.cabal +++ b/scrappy-core.cabal @@ -3,7 +3,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.0 +version: 0.1.0.1 synopsis: html pattern matching library and high-level interface concurrent requests lib for webscraping description: Scrappy is meant to be a fully expressive library for all aspects of webscraping. @@ -38,9 +38,6 @@ category: Webscraping build-type: Simple extra-source-files: README.MD -source-repository head - type: git - location: https://github.com/Ace-Interview-Prep/scrappy-core library exposed-modules: Scrappy.Find , Scrappy.Scrape @@ -52,37 +49,46 @@ , Scrappy.Elem.ITextElemParser , Scrappy.Elem.ChainHTML , Scrappy.Links - , Scrappy.Files , Scrappy.Types - build-depends: aeson >= 2.2.3 && < 2.3 - , base >= 4.20.2 && < 4.21 - , bytestring >= 0.12.2 && < 0.13 - , containers >= 0.7 && < 0.8 - , directory >= 1.3.8 && < 1.4 - , filepath >= 1.5.4 && < 1.6 - , lens >= 5.3.5 && < 5.4 - , modern-uri >= 0.3.6 && < 0.4 - , network-uri >= 2.6.4 && < 2.7 - , parsec >= 3.1.18 && < 3.2 - , parser-combinators >= 1.3.1 && < 1.4 - , text >= 2.1.3 && < 2.2 - , transformers >= 0.6.1 && < 0.7 - --- base --- , aeson --- , bytestring --- , containers --- , directory --- , filepath --- , lens --- , modern-uri --- -- ^ less maintained? --- , network-uri --- , parsec --- , parser-combinators --- , text --- , transformers + build-depends: base >=4.19.0 && <5 + , aeson >=2.2.3 && <2.3 + , bytestring >=0.12.2 && <0.13 + , containers >=0.7 && <0.8 + , lens >=5.3.5 && <5.4 + , modern-uri >=0.3.6 && <0.4 + , network-uri >=2.6.4 && <2.7 + , parsec >=3.1.18 && <3.2 + , parser-combinators >=1.3.1 && <1.4 + , text >=2.1.3 && <2.2 + , transformers >=0.6.1 && <0.7 hs-source-dirs: src default-language: Haskell2010 + +-- test-suite scrappy-core-test +-- type: exitcode-stdio-1.0 +-- hs-source-dirs: test +-- main-is: Spec.hs +-- other-modules: Scrappy.ScrapeSpec +-- , Scrappy.FindSpec +-- , Scrappy.LinksSpec +-- , Scrappy.RoundtripSpec +-- , Scrappy.RoundtripInnerSpec +-- , Scrappy.Elem.SimpleElemParserSpec +-- , Scrappy.Elem.TreeElemParserSpec +-- , Scrappy.Elem.ContainsSpec +-- , Scrappy.Elem.ElemHeadParseSpec +-- , Scrappy.Elem.ITextElemParserSpec +-- , TestUtils +-- build-depends: base +-- , scrappy-core +-- , hspec >= 2.7 && < 3 +-- , QuickCheck >= 2.14 && < 3 +-- , parsec +-- , containers +-- , filepath +-- , directory +-- build-tool-depends: hspec-discover:hspec-discover >= 2.7 && < 3 +-- default-language: Haskell2010 +-- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N diff --git a/src/Scrappy/Elem/SimpleElemParser.hs b/src/Scrappy/Elem/SimpleElemParser.hs --- a/src/Scrappy/Elem/SimpleElemParser.hs +++ b/src/Scrappy/Elem/SimpleElemParser.hs @@ -79,7 +79,7 @@ $ (try (string "/>") >> return []) <|> (try $ innerElemParser elem' innerSpec) -- need to be sure that we have exhausted looking for an end tag, then we can do the following safely <|> (selfClosingTextful innerSpec) - return $ Elem' elem' attrs' matches (reverse asString) + return $ Elem' elem' attrs' matches asString -- | Generic interface for building Html element patterns where we do not differentiate based on whats inside @@ -104,11 +104,11 @@ $ (try (string "/>") >> return []) <|> (try $ innerElemParser elem' innerSpec) -- need to be sure that we have exhausted looking for an end tag, then we can do the following safely <|> (selfClosingTextful innerSpec) - return $ Elem' elem' attrs' matches (reverse asString) + return $ Elem' elem' attrs' matches asString - + clickableHref :: Stream s m Char => Bool -> LastUrl -> ParsecT s u m Clickable clickableHref booly cUrl = do elA <- parseOpeningTag Nothing [("href", Nothing)] @@ -290,7 +290,7 @@ $ (try (string "/>") >> return []) <|> (try $ innerElemParser elem' innerSpec) -- need to be sure that we have exhausted looking for an end tag, then we can do the following safely <|> (selfClosingTextful innerSpec) - return $ Elem' elem' attrs' matches (reverse asString) + return $ Elem' elem' attrs' matches asString -- elemParserInternalV2 :: (ShowHTML a, Stream s m Char) => @@ -349,8 +349,7 @@ stylingElem = do (e,_) <- parseOpeningTag (Just stylingTags) [] char '>' - fmap (reverse. fst) $ manyTill_ anyChar (endTag e) - -- matches : Reversed >-> RW + fmap fst $ manyTill_ anyChar (endTag e) -- f :: ([a], [b], [c]) -> Elem' a -- f (x,y,z) = f' x y z diff --git a/src/Scrappy/Elem/TreeElemParser.hs b/src/Scrappy/Elem/TreeElemParser.hs --- a/src/Scrappy/Elem/TreeElemParser.hs +++ b/src/Scrappy/Elem/TreeElemParser.hs @@ -104,7 +104,7 @@ $ (try (string "/>") >> return []) <|> (try $ innerElemParser2 elem' matchh) <|> (selfClosingTextful matchh) - return $ TreeHTML elem' attrs' (reverse matchBook) (reverse inText) (reverse treees) + return $ TreeHTML elem' attrs' matchBook inText treees ------------------------------------------------------------------------------------------------------------------- @@ -116,10 +116,10 @@ innerTreeElemParser :: (ShowHTML a, Stream s m Char) => Elem -> Maybe (ParsecT s u m a) - -> ParsecT s u m (String, [a], [Tree ElemHead]) + -> ParsecT s u m (String, [a], [Tree ElemHead]) innerTreeElemParser elem' matchh = do fmap (foldr foldFuncTrup mempty) - $ (try (string "/>") >> return []) + $ (try (string "/>") >> return []) <|> (try $ innerElemParser2 elem' matchh) <|> (selfClosingTextful matchh) -- then i apply this to all leaves of the Map @@ -215,16 +215,13 @@ -- fmap ((flip (:) []) . IText . (:[])) specificITextParser -- fmap ((flip (:) []) . IText . fst) (manyTill_ anyChar (endTag elemTag)) - manyElHeads -> - -- ((endTag elemTag) >> validateGPR manyElHeads) + manyElHeads -> + -- For strict matching: try expected elements first, fail on unexpected elements liftA2 (:) (fmap Match $ try (fromMaybe parserZero match)) (htmlGenParserRepeat elemTag match manyElHeads) - <|> liftA2 (:) (fmap IText $ try stylingElem) (htmlGenParserRepeat elemTag match manyElHeads) <|> try ((treeElemParserSpecificContinuous match manyElHeads) >>= (\(sM, a) -> fmap ((Element a):) (htmlGenParserRepeat elemTag match sM))) - - -- if at this point in time with all possibilities considered: - -- do (if openingTag then fail else Itext) - <|> liftA2 (:) (fmap (IText . (:[])) specificChar) (htmlGenParserRepeat elemTag match manyElHeads) + -- Only allow text content that's not part of an opening tag + <|> liftA2 (:) (fmap (IText . (:[])) (specificChar' elemTag)) (htmlGenParserRepeat elemTag match manyElHeads) -- case parseOpeningTag @@ -387,19 +384,19 @@ Maybe (ParsecT s u m a) -> Elem -> SubTree ElemHead - -> ParsecT s u m ([a], String, [Tree ElemHead]) + -> ParsecT s u m ([a], String, [Tree ElemHead]) innerParserContains match tag subTree = case elem tag selfClosing of True -> if not $ null subTree then undefined else do (try (string ">") <|> string "/>") return (mempty, mempty, mempty) - False -> do - -- char '>' + False -> do + char '>' x <- htmlGenParserContains tag match (reverse $ groupify subTree []) let - -- | need to ensure all the trees are in order + -- | need to ensure all the trees are in order (inText, matchBook, treees) = foldr foldFuncTrup mempty (x) - return (matchBook, (reverse inText), (reverse treees))--(_matches itr) (_innerText itr) (innerTree itr) + return (matchBook, inText, treees) -- | Very similar to treeElemParserSpecific except that it allows for a new nodes in the HTML DOM tree -- | to exist at random as long as when we resume parsing we still find all of the branches we found in the @@ -410,6 +407,7 @@ -> ParsecT s u m (TreeHTML a) similarTreeH matchh treeH = do (e,at) <- parseOpeningTag (Just $ [elTag treeH]) (((fmap . fmap) Just) . Map.toList $ attrs treeH) + char '>' (inTx, m, inTr) <- fmap (foldr foldFuncTrup mempty) (htmlGenParserContains e matchh (groupify (_innerTree' treeH) [])) return $ TreeHTML e at m inTx inTr @@ -508,7 +506,7 @@ let -- | need to ensure all the trees are in order (inText, matchBook, treees) = foldr foldFuncTrup mempty (x) - return (matchBook, (reverse inText), (reverse treees))--(_matches itr) (_innerText itr) (innerTree itr) + return (matchBook, inText, treees) @@ -835,8 +833,7 @@ stylingElem = do (e,_) <- parseOpeningTag (Just stylingTags) [] char '>' - fmap (reverse . fst) $ manyTill_ anyChar (endTag e) - -- matches : Reversed >-> RW + fmap fst $ manyTill_ anyChar (endTag e) diff --git a/src/Scrappy/Elem/Types.hs b/src/Scrappy/Elem/Types.hs --- a/src/Scrappy/Elem/Types.hs +++ b/src/Scrappy/Elem/Types.hs @@ -432,13 +432,21 @@ buildAttrs (attr:attrss) = " " <> fst attr <> "=" <> "\"" <> snd attr <> "\"" <> buildAttrs attrss +-- | List of HTML self-closing (void) elements +selfClosingElems :: [String] +selfClosingElems = ["area", "base", "br", "col", "embed", "hr", "img", "input", "link", "meta", "param", "source", "track", "wbr"] + treeElemToStr :: (ShowHTML a) => TreeHTML a -> String treeElemToStr (TreeHTML{..}) = - "<" <> _topEl <> mdToStringPairs _topAttrs <> ">" <> _innerText' <> " _topEl <> ">" - where mdToStringPairs attrsSet = go (toList attrsSet) + if _topEl `elem` selfClosingElems + then "<" <> _topEl <> mdToStringPairs _topAttrs <> ">" + else "<" <> _topEl <> mdToStringPairs _topAttrs <> ">" <> _innerText' <> " _topEl <> ">" + where mdToStringPairs attrsSet = case toList attrsSet of + [] -> "" + attrs -> " " <> go attrs go [] = "" - go (atr:[]) = (fst atr) <> "=" <> ('"' : snd atr) <> ('"' : []) - go (atr: attrsSet) = (fst atr) <> "=" <> ('"' : snd atr) <> ('"' : []) <> go attrsSet + go (atr:[]) = (fst atr) <> "=" <> ('"' : snd atr) <> ('"' : []) + go (atr: attrsSet) = (fst atr) <> "=" <> ('"' : snd atr) <> "\" " <> go attrsSet -- Future concern: @@ -464,27 +472,27 @@ -- | Bug found: matches start right way then get reversed -foldFuncTup :: (ShowHTML (e a), ShowHTML a, ElementRep e) => HTMLMatcher e a -> (String, [a]) -> (String, [a]) +foldFuncTup :: (ShowHTML (e a), ShowHTML a, ElementRep e) => HTMLMatcher e a -> (String, [a]) -> (String, [a]) foldFuncTup hMatcher itr = case hMatcher of - IText str -> - (fst itr <> str, snd itr) + IText str -> + (str <> fst itr, snd itr) -- May need to enforce a Show Instance on 'mat' - Match mat -> - (fst itr <> (reverse $ showH mat), snd itr <> [mat]) + Match mat -> + (showH mat <> fst itr, snd itr <> [mat]) --concat to fullInnerText Element elem -> --interEl :: ElemHead [HtmlMatcher] - (fst itr <> (reverse $ showH elem), snd itr <> matches' elem) + (showH elem <> fst itr, snd itr <> matches' elem) -foldFuncTrup :: (ShowHTML a) => HTMLMatcher TreeHTML a -> (String, [a], Forest ElemHead) -> (String, [a], Forest ElemHead) +foldFuncTrup :: (ShowHTML a) => HTMLMatcher TreeHTML a -> (String, [a], Forest ElemHead) -> (String, [a], Forest ElemHead) foldFuncTrup hMatcher itr = case hMatcher of - IText str -> - (fst' itr <> str, snd' itr, thd' itr) + IText str -> + (str <> fst' itr, snd' itr, thd' itr) -- May need to enforce a Show Instance on 'mat' - Match mat -> - (fst' itr <> (showH mat), snd' itr <> [mat], thd' itr) + Match mat -> + (showH mat <> fst' itr, snd' itr <> [mat], thd' itr) --concat to fullInnerText Element elem -> --interEl :: ElemHead [HtmlMatcher] - (fst' itr <> (reverse $ showH elem), snd' itr <> matches' elem, thd' itr <> ((makeBranch elem):[])) + (showH elem <> fst' itr, snd' itr <> matches' elem, thd' itr <> [makeBranch elem]) -- | In our failed test case with the command : parse f "" "" -- where f :: (Stream s m Char) => ParsecT s u m (TreeHTML String); f = treeElemParser (Just ["a"]) Nothing [] @@ -559,14 +567,14 @@ foldFuncITR :: (ShowHTML a, ElementRep e) => HTMLMatcher e a -> InnerTextResult a -> InnerTextResult a foldFuncITR hMatcher itr = case hMatcher of - IText str -> - InnerTextResult (_matchesITR itr) (_fullInner itr <> str) + IText str -> + InnerTextResult (_matchesITR itr) (str <> _fullInner itr) -- May need to enforce a Show Instance on 'mat' - Match mat -> - InnerTextResult (mat : _matchesITR itr) (_fullInner itr <> (showH mat)) + Match mat -> + InnerTextResult (_matchesITR itr <> [mat]) (showH mat <> _fullInner itr) --concat to fullInnerText Element elem -> --interEl :: ElemHead [HtmlMatcher] - InnerTextResult (matches' elem <> _matchesITR itr) (_fullInner itr <> (innerText' elem)) + InnerTextResult (_matchesITR itr <> matches' elem) (innerText' elem <> _fullInner itr) -- foldFuncITHT :: (ShowHTML a, ElementRep e) => HTMLMatcher TreeHTML a -> InnerTextResult a -> InnerTextResult a @@ -577,15 +585,15 @@ HTMLMatcher TreeHTML a -> InnerTextHTMLTree a -> InnerTextHTMLTree a -fHM_c hMatcher ithT = case hMatcher of - IText str -> - InnerTextHTMLTree (_matches ithT) (_innerText ithT <> str) (innerTree ithT) +fHM_c hMatcher ithT = case hMatcher of + IText str -> + InnerTextHTMLTree (_matches ithT) (str <> _innerText ithT) (innerTree ithT) -- May need to enforce a Show Instance on 'mat' - Match mat -> - InnerTextHTMLTree (mat : (_matches ithT)) (_innerText ithT <> (showH mat)) (innerTree ithT) + Match mat -> + InnerTextHTMLTree (_matches ithT <> [mat]) (showH mat <> _innerText ithT) (innerTree ithT) --concat to fullInnerText Element htmlTree -> --interEl :: ElemHead [HtmlMatcher] - InnerTextHTMLTree (_matches ithT <> matches' htmlTree) ((_innerText ithT) <> showH htmlTree) ((makeBranch htmlTree) : innerTree ithT) + InnerTextHTMLTree (_matches ithT <> matches' htmlTree) (showH htmlTree <> _innerText ithT) (innerTree ithT <> [makeBranch htmlTree]) makeBranch :: TreeHTML a -> Tree ElemHead @@ -599,15 +607,15 @@ enoughMatches :: Int -> String -> Map String String -> (String, [a]) -> ParsecT s u m (Elem' a) -enoughMatches required e a (asString, matches) = +enoughMatches required e a (asString, matches) = if required <= (length matches) - then return $ Elem' e a matches (reverse asString) - else parserFail "not enough matches" -- should throw real error + then return $ Elem' e a matches asString + else parserFail "not enough matches" -- should throw real error enoughMatchesTree :: Int -> String -> Map String String -> (String, [a], Forest ElemHead) -> ParsecT s u m (TreeHTML a) -enoughMatchesTree required e a (asString, matches, forest) = +enoughMatchesTree required e a (asString, matches, forest) = if required <= (length matches) - then return $ TreeHTML e a matches (reverse asString) forest + then return $ TreeHTML e a matches asString forest else parserFail "not enough matches" -- should throw real error diff --git a/src/Scrappy/Files.hs b/src/Scrappy/Files.hs deleted file mode 100644 --- a/src/Scrappy/Files.hs +++ /dev/null @@ -1,65 +0,0 @@ -module Scrappy.Files where - -import Scrappy.Types -import Scrappy.Scrape -import Text.Parsec -import Scrappy.Elem -import qualified Data.Map.Strict as Map -import Control.Monad -import Data.Map.Strict (Map,keys) -import Data.List (foldl') -import System.FilePath -import System.Directory - --- TEMPORARY: move to own package when im not lazy - - - --- | Recursively lists all files in a directory, returning absolute file paths. -listFilesRecursive :: FilePath -> IO [FilePath] -listFilesRecursive dir = do - contents <- listDirectory dir -- Get directory contents - paths <- forM contents $ \name -> do - let fullPath = dir name -- Create full path - isDir <- doesDirectoryExist fullPath - if isDir - then listFilesRecursive fullPath -- Recursively search subdirectories - else do - absPath <- makeAbsolute fullPath -- Get absolute path in IO context - return [absPath] -- Wrap in list for concatenation - return (concat paths) -- Flatten list of lists - - -searchFile :: ScraperT a -> FilePath -> IO Bool -searchFile p fp = do - str <- readFile fp - pure $ exists p str - -searchStrFile :: String -> FilePath -> IO Bool -searchStrFile s fp = searchFile (string "s") fp - -searchManyFile :: [String] -> FilePath -> IO (Map String Int) -searchManyFile strs fp = do - file <- readFile fp - case scrape (buildElemsOpts strs) file of - Nothing -> pure mempty - Just results -> pure $ countOccurrences results - --- | Function to count occurrences of each unique string in a list -countOccurrences :: [String] -> Map String Int -countOccurrences = foldl' (\acc word -> Map.insertWith (+) word 1 acc) Map.empty - - - -areFilesUsed :: FilePath -> FilePath -> IO () -areFilesUsed sourceDir usageDir = do - sources <- listFilesRecursive sourceDir - searchFiles <- listFilesRecursive usageDir - let sources' = takeFileName <$> sources - maps <- mapM (\x -> searchManyFile sources' x) searchFiles - let mapped = mconcat maps - print mapped - - print "---" - - print $ filter (\s -> not $ elem s (keys mapped)) sources' diff --git a/src/Scrappy/Scrape.hs b/src/Scrappy/Scrape.hs --- a/src/Scrappy/Scrape.hs +++ b/src/Scrappy/Scrape.hs @@ -37,7 +37,7 @@ -- TODO(galen): move to Scrappy.Scrape -- Generic function for dropping an abstract pattern from text filterFromTextP :: ScraperT a -> ScraperT String -filterFromTextP p = (many $ try p) >> (liftA2 (:) anyChar $ filterFromTextP p) +filterFromTextP p = (many (try p)) >> (liftA2 (:) anyChar (filterFromTextP p)) -- We can return a string since this will never fail -- its provably impossible