diff options
| -rw-r--r-- | .tmuxinator.yml | 2 | ||||
| -rw-r--r-- | Makefile | 4 | ||||
| -rw-r--r-- | application.conf | 2 | ||||
| -rw-r--r-- | shell.nix | 14 | ||||
| -rw-r--r-- | src/AdListener.hs | 77 | ||||
| -rw-r--r-- | src/Conf.hs | 29 | ||||
| -rw-r--r-- | src/Fetch.hs | 25 | ||||
| -rw-r--r-- | src/Mail.hs | 9 | ||||
| -rw-r--r-- | src/Main.hs | 10 | ||||
| -rw-r--r-- | src/Model/Mail.hs | 5 |
10 files changed, 82 insertions, 95 deletions
diff --git a/.tmuxinator.yml b/.tmuxinator.yml index 518c502..d5d7fee 100644 --- a/.tmuxinator.yml +++ b/.tmuxinator.yml @@ -5,4 +5,4 @@ windows: layout: fff4,119x58,0,0{94x58,0,0,0,24x58,95,0,1} panes: - # Empty - - make install && make build && make watch + - make clean build watch @@ -3,10 +3,6 @@ all: build clean: @cabal clean > /dev/null -install: - @cabal2nix --shell . > leboncoin-listener.nix - @nix-shell leboncoin-listener.nix -I ~ --command 'cabal configure' - watch: @nodemon -e hs,conf --exec 'make build-and-launch' diff --git a/application.conf b/application.conf index 8f0bfee..3a1b357 100644 --- a/application.conf +++ b/application.conf @@ -1,4 +1,4 @@ -url = "https://www.leboncoin.fr/locations/offres/ile_de_france/?f=a&th=1" +urls = ["https://www.leboncoin.fr/locations/offres/ile_de_france/?f=a&th=1"] mailFrom = "leboncoin-listener@mail.com" mailTo = ["jean.dupont@mail.fr", "anne.smith@mail.com"] properties = ["cp", "city", "surface", "ges"] @@ -7,6 +7,20 @@ with import <nixpkgs> {}; { tmux tmuxinator nodePackages.nodemon + (haskellPackages.ghcWithPackages (p: with p; [ + text + bytestring + containers + directory + time + http-conduit + tagsoup + mime-mail + blaze-html + blaze-markup + clay + config-manager + ])) ]; }; } 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) |