aboutsummaryrefslogtreecommitdiff
path: root/src/executable/haskell/Service/AdListener.hs
blob: 5cf26d139eeb6c8b8f6c5780973b5497ae0666d7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
module Service.AdListener
  ( start
  ) where

import           Control.Concurrent   (threadDelay)
import qualified Data.Text            as T
import qualified Data.Text.IO         as T
import           Network.HTTP.Conduit (Manager)
import           Prelude              hiding (error)

import           Conf                 (Conf)
import qualified Conf
import qualified FetchAd
import           Model.Ad             (Ad)
import qualified Model.Ad             as Ad
import           Model.Mail           (Mail (Mail))
import           Model.URL            (URL)
import qualified Service.MailService  as MailService
import qualified Utils.Time           as TimeUtils
import qualified View.Ad              as Ad

start :: Conf -> Manager -> IO ()
start conf manager = do
  ads <- fetchAds conf manager
  let newURLs = map Ad.url ads
  T.putStrLn "Listening to new ads…"
  waitListenInterval conf
  listenToNewAdsWithViewedURLs conf manager newURLs

listenToNewAdsWithViewedURLs :: Conf -> Manager -> [URL] -> IO ()
listenToNewAdsWithViewedURLs conf manager viewedURLs = do
  ads <- fetchAds conf manager
  let (newURLs, newAds) = Ad.getNewAds viewedURLs ads
  time <- TimeUtils.getCurrentFormattedTime
  if not (null newAds)
    then
      do
        _ <- T.putStrLn (Ad.renderConsoleAds time newAds)
        sendMail conf newAds
    else
      return ()
  waitListenInterval conf
  listenToNewAdsWithViewedURLs conf manager (viewedURLs ++ newURLs)

fetchAds :: Conf -> Manager -> IO [Ad]
fetchAds conf manager = do
  leboncoinAds <- FetchAd.leboncoin manager (Conf.leboncoinUrls conf)
  ouestFranceAds <- FetchAd.ouestFrance manager (Conf.ouestFranceUrls conf)
  seLogerAds <- FetchAd.seLoger manager (Conf.seLogerUrls conf)
  let results = leboncoinAds ++ ouestFranceAds ++ seLogerAds
  T.putStrLn . T.concat $
    [ "Parsed "
    , T.pack . show $ length results
    , " results"
    ]
  return results

sendMail :: Conf -> [Ad] -> IO ()
sendMail conf ads =
  let (title, plainBody) = Ad.renderAds ads
      mail = Mail (Conf.mailFrom conf) (Conf.mailTo conf) title plainBody
  in  MailService.send (Conf.mailMock conf) mail >> return ()

waitListenInterval :: Conf -> IO ()
waitListenInterval = threadDelay . (*) 1000000 . round . Conf.listenInterval