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

Open connection with sqlite only once

Browse source
This commit is contained in:
Akshay Mankar 2023-11-14 13:43:19 +01:00
parent 8ad2c5bcdc
commit 1978758c07
Signed by: axeman
GPG key ID: CA08F3AB62369B89
1 changed files with 21 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -21,6 +21,7 @@ import Database.SQLite.Simple
import GHC.Generics import GHC.Generics
import Network.HTTP.Client.OpenSSL import Network.HTTP.Client.OpenSSL
import Network.Wreq hiding (Options) import Network.Wreq hiding (Options)
import Network.Wreq qualified as Wreq
import Options.Generic import Options.Generic
import Servant.Client (mkClientEnv) import Servant.Client (mkClientEnv)
import System.Exit (exitFailure) import System.Exit (exitFailure)
@ -28,16 +29,18 @@ import Telegram.Bot.API
import Telegram.Bot.Simple import Telegram.Bot.Simple
import Telegram.Bot.Simple.Debug import Telegram.Bot.Simple.Debug
import Text.HTML.Scalpel import Text.HTML.Scalpel
import qualified Network.Wreq as Wreq
main :: IO () main :: IO ()
main = withOpenSSL $ do main = withOpenSSL $ do
opts <- unwrapRecord "Berlin Scrapper" opts :: Options Unwrapped <- unwrapRecord "Berlin Scrapper"
token <- getEnvToken "TELEGRAM_BOT_TOKEN" token <- getEnvToken "TELEGRAM_BOT_TOKEN"
httpMgr <- newOpenSSLManager httpMgr <- newOpenSSLManager
dbConn <- open opts.dbFile
createTable dbConn
let clientEnv = mkClientEnv httpMgr (botBaseUrl token) let clientEnv = mkClientEnv httpMgr (botBaseUrl token)
wreqOpts = Wreq.defaults & Wreq.manager .~ Right httpMgr wreqOpts = Wreq.defaults & Wreq.manager .~ Right httpMgr
startBot (traceBotDefault $ botApp opts wreqOpts) clientEnv >>= \case env = Env {..}
startBot (traceBotDefault $ botApp env) clientEnv >>= \case
Left err -> do Left err -> do
putStrLn $ "Bot failed with: " <> show err putStrLn $ "Bot failed with: " <> show err
exitFailure exitFailure
@ -73,6 +76,11 @@ data IBWResponse = IBWResponse
instance FromJSON IBWResponse instance FromJSON IBWResponse
data Env = Env
{ dbConn :: Connection,
wreqOpts :: Wreq.Options
}
-- * Parsing -- * Parsing
queryIBW :: Wreq.Options -> IO IBWResponse queryIBW :: Wreq.Options -> IO IBWResponse
@ -174,13 +182,13 @@ type Model = ()
newtype Action = StartChat Chat newtype Action = StartChat Chat
deriving (Show) deriving (Show)
botApp :: Options Unwrapped -> Wreq.Options -> BotApp Model Action botApp :: Env -> BotApp Model Action
botApp opts wreqOpts = botApp env =
BotApp BotApp
{ botInitialModel = (), { botInitialModel = (),
botAction = action, botAction = action,
botHandler = handler, botHandler = handler,
botJobs = [scrapeJob opts wreqOpts] botJobs = [scrapeJob env]
} }
action :: Update -> Model -> Maybe Action action :: Update -> Model -> Maybe Action
@ -196,25 +204,23 @@ handler (StartChat chat) model =
model <# do model <# do
liftIO $ putStrLn $ "Chat started! " <> ppAsJSON chat liftIO $ putStrLn $ "Chat started! " <> ppAsJSON chat
scrapeJob :: Options Unwrapped -> Wreq.Options -> BotJob Model Action scrapeJob :: Env -> BotJob Model Action
scrapeJob opts wreqOpts = scrapeJob env =
BotJob BotJob
{ botJobSchedule = "* * * * *", { botJobSchedule = "* * * * *",
botJobTask = scrapeJobTask opts wreqOpts botJobTask = scrapeJobTask env
} }
scrapeJobTask :: Options Unwrapped -> Wreq.Options -> Model -> Eff Action Model scrapeJobTask :: Env -> Model -> Eff Action Model
scrapeJobTask opts wreqOpts m = scrapeJobTask env m =
m <# do m <# do
liftIO $ putStrLn "Starting scrape job" liftIO $ putStrLn "Starting scrape job"
res <- liftIO $ queryIBW wreqOpts res <- liftIO $ queryIBW env.wreqOpts
let offers = fromJust $ scrapeStringLike res.searchresults scrapeOffers let offers = fromJust $ scrapeStringLike res.searchresults scrapeOffers
liftIO $ putStrLn "Fetched offers" liftIO $ putStrLn "Fetched offers"
conn <- liftIO $ open (dbFile opts)
liftIO $ createTable conn
mapM_ mapM_
( \offer -> do ( \offer -> do
isNewOffer <- liftIO $ saveOffer conn offer isNewOffer <- liftIO $ saveOffer env.dbConn offer
when isNewOffer $ do when isNewOffer $ do
liftIO $ putStrLn "Found a new offer" liftIO $ putStrLn "Found a new offer"
notify offer notify offer