Enable the listener only during some hours

7 files changed, 165 insertions, 88 deletions

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)