aboutsummaryrefslogtreecommitdiff
path: root/src/executable/haskell/Service/AdListener.hs
blob: f0adbb89cce9994826c1892f20ded16cc325fe69 (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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
module Service.AdListener
  ( start
  ) where

import           Control.Concurrent       (threadDelay)
import           Data.Either              (rights)
import           Data.Text.Encoding       as T
import qualified Data.Text.IO             as T
import           Prelude                  hiding (error)

import           Conf                     (Conf)
import qualified Conf
import           Model.Ad                 (Ad)
import qualified Model.Ad                 as Ad
import           Model.Mail               (Mail (Mail))
import           Model.URL                (URL)
import qualified Parser.LeboncoinParser   as LeboncoinParser
import qualified Parser.OuestFranceParser as OuestFranceParser
import qualified Parser.SeLogerParser     as SeLogerParser
import qualified Service.MailService      as MailService
import qualified Utils.HTTP               as HTTP
import qualified Utils.Time               as TimeUtils
import qualified View.Ad                  as Ad

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

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

fetchAds :: Conf -> IO [Ad]
fetchAds conf = do
  leboncoinAds <- getLeboncoinAds conf
  ouestFranceAds <- getOuestFranceAds conf
  seLogerAds <- getSeLogerAds conf
  let results = leboncoinAds ++ ouestFranceAds ++ seLogerAds
  if null results
    then T.putStrLn "Parsed 0 results!"
    else return ()
  return results

getLeboncoinAds :: Conf -> IO [Ad]
getLeboncoinAds conf =
  fmap (concat . map LeboncoinParser.parse . rights)
    . sequence
    . map (HTTP.get T.decodeLatin1)
    . Conf.leboncoinUrls
    $ conf

getOuestFranceAds :: Conf -> IO [Ad]
getOuestFranceAds conf =
  fmap (concat . map OuestFranceParser.parse . rights)
    . sequence
    . map (HTTP.get T.decodeUtf8)
    . Conf.ouestFranceUrls
    $ conf

getSeLogerAds :: Conf -> IO [Ad]
getSeLogerAds conf =
  fmap (concat . map SeLogerParser.parse . rights)
    . sequence
    . map (HTTP.get T.decodeUtf8)
    . Conf.seLogerUrls
    $ conf

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 mail >> return ()

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