crawlchain 0.1.2.0 → 0.2.0.0

raw patch · 8 files changed

+147/−38 lines, 8 filesdep ~base

Dependency ranges changed: base

Files

• crawlchain.cabal +35/−3
• src/Network/CrawlChain/Constants.hs +0/−4
• src/Network/CrawlChain/CrawlChain.hs +1/−1
• src/Network/CrawlChain/CrawlDirective.hs +27/−9
• src/Network/CrawlChain/CrawlingContext.hs +39/−14
• src/Network/CrawlChain/CrawlingParameters.hs +5/−4
• src/Network/CrawlChain/Storing.hs +0/−3
• test/src/CrawlingTests.hs +40/−0

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                crawlchain-version:             0.1.2.0+version:             0.2.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@@ -29,8 +29,7 @@                        -- visible for tests                      , Network.CrawlChain.CrawlingContext                      , Network.CrawlChain.DirectiveChainResult-  other-modules:       Network.CrawlChain.Constants-                     , Network.CrawlChain.CrawlChains+  other-modules:       Network.CrawlChain.CrawlChains                      , Network.CrawlChain.Crawling                      , Network.CrawlChain.Downloading                      , Network.CrawlChain.Report@@ -58,5 +57,38 @@                      , crawlchain                      , split                      , tagsoup+  default-language:    Haskell2010+  ghc-options:         -Wall++  +Test-Suite crawling-tests+  type: exitcode-stdio-1.0+  main-is: CrawlingTests.hs+  other-modules:       Network.CrawlChain.CrawlAction+                     , Network.CrawlChain.CrawlChain+                     , Network.CrawlChain.CrawlChains+                     , Network.CrawlChain.CrawlDirective+                     , Network.CrawlChain.CrawlResult+                     , Network.CrawlChain.Crawling+                     , Network.CrawlChain.CrawlingContext+                     , Network.CrawlChain.CrawlingParameters+                     , Network.CrawlChain.DirectiveChainResult+                     , Network.CrawlChain.Downloading+                     , Network.CrawlChain.Report+                     , Network.CrawlChain.Storing+                     , Network.CrawlChain.Util+                     , Network.URI.Util+                     , Text.HTML.CrawlChain.HtmlFiltering+  hs-source-dirs:      src, test/src+  build-depends:       base+                     , crawlchain+                     , bytestring+                     , directory+                     , http-streams+                     , network-uri+                     , text+                     , time+                     , tagsoup+                     , split   default-language:    Haskell2010   ghc-options:         -Wall

@@ -1,4 +0,0 @@-module Network.CrawlChain.Constants where--testResourcePath :: String-testResourcePath = "test/resources/"

@@ -43,7 +43,7 @@ crawlChains args =       executeCrawlChain context (paramInitialAction args) (paramCrawlDirective args)         where-          context = if paramDoStore args then storingContext else defaultContext+          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

@@ -3,13 +3,31 @@ import Network.CrawlChain.CrawlAction import Network.CrawlChain.CrawlResult +{-|+  A crawl directive takes a content of a web page and produces crawl actions for links/forms to follow.+  The general idea is to specify a list of operations that in theory produces a dynamically collected+  tree of requests which leaves are either dead ends or end results.++  Additional, logical branching/combination of Directives is possible with:+   * Alternatives - evaluate both Directives in order.+   * Restart - evaluate completely new initial action & chain if the previous combo does not produce end results.+-} data CrawlDirective =-    SimpleDirective (String -> [CrawlAction])          -- | access content to find absolute follow-up urls-  | RelativeDirective (String -> [CrawlAction])        -- | as simple, but found relative urls are completed-  | FollowUpDirective (CrawlResult -> [CrawlAction])   -- | as simple, but with access to complete result-  | DelayDirective Int CrawlDirective                  -- | wait additional seconds before executing-  | RetryDirective Int CrawlDirective                  -- | if given directive yields no results use add. retries-  | AlternativeDirective CrawlDirective CrawlDirective -- | fallback to second argument if first yields no results-  | RestartChainDirective (CrawlAction, CrawlDirective)-- | the possibility to start a new chain (when using alternative)-  | GuardDirective (CrawlAction -> Bool)               -- | not crawling anything, just a blacklisting option-  | DirectiveSequence [CrawlDirective]                 -- | chaining of directives+    SimpleDirective (String -> [CrawlAction])+    -- ^ access content to find absolute follow-up urls+  | RelativeDirective (String -> [CrawlAction])+    -- ^ as simple, but found relative urls are completed+  | FollowUpDirective (CrawlResult -> [CrawlAction])+    -- ^ as simple, but with access to complete result+  | DelayDirective Int CrawlDirective+    -- ^ wait additional seconds before executing+  | RetryDirective Int CrawlDirective+    -- ^ if given directive yields no results use add. retries+  | AlternativeDirective CrawlDirective CrawlDirective+    -- ^ fallback to second argument if first yields no results+  | RestartChainDirective (CrawlAction, CrawlDirective)+    -- ^ the possibility to start a new chain (when using alternative)+  | GuardDirective (CrawlAction -> Bool)+    -- ^ not crawling anything, just a blacklisting option+  | DirectiveSequence [CrawlDirective]+    -- ^ chaining of directives

