From 5977e1454d7738ddb086d37b20337e350e380790 Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Sat, 11 Apr 2015 11:50:48 +0200
Subject: Fetch first page ads of a given leboncoin url, fetch also the
 description page of each item.

---
 src/Ad.hs | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)
 create mode 100644 src/Ad.hs

(limited to 'src/Ad.hs')

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)
-- 
cgit v1.2.3