Enable the listener only during some hours

3 files changed, 35 insertions, 29 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)