diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/NOTES b/NOTES
new file mode 100644
--- /dev/null
+++ b/NOTES
@@ -0,0 +1,29 @@
+
+
+
+
+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
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Text/Feed/Crawl.hs b/Text/Feed/Crawl.hs
new file mode 100644
--- /dev/null
+++ b/Text/Feed/Crawl.hs
@@ -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
+
+
diff --git a/Text/Feed/Crawl/Common.hs b/Text/Feed/Crawl/Common.hs
new file mode 100644
--- /dev/null
+++ b/Text/Feed/Crawl/Common.hs
@@ -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"]
+
diff --git a/Text/Feed/Crawl/DetectLink.hs b/Text/Feed/Crawl/DetectLink.hs
new file mode 100644
--- /dev/null
+++ b/Text/Feed/Crawl/DetectLink.hs
@@ -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)
+ )
+
diff --git a/feed-crawl.cabal b/feed-crawl.cabal
new file mode 100644
--- /dev/null
+++ b/feed-crawl.cabal
@@ -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
+
+