Use a logger

berlin-scraper/app/Main.hs

@@ -7,6 +7,7 @@
 
 module Main where
 
+import Control.Exception
 import Control.Lens (view, (&), (.~))
 import Control.Monad (when)
 import Control.Monad.IO.Class
@@ -16,32 +17,42 @@ import Data.ByteString.Lazy qualified as LBS
 import Data.Maybe (fromJust, fromMaybe, listToMaybe)
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
-import Data.Text.IO qualified as Text
 import Database.SQLite.Simple
 import GHC.Generics
+import Katip
 import Network.HTTP.Client.OpenSSL
 import Network.Wreq hiding (Options)
+import Network.Wreq qualified as Wreq
 import Options.Generic
 import Servant.Client (mkClientEnv)
 import System.Exit (exitFailure)
+import System.IO
 import Telegram.Bot.API
 import Telegram.Bot.Simple
 import Telegram.Bot.Simple.Debug
 import Text.HTML.Scalpel
-import qualified Network.Wreq as Wreq
+import Data.String (IsString(..))
 
 main :: IO ()
 main = withOpenSSL $ do
-  opts <- unwrapRecord "Berlin Scrapper"
+  opts :: Options Unwrapped <- unwrapRecord "Berlin Scrapper"
   token <- getEnvToken "TELEGRAM_BOT_TOKEN"
   httpMgr <- newOpenSSLManager
-  let clientEnv = mkClientEnv httpMgr (botBaseUrl token)
-      wreqOpts = Wreq.defaults & Wreq.manager .~ Right httpMgr
-  startBot (traceBotDefault $ botApp opts wreqOpts) clientEnv >>= \case
-    Left err -> do
-      putStrLn $ "Bot failed with: " <> show err
-      exitFailure
-    _ -> pure ()
+  dbConn <- open opts.dbFile
+  createTable dbConn
+
+  handleScribe <- mkHandleScribe ColorIfTerminal stdout (permitItem InfoS) V2
+  let makeLogEnv = registerScribe "stdout" handleScribe defaultScribeSettings =<< initLogEnv "MyApp" "production"
+  bracket makeLogEnv closeScribes $ \logEnv -> do
+    let clientEnv = mkClientEnv httpMgr (botBaseUrl token)
+        wreqOpts = Wreq.defaults & Wreq.manager .~ Right httpMgr
+        env = Env {..}
+    liftIO $
+      startBot (traceBotDefault $ botApp env) clientEnv >>= \case
+        Left err -> do
+          info env "main" $ "Bot failed with: " <> fromString (show err)
+          exitFailure
+        _ -> pure ()
 
 -- * Types
 
@@ -73,6 +84,12 @@ data IBWResponse = IBWResponse
 
 instance FromJSON IBWResponse
 
+data Env = Env
+  { dbConn :: Connection,
+    wreqOpts :: Wreq.Options,
+    logEnv :: LogEnv
+  }
+
 -- * Parsing
 
 queryIBW :: Wreq.Options -> IO IBWResponse
@@ -174,13 +191,13 @@ type Model = ()
 newtype Action = StartChat Chat
   deriving (Show)
 
-botApp :: Options Unwrapped -> Wreq.Options -> BotApp Model Action
-botApp opts wreqOpts =
+botApp :: Env -> BotApp Model Action
+botApp env =
   BotApp
     { botInitialModel = (),
       botAction = action,
-      botHandler = handler,
-      botJobs = [scrapeJob opts wreqOpts]
+      botHandler = handler env,
+      botJobs = [scrapeJob env]
     }
 
 action :: Update -> Model -> Maybe Action
@@ -191,38 +208,39 @@ action update _ = do
     then pure $ StartChat msg.messageChat
     else Nothing
 
-handler :: Action -> Model -> Eff Action Model
-handler (StartChat chat) model =
+handler :: Env -> Action -> Model -> Eff Action Model
+handler env (StartChat chat) model =
   model <# do
-    liftIO $ putStrLn $ "Chat started! " <> ppAsJSON chat
+    info env "telegram.handler" $ "Chat started! " <> fromString (ppAsJSON chat)
 
-scrapeJob :: Options Unwrapped -> Wreq.Options -> BotJob Model Action
-scrapeJob opts wreqOpts =
+scrapeJob :: Env -> BotJob Model Action
+scrapeJob env =
   BotJob
     { botJobSchedule = "* * * * *",
-      botJobTask = scrapeJobTask opts wreqOpts
+      botJobTask = scrapeJobTask env
     }
 
