diff --git a/berlin-scraper/app/Main.hs b/berlin-scraper/app/Main.hs index c98f733..39a1018 100644 --- a/berlin-scraper/app/Main.hs +++ b/berlin-scraper/app/Main.hs @@ -15,6 +15,7 @@ import Data.Aeson hiding (Options) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as LBS import Data.Maybe (fromJust, fromMaybe, listToMaybe) +import Data.String (IsString (..)) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Database.SQLite.Simple @@ -31,7 +32,6 @@ 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 @@ -92,8 +92,11 @@ data Env = Env -- * Parsing -queryIBW :: Wreq.Options -> IO IBWResponse -queryIBW wreqOpts = do +queryIBW :: Wreq.Options -> WBS -> IO IBWResponse +queryIBW wreqOpts wbs = do + let wbsParam = case wbs of + WBS -> "all" + NoWBS -> "0" let reqBody = [ partText "q" "wf-save-srch", partText "save" "false", @@ -112,7 +115,7 @@ queryIBW wreqOpts = do partText "etagen_dg" "false", partText "balkon_loggia_terrasse" "false", partText "garten" "false", - partText "wbs" "all", + partText "wbs" wbsParam, partText "barrierefrei" "false", partText "gaeste_wc" "false", partText "aufzug" "false", @@ -164,23 +167,30 @@ readEuropeanNumber x = do -- * SQLite -insertOffer :: Connection -> Offer -> IO () -insertOffer conn = - execute conn "INSERT INTO offers (id, title, address, rooms, area, availableFrom, link) VALUES (?, ?, ?, ?, ?, ?, ?)" +data WBS = WBS | NoWBS -getOffer :: Connection -> Text -> IO (Maybe Offer) -getOffer conn offerId = - listToMaybe <$> query conn "SELECT * from offers where id = ?" (Only offerId) +tableName :: WBS -> Text +tableName WBS = "offers" +tableName NoWBS = "offers_without_wbs" + +insertOffer :: Connection -> WBS -> Offer -> IO () +insertOffer conn wbs = + execute conn $ "INSERT INTO " <> Query (tableName wbs) <> " (id, title, address, rooms, area, availableFrom, link) VALUES (?, ?, ?, ?, ?, ?, ?)" + +getOffer :: Connection -> WBS -> Text -> IO (Maybe Offer) +getOffer conn wbs offerId = + listToMaybe <$> query conn ("SELECT * from " <> Query (tableName wbs) <> " where id = ?") (Only offerId) createTable :: Connection -> IO () -createTable conn = +createTable conn = do execute_ conn "CREATE TABLE IF NOT EXISTS offers (id TEXT PRIMARY KEY, title TEXT, address TEXT, rooms REAL, area REAL, availableFrom TEXT, link TEXT)" + execute_ conn "CREATE TABLE IF NOT EXISTS offers_without_wbs (id TEXT PRIMARY KEY, title TEXT, address TEXT, rooms REAL, area REAL, availableFrom TEXT, link TEXT)" -saveOffer :: Connection -> Offer -> IO Bool -saveOffer conn offer = do - getOffer conn offer.id_ >>= \case +saveOffer :: Connection -> WBS -> Offer -> IO Bool +saveOffer conn wbs offer = do + getOffer conn wbs offer.id_ >>= \case Nothing -> do - insertOffer conn offer + insertOffer conn wbs offer pure True _ -> pure False @@ -217,30 +227,32 @@ scrapeJob :: Env -> BotJob Model Action scrapeJob env = BotJob { botJobSchedule = "* * * * *", - botJobTask = scrapeJobTask env + botJobTask = \m -> do + scrapeJobTask env m WBS + scrapeJobTask env m NoWBS } -scrapeJobTask :: Env -> Model -> Eff Action Model -scrapeJobTask env m = +scrapeJobTask :: Env -> Model -> WBS -> Eff Action Model +scrapeJobTask env m wbs = m <# do info env "scrapeJobTask" "Starting scrape job" - res <- liftIO $ queryIBW env.wreqOpts + 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 offer + isNewOffer <- liftIO $ saveOffer env.dbConn wbs offer when isNewOffer $ do info env "scrapeJobTask" "Found a new offer" - notify env offer + notify env wbs offer ) offers -info :: MonadIO m => Env -> Namespace -> LogStr -> m () +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 +notify :: Env -> WBS -> Offer -> BotM () +notify env wbs offer = do let offerTitle = "" <> offer.title <> "" offerAddress = "Address: " <> fromMaybe "N/A" offer.address offerRooms = "Rooms: " <> maybe "N/A" (Text.pack . show) offer.rooms @@ -251,10 +263,17 @@ notify env offer = do -- sendMsgReq1 = (defSendMessage (SomeChatId $ ChatId 952512153) offerText) {sendMessageParseMode = Just HTML} -- sendMsgReq2 = (defSendMessage (SomeChatId $ ChatId 116981707) offerText) {sendMessageParseMode = Just HTML} sendMsgReq3 = (defSendMessage (SomeChatId $ ChatId 5781922807) offerText) {sendMessageParseMode = Just HTML} - res3 <- runTG sendMsgReq3 - liftIO $ - if res3.responseOk - then info env "notify" "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 res3)) + sendMsgReq4 = (defSendMessage (SomeChatId $ ChatId 7008484163) offerText) {sendMessageParseMode = Just HTML} + msgReq = case wbs of + WBS -> sendMsgReq3 + NoWBS -> sendMsgReq4 + sendMessageWithLogs env offer msgReq + +sendMessageWithLogs :: Env -> Offer -> SendMessageRequest -> BotM () +sendMessageWithLogs env offer sendMsgReq = do + res <- runTG sendMsgReq + if res.responseOk + then info env "notify" "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))