Use a logger
This commit is contained in:
parent
1978758c07
commit
8ef9b1c24e
|
@ -7,6 +7,7 @@
|
|||
|
||||
module Main where
|
||||
|
||||
import Control.Exception
|
||||
import Control.Lens (view, (&), (.~))
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.IO.Class
|
||||
|
@ -16,19 +17,21 @@ import Data.ByteString.Lazy qualified as LBS
|
|||
import Data.Maybe (fromJust, fromMaybe, listToMaybe)
|
||||
import Data.Text qualified as Text
|
||||
import Data.Text.Encoding qualified as Text
|
||||
import Data.Text.IO qualified as Text
|
||||
import Database.SQLite.Simple
|
||||
import GHC.Generics
|
||||
import Katip
|
||||
import Network.HTTP.Client.OpenSSL
|
||||
import Network.Wreq hiding (Options)
|
||||
import Network.Wreq qualified as Wreq
|
||||
import Options.Generic
|
||||
import Servant.Client (mkClientEnv)
|
||||
import System.Exit (exitFailure)
|
||||
import System.IO
|
||||
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
|
||||
|
@ -37,14 +40,19 @@ main = withOpenSSL $ do
|
|||
httpMgr <- newOpenSSLManager
|
||||
dbConn <- open opts.dbFile
|
||||
createTable dbConn
|
||||
let clientEnv = mkClientEnv httpMgr (botBaseUrl token)
|
||||
wreqOpts = Wreq.defaults & Wreq.manager .~ Right httpMgr
|
||||
env = Env {..}
|
||||
startBot (traceBotDefault $ botApp env) clientEnv >>= \case
|
||||
Left err -> do
|
||||
putStrLn $ "Bot failed with: " <> show err
|
||||
exitFailure
|
||||
_ -> pure ()
|
||||
|
||||
handleScribe <- mkHandleScribe ColorIfTerminal stdout (permitItem InfoS) V2
|
||||
let makeLogEnv = registerScribe "stdout" handleScribe defaultScribeSettings =<< initLogEnv "MyApp" "production"
|
||||
bracket makeLogEnv closeScribes $ \logEnv -> do
|
||||
let clientEnv = mkClientEnv httpMgr (botBaseUrl token)
|
||||
wreqOpts = Wreq.defaults & Wreq.manager .~ Right httpMgr
|
||||
env = Env {..}
|
||||
liftIO $
|
||||
startBot (traceBotDefault $ botApp env) clientEnv >>= \case
|
||||
Left err -> do
|
||||
info env "main" $ "Bot failed with: " <> fromString (show err)
|
||||
exitFailure
|
||||
_ -> pure ()
|
||||
|
||||
-- * Types
|
||||
|
||||
|
@ -78,7 +86,8 @@ instance FromJSON IBWResponse
|
|||
|
||||
data Env = Env
|
||||
{ dbConn :: Connection,
|
||||
wreqOpts :: Wreq.Options
|
||||
wreqOpts :: Wreq.Options,
|
||||
logEnv :: LogEnv
|
||||
}
|
||||
|
||||
-- * Parsing
|
||||
|
@ -187,7 +196,7 @@ botApp env =
|
|||
BotApp
|
||||
{ botInitialModel = (),
|
||||
botAction = action,
|
||||
botHandler = handler,
|
||||
botHandler = handler env,
|
||||
botJobs = [scrapeJob env]
|
||||
}
|
||||
|
||||
|
@ -199,10 +208,10 @@ action update _ = do
|
|||
then pure $ StartChat msg.messageChat
|
||||
else Nothing
|
||||
|
||||
handler :: Action -> Model -> Eff Action Model
|
||||
handler (StartChat chat) model =
|
||||
handler :: Env -> Action -> Model -> Eff Action Model
|
||||
handler env (StartChat chat) model =
|
||||
model <# do
|
||||
liftIO $ putStrLn $ "Chat started! " <> ppAsJSON chat
|
||||
info env "telegram.handler" $ "Chat started! " <> fromString (ppAsJSON chat)
|
||||
|
||||
scrapeJob :: Env -> BotJob Model Action
|
||||
scrapeJob env =
|
||||
|
@ -214,21 +223,24 @@ scrapeJob env =
|
|||
scrapeJobTask :: Env -> Model -> Eff Action Model
|
||||
scrapeJobTask env m =
|
||||
m <# do
|
||||
liftIO $ putStrLn "Starting scrape job"
|
||||
info env "scrapeJobTask" "Starting scrape job"
|
||||
res <- liftIO $ queryIBW env.wreqOpts
|
||||
let offers = fromJust $ scrapeStringLike res.searchresults scrapeOffers
|
||||
liftIO $ putStrLn "Fetched offers"
|
||||
info env "scrapeJobTask" "Fetched offers"
|
||||
mapM_
|
||||
( \offer -> do
|
||||
isNewOffer <- liftIO $ saveOffer env.dbConn offer
|
||||
when isNewOffer $ do
|
||||
liftIO $ putStrLn "Found a new offer"
|
||||
notify offer
|
||||
info env "scrapeJobTask" "Found a new offer"
|
||||
notify env offer
|
||||
)
|
||||
offers
|
||||
|
||||
notify :: Offer -> BotM ()
|
||||
notify offer = do
|
||||
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
|
||||
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
|
||||
|
@ -241,14 +253,14 @@ notify offer = do
|
|||
res1 <- runTG sendMsgReq1
|
||||
liftIO $
|
||||
if res1.responseOk
|
||||
then putStrLn "Notified successfully"
|
||||
then info env "notify" "Notified successfully"
|
||||
else do
|
||||
putStrLn $ "Failed to notify the offer: " <> show offer
|
||||
Text.putStrLn $ "Response: " <> Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res1)
|
||||
info env "notify" $ "Failed to notify the offer: " <> fromString (show offer)
|
||||
info env "notify" $ "Response: " <> fromString (Text.unpack $ Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res1))
|
||||
res2 <- runTG sendMsgReq2
|
||||
liftIO $
|
||||
if res2.responseOk
|
||||
then putStrLn "Notified successfully"
|
||||
then info env "notify" "Notified successfully"
|
||||
else do
|
||||
putStrLn $ "Failed to notify the offer: " <> show offer
|
||||
Text.putStrLn $ "Response: " <> Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res2)
|
||||
info env "notify" $ "Failed to notify the offer: " <> fromString (show offer)
|
||||
info env "notify" $ "Response: " <> fromString (Text.unpack $ Text.decodeUtf8 (LBS.toStrict $ Aeson.encode res2))
|
||||
|
|
|
@ -28,6 +28,7 @@ executable berlin-scraper
|
|||
, servant-client
|
||||
, http-client-openssl
|
||||
, bytestring
|
||||
, katip
|
||||
hs-source-dirs: app
|
||||
default-language: GHC2021
|
||||
ghc-options: -threaded -with-rtsopts=-N
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
{ mkDerivation, aeson, base, bytestring, http-client-openssl, lens
|
||||
, lib, optparse-generic, scalpel, servant-client, sqlite-simple
|
||||
, telegram-bot-api, telegram-bot-simple, text, wreq
|
||||
{ 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
|
||||
}:
|
||||
mkDerivation {
|
||||
pname = "berlin-scraper";
|
||||
|
@ -9,9 +9,9 @@ mkDerivation {
|
|||
isLibrary = false;
|
||||
isExecutable = true;
|
||||
executableHaskellDepends = [
|
||||
aeson base bytestring http-client-openssl lens optparse-generic
|
||||
scalpel servant-client sqlite-simple telegram-bot-api
|
||||
telegram-bot-simple text wreq
|
||||
aeson base bytestring http-client-openssl katip lens
|
||||
optparse-generic scalpel servant-client sqlite-simple
|
||||
telegram-bot-api telegram-bot-simple text wreq
|
||||
];
|
||||
license = lib.licenses.agpl3Plus;
|
||||
mainProgram = "berlin-scraper";
|
||||
|
|
Loading…
Reference in a new issue