-scrapeJobTask :: Options Unwrapped -> Wreq.Options -> Model -> Eff Action Model
-scrapeJobTask opts wreqOpts m =
+scrapeJobTask :: Env -> Model -> Eff Action Model
+scrapeJobTask env m =
   m <# do
-    liftIO $ putStrLn "Starting scrape job"
-    res <- liftIO $ queryIBW wreqOpts
+    info env "scrapeJobTask" "Starting scrape job"
+    res <- liftIO $ queryIBW env.wreqOpts
     let offers = fromJust $ scrapeStringLike res.searchresults scrapeOffers
-    liftIO $ putStrLn "Fetched offers"
-    conn <- liftIO $ open (dbFile opts)
-    liftIO $ createTable conn
+    info env "scrapeJobTask" "Fetched offers"
     mapM_
       ( \offer -> do
-          isNewOffer <- liftIO $ saveOffer conn offer
+          isNewOffer <- liftIO $ saveOffer env.dbConn offer
           when isNewOffer $ do
-            liftIO $ putStrLn "Found a new offer"
-            notify offer
+            info env "scrapeJobTask" "Found a new offer"
+            notify env offer
       )
       offers
 
-notify :: Offer -> BotM ()
-notify offer = do
+info :: MonadIO m => Env -> Namespace -> LogStr -> m ()
+info env ns l = liftIO $ runKatipT env.logEnv $ logMsg ns InfoS l
+
+notify :: Env -> Offer -> BotM ()
+notify env offer = do
   let offerTitle = "<b><u>" <> offer.title <> "</u></b>"
       offerAddress = "<b>Address:</b> " <> fromMaybe "N/A" offer.address
       offerRooms = "<b>Rooms:</b> " <> maybe "N/A" (Text.pack . show) offer.rooms
@@ -235,14 +253,14 @@ notify offer = do
   res1 <- runTG sendMsgReq1
   liftIO $
     if res1.responseOk
-      then putStrLn "Notified successfully"
+      then info env "notify" "Notified successfully"
       else do
-        putStrLn $ "Failed to notify the offer: " <> show offer
-        Text.putStrLn $ "Response: " <> Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res1)
+        info env "notify" $ "Failed to notify the offer: " <> fromString (show offer)
+        info env "notify" $ "Response: " <> fromString (Text.unpack $ Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res1))
   res2 <- runTG sendMsgReq2
   liftIO $
     if res2.responseOk
-      then putStrLn "Notified successfully"
+      then info env "notify" "Notified successfully"
       else do
-        putStrLn $ "Failed to notify the offer: " <> show offer
-        Text.putStrLn $ "Response: " <> Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res2)
+        info env "notify" $ "Failed to notify the offer: " <> fromString (show offer)
+        info env "notify" $ "Response: " <> fromString (Text.unpack $ Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res2))

berlin-scraper/berlin-scraper.cabal

@@ -28,6 +28,7 @@ executable berlin-scraper
                     , servant-client
                     , http-client-openssl
                     , bytestring
+                    , katip
     hs-source-dirs:   app
     default-language: GHC2021
     ghc-options:    -threaded -with-rtsopts=-N

berlin-scraper/default.nix

@@ -1,6 +1,6 @@
-{ mkDerivation, aeson, base, bytestring, http-client-openssl, lens
-, lib, optparse-generic, scalpel, servant-client, sqlite-simple
-, telegram-bot-api, telegram-bot-simple, text, wreq
+{ mkDerivation, aeson, base, bytestring, http-client-openssl, katip
+, lens, lib, optparse-generic, scalpel, servant-client
+, sqlite-simple, telegram-bot-api, telegram-bot-simple, text, wreq
 }:
 mkDerivation {
   pname = "berlin-scraper";
@@ -9,9 +9,9 @@ mkDerivation {
   isLibrary = false;
   isExecutable = true;
   executableHaskellDepends = [
-    aeson base bytestring http-client-openssl lens optparse-generic
-    scalpel servant-client sqlite-simple telegram-bot-api
-    telegram-bot-simple text wreq
+    aeson base bytestring http-client-openssl katip lens
+    optparse-generic scalpel servant-client sqlite-simple
+    telegram-bot-api telegram-bot-simple text wreq
   ];
   license = lib.licenses.agpl3Plus;
   mainProgram = "berlin-scraper";