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