From 69e69017b75d1cdaa1fd2aef2818de5111b29735 Mon Sep 17 00:00:00 2001
From: Joris
Date: Thu, 14 Jul 2016 11:57:12 +0000
Subject: Update code and fix parsers

---
 src/AdListener.hs | 105 ++++++++++++++++++++++++------------------------------
 1 file changed, 47 insertions(+), 58 deletions(-)

(limited to 'src/AdListener.hs')

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
-- 
cgit v1.2.3