aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/executable/haskell/Conf.hs24
-rw-r--r--src/executable/haskell/Service/AdListener.hs26
-rw-r--r--src/executable/haskell/Utils/Time.hs14
-rw-r--r--src/lib/haskell/Utils/Time.hs29
-rw-r--r--src/test/haskell/Main.hs67
-rw-r--r--src/test/haskell/ParserSpec.hs63
-rw-r--r--src/test/haskell/TimeSpec.hs30
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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 03:00:13 +0000