diff --git a/berlin-scraper/app/Main.hs b/berlin-scraper/app/Main.hs index 39a1018..6ee06dc 100644 --- a/berlin-scraper/app/Main.hs +++ b/berlin-scraper/app/Main.hs @@ -11,6 +11,7 @@ import Control.Exception import Control.Lens (view, (&), (.~)) import Control.Monad (when) import Control.Monad.IO.Class +import Control.Monad.Trans.Class (lift) import Data.Aeson hiding (Options) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as LBS @@ -50,7 +51,7 @@ main = withOpenSSL $ do liftIO $ startBot (traceBotDefault $ botApp env) clientEnv >>= \case Left err -> do - info env "main" $ "Bot failed with: " <> fromString (show err) + runKatipContextT env.logEnv () "main" $ info $ "Bot failed with: " <> fromString (show err) exitFailure _ -> pure () @@ -221,7 +222,7 @@ action update _ = do handler :: Env -> Action -> Model -> Eff Action Model handler env (StartChat chat) model = model <# do - info env "telegram.handler" $ "Chat started! " <> fromString (ppAsJSON chat) + runKatipContextT env.logEnv () "telegram.handler" $ info $ "Chat started! " <> fromString (ppAsJSON chat) scrapeJob :: Env -> BotJob Model Action scrapeJob env = @@ -232,27 +233,37 @@ scrapeJob env = scrapeJobTask env m NoWBS } +wbsText :: WBS -> Text +wbsText WBS = "WBS" +wbsText NoWBS = "NoWBS" + scrapeJobTask :: Env -> Model -> WBS -> Eff Action Model scrapeJobTask env m wbs = - m <# do - info env "scrapeJobTask" "Starting scrape job" - res <- liftIO $ queryIBW env.wreqOpts wbs - let offers = fromJust $ scrapeStringLike res.searchresults scrapeOffers - info env "scrapeJobTask" "Fetched offers" - mapM_ - ( \offer -> do - isNewOffer <- liftIO $ saveOffer env.dbConn wbs offer - when isNewOffer $ do - info env "scrapeJobTask" "Found a new offer" - notify env wbs offer + m + <# runKatipContextT + env.logEnv + (sl "wbs" (wbsText wbs)) + "scrapeJobTask" + ( do + info "Starting scrape job" + res <- liftIO $ queryIBW env.wreqOpts wbs + let offers = fromJust $ scrapeStringLike res.searchresults scrapeOffers + info "Fetched offers" + mapM_ + ( \offer -> do + isNewOffer <- liftIO $ saveOffer env.dbConn wbs offer + when isNewOffer $ do + info "Found a new offer" + katipAddNamespace "notify" $ notify wbs offer + ) + offers ) - offers -info :: (MonadIO m) => Env -> Namespace -> LogStr -> m () -info env ns l = liftIO $ runKatipT env.logEnv $ logMsg ns InfoS l +info :: (Katip m) => LogStr -> m () +info = logMsg mempty InfoS -notify :: Env -> WBS -> Offer -> BotM () -notify env wbs offer = do +notify :: WBS -> Offer -> KatipContextT BotM () +notify wbs offer = do let offerTitle = "" <> offer.title <> "" offerAddress = "Address: " <> fromMaybe "N/A" offer.address offerRooms = "Rooms: " <> maybe "N/A" (Text.pack . show) offer.rooms @@ -267,13 +278,13 @@ notify env wbs offer = do msgReq = case wbs of WBS -> sendMsgReq3 NoWBS -> sendMsgReq4 - sendMessageWithLogs env offer msgReq + sendMessageWithLogs offer msgReq -sendMessageWithLogs :: Env -> Offer -> SendMessageRequest -> BotM () -sendMessageWithLogs env offer sendMsgReq = do - res <- runTG sendMsgReq +sendMessageWithLogs :: Offer -> SendMessageRequest -> KatipContextT BotM () +sendMessageWithLogs offer sendMsgReq = do + res <- lift $ runTG sendMsgReq if res.responseOk - then info env "notify" "Notified successfully" + then info "Notified successfully" else do - info env "notify" $ "Failed to notify the offer: " <> fromString (show offer) - info env "notify" $ "Response: " <> fromString (Text.unpack $ Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res)) + info $ "Failed to notify the offer: " <> fromString (show offer) + info $ "Response: " <> fromString (Text.unpack $ Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res)) diff --git a/berlin-scraper/berlin-scraper.cabal b/berlin-scraper/berlin-scraper.cabal index d7e0dd7..553b2d1 100644 --- a/berlin-scraper/berlin-scraper.cabal +++ b/berlin-scraper/berlin-scraper.cabal @@ -29,6 +29,7 @@ executable berlin-scraper , http-client-openssl , bytestring , katip + , transformers hs-source-dirs: app default-language: GHC2021 ghc-options: -threaded -with-rtsopts=-N diff --git a/berlin-scraper/default.nix b/berlin-scraper/default.nix index 58fc72b..7096dae 100644 --- a/berlin-scraper/default.nix +++ b/berlin-scraper/default.nix @@ -1,6 +1,7 @@ { 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 +, sqlite-simple, telegram-bot-api, telegram-bot-simple, text +, transformers, wreq }: mkDerivation { pname = "berlin-scraper"; @@ -11,7 +12,7 @@ mkDerivation { executableHaskellDepends = [ aeson base bytestring http-client-openssl katip lens optparse-generic scalpel servant-client sqlite-simple - telegram-bot-api telegram-bot-simple text wreq + telegram-bot-api telegram-bot-simple text transformers wreq ]; license = lib.licenses.agpl3Plus; mainProgram = "berlin-scraper";