@@ -1,11 +1,20 @@+{-|+ Enabling tests: provide different crawling implementations:++ - regular+ - storing the crawled URLs and its content to prepare new tests+ - reading the stored content in tests - has no real world application+-} module Network.CrawlChain.CrawlingContext (-    CrawlingContext, DefaultCrawlingContext(..), crawler,-    defaultContext, storingContext, bufferingFilename+    CrawlingContext, crawler,+    defaultContext, storingContext, readingContext   ) where -import Network.CrawlChain.Constants+import System.Directory (doesFileExist)+ import Network.CrawlChain.Crawling (crawl, crawlAndStore, Crawler) import Network.CrawlChain.CrawlAction+import Network.CrawlChain.CrawlResult  class CrawlingContext a where   crawler :: a -> Crawler@@ -16,19 +25,17 @@ instance CrawlingContext DefaultCrawlingContext where   crawler = crawlImplementation -{-- Enabling tests: provide different crawling implementations:-- - regular- - storing the crawled URLs and its content to prepare new tests- - reading the stored content in tests - has no real world application and is defined in the actual tests--}-defaultContext, storingContext :: DefaultCrawlingContext+defaultContext :: DefaultCrawlingContext defaultContext = DefaultCrawlingContext crawl-storingContext = DefaultCrawlingContext $ crawlAndStore bufferingFilename -bufferingFilename :: CrawlAction -> String-bufferingFilename a = testResourcePath ++ (fname a) ++ if isPost a then "-POST" else ""+storingContext :: String -> DefaultCrawlingContext+storingContext prefix = DefaultCrawlingContext $ crawlAndStore $ bufferingFilename prefix++{-|+  Make a unique name for a crawl action - prefix is used to specify the target folder including a specific test prefix+-}+bufferingFilename :: String -> CrawlAction -> String+bufferingFilename prefix a = prefix ++ "/" ++ (fname a) ++ if isPost a then "-POST" else ""   where     isPost (PostRequest _ _ _) = True     isPost _ = False@@ -39,3 +46,21 @@           where             dropOn :: Char -> String -> Char -> String             dropOn c = \collected nextC -> if c == nextC then "" else nextC:collected++readingContext :: String -> DefaultCrawlingContext+readingContext = DefaultCrawlingContext . readFromFiles++readFromFiles :: String -> CrawlAction -> IO CrawlResult+readFromFiles testnamePrefix a = do+  putStrLn $ "  - Reading " ++ filename ++ " for " ++ testnamePrefix+  found <- doesFileExist filename+  if found+    then readFile filename >>= \content -> return $ wrapAsRequest content+    else do+         putStrLn ("  - " ++ notFoundMsg)+         return $ CrawlResult a "" $ CrawlingFailed notFoundMsg+  where+    filename = bufferingFilename testnamePrefix a+    wrapAsRequest :: String -> CrawlResult+    wrapAsRequest content = CrawlResult a content CrawlingOk+    notFoundMsg = "not found in store: " ++ filename

@@ -4,8 +4,9 @@ import Network.CrawlChain.CrawlDirective  data CrawlingParameters = CrawlingParameters {-  paramInitialAction :: CrawlAction,-  paramCrawlDirective :: CrawlDirective,-  paramDoDownload :: Bool,-  paramDoStore :: Bool+  paramName :: String, -- ^ name of crawl run+  paramInitialAction :: CrawlAction, -- ^ starting point+  paramCrawlDirective :: CrawlDirective, -- ^ list of operations sequentially on all previous results+  paramDoDownload :: Bool, -- ^ store the content of a single result (the first) of the last operation step+  paramDoStore :: Bool -- ^ store the url of a single result (the first)  of the last operation step   }

@@ -20,6 +20,3 @@        return (dir' ++ "/" ++ dest)        )    dir--makeFilename :: String -> String -> String -> String-makeFilename series season episode = series ++ "-S" ++ season++ "E" ++ episode ++ ".mp4"

@@ -0,0 +1,40 @@+module Main (main) where++import Data.Maybe (listToMaybe)+import System.Exit (exitFailure)++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++testResourcePath :: String+testResourcePath = "test/resources"++-- I really would like to use the detailed test-suite, but that seems to be still unsupported albeit years have passed.+main :: IO ()+main = do+    doTest "basicTest" basicTestChain "expected.html"+  where+    basicTestChain =+      (GetRequest "http://first.html",+       SimpleDirective extractLinks)++doTest :: String -> (CrawlAction, CrawlDirective) -> String -> IO ()+doTest testname template expectedUrl = do+  results <- uncurry (executeCrawlChain testingContext) template+  checkFirstResult results expectedUrl+  where+    testingContext = readingContext $ testResourcePath ++ "/" ++ testname++checkFirstResult :: [DirectiveChainResult] -> String -> IO ()+checkFirstResult rps expected =+  if maybe False (== expected) foundUrl+  then putStrLn $ "\nSuccessfully checked " ++ msg +  else putStrLn ("\nFailed to check " ++ msg ++ ", found: " ++ (show foundUrl)+                 ++ " in:\n\n" ++ (maybe "" (show . resultHistory) (listToMaybe rps))) >> exitFailure+  where+    foundUrl = extractFirstResult rps >>= return . crawlUrl+    msg = ": " ++ expected