aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/AdListener.hs77
-rw-r--r--src/Conf.hs29
-rw-r--r--src/Fetch.hs25
-rw-r--r--src/Mail.hs9
-rw-r--r--src/Main.hs10
-rw-r--r--src/Model/Mail.hs5
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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 03:53:30 +0000