crawlchain 0.1.0.9 → 0.1.1.4

raw patch · 6 files changed

+48/−25 lines, 6 files

Files

• crawlchain.cabal +2/−1
• src/Network/CrawlChain/BasicTemplates.hs +1/−0
• src/Network/CrawlChain/CrawlChains.hs +14/−4
• src/Network/CrawlChain/CrawlDirective.hs +8/−6
• src/Network/CrawlChain/Crawling.hs +3/−14
• src/Network/CrawlChain/Util.hs +20/−0

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                crawlchain-version:             0.1.0.9+version:             0.1.1.4 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@@ -34,6 +34,7 @@                      , Network.CrawlChain.Crawling                      , Network.CrawlChain.Downloading                      , Network.CrawlChain.Report+                     , Network.CrawlChain.Util   build-depends:       base < 4.9                      , bytestring                      , directory

@@ -17,6 +17,7 @@  searchWebTemplate :: String -> String -> (CrawlAction, CrawlDirective) searchWebTemplate site searchTerm = searchWebTemplateAndProcessHits site searchTerm [] Nothing (id . snd)+ searchWebTemplateAndProcessHits :: String -> String                                    -> [String] -> Maybe ContainedTextFilter                                    -> ((CrawlAction, [CrawlAction]) -> [CrawlAction])

@@ -16,7 +16,7 @@ import Network.CrawlChain.CrawlDirective import Network.CrawlChain.DirectiveChainResult import Network.CrawlChain.Report-+import Network.CrawlChain.Util  executeCrawlChain :: CrawlingContext a => a -> CrawlAction -> CrawlDirective -> IO [DirectiveChainResult] executeCrawlChain = followDirective [] []@@ -51,6 +51,14 @@     followDirective' (SimpleDirective logic) = crawlAndSearch (logic . crawlingContent)     followDirective' (RelativeDirective logic) = crawlAndSearch (makeAbsoluteLogicMapper logic)     followDirective' (FollowUpDirective logic) = crawlAndSearch logic+    followDirective' (DelayDirective sec d) = delaySeconds sec >> followDirective' d+    followDirective' (RetryDirective num d) = do+      results <- followDirective' d+      if num > 0 && all (null . lastResult) results+        then do+             putStrLn $ "retrying "++(show num)++" more times"+             followDirective' $ RetryDirective (num-1) d+        else return results     followDirective' (AlternativeDirective a1 a2) = do       a1Results <- followDirective' a1       if all (null . lastResult) a1Results -- only use alternative if no results at all@@ -62,11 +70,13 @@     crawlAndSearch :: (CrawlResult -> [CrawlAction]) -> IO [DirectiveChainResult]     crawlAndSearch searchLogic = crawler context crawlAction >>= processCrawlingResult       where-        processCrawlingResult crawlingResult = return searchCrawlingResult >>= logSearchResults >>= return . wrapActions >>= appendResult-          where+        processCrawlingResult crawlingResult =+          return searchCrawlingResult >>= logSearchResults >>= return . wrapActions >>= appendResult where             searchCrawlingResult :: [CrawlAction]             searchCrawlingResult = if crawlWasNoSuccess crawlingResult then [] else searchLogic crawlingResult-            logSearchResults res = putStrLn ("  found " ++ (show $ length res) ++" follow-up actions:" ++ (show $ map crawlUrl $ res)) >> return res+            logSearchResults res =+              putStrLn ("  found " ++ (show $ length res) ++" follow-up actions:" ++ (show $ map crawlUrl $ res))+              >> return res             wrapActions :: [CrawlAction] -> DirectiveChainResult             wrapActions res                 | null res = DirectiveChainResult (errReport crawlingResult:reportPath) []

@@ -4,9 +4,11 @@ import Network.CrawlChain.CrawlResult  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-  | AlternativeDirective CrawlDirective CrawlDirective -- fallback to second argument if first yields no results-  | RestartChainDirective (CrawlAction, CrawlDirective)-- the possibility to start over (when using alternative)-  | 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)+  | DirectiveSequence [CrawlDirective]                 -- | chaining of directives

@@ -4,17 +4,13 @@   Crawler ) where -import Prelude hiding (log)--import Control.Concurrent (threadDelay)-import Data.Time.Format (formatTime, defaultTimeLocale)-import Data.Time.LocalTime (getZonedTime) import Network.HTTP import Network.Stream (Result) import Network.URI  import Network.CrawlChain.CrawlAction import Network.CrawlChain.CrawlResult+import Network.CrawlChain.Util import Network.URI.Util  type RequestType = Request_String@@ -22,7 +18,7 @@ type CrawlActionDescriber = CrawlAction -> String  crawl :: Crawler-crawl action = log "delaying crawl for 1s" >> threadDelay 1000000 >> crawl' action 3 (toRequest action)+crawl action = delaySeconds 1 >> crawl' action 3 (toRequest action)  crawlAndStore :: CrawlActionDescriber -> Crawler crawlAndStore describer = (>>= store) . crawl@@ -41,13 +37,6 @@                   putStrLn $ "writing to " ++ n                   writeFile n c -log :: String -> IO ()-log msg = printTime >> putStr ("> " ++ msg ++ "\n")-  where-    printTime = getZonedTime >>= return . formatTime' >>= putStr-      where-        formatTime' = formatTime defaultTimeLocale "%Y-%m-%d_%H:%M:%S"- toRequest :: CrawlAction -> RequestType toRequest (GetRequest url) = addStandardHeader $ mkRequest GET (toURI url) toRequest (PostRequest url params postType) =@@ -77,7 +66,7 @@   response <- simpleHTTP request   body <- getResponseBody response   code <- getResponseCode response-  log $ "Crawled " ++ (showRequest request) ++ " with result: " ++ (show code)+  logMsg $ "Crawled " ++ (showRequest request) ++ " with result: " ++ (show code)   checkRedirect maxRedirects request (crawlResult response body code)   where      crawlResult :: (HasHeaders a) => Result a -> String -> ResponseCode -> CrawlResult

@@ -0,0 +1,20 @@+module Network.CrawlChain.Util where++import Prelude hiding (log)++import Control.Concurrent (threadDelay)+import Data.Time.Format (formatTime, defaultTimeLocale)+import Data.Time.LocalTime (getZonedTime)++logMsg :: String -> IO ()+logMsg msg = printTime >> putStr ("> " ++ msg ++ "\n")+  where+    printTime = getZonedTime >>= return . formatTime' >>= putStr+      where+        formatTime' = formatTime defaultTimeLocale "%Y-%m-%d_%H:%M:%S"+++delaySeconds :: Int -> IO ()+delaySeconds s = do+  logMsg $ "delaying for "++(show s)++"s"+  threadDelay $ s*1000000