Use a logger

This commit is contained in:
Akshay Mankar 2023-11-14 22:36:44 +01:00
parent 1978758c07
commit 8ef9b1c24e
Signed by: axeman
GPG key ID: CA08F3AB62369B89
3 changed files with 45 additions and 32 deletions

View file

@ -7,6 +7,7 @@
module Main where module Main where
import Control.Exception
import Control.Lens (view, (&), (.~)) import Control.Lens (view, (&), (.~))
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.IO.Class import Control.Monad.IO.Class
@ -16,19 +17,21 @@ import Data.ByteString.Lazy qualified as LBS
import Data.Maybe (fromJust, fromMaybe, listToMaybe) import Data.Maybe (fromJust, fromMaybe, listToMaybe)
import Data.Text qualified as Text import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text import Data.Text.Encoding qualified as Text
import Data.Text.IO qualified as Text
import Database.SQLite.Simple import Database.SQLite.Simple
import GHC.Generics import GHC.Generics
import Katip
import Network.HTTP.Client.OpenSSL import Network.HTTP.Client.OpenSSL
import Network.Wreq hiding (Options) import Network.Wreq hiding (Options)
import Network.Wreq qualified as Wreq import Network.Wreq qualified as Wreq
import Options.Generic import Options.Generic
import Servant.Client (mkClientEnv) import Servant.Client (mkClientEnv)
import System.Exit (exitFailure) import System.Exit (exitFailure)
import System.IO
import Telegram.Bot.API import Telegram.Bot.API
import Telegram.Bot.Simple import Telegram.Bot.Simple
import Telegram.Bot.Simple.Debug import Telegram.Bot.Simple.Debug
import Text.HTML.Scalpel import Text.HTML.Scalpel
import Data.String (IsString(..))
main :: IO () main :: IO ()
main = withOpenSSL $ do main = withOpenSSL $ do
@ -37,12 +40,17 @@ main = withOpenSSL $ do
httpMgr <- newOpenSSLManager httpMgr <- newOpenSSLManager
dbConn <- open opts.dbFile dbConn <- open opts.dbFile
createTable dbConn 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) let clientEnv = mkClientEnv httpMgr (botBaseUrl token)
wreqOpts = Wreq.defaults & Wreq.manager .~ Right httpMgr wreqOpts = Wreq.defaults & Wreq.manager .~ Right httpMgr
env = Env {..} env = Env {..}
liftIO $
startBot (traceBotDefault $ botApp env) clientEnv >>= \case startBot (traceBotDefault $ botApp env) clientEnv >>= \case
Left err -> do Left err -> do
putStrLn $ "Bot failed with: " <> show err info env "main" $ "Bot failed with: " <> fromString (show err)
exitFailure exitFailure
_ -> pure () _ -> pure ()
@ -78,7 +86,8 @@ instance FromJSON IBWResponse
data Env = Env data Env = Env
{ dbConn :: Connection, { dbConn :: Connection,
wreqOpts :: Wreq.Options wreqOpts :: Wreq.Options,
logEnv :: LogEnv
} }
-- * Parsing -- * Parsing
@ -187,7 +196,7 @@ botApp env =
BotApp BotApp
{ botInitialModel = (), { botInitialModel = (),
botAction = action, botAction = action,
botHandler = handler, botHandler = handler env,
botJobs = [scrapeJob env] botJobs = [scrapeJob env]
} }
@ -199,10 +208,10 @@ action update _ = do
then pure $ StartChat msg.messageChat then pure $ StartChat msg.messageChat
else Nothing else Nothing
handler :: Action -> Model -> Eff Action Model handler :: Env -> Action -> Model -> Eff Action Model
handler (StartChat chat) model = handler env (StartChat chat) model =
model <# do model <# do
liftIO $ putStrLn $ "Chat started! " <> ppAsJSON chat info env "telegram.handler" $ "Chat started! " <> fromString (ppAsJSON chat)
scrapeJob :: Env -> BotJob Model Action scrapeJob :: Env -> BotJob Model Action
scrapeJob env = scrapeJob env =
@ -214,21 +223,24 @@ scrapeJob env =
scrapeJobTask :: Env -> Model -> Eff Action Model scrapeJobTask :: Env -> Model -> Eff Action Model
scrapeJobTask env m = scrapeJobTask env m =
m <# do m <# do
liftIO $ putStrLn "Starting scrape job" info env "scrapeJobTask" "Starting scrape job"
res <- liftIO $ queryIBW env.wreqOpts res <- liftIO $ queryIBW env.wreqOpts
let offers = fromJust $ scrapeStringLike res.searchresults scrapeOffers let offers = fromJust $ scrapeStringLike res.searchresults scrapeOffers
liftIO $ putStrLn "Fetched offers" info env "scrapeJobTask" "Fetched offers"
mapM_ mapM_
( \offer -> do ( \offer -> do
isNewOffer <- liftIO $ saveOffer env.dbConn offer isNewOffer <- liftIO $ saveOffer env.dbConn offer
when isNewOffer $ do when isNewOffer $ do
liftIO $ putStrLn "Found a new offer" info env "scrapeJobTask" "Found a new offer"
notify offer notify env offer
) )
offers offers
notify :: Offer -> BotM () info :: MonadIO m => Env -> Namespace -> LogStr -> m ()
notify offer = do 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>" let offerTitle = "<b><u>" <> offer.title <> "</u></b>"
offerAddress = "<b>Address:</b> " <> fromMaybe "N/A" offer.address offerAddress = "<b>Address:</b> " <> fromMaybe "N/A" offer.address
offerRooms = "<b>Rooms:</b> " <> maybe "N/A" (Text.pack . show) offer.rooms offerRooms = "<b>Rooms:</b> " <> maybe "N/A" (Text.pack . show) offer.rooms
@ -241,14 +253,14 @@ notify offer = do
res1 <- runTG sendMsgReq1 res1 <- runTG sendMsgReq1
liftIO $ liftIO $
if res1.responseOk if res1.responseOk
then putStrLn "Notified successfully" then info env "notify" "Notified successfully"
else do else do
putStrLn $ "Failed to notify the offer: " <> show offer info env "notify" $ "Failed to notify the offer: " <> fromString (show offer)
Text.putStrLn $ "Response: " <> Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res1) info env "notify" $ "Response: " <> fromString (Text.unpack $ Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res1))
res2 <- runTG sendMsgReq2 res2 <- runTG sendMsgReq2
liftIO $ liftIO $
if res2.responseOk if res2.responseOk
then putStrLn "Notified successfully" then info env "notify" "Notified successfully"
else do else do
putStrLn $ "Failed to notify the offer: " <> show offer info env "notify" $ "Failed to notify the offer: " <> fromString (show offer)
Text.putStrLn $ "Response: " <> Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res2) info env "notify" $ "Response: " <> fromString (Text.unpack $ Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res2))

View file

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

View file

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