diff options
| -rw-r--r-- | README.md | 1 | ||||
| -rw-r--r-- | ad-listener.cabal | 2 | ||||
| -rw-r--r-- | application.conf | 2 | ||||
| -rw-r--r-- | src/executable/haskell/Conf.hs | 5 | ||||
| -rw-r--r-- | src/executable/haskell/Main.hs | 5 | ||||
| -rw-r--r-- | src/executable/haskell/Service/AdListener.hs | 19 | ||||
| -rw-r--r-- | src/executable/haskell/Service/MailService.hs | 6 | ||||
| -rw-r--r-- | src/lib/haskell/Utils/HTTP.hs | 4 | ||||
| -rw-r--r-- | stack.yaml | 3 |
9 files changed, 26 insertions, 21 deletions
@@ -36,6 +36,5 @@ See [application.conf](application.conf). ## Ideas -- add logging system - 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 22f7adb..21962b6 100644 --- a/ad-listener.cabal +++ b/ad-listener.cabal @@ -25,6 +25,7 @@ Library , time , wreq , random + , logging Exposed-modules: FetchAd @@ -62,6 +63,7 @@ Executable ad-listener , text , time , wreq + , logging Other-modules: Conf diff --git a/application.conf b/application.conf index a6548df..eb958b6 100644 --- a/application.conf +++ b/application.conf @@ -11,4 +11,6 @@ listenTo = 22 hours listenInterval = 1 hour listenIntervalNoise = 15 minutes +logLevel = LevelDebug + importMaybe "local.conf" diff --git a/src/executable/haskell/Conf.hs b/src/executable/haskell/Conf.hs index 0dc857b..53a1046 100644 --- a/src/executable/haskell/Conf.hs +++ b/src/executable/haskell/Conf.hs @@ -3,6 +3,7 @@ module Conf , Conf(..) ) where +import qualified Control.Logging as Logging import qualified Data.ConfigManager as Conf import Data.Text (Text) import qualified Data.Text as T @@ -21,6 +22,7 @@ data Conf = Conf , listenTo :: DiffTime , listenInterval :: DiffTime , listenIntervalNoise :: DiffTime + , logLevel :: Logging.LogLevel } deriving Show parse :: FilePath -> IO Conf @@ -38,7 +40,8 @@ parse path = do Conf.lookup "listenFrom" conf <*> Conf.lookup "listenTo" conf <*> Conf.lookup "listenInterval" conf <*> - Conf.lookup "listenIntervalNoise" conf + Conf.lookup "listenIntervalNoise" conf <*> + Conf.lookup "logLevel" conf ) case conf of Left msg -> error (T.unpack msg) diff --git a/src/executable/haskell/Main.hs b/src/executable/haskell/Main.hs index 8c0f37f..34d67a2 100644 --- a/src/executable/haskell/Main.hs +++ b/src/executable/haskell/Main.hs @@ -2,6 +2,7 @@ module Main ( main ) where +import qualified Control.Logging as Logging import qualified Network.Wreq.Session as Session import qualified Conf @@ -11,4 +12,6 @@ main :: IO () main = do conf <- Conf.parse "application.conf" session <- Session.newSession - AdListener.start conf session + Logging.withStdoutLogging $ do + Logging.setLogLevel (Conf.logLevel conf) + AdListener.start conf session diff --git a/src/executable/haskell/Service/AdListener.hs b/src/executable/haskell/Service/AdListener.hs index 9a9fc3d..b8ae5e9 100644 --- a/src/executable/haskell/Service/AdListener.hs +++ b/src/executable/haskell/Service/AdListener.hs @@ -3,8 +3,8 @@ module Service.AdListener ) where import Control.Concurrent (threadDelay) +import qualified Control.Logging as Logging 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) @@ -23,7 +23,7 @@ start :: Conf -> Session -> IO () start conf session = do ads <- fetchAds conf session let newURLs = map Ad.url ads - T.putStrLn "Listening to new ads…" + Logging.log "Listening to new ads…" sleepUntilReady conf listenToNewAdsWithViewedURLs conf session newURLs @@ -35,7 +35,7 @@ listenToNewAdsWithViewedURLs conf session viewedURLs = do if not (null newAds) then do - _ <- T.putStrLn (Ad.renderConsoleAds time newAds) + _ <- Logging.log (Ad.renderConsoleAds time newAds) sendMail conf newAds else return () @@ -48,19 +48,12 @@ fetchAds conf session = do ouestFranceAds <- FetchAd.ouestFrance session (Conf.ouestFranceUrls conf) seLogerAds <- FetchAd.seLoger session (Conf.seLogerUrls conf) let ads = leboncoinAds ++ ouestFranceAds ++ seLogerAds - logFetchAds ads - return ads - -logFetchAds :: [Ad] -> IO () -logFetchAds ads = do - now <- TimeUtils.getCurrentFormattedTime - T.putStrLn . T.concat $ - [ "At " - , now - , ": fetched " + Logging.log . T.concat $ + [ "Fetched " , T.pack . show $ length ads , " ads" ] + return ads sendMail :: Conf -> [Ad] -> IO () sendMail conf ads = diff --git a/src/executable/haskell/Service/MailService.hs b/src/executable/haskell/Service/MailService.hs index cb61c47..3a5bfd0 100644 --- a/src/executable/haskell/Service/MailService.hs +++ b/src/executable/haskell/Service/MailService.hs @@ -4,9 +4,9 @@ module Service.MailService import Control.Arrow (left) import Control.Exception (SomeException, try) +import qualified Control.Logging as Logging import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.IO as T import qualified Data.Text.Lazy as LT import Data.Text.Lazy.Builder (fromText, toLazyText) import qualified Network.Mail.Mime as Mime @@ -17,7 +17,7 @@ import qualified Model.Mail as Mail send :: Bool -> Mail -> IO (Either Text ()) send isMock mail = if isMock then do - putStrLn $ "MOCK sending mail " ++ (show mail) + Logging.log $ T.concat [ "MOCK sending mail ", T.pack . show $ mail ] return . Right $ () else do result <- @@ -25,7 +25,7 @@ send isMock mail = (try (Mime.renderSendMail . getMimeMail $ mail) :: IO (Either SomeException ())) case result of Left err -> - T.putStrLn . T.concat $ + Logging.loggingLogger Logging.LevelError "" . T.concat $ [ "Error sending the following email (" , T.pack . show $ mail , ":\n" diff --git a/src/lib/haskell/Utils/HTTP.hs b/src/lib/haskell/Utils/HTTP.hs index d441f86..b6d789a 100644 --- a/src/lib/haskell/Utils/HTTP.hs +++ b/src/lib/haskell/Utils/HTTP.hs @@ -3,11 +3,11 @@ module Utils.HTTP ) where import Control.Lens ((^.)) +import qualified Control.Logging as Logging import qualified Data.ByteString.Lazy as BS import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding as T -import qualified Data.Text.IO as T import qualified Network.Wreq as Wreq import Network.Wreq.Session (Session) import qualified Network.Wreq.Session as Session @@ -25,7 +25,7 @@ get session url = do if statusCode >= 200 && statusCode < 300 then return . Right $ body else do - T.putStrLn . T.concat $ + Logging.loggingLogger Logging.LevelError "" . T.concat $ [ "Got status " , T.pack . show $ statusCode , " while fetching " @@ -6,3 +6,6 @@ packages: git: https://gitlab.com/guyonvarch/config-manager commit: c0f5e9c5ad8ac88b05ecff9b035c59480829aff1 extra-dep: true + +extra-deps: +- logging-3.0.5@sha256:88096d3124fce9a19af3720f751e1a354d866ed5030d2e5197238d2277cdb2f2 |