Commit 88a2f0c2 authored by Joris's avatar Joris

Use logging library instead of putStrLn

parent 3e2c3f01
......@@ -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.
......@@ -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
......
......@@ -11,4 +11,6 @@ listenTo = 22 hours
listenInterval = 1 hour
listenIntervalNoise = 15 minutes
logLevel = LevelDebug
importMaybe "local.conf"
......@@ -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)
......
......@@ -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
......@@ -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 =
......
......@@ -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"
......
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment