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 --- 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 +++++++++++++ 7 files changed, 165 insertions(+), 88 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 (limited to 'src') 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