packages feed

crawlchain 0.2.0.0 → 0.3.0.0

raw patch · 6 files changed

+113/−78 lines, 6 files

Files

crawlchain.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                crawlchain-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Simulation user crawl paths description:         Library for simulating user crawl paths (trees) with selectors - takes an initial action and a chain of processing actions to crawl a tree (lazy, depth first) searching for a matching branch. stability:           experimental@@ -16,7 +16,7 @@  library   hs-source-dirs:      src-  exposed-modules:     Network.CrawlChain.CrawlChain+  exposed-modules:     Network.CrawlChain                      , Network.CrawlChain.CrawlingParameters                      , Network.CrawlChain.BasicTemplates                      , Network.CrawlChain.CrawlAction@@ -64,8 +64,8 @@ Test-Suite crawling-tests   type: exitcode-stdio-1.0   main-is: CrawlingTests.hs-  other-modules:       Network.CrawlChain.CrawlAction-                     , Network.CrawlChain.CrawlChain+  other-modules:       Network.CrawlChain+                     , Network.CrawlChain.CrawlAction                      , Network.CrawlChain.CrawlChains                      , Network.CrawlChain.CrawlDirective                      , Network.CrawlChain.CrawlResult
+ src/Network/CrawlChain.hs view
@@ -0,0 +1,63 @@+module Network.CrawlChain (+  crawlChain, crawlChains, -- primary interface +  executeActions, crawlForUrl, -- legacy, deprecated+  executeCrawlChain -- visible for tests+  ) where++import Data.List (intersperse)++import Network.CrawlChain.CrawlAction+import Network.CrawlChain.CrawlingParameters+import Network.CrawlChain.CrawlChains+import Network.CrawlChain.CrawlingContext (defaultContext, storingContext)+import Network.CrawlChain.DirectiveChainResult (extractFirstResult)+import Network.CrawlChain.Downloading++executeActions :: CrawlingParameters -> String -> String -> IO ()+executeActions args dir fName = do+  downloadAction <- crawlChain args+  if paramDoDownload args+    then downloadStep dir fName downloadAction+    else storeDownloadAction "external-load" (Just dir ) fName downloadAction++crawlForUrl :: CrawlingParameters -> IO (Maybe String)+crawlForUrl args = do+  crawlResult <- crawlChain args+  case crawlResult of+       (Just (GetRequest url)) -> return $ Just url+       (Just _) -> putStrLn "POST result processing not implemented" >> return Nothing+       Nothing -> return Nothing++{-|+ Returns only the first result of a completely matching branch of the crawling directive.+-}+crawlChain :: CrawlingParameters -> IO (Maybe CrawlAction)+crawlChain args = do+  results <- crawlChains args+  logAndReturnFirstOk results++{-|+ Returns all possible results of the craling directive - meant to be used with lazyness in mind as needed.+-}+crawlChains :: CrawlingParameters -> IO [DirectiveChainResult]+crawlChains args =+      executeCrawlChain context (paramInitialAction args) (paramCrawlDirective args)+        where+          context = if paramDoStore args then storingContext (paramName args) else defaultContext++downloadStep :: String -> String -> Maybe CrawlAction -> IO ()+downloadStep dir fName downloadAction = maybe (return ()) (downloadTo (Just dir) fName) downloadAction++logAndReturnFirstOk :: [DirectiveChainResult] -> IO (Maybe CrawlAction)+logAndReturnFirstOk results = do+  firstOk <- (return . extractFirstResult) results+  putDetailsOnFailure firstOk results+  return firstOk++putDetailsOnFailure :: Maybe CrawlAction -> [DirectiveChainResult] -> IO ()+putDetailsOnFailure firstSuccess results =+  case firstSuccess of+   Just a -> putStr "  Using result: " >> print a+   Nothing -> do+     putStrLn $ "  No results found - details: " ++ showAllFailures where+       showAllFailures = concat $ intersperse "\n\n" $ map showResultPath results
− src/Network/CrawlChain/CrawlChain.hs 
@@ -1,63 +0,0 @@-module Network.CrawlChain.CrawlChain (-  crawlChain, crawlChains, -- primary interface -  executeActions, crawlForUrl, -- legacy, deprecated-  executeCrawlChain -- visible for tests-  ) where--import Data.List (intersperse)--import Network.CrawlChain.CrawlAction-import Network.CrawlChain.CrawlingParameters-import Network.CrawlChain.CrawlChains-import Network.CrawlChain.CrawlingContext (defaultContext, storingContext)-import Network.CrawlChain.DirectiveChainResult (extractFirstResult)-import Network.CrawlChain.Downloading--executeActions :: CrawlingParameters -> String -> String -> IO ()-executeActions args dir fName = do-  downloadAction <- crawlChain args-  if paramDoDownload args-    then downloadStep dir fName downloadAction-    else storeDownloadAction "external-load" (Just dir ) fName downloadAction--crawlForUrl :: CrawlingParameters -> IO (Maybe String)-crawlForUrl args = do-  crawlResult <- crawlChain args-  case crawlResult of-       (Just (GetRequest url)) -> return $ Just url-       (Just _) -> putStrLn "POST result processing not implemented" >> return Nothing-       Nothing -> return Nothing--{-|- Returns only the first result of a completely matching branch of the crawling directive.--}-crawlChain :: CrawlingParameters -> IO (Maybe CrawlAction)-crawlChain args = do-  results <- crawlChains args-  logAndReturnFirstOk results--{-|- Returns all possible results of the craling directive - meant to be used with lazyness in mind as needed.--}-crawlChains :: CrawlingParameters -> IO [DirectiveChainResult]-crawlChains args =-      executeCrawlChain context (paramInitialAction args) (paramCrawlDirective args)-        where-          context = if paramDoStore args then storingContext (paramName args) else defaultContext--downloadStep :: String -> String -> Maybe CrawlAction -> IO ()-downloadStep dir fName downloadAction = maybe (return ()) (downloadTo (Just dir) fName) downloadAction--logAndReturnFirstOk :: [DirectiveChainResult] -> IO (Maybe CrawlAction)-logAndReturnFirstOk results = do-  firstOk <- (return . extractFirstResult) results-  putDetailsOnFailure firstOk results-  return firstOk--putDetailsOnFailure :: Maybe CrawlAction -> [DirectiveChainResult] -> IO ()-putDetailsOnFailure firstSuccess results =-  case firstSuccess of-   Just a -> putStr "  Using result: " >> print a-   Nothing -> do-     putStrLn $ "  No results found - details: " ++ showAllFailures where-       showAllFailures = concat $ intersperse "\n\n" $ map showResultPath results
src/Text/HTML/CrawlChain/HtmlFiltering.hs view
@@ -1,4 +1,5 @@ module Text.HTML.CrawlChain.HtmlFiltering (+  extractTagsContent, findAttributes,   extractLinks, extractLinksMatching, extractLinksWithAttributes, extractLinksFilteringUrlAttrs, extractLinksFilteringAll, unevaluated,   findAllUrlsEndingWith, findFirstLinkAfter,   extractFirstForm,@@ -17,6 +18,33 @@ type TagS = Tag String type AttrFilter = [(String, String)] -> Bool type ContainedTextFilter = [String] -> Bool++{-| (name, content, attributes)-}+type TagContent = (String, String, [(String, String)])++{-|+ Content of the tags up to the first child tag (as simplification) - with attributes.+-}+extractTagsContent :: String -> [TagContent]+extractTagsContent  =+  extractContentFromTagStream ("", "", []) .+  canonicalizeTags .+  parseTags+  where+    extractContentFromTagStream :: TagContent -> [TagS] -> [(String, String, [(String, String)])]+    extractContentFromTagStream tagContent@(name, _, _) []+      | null name = []+      | otherwise = [tagContent]+    extractContentFromTagStream tagContent@(name,content,attributes) (t:ts) = handle t where+      handle (TagText c) = extractContentFromTagStream (name, content ++ c, attributes) ts+      handle (TagOpen n as) = (if null name then [] else [tagContent]) ++ extractContentFromTagStream (n, "", as) ts+      handle _ = extractContentFromTagStream tagContent ts++findAttributes :: String -> [TagContent] -> [String]+findAttributes name = foldr ((++) . findAttr') []+  where+    findAttr' :: TagContent -> [String]+    findAttr' (_, _, as) = map snd $ filter (\(n,_) -> n==name) as  noUrlFilter :: String -> Bool noUrlFilter = unevaluated
test/src/CrawlingTests.hs view
@@ -3,9 +3,9 @@ import Data.Maybe (listToMaybe) import System.Exit (exitFailure) +import Network.CrawlChain import Network.CrawlChain.CrawlingContext import Network.CrawlChain.CrawlAction-import Network.CrawlChain.CrawlChain import Network.CrawlChain.CrawlDirective import Network.CrawlChain.DirectiveChainResult import Text.HTML.CrawlChain.HtmlFiltering
test/src/HtmlFilteringTests.hs view
@@ -7,19 +7,26 @@  main :: IO () main = do-  match extractLinks "<a href=\"link\">text</a>" ["link"]-  match extractLinks "<a href=\"link\" />" ["link"]-  match extractLinks "<a href=\"link\">sdf</a><a href=\"link2\">sdf</a>" ["link", "link2"]-  match (extractLinksFilteringAll unevaluated unevaluated unevaluated) "<a href=\"link\">text<span>bla</span></a>" ["link"]-  match (extractLinksFilteringAll unevaluated unevaluated (any (=="bla"))) "<a href=\"link\">text<span>bla</span></a>" ["link"]-  match (extractLinksFilteringAll unevaluated unevaluated (not . any (=="bla"))) "<a href=\"link\">text<span>bla</span></a>" []-  match extractLinks "<iframe src=\"link\"></iframe>" ["link"]-  match extractLinks "<iframe src=\"link\"/>" ["link"]+  matchR extractLinks "<a href=\"link\">text</a>" ["link"]+  matchR extractLinks "<a href=\"link\" />" ["link"]+  matchR extractLinks "<a href=\"link\">sdf</a><a href=\"link2\">sdf</a>" ["link", "link2"]+  matchR (extractLinksFilteringAll unevaluated unevaluated unevaluated) "<a href=\"link\">text<span>bla</span></a>" ["link"]+  matchR (extractLinksFilteringAll unevaluated unevaluated (any (=="bla"))) "<a href=\"link\">text<span>bla</span></a>" ["link"]+  matchR (extractLinksFilteringAll unevaluated unevaluated (not . any (=="bla"))) "<a href=\"link\">text<span>bla</span></a>" []+  matchR extractLinks "<iframe src=\"link\"></iframe>" ["link"]+  matchR extractLinks "<iframe src=\"link\"/>" ["link"]+  matchR (map GetRequest . findAttributes "attr" . extractTagsContent) "<script attr=\"some_url\">content</div><div>bla</script>" ["some_url"]+  match extractTagsContent "" []+  match extractTagsContent "<div/>" [("div", "", [])]+  match extractTagsContent "<div>sdf</div>" [("div", "sdf", [])]+  match extractTagsContent "<div attr=\"1\">sdf</div>" [("div", "sdf", [("attr", "1")])]+  match extractTagsContent "<script attr=\"some_url\">content</script><div>bla</div>" [("script", "content", [("attr","some_url")]),("div", "bla", [])]     where-      match method input expected = -        if actual /= map GetRequest expected+      match method input expected =+        if actual /= expected         then putStrLn ("could not find " ++ (show expected) ++ " in; " ++ input) >> exitFailure         else pure ()         where           actual = method input+      matchR method input expected = match method input (map GetRequest expected)