axeman/wohnugs-suche
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Service WBS and Non-WBS people at once

Browse source
This commit is contained in:
Akshay Mankar 2024-04-22 22:49:10 +02:00
parent 58a53fa76b
commit f76db8b36a
Signed by: axeman
GPG key ID: CA08F3AB62369B89
1 changed files with 50 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

81
berlin-scraper/app/Main.hs
View file

@ -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 = "<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
@ -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))