From 317e7b1e7319182e5caa5169119aea9fc8d660b6 Mon Sep 17 00:00:00 2001 From: Joris Date: Thu, 5 Sep 2019 20:46:36 +0200 Subject: Enable the listener only during some hours --- .tmuxinator.yml | 2 +- Makefile | 2 +- README.md | 5 ++- ad-listener.cabal | 12 +++-- application.conf | 7 +-- src/executable/haskell/Conf.hs | 24 ++++++---- src/executable/haskell/Service/AdListener.hs | 26 ++++++++--- src/executable/haskell/Utils/Time.hs | 14 ------ src/lib/haskell/Utils/Time.hs | 29 ++++++++++++ src/test/haskell/Main.hs | 67 ++++------------------------ src/test/haskell/ParserSpec.hs | 63 ++++++++++++++++++++++++++ src/test/haskell/TimeSpec.hs | 30 +++++++++++++ 12 files changed, 182 insertions(+), 99 deletions(-) delete mode 100644 src/executable/haskell/Utils/Time.hs create mode 100644 src/lib/haskell/Utils/Time.hs create mode 100644 src/test/haskell/ParserSpec.hs create mode 100644 src/test/haskell/TimeSpec.hs diff --git a/.tmuxinator.yml b/.tmuxinator.yml index 94a744e..0d7363f 100644 --- a/.tmuxinator.yml +++ b/.tmuxinator.yml @@ -5,4 +5,4 @@ windows: - console: - # Empty - app: - - make clean watch + - make clean install watch diff --git a/Makefile b/Makefile index 039a460..d47552e 100644 --- a/Makefile +++ b/Makefile @@ -20,7 +20,7 @@ watch: build @nodemon --watch src --delay 0.2 -e hs,conf --exec 'clear && make build-and-launch' build-and-launch: - @(pkill ad-listener || true) && (stack exec ad-listener || true) + @(pkill ad-listener || true) && (stack build && stack exec ad-listener || true) build: @stack build diff --git a/README.md b/README.md index 7555455..ca0390d 100644 --- a/README.md +++ b/README.md @@ -34,6 +34,7 @@ See [application.conf](application.conf). `sendmail` command is used for notifications. -## Todo +## Ideas -Add tests on fetched data +- add sqlite DB, to get back to previous state if shut down, it also permits to + see what has already been seen. diff --git a/ad-listener.cabal b/ad-listener.cabal index fbe094e..be9c388 100644 --- a/ad-listener.cabal +++ b/ad-listener.cabal @@ -18,11 +18,12 @@ Library Build-depends: base , bytestring - , wreq - , tagsoup - , text , http-types , lens + , tagsoup + , text + , time + , wreq Exposed-modules: FetchAd @@ -32,6 +33,7 @@ Library , Parser.OuestFranceParser , Parser.SeLogerParser , Utils.HTTP + , Utils.Time Other-modules: Parser.Utils @@ -65,7 +67,6 @@ Executable ad-listener , Model.Mail , Service.AdListener , Service.MailService - , Utils.Time , View.Ad Test-suite test @@ -84,6 +85,9 @@ Test-suite test , ad-listener , text , wreq + , time Other-modules: Ads + ParserSpec + TimeSpec diff --git a/application.conf b/application.conf index f470b7b..a6548df 100644 --- a/application.conf +++ b/application.conf @@ -3,11 +3,12 @@ ouestFranceUrls = [] seLogerUrls = [] mailFrom = "ad-listener@mail.com" - mailTo = [] - mailMock = False -listenInterval = 20 minute +listenFrom = 9 hours +listenTo = 22 hours +listenInterval = 1 hour +listenIntervalNoise = 15 minutes importMaybe "local.conf" diff --git a/src/executable/haskell/Conf.hs b/src/executable/haskell/Conf.hs index df26ea0..0dc857b 100644 --- a/src/executable/haskell/Conf.hs +++ b/src/executable/haskell/Conf.hs @@ -6,18 +6,21 @@ module Conf import qualified Data.ConfigManager as Conf import Data.Text (Text) import qualified Data.Text as T -import Data.Time.Clock (NominalDiffTime) +import Data.Time.Clock (DiffTime) import Model.URL data Conf = Conf - { leboncoinUrls :: [URL] - , ouestFranceUrls :: [URL] - , seLogerUrls :: [URL] - , mailFrom :: Text - , mailTo :: [Text] - , mailMock :: Bool - , listenInterval :: NominalDiffTime + { leboncoinUrls :: [URL] + , ouestFranceUrls :: [URL] + , seLogerUrls :: [URL] + , mailFrom :: Text + , mailTo :: [Text] + , mailMock :: Bool + , listenFrom :: DiffTime + , listenTo :: DiffTime + , listenInterval :: DiffTime + , listenIntervalNoise :: DiffTime } deriving Show parse :: FilePath -> IO Conf @@ -32,7 +35,10 @@ parse path = do Conf.lookup "mailFrom" conf <*> Conf.lookup "mailTo" conf <*> Conf.lookup "mailMock" conf <*> - Conf.lookup "listenInterval" conf + Conf.lookup "listenFrom" conf <*> + Conf.lookup "listenTo" conf <*> + Conf.lookup "listenInterval" conf <*> + Conf.lookup "listenIntervalNoise" conf ) case conf of Left msg -> error (T.unpack msg) diff --git a/src/executable/haskell/Service/AdListener.hs b/src/executable/haskell/Service/AdListener.hs index c393f38..9af92f4 100644 --- a/src/executable/haskell/Service/AdListener.hs +++ b/src/executable/haskell/Service/AdListener.hs @@ -5,8 +5,8 @@ module Service.AdListener import Control.Concurrent (threadDelay) import qualified Data.Text as T import qualified Data.Text.IO as T +import qualified Data.Time.LocalTime as LocalTime import Network.Wreq.Session (Session) -import Prelude hiding (error) import Conf (Conf) import qualified Conf @@ -21,10 +21,11 @@ import qualified View.Ad as Ad start :: Conf -> Session -> IO () start conf session = do - ads <- fetchAds conf session + -- ads <- fetchAds conf session + let ads = [] let newURLs = map Ad.url ads T.putStrLn "Listening to new ads…" - waitListenInterval conf + sleepUntilReady conf listenToNewAdsWithViewedURLs conf session newURLs listenToNewAdsWithViewedURLs :: Conf -> Session -> [URL] -> IO () @@ -39,7 +40,7 @@ listenToNewAdsWithViewedURLs conf session viewedURLs = do sendMail conf newAds else return () - waitListenInterval conf + sleepUntilReady conf listenToNewAdsWithViewedURLs conf session (viewedURLs ++ newURLs) fetchAds :: Conf -> Session -> IO [Ad] @@ -61,5 +62,18 @@ sendMail conf ads = mail = Mail (Conf.mailFrom conf) (Conf.mailTo conf) title plainBody in MailService.send (Conf.mailMock conf) mail >> return () -waitListenInterval :: Conf -> IO () -waitListenInterval = threadDelay . (*) 1000000 . round . Conf.listenInterval +sleepUntilReady :: Conf -> IO () +sleepUntilReady conf = do + timeSinceMidnight <- + (LocalTime.timeOfDayToTime . LocalTime.localTimeOfDay . LocalTime.zonedTimeToLocalTime) + <$> LocalTime.getZonedTime + case TimeUtils.asleepDuration (Conf.listenFrom conf) (Conf.listenTo conf) timeSinceMidnight of + Just d -> do + sleepSeconds d + + Nothing -> + -- TODO 04/09/2019: Add noise + sleepSeconds . Conf.listenInterval $ conf + where + sleepSeconds = + threadDelay . (*) 1000000 . round diff --git a/src/executable/haskell/Utils/Time.hs b/src/executable/haskell/Utils/Time.hs deleted file mode 100644 index b6045a7..0000000 --- a/src/executable/haskell/Utils/Time.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Utils.Time - ( getCurrentFormattedTime - ) where - -import Data.Text (Text) -import qualified Data.Text as T - -import Data.Time.Format (defaultTimeLocale, formatTime) -import Data.Time.LocalTime (getZonedTime) - -getCurrentFormattedTime :: IO Text -getCurrentFormattedTime = do - zonedTime <- getZonedTime - return (T.pack $ formatTime defaultTimeLocale "%Hh%M" zonedTime) diff --git a/src/lib/haskell/Utils/Time.hs b/src/lib/haskell/Utils/Time.hs new file mode 100644 index 0000000..88aeeb6 --- /dev/null +++ b/src/lib/haskell/Utils/Time.hs @@ -0,0 +1,29 @@ +module Utils.Time + ( getCurrentFormattedTime + , asleepDuration + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Clock (DiffTime) +import qualified Data.Time.Clock as Clock +import qualified Data.Time.Format as Format +import qualified Data.Time.LocalTime as LocalTime + +getCurrentFormattedTime :: IO Text +getCurrentFormattedTime = do + zonedTime <- LocalTime.getZonedTime + return (T.pack $ Format.formatTime Format.defaultTimeLocale "%Hh%M" zonedTime) + +asleepDuration :: DiffTime -> DiffTime -> DiffTime -> Maybe DiffTime +asleepDuration from to t = + if t < from && from < to then + Just $ from - t + else if t > to && to > from then + Just $ day - t + from + else if t > to && t < from then + Just $ from - t + else + Nothing + where + day = (realToFrac Clock.nominalDay) :: DiffTime diff --git a/src/test/haskell/Main.hs b/src/test/haskell/Main.hs index 541cc54..5422108 100644 --- a/src/test/haskell/Main.hs +++ b/src/test/haskell/Main.hs @@ -1,62 +1,11 @@ -import Data.Maybe (catMaybes) -import qualified Data.Text.IO as T -import qualified Network.Wreq.Session as Session -import Test.Hspec +module Main (main) where -import qualified Ads -import qualified FetchAd -import Model.Ad (Ad (..)) -import qualified Parser.LeboncoinParser as LeboncoinParser --- import qualified Parser.OuestFranceParser as OuestFranceParser --- import qualified Parser.SeLogerParser as SeLogerParser +import qualified Test.Hspec as Hspec -main :: IO () -main = do - session <- Session.newSession - - hspec $ do - describe "LeboncoinParser" $ do - - it "should parse no results from empty string" $ do - LeboncoinParser.parse "" `shouldBe` [] - - it "should parse ads from local page" $ do - ads <- T.readFile "src/test/resources/leboncoin.html" - LeboncoinParser.parse ads `shouldBe` Ads.leboncoin +import qualified ParserSpec +import qualified TimeSpec - it "should parse ads from remote page" $ do - ads <- FetchAd.leboncoin - session - ["https://www.leboncoin.fr/annonces/offres/ile_de_france/"] - checkAds ads - - -- describe "OuestFranceParser" $ do - -- - -- it "should parse no results from empty string" $ do - -- OuestFranceParser.parse "" `shouldBe` [] - -- - -- it "should parse ads from page" $ do - -- rawOuestFranceAds <- T.readFile "src/test/resources/ouestFrance.html" - -- OuestFranceParser.parse rawOuestFranceAds `shouldBe` Ads.ouestFrance - -- - -- it "should parse ads from remote page" $ do - -- ads <- FetchAd.ouestFrance ["https://www.ouestfrance-immo.com/louer/appartement/rennes-35-35000/"] - -- checkAds ads - -- - -- describe "SeLogerParser" $ do - -- - -- it "should parse no results from empty string" $ do - -- SeLogerParser.parse "" `shouldBe` [] - -- - -- it "should parse ads from page" $ do - -- ads <- T.readFile "src/test/resources/seLoger.html" - -- SeLogerParser.parse ads `shouldBe` Ads.seLoger - -- - -- it "should parse ads from remote page" $ do - -- ads <- FetchAd.seLoger ["https://www.seloger.com/list.htm?tri=initial&idtypebien=2,1&idtt=2,5&naturebien=1,2,4&ci=690123"] - -- checkAds ads - -checkAds :: [Ad] -> IO () -checkAds ads = do - length ads `shouldSatisfy` (\n -> n > 10) - (length . catMaybes . map price $ ads) `shouldSatisfy` (\n -> n > 10) +main :: IO () +main = Hspec.hspec $ do + ParserSpec.spec + TimeSpec.spec diff --git a/src/test/haskell/ParserSpec.hs b/src/test/haskell/ParserSpec.hs new file mode 100644 index 0000000..64b2b33 --- /dev/null +++ b/src/test/haskell/ParserSpec.hs @@ -0,0 +1,63 @@ +module ParserSpec (spec) where + +import Data.Maybe (catMaybes) +import qualified Data.Text.IO as T +import qualified Network.Wreq.Session as Session +import Test.Hspec + +import qualified Ads +import qualified FetchAd +import Model.Ad (Ad (..)) +import qualified Parser.LeboncoinParser as LeboncoinParser +-- import qualified Parser.OuestFranceParser as OuestFranceParser +-- import qualified Parser.SeLogerParser as SeLogerParser + +spec :: Spec +spec = do + describe "Parser" $ do + session <- runIO Session.newSession + describe "LeBonCoin" $ do + + it "should parse no results from empty string" $ do + LeboncoinParser.parse "" `shouldBe` [] + + it "should parse ads from local page" $ do + ads <- T.readFile "src/test/resources/leboncoin.html" + LeboncoinParser.parse ads `shouldBe` Ads.leboncoin + + it "should parse ads from remote page" $ do + ads <- FetchAd.leboncoin + session + ["https://www.leboncoin.fr/annonces/offres/ile_de_france/"] + checkAds ads + + -- describe "OuestFrance" $ do + -- + -- it "should parse no results from empty string" $ do + -- OuestFranceParser.parse "" `shouldBe` [] + -- + -- it "should parse ads from page" $ do + -- rawOuestFranceAds <- T.readFile "src/test/resources/ouestFrance.html" + -- OuestFranceParser.parse rawOuestFranceAds `shouldBe` Ads.ouestFrance + -- + -- it "should parse ads from remote page" $ do + -- ads <- FetchAd.ouestFrance ["https://www.ouestfrance-immo.com/louer/appartement/rennes-35-35000/"] + -- checkAds ads + -- + -- describe "SeLoger" $ do + -- + -- it "should parse no results from empty string" $ do + -- SeLogerParser.parse "" `shouldBe` [] + -- + -- it "should parse ads from page" $ do + -- ads <- T.readFile "src/test/resources/seLoger.html" + -- SeLogerParser.parse ads `shouldBe` Ads.seLoger + -- + -- it "should parse ads from remote page" $ do + -- ads <- FetchAd.seLoger ["https://www.seloger.com/list.htm?tri=initial&idtypebien=2,1&idtt=2,5&naturebien=1,2,4&ci=690123"] + -- checkAds ads + +checkAds :: [Ad] -> IO () +checkAds ads = do + length ads `shouldSatisfy` (\n -> n > 10) + (length . catMaybes . map price $ ads) `shouldSatisfy` (\n -> n > 10) diff --git a/src/test/haskell/TimeSpec.hs b/src/test/haskell/TimeSpec.hs new file mode 100644 index 0000000..4248e68 --- /dev/null +++ b/src/test/haskell/TimeSpec.hs @@ -0,0 +1,30 @@ +module TimeSpec (spec) where + +import Data.Time.Clock (DiffTime) +import qualified Data.Time.Clock as Clock +import Test.Hspec + +import qualified Utils.Time as TimeUtils + +spec :: Spec +spec = + describe "Utils.Time" $ + describe "asleepDuration" $ do + + it "should not be asleep in range" $ do + TimeUtils.asleepDuration (hour 8) (hour 22) (hour 15) `shouldBe` Nothing + + it "should not be asleep in day overlapping range" $ do + TimeUtils.asleepDuration (hour 22) (hour 8) (hour 6) `shouldBe` Nothing + + it "should be asleep before the range" $ do + TimeUtils.asleepDuration (hour 10) (hour 12) (hour 6) `shouldBe` Just (hour 4) + + it "should be asleep after the range" $ do + TimeUtils.asleepDuration (hour 10) (hour 14) (hour 15) `shouldBe` Just (hour 19) + + it "should be asleep before a day overlapping range" $ do + TimeUtils.asleepDuration (hour 23) (hour 1) (hour 3) `shouldBe` Just (hour 20) + +hour :: Int -> DiffTime +hour h = Clock.secondsToDiffTime (fromIntegral h * 60 * 60) -- cgit v1.2.3