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