diff --git a/crawlchain.cabal b/crawlchain.cabal --- a/crawlchain.cabal +++ b/crawlchain.cabal @@ -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 diff --git a/src/Network/CrawlChain/Constants.hs b/src/Network/CrawlChain/Constants.hs deleted file mode 100644 --- a/src/Network/CrawlChain/Constants.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Network.CrawlChain.Constants where - -testResourcePath :: String -testResourcePath = "test/resources/" diff --git a/src/Network/CrawlChain/CrawlChain.hs b/src/Network/CrawlChain/CrawlChain.hs --- a/src/Network/CrawlChain/CrawlChain.hs +++ b/src/Network/CrawlChain/CrawlChain.hs @@ -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 diff --git a/src/Network/CrawlChain/CrawlDirective.hs b/src/Network/CrawlChain/CrawlDirective.hs --- a/src/Network/CrawlChain/CrawlDirective.hs +++ b/src/Network/CrawlChain/CrawlDirective.hs @@ -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 diff --git a/src/Network/CrawlChain/CrawlingContext.hs b/src/Network/CrawlChain/CrawlingContext.hs --- a/src/Network/CrawlChain/CrawlingContext.hs +++ b/src/Network/CrawlChain/CrawlingContext.hs @@ -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 diff --git a/src/Network/CrawlChain/CrawlingParameters.hs b/src/Network/CrawlChain/CrawlingParameters.hs --- a/src/Network/CrawlChain/CrawlingParameters.hs +++ b/src/Network/CrawlChain/CrawlingParameters.hs @@ -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 } diff --git a/src/Network/CrawlChain/Storing.hs b/src/Network/CrawlChain/Storing.hs --- a/src/Network/CrawlChain/Storing.hs +++ b/src/Network/CrawlChain/Storing.hs @@ -20,6 +20,3 @@ return (dir' ++ "/" ++ dest) ) dir - -makeFilename :: String -> String -> String -> String -makeFilename series season episode = series ++ "-S" ++ season++ "E" ++ episode ++ ".mp4" diff --git a/test/src/CrawlingTests.hs b/test/src/CrawlingTests.hs new file mode 100644 --- /dev/null +++ b/test/src/CrawlingTests.hs @@ -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