crawlchain 0.1.1.4 → 0.1.1.5

raw patch · 5 files changed

+21/−15 lines, 5 files

Files

• crawlchain.cabal +1/−1
• src/Network/CrawlChain/CrawlAction.hs +5/−1
• src/Network/CrawlChain/CrawlChain.hs +8/−11
• src/Network/CrawlChain/CrawlChains.hs +2/−2
• src/Network/CrawlChain/Crawling.hs +5/−0

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                crawlchain-version:             0.1.1.4+version:             0.1.1.5 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

@@ -1,6 +1,10 @@ module Network.CrawlChain.CrawlAction where -data PostType = Undefined | PostForm deriving (Show, Eq)+data PostType+ = Undefined+ | PostForm+ | PostAJAX+ deriving (Show, Eq) type PostParams = [(String, String)]   data CrawlAction = GetRequest String

@@ -50,16 +50,13 @@ logAndReturnFirstOk :: [DirectiveChainResult] -> IO (Maybe CrawlAction) logAndReturnFirstOk results = do   firstOk <- (return . extractFirstResult) results-  putResults firstOk results+  putDetailsOnFailure firstOk results   return firstOk -putResults :: Maybe CrawlAction -> [DirectiveChainResult] -> IO ()-putResults firstSuccess results =-  maybe writeFailures putSuccess firstSuccess-    where-      putSuccess :: CrawlAction -> IO ()-      putSuccess a = putStrLn (crawlUrl a)-      writeFailures = do-        putStrLn "no results found, look into failures.log"-        writeFile "failures.log" showAllFailures-          where showAllFailures = concat $ intersperse "\n\n" $ map showResultPath results+putDetailsOnFailure :: Maybe CrawlAction -> [DirectiveChainResult] -> IO ()+putDetailsOnFailure firstSuccess results =+  case firstSuccess of+   Just _ -> return ()+   Nothing -> do+     putStrLn $ "no results found - details: " ++ showAllFailures where+       showAllFailures = concat $ intersperse "\n\n" $ map showResultPath results

@@ -79,13 +79,13 @@               >> return res             wrapActions :: [CrawlAction] -> DirectiveChainResult             wrapActions res-                | null res = DirectiveChainResult (errReport crawlingResult:reportPath) []+                | null res = DirectiveChainResult (reportPath ++ [errReport crawlingResult]) []                 | otherwise = DirectiveChainResult updateReportPath res               where                 updateReportPath :: [Report]                 updateReportPath = okReport crawlingResult : reportPath             appendResult :: DirectiveChainResult -> IO [DirectiveChainResult]-            appendResult = return . (collectedResults ++) . (:[])+            appendResult res = return $ collectedResults ++ [res]  {-  Whereas definition of single directives is pretty straightforward to understand, sequences are handled in this internal method. Notes:

@@ -59,12 +59,17 @@     mkHeader HdrContentType "application/x-www-form-urlencoded",     mkHeader HdrContentLength (show $ length formParams)   ]+makePostHeaders PostAJAX formParams = ajaxHeader:(makePostHeaders PostForm formParams) where+  ajaxHeader = mkHeader (HdrCustom "X-Requested-With") "XMLHttpRequest" makePostHeaders _ _ = []  crawl' :: CrawlAction -> Int -> RequestType -> IO CrawlResult crawl' originalAction maxRedirects request = do+--  print request   response <- simpleHTTP request+--  print response   body <- getResponseBody response+--  print body   code <- getResponseCode response   logMsg $ "Crawled " ++ (showRequest request) ++ " with result: " ++ (show code)   checkRedirect maxRedirects request (crawlResult response body code)