Use logging library instead of putStrLn

9 files changed, 26 insertions, 21 deletions

diff --git a/README.md b/README.md
index cf16767..ca0390d 100644
--- a/README.md
+++ b/README.md
@@ -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 "
diff --git a/stack.yaml b/stack.yaml
index fa3fa4d..b953365 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -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