diff options
Diffstat (limited to 'src/executable')
| -rw-r--r-- | src/executable/haskell/Conf.hs | 24 | ||||
| -rw-r--r-- | src/executable/haskell/Service/AdListener.hs | 26 | ||||
| -rw-r--r-- | src/executable/haskell/Utils/Time.hs | 14 |
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) |