Enable multi-urls in config file

6 files changed, 66 insertions, 89 deletions

diff --git a/src/AdListener.hs b/src/AdListener.hs
index 3db4c6a..d8400d8 100644
--- a/src/AdListener.hs
+++ b/src/AdListener.hs
@@ -6,14 +6,11 @@ module AdListener
 
 import Prelude hiding (error)
 
-import Data.Text (Text)
 import qualified Data.Text.IO as T
-import qualified Data.Text.Lazy as LT
-import Data.Text.Lazy.Builder (toLazyText, fromText)
 
 import Control.Concurrent (threadDelay)
 
-import Fetch (fetchResumes, fetchAds)
+import qualified Fetch
 
 import Model.Ad
 import Model.URL
@@ -32,61 +29,39 @@ import Time (getCurrentFormattedTime)
 
 start :: Conf -> IO ()
 start conf = do
-  eitherResumes <- fetchResumes (Conf.url conf)
-  case eitherResumes of
-    Left error ->
-      showErrorAndListenBack conf [] error
-    Right resumes -> do
-      let newURLs = map url resumes
-      T.putStrLn "Listening to new ads…"
-      waitListenInterval conf
-      listenToNewAdsWithViewedURLs conf newURLs
+  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
-  eitherResumes <- fetchResumes (Conf.url conf)
-  case eitherResumes of
-    Left error ->
-      showErrorAndListenBack conf viewedURLs error
-    Right resumes ->
-      listenToNewAdsWithResumes conf viewedURLs resumes
-
-listenToNewAdsWithResumes :: Conf -> [URL] -> [Resume] -> IO ()
-listenToNewAdsWithResumes conf viewedURLs resumes =
+  resumes <- Fetch.resumes . Conf.urls $ conf
   let (newURLs, newResumes) = getNewResumes viewedURLs resumes
-  in  do
-        eitherNewAds <- fetchAds newResumes
-        case eitherNewAds of
-          Left error ->
-            showErrorAndListenBack conf viewedURLs error
-          Right newAds -> do
-            time <- getCurrentFormattedTime
-            if not (null newAds)
-              then
-                let message = P.renderConsoleAds conf time newAds
-                in  do
-                      T.putStrLn message
-                      trySendMail conf newAds
-              else
-                return ()
-            waitListenInterval conf
-            listenToNewAdsWithViewedURLs conf (viewedURLs ++ newURLs)
+  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)
 
-trySendMail :: Conf -> [Ad] -> IO ()
-trySendMail conf ads =
+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 (strictToLazy plainBody) (strictToLazy htmlBody)
+      mail = Mail (Conf.mailFrom conf) (Conf.mailTo conf) title plainBody 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
-  waitListenInterval conf
-  listenToNewAdsWithViewedURLs conf viewedURLs
-
 waitListenInterval :: Conf -> IO ()
 waitListenInterval = threadDelay . (*) 1000000 . round . Conf.listenInterval
diff --git a/src/Conf.hs b/src/Conf.hs
index fccf2a5..03f8dc2 100644
--- a/src/Conf.hs
+++ b/src/Conf.hs
@@ -6,27 +6,32 @@ module Conf
   ) where
 
 import Data.Text (Text)
+import qualified Data.Text as T
 import qualified Data.ConfigManager as Conf
 import Data.Time.Clock (NominalDiffTime)
 
 import Model.URL
 
 data Conf = Conf
-  { url :: URL
+  { urls :: [URL]
   , mailFrom :: Text
   , mailTo :: [Text]
   , properties :: [Text]
   , listenInterval :: NominalDiffTime
   } deriving Show
 
-parse :: FilePath -> IO (Either Text Conf)
-parse path =
-  (flip fmap) (Conf.readConfig path) (\configOrError -> do
-    conf <- configOrError
-    Conf <$>
-      Conf.lookup "url" conf <*>
-      Conf.lookup "mailFrom" conf <*>
-      Conf.lookup "mailTo" conf <*>
-      Conf.lookup "properties" conf <*>
-      Conf.lookup "listenInterval" conf
-  )
+parse :: FilePath -> IO Conf
+parse path = do
+  conf <-
+    (flip fmap) (Conf.readConfig path) (\configOrError -> do
+      conf <- configOrError
+      Conf <$>
+        Conf.lookup "urls" conf <*>
+        Conf.lookup "mailFrom" conf <*>
+        Conf.lookup "mailTo" conf <*>
+        Conf.lookup "properties" conf <*>
+        Conf.lookup "listenInterval" conf
+    )
+  case conf of
+    Left msg -> error (T.unpack msg)
+    Right c -> return c
diff --git a/src/Fetch.hs b/src/Fetch.hs
index ea82caa..5d14de4 100644
--- a/src/Fetch.hs
+++ b/src/Fetch.hs
@@ -1,12 +1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Fetch
-  ( fetchResumes
-  , fetchAds
+  ( resumes
+  , ads
   ) where
 
 import Data.Text (Text)
 import qualified Data.Text.IO as T
+import Data.Either (rights)
 
 import Page
 
@@ -18,18 +19,16 @@ import Model.URL (URL)
 import qualified Parser.Resume as Resume
 import qualified Parser.Detail as Detail
 
-fetchResumes :: URL -> IO (Either Text [Resume])
-fetchResumes url = do
-  resumes <- fmap Resume.parse <$> Page.get url
-  if null resumes
+resumes :: [URL] -> IO [Resume]
+resumes urls = do
+  results <- fmap (concat . map Resume.parse . rights) . sequence . map Page.get $ urls
+  if null results
     then T.putStrLn "Parsed 0 results!"
     else return ()
-  return resumes
+  return results
 
-fetchAds :: [Resume] -> IO (Either Text [Ad])
-fetchAds resumes = do
-  xs <- sequence $ map fetchAd resumes
-  return $ sequence xs
+ads :: [Resume] -> IO (Either Text [Ad])
+ads = fmap sequence . sequence . map ad
 
-fetchAd :: Resume -> IO (Either Text Ad)
-fetchAd resume = fmap (\ad -> Ad resume (Detail.parse ad)) <$> Page.get (Resume.url resume)
+ad :: Resume -> IO (Either Text Ad)
+ad resume = fmap (\x -> Ad resume (Detail.parse x)) <$> Page.get (Resume.url resume)
diff --git a/src/Mail.hs b/src/Mail.hs
index bf1516e..1145f9f 100644
--- a/src/Mail.hs
+++ b/src/Mail.hs
@@ -6,6 +6,8 @@ module Mail
 
 import Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import Data.Text.Lazy.Builder (toLazyText, fromText)
 import Data.Either (isLeft)
 
 import Control.Exception (SomeException, try)
@@ -30,8 +32,8 @@ getMimeMail mail =
   in  fromMail
         { Mime.mailTo = map address . Mail.to $ mail
         , Mime.mailParts =
-            [ [ Mime.plainPart . Mail.plainBody $ mail
-              , Mime.htmlPart . Mail.htmlBody $ mail
+            [ [ Mime.plainPart . strictToLazy . Mail.plainBody $ mail
+              , Mime.htmlPart . strictToLazy . Mail.htmlBody $ mail
               ]
             ]
         , Mime.mailHeaders = [("Subject", Mail.subject mail)]
@@ -43,3 +45,6 @@ address addressEmail =
     { Mime.addressName = Nothing
     , Mime.addressEmail = addressEmail
     }
+
+strictToLazy :: Text -> LT.Text
+strictToLazy = toLazyText . fromText
diff --git a/src/Main.hs b/src/Main.hs
index 27dcfa5..75749cd 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -4,17 +4,11 @@ module Main
   ( main
   ) where
 
-import qualified Data.Text.IO as T
-
 import qualified AdListener
 
 import qualified Conf
 
 main :: IO ()
 main = do
-  eitherConfig <- Conf.parse "application.conf"
-  case eitherConfig of
-    Right config ->
-      AdListener.start config
-    Left message ->
-      T.putStrLn message
+  conf <- Conf.parse "application.conf"
+  AdListener.start conf
diff --git a/src/Model/Mail.hs b/src/Model/Mail.hs
index 20addee..7c75bbb 100644
--- a/src/Model/Mail.hs
+++ b/src/Model/Mail.hs
@@ -3,12 +3,11 @@ module Model.Mail
   ) where
 
 import Data.Text (Text)
-import qualified Data.Text.Lazy as LT
 
 data Mail = Mail
   { from :: Text
   , to :: [Text]
   , subject :: Text
-  , plainBody :: LT.Text
-  , htmlBody :: LT.Text
+  , plainBody :: Text
+  , htmlBody :: Text
   } deriving (Eq, Show)