src/AdListener.hs


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

{-# LANGUAGE OverloadedStrings #-}

module AdListener
  ( start
  ) where

import Prelude hiding (error)

import qualified Data.Text.IO as T

import Control.Concurrent (threadDelay)

import qualified Fetch

import Model.Ad
import Model.URL
import Model.Resume

import qualified View.Plain.Ad as P
import qualified View.Html.Ad as H

import Mail
import Model.Mail (Mail(Mail))

import Conf (Conf)
import qualified Conf

import Time (getCurrentFormattedTime)

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

listenToNewAdsWithViewedURLs :: Conf -> [URL] -> IO ()
listenToNewAdsWithViewedURLs conf viewedURLs = do
  resumes <- Fetch.resumes . Conf.urls $ conf
  let (newURLs, newResumes) = getNewResumes viewedURLs resumes
  eitherNewAds <- Fetch.ads newResumes
  case eitherNewAds of
    Left error -> do
      T.putStrLn error
      waitListenInterval conf
      listenToNewAdsWithViewedURLs conf viewedURLs
    Right newAds -> do
      time <- getCurrentFormattedTime
      if not (null newAds)
        then
          let message = P.renderConsoleAds conf time newAds
          in  T.putStrLn message >> sendMail conf newAds
        else
          return ()
      waitListenInterval conf
      listenToNewAdsWithViewedURLs conf (viewedURLs ++ newURLs)

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

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