diff options
author | Joris Guyonvarch | 2015-04-11 11:50:48 +0200 |
---|---|---|
committer | Joris Guyonvarch | 2015-04-11 12:03:22 +0200 |
commit | 5977e1454d7738ddb086d37b20337e350e380790 (patch) | |
tree | e03261144e3d534434242c1dd037c2a4e4db5a9f /src/Ad.hs |
Fetch first page ads of a given leboncoin url, fetch also the description page of each item.
Diffstat (limited to 'src/Ad.hs')
-rw-r--r-- | src/Ad.hs | 33 |
1 files changed, 33 insertions, 0 deletions
diff --git a/src/Ad.hs b/src/Ad.hs new file mode 100644 index 0000000..0fa131c --- /dev/null +++ b/src/Ad.hs @@ -0,0 +1,33 @@ +module Ad + ( getAds + ) where + +import Text.HTML.TagSoup (parseTags) + +import Page (getPage) + +import Model.Ad +import Model.Resume +import Model.Detail + +import Parser.Resume +import Parser.Detail + +getAds :: String -> IO (Either String [Ad]) +getAds url = do + eitherPage <- getPage url + case eitherPage of + Left error -> + return (Left error) + Right page -> + getAdsFromPage page + +getAdsFromPage :: String -> IO (Either String [Ad]) +getAdsFromPage page = do + xs <- sequence $ map getAd (parseResumes page) + return $ sequence xs + +getAd :: Resume -> IO (Either String Ad) +getAd resume = do + page <- getPage (url resume) + fmap (\page -> Ad { resume = resume, detail = parseDetail (parseTags page)}) <$> getPage (url resume) |