packages feed

feed-crawl (empty) → 0.1.0.0

raw patch · 7 files changed

+241/−0 lines, 7 filesdep +basedep +bytestringdep +conduitsetup-changed

Dependencies added: base, bytestring, conduit, connection, http-conduit, http-types, hxt, text, transformers

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Daniel Choi++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ NOTES view
@@ -0,0 +1,29 @@+<link rel="alternate" type="application/rss+xml" title="The Blog of Author Tim Ferriss &raquo; Comments Feed" href="http://fourhourworkweek.com/comments/feed/" />+<link rel="alternate" type="application/rss+xml" title="The Blog of Author Tim Ferriss &raquo; Landing Comments Feed" href="http://fourhourworkweek.com/landing/feed/" />+++feed-crawl $ dist feed-crawl http://fourhourworkweek.com/landing/feed+[Status' {sStatusCode = 301, sLocation = Just "http://fourhourworkweek.com/landing/feed/", sContentType = Just "text/html; charset=utf-8"}]+Just "text/xml; charset=UTF-8"+feed-crawl $ +++Link {linkRel = "alternate", linkHref = "http://fourhourworkweek.com/feed/", linkType = "application/rss+xml", linkTitle = "The Blog of Author Tim Ferriss \187 Feed"}+Link {linkRel = "alternate", linkHref = "http://fourhourworkweek.com/comments/feed/", linkType = "application/rss+xml", linkTitle = "The Blog of Author Tim Ferriss \187 Comments Feed"}+Link {linkRel = "alternate", linkHref = "http://fourhourworkweek.com/landing/feed/", linkType = "application/rss+xml", linkTitle = "The Blog of Author Tim Ferriss \187 Landing Comments Feed"}+Link {linkRel = "alternate", linkHref = "https://public-api.wordpress.com/oembed/1.0/?format=json&url=http%3A%2F%2Ffourhourworkweek.com%2F&for=wpcom-auto-discovery", linkType = "application/json+oembed", linkTitle = ""}+Link {linkRel = "alternate", linkHref = "https://public-api.wordpress.com/oembed/1.0/?format=xml&url=http%3A%2F%2Ffourhourworkweek.com%2F&for=wpcom-auto-discovery", linkType = "application/xml+oembed", linkTitle = ""}+  577  dist feed-crawl http://fourhourworkweek.com/landing/feed/+  579  dist feed-crawl http://fourhourworkweek.com/landing/feed/+  580  dist feed-crawl http://fourhourworkweek.com/landing/feed/+  581  dist feed-crawl http://fourhourworkweek.com/landing/feed+  588  dist feed-crawl http://fourhourworkweek.com/landing/feed+  589  dist feed-crawl http://fourhourworkweek.com/landing/feed+  590  dist feed-crawl http://fourhourworkweek.com/landing/feed+  591  dist feed-crawl http://fourhourworkweek.com/landing/feed+  592  dist feed-crawl http://fourhourworkweek.com/landing/+  593  dist feed-crawl http://fourhourworkweek.com+  596  dist feed-crawl http://fourhourworkweek.com+  597  dist feed-crawl http://fourhourworkweek.comfg+  655  h | grep feed-crawl+  656  h | grep feed-crawl >> NOTES
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/Feed/Crawl.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +module Text.Feed.Crawl where+import Text.Feed.Crawl.Common+import Text.Feed.Crawl.DetectLink+import Network.Connection (TLSSettings(..))+import Network.HTTP.Conduit+import qualified Data.Conduit as C+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL+import System.Environment+import System.IO+import Control.Monad.Trans.State.Lazy +import Control.Monad.Trans.Class (lift)+import Network.HTTP.Types.Status (statusCode)+import Network.HTTP.Types.Header +import Control.Monad.IO.Class+import Data.Maybe (listToMaybe, catMaybes)+import qualified Control.Exception as E++-- |The main function+crawlURL :: String +          -> IO CrawlResult+crawlURL url = do+    request <- parseUrl url+    let settings = mkManagerSettings (TLSSettingsSimple True False False) Nothing+    (mkCrawlResult url =<< withRedirectTracking settings request)+      `E.catch` (\e -> return . Left . CrawlHttpError $ e)+    ++mkCrawlResult :: String -> (Response BL.ByteString, [Status]) -> IO CrawlResult+mkCrawlResult firstUrl (resp, statuses) = do+  let ct = lookup hContentType . responseHeaders $ resp+  let loc = lookup hLocation . responseHeaders $ resp+  let urls = catMaybes [ sLocation | Status{..}  <- statuses ]+  if isFeedContentType ct +      then return . Right $ CrawlSuccess {+                    crawlLastContentType = ct+                  , crawlLastUrl = head (urls ++ [B.pack firstUrl])+                  , crawlFeedContent = responseBody resp+                  }+      else do+          links <- findFeedLinks (BL.unpack . responseBody $ resp)+          return . Left $ CrawlFoundFeedLinks links+        ++-- |Returns a tuple of response and list of redirect locations. +--  The first location is the last redirect.+withRedirectTracking :: ManagerSettings +                     -> Request +                     -> IO (Response BL.ByteString, [Status])+withRedirectTracking settings request = do+    m <- newManager settings+    r <- runStateT (traceRedirects request m) []+    return r++traceRedirects :: Request +               -> Manager +               -> StateT [Status] IO (Response BL.ByteString)+traceRedirects req' man = do+   let req = req' { checkStatus = \_ _ _ -> Nothing }+   res <- httpLbs req{redirectCount=0} man+   let req2 = getRedirectedRequest req (responseHeaders res) (responseCookieJar res) (statusCode (responseStatus res))+   let location = lookup hLocation . responseHeaders $ res+   case (req2, location) of +      (Just req2', Just location') -> do+          let st = Status {+              sStatusCode = statusCode (responseStatus res)+            , sLocation = lookup hLocation . responseHeaders $ res+            , sContentType = lookup hContentType . responseHeaders $ res+            }+          modify (st:)+          traceRedirects req2' man+      _ -> return res++isFeed :: Status -> Bool+isFeed Status{..} = isFeedContentType sContentType ++
+ Text/Feed/Crawl/Common.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +module Text.Feed.Crawl.Common where+import Data.Char (toLower)+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL+import Network.HTTP.Conduit (HttpException)++type CrawlResult = Either CrawlFail CrawlSuccess++data CrawlFail = +    CrawlFoundFeedLinks [Link] +  | CrawlHttpError HttpException+  deriving Show++data CrawlSuccess = CrawlSuccess {+      crawlLastContentType :: Maybe B.ByteString+    , crawlLastUrl :: B.ByteString+    , crawlFeedContent :: BL.ByteString+  } deriving Show++data Status = Status {+      sStatusCode :: Int+    , sLocation :: Maybe B.ByteString+    , sContentType :: Maybe B.ByteString+    } deriving Show++data Link = Link {+    linkRel :: String+  , linkHref :: String+  , linkType :: String+  , linkTitle :: String+  } deriving Show+++isFeedContentType :: Maybe B.ByteString -> Bool+isFeedContentType Nothing = False   -- right logic? maybe default to trying to parse unknown type+isFeedContentType (Just bs) = +    -- e.g. input is "text/html; charset=utf-8" +    let (mimetype, _) = B.break (== ';') bs +    in map toLower (B.unpack mimetype) `elem` feedMimeTypes++feedMimeTypes = [+    "application/rss+xml"+  , "application/rdf+xml"+  , "application/atom+xml"+  , "application/xml"+  , "text/xml"]+
+ Text/Feed/Crawl/DetectLink.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards, Arrows #-} +module Text.Feed.Crawl.DetectLink where+import Text.XML.HXT.Core +import qualified Data.ByteString.Char8 as B+import Text.Feed.Crawl.Common++findFeedLinks :: String -> IO [Link]+findFeedLinks input = do+  runX (+      readString [+            withParseHTML yes+          ] input +      >>>+      scrapePage ) ++scrapePage = +      deep (isElem >>> hasName "head") >>>+      deep (isElem +        >>> hasName "link" +        >>> hasAttrValue "rel" (== "alternate")+        >>> (proc x -> do+              rel <- getAttrValue "rel" -< x+              href <- getAttrValue "href" -< x+              typ <- getAttrValue "type" -< x+              title <- (getAttrValue "title" `orElse` constA "") -< x+              returnA -< Link rel href typ title)+      )+
+ feed-crawl.cabal view
@@ -0,0 +1,36 @@+-- Initial feed-crawl.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                feed-crawl+version:             0.1.0.0+synopsis:            Feed crawling utilities+-- description:         +homepage:            https://github.com/danchoi/feed-crawl+license:             MIT+license-file:        LICENSE+author:              Daniel Choi+maintainer:          dhchoi@gmail.com+-- copyright:           +category:            Text+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Text.Feed.Crawl+                     , Text.Feed.Crawl.DetectLink+                     , Text.Feed.Crawl.Common+  build-depends:       base >=4.7 && <4.8+                     , http-conduit >= 2.1.5+                     , conduit+                     , connection+                     , text+                     , bytestring+                     , transformers+                     , http-types+                     , hxt++  -- hs-source-dirs:      +  default-language:    Haskell2010++