Use a logger

main
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
import Control.Exception
import Control.Lens (view, (&), (.~))
import Control.Monad (when)
import Control.Monad.IO.Class
@ -16,19 +17,21 @@ 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 Data.String (IsString(..))
main :: IO ()
main = withOpenSSL $ do
@ -37,14 +40,19 @@ main = withOpenSSL $ do
httpMgr <- newOpenSSLManager
dbConn <- open opts.dbFile
createTable dbConn
let clientEnv = mkClientEnv httpMgr (botBaseUrl token)
wreqOpts = Wreq.defaults & Wreq.manager .~ Right httpMgr
env = Env {..}
startBot (traceBotDefault $ botApp env) clientEnv >>= \case
Left err -> do
putStrLn $ "Bot failed with: " <> show err
exitFailure
_ -> pure ()
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
@ -78,7 +86,8 @@ instance FromJSON IBWResponse
data Env = Env
{ dbConn :: Connection,
wreqOpts :: Wreq.Options
wreqOpts :: Wreq.Options,
logEnv :: LogEnv
}
-- * Parsing
@ -187,7 +196,7 @@ botApp env =
BotApp
{ botInitialModel = (),
botAction = action,
botHandler = handler,
botHandler = handler env,
botJobs = [scrapeJob env]
}
@ -199,10 +208,10 @@ 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 :: Env -> BotJob Model Action
scrapeJob env =
@ -214,21 +223,24 @@ scrapeJob env =
scrapeJobTask :: Env -> Model -> Eff Action Model
scrapeJobTask env m =
m <# do
liftIO $ putStrLn "Starting scrape job"
info env "scrapeJobTask" "Starting scrape job"
res <- liftIO $ queryIBW env.wreqOpts
let offers = fromJust $ scrapeStringLike res.searchresults scrapeOffers
liftIO $ putStrLn "Fetched offers"
info env "scrapeJobTask" "Fetched offers"
mapM_
( \offer -> do
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
@ -241,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))

View File

@ -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

View File

@ -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";