blob: b8ae5e9c38193026f0c798ab6f031288506f9801 (
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
|
module Service.AdListener
( start
) where
import Control.Concurrent (threadDelay)
import qualified Control.Logging as Logging
import qualified Data.Text as T
import qualified Data.Time.LocalTime as LocalTime
import Network.Wreq.Session (Session)
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 -> Session -> IO ()
start conf session = do
ads <- fetchAds conf session
let newURLs = map Ad.url ads
Logging.log "Listening to new ads…"
sleepUntilReady conf
listenToNewAdsWithViewedURLs conf session newURLs
listenToNewAdsWithViewedURLs :: Conf -> Session -> [URL] -> IO ()
listenToNewAdsWithViewedURLs conf session viewedURLs = do
ads <- fetchAds conf session
let (newURLs, newAds) = Ad.getNewAds viewedURLs ads
time <- TimeUtils.getCurrentFormattedTime
if not (null newAds)
then
do
_ <- Logging.log (Ad.renderConsoleAds time newAds)
sendMail conf newAds
else
return ()
sleepUntilReady conf
listenToNewAdsWithViewedURLs conf session (viewedURLs ++ newURLs)
fetchAds :: Conf -> Session -> IO [Ad]
fetchAds conf session = do
leboncoinAds <- FetchAd.leboncoin session (Conf.leboncoinUrls conf)
ouestFranceAds <- FetchAd.ouestFrance session (Conf.ouestFranceUrls conf)
seLogerAds <- FetchAd.seLoger session (Conf.seLogerUrls conf)
let ads = leboncoinAds ++ ouestFranceAds ++ seLogerAds
Logging.log . T.concat $
[ "Fetched "
, T.pack . show $ length ads
, " ads"
]
return ads
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 ()
sleepUntilReady :: Conf -> IO ()
sleepUntilReady conf = do
timeSinceMidnight <-
(LocalTime.timeOfDayToTime . LocalTime.localTimeOfDay . LocalTime.zonedTimeToLocalTime)
<$> LocalTime.getZonedTime
case TimeUtils.asleepDuration (Conf.listenFrom conf) (Conf.listenTo conf) timeSinceMidnight of
Just d -> do
sleepSeconds d
Nothing -> do
duration <- TimeUtils.addNoise (Conf.listenInterval conf) (Conf.listenIntervalNoise conf)
sleepSeconds duration
where
sleepSeconds =
threadDelay . (*) 1000000 . round
|
