Enable the listener only during some hours

12 files changed, 182 insertions, 99 deletions

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)