aboutsummaryrefslogtreecommitdiff
path: root/src/AdListener.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/AdListener.hs')
-rw-r--r--src/AdListener.hs105
1 files changed, 47 insertions, 58 deletions
diff --git a/src/AdListener.hs b/src/AdListener.hs
index a52e188..9946d9e 100644
--- a/src/AdListener.hs
+++ b/src/AdListener.hs
@@ -1,14 +1,15 @@
{-# LANGUAGE OverloadedStrings #-}
module AdListener
- ( listenToNewAds
+ ( start
) where
-import Data.List (intersperse)
+import Prelude hiding (error)
+
import Data.Text (Text)
-import qualified Data.Text as T
import qualified Data.Text.IO as T
-import Data.Time.Clock (getCurrentTime, diffUTCTime, UTCTime)
+import qualified Data.Text.Lazy as LT
+import Data.Text.Lazy.Builder (toLazyText, fromText)
import Control.Concurrent (threadDelay)
@@ -21,84 +22,72 @@ import Model.Resume
import qualified View.Plain.Ad as P
import qualified View.Html.Ad as H
-import Page
-import Parser.Detail
-
-import Mail (sendMail)
+import Mail
+import Model.Mail (Mail(Mail))
-import Config (Config)
-import qualified Config as C
+import Conf (Conf)
+import qualified Conf
import Time (getCurrentFormattedTime)
-listenToNewAds :: Config -> IO ()
-listenToNewAds config = do
- eitherResumes <- fetchResumes (C.url config)
+start :: Conf -> IO ()
+start conf = do
+ eitherResumes <- fetchResumes (Conf.url conf)
case eitherResumes of
Left error ->
- showErrorAndListenBack config [] error
- Right resumes ->
+ showErrorAndListenBack conf [] error
+ Right resumes -> do
let newURLs = map url resumes
- in do
- putStrLn "Listening for new ads…"
- waitOneMinute
- listenToNewAdsWithViewedURLs config newURLs
-
-listenToNewAdsWithViewedURLs :: Config -> [URL] -> IO ()
-listenToNewAdsWithViewedURLs config viewedURLs = do
- eitherResumes <- fetchResumes (C.url config)
+ putStrLn "Listening to new ads…"
+ waitListenInterval conf
+ listenToNewAdsWithViewedURLs conf newURLs
+
+listenToNewAdsWithViewedURLs :: Conf -> [URL] -> IO ()
+listenToNewAdsWithViewedURLs conf viewedURLs = do
+ eitherResumes <- fetchResumes (Conf.url conf)
case eitherResumes of
Left error ->
- showErrorAndListenBack config viewedURLs error
+ showErrorAndListenBack conf viewedURLs error
Right resumes ->
- listenToNewAdsWithResumes config viewedURLs resumes
+ listenToNewAdsWithResumes conf viewedURLs resumes
-listenToNewAdsWithResumes :: Config -> [URL] -> [Resume] -> IO ()
-listenToNewAdsWithResumes config viewedURLs resumes =
+listenToNewAdsWithResumes :: Conf -> [URL] -> [Resume] -> IO ()
+listenToNewAdsWithResumes conf viewedURLs resumes =
let (newURLs, newResumes) = getNewResumes viewedURLs resumes
in do
eitherNewAds <- fetchAds newResumes
case eitherNewAds of
Left error ->
- showErrorAndListenBack config viewedURLs error
+ showErrorAndListenBack conf viewedURLs error
Right newAds ->
do
time <- getCurrentFormattedTime
if not (null newAds)
then
- let message = P.renderConsoleAds config time newAds
+ let message = P.renderConsoleAds conf time newAds
in do
T.putStrLn message
- trySendMail config newAds
+ trySendMail conf newAds
else
return ()
- waitOneMinute
- listenToNewAdsWithViewedURLs config (viewedURLs ++ newURLs)
-
-trySendMail :: Config -> [Ad] -> IO ()
-trySendMail config ads =
- case C.mailTo config of
- [] ->
- return ()
- mailTo ->
- let (title, plainBody) = P.renderAds config ads
- htmlBody = H.renderAds config ads
- in do
- eitherMailSuccess <- sendMail mailTo title plainBody htmlBody
- case eitherMailSuccess of
- Right () ->
- putStrLn "\nMail sent."
- Left error ->
- T.putStrLn . T.concat $
- [ "\nError sending mail: "
- , error
- ]
-
-showErrorAndListenBack :: Config -> [URL] -> Text -> IO ()
-showErrorAndListenBack config viewedURLs error = do
+ waitListenInterval conf
+ listenToNewAdsWithViewedURLs conf (viewedURLs ++ newURLs)
+
+trySendMail :: Conf -> [Ad] -> IO ()
+trySendMail conf ads =
+ let (title, plainBody) = P.renderAds conf ads
+ htmlBody = H.renderAds conf ads
+ mail = Mail (Conf.mailFrom conf) (Conf.mailTo conf) title (strictToLazy plainBody) (strictToLazy htmlBody)
+ in Mail.send mail >> return ()
+
+strictToLazy :: Text -> LT.Text
+strictToLazy = toLazyText . fromText
+
+showErrorAndListenBack :: Conf -> [URL] -> Text -> IO ()
+showErrorAndListenBack conf viewedURLs error = do
T.putStrLn error
- waitOneMinute
- listenToNewAdsWithViewedURLs config viewedURLs
+ waitListenInterval conf
+ listenToNewAdsWithViewedURLs conf viewedURLs
-waitOneMinute :: IO ()
-waitOneMinute = threadDelay (1000 * 1000 * 60)
+waitListenInterval :: Conf -> IO ()
+waitListenInterval = threadDelay . (*) 1000000 . round . Conf.listenInterval