MasseR/reddit-pub
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Run forever

Browse Source
This commit is contained in:
Mats Rauhala 2022-04-20 20:29:04 +03:00
parent 9002d3424c
commit 21013d7e40
1 changed files with 18 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/MyLib.hs
View File

@ -2,20 +2,25 @@
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-} {-# LANGUAGE DerivingVia #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module MyLib (defaultMain) where module MyLib (defaultMain) where
import Control.Concurrent (threadDelay)
import Control.Exception (bracket) import Control.Exception (bracket)
import Control.Lens import Control.Lens
import Control.Monad (void) import Control.Monad (forever, void)
import Data.Aeson (FromJSON, ToJSON, Value) import Data.Aeson (FromJSON, ToJSON, Value)
import qualified Data.Aeson as A import qualified Data.Aeson as A
import Data.Aeson.Lens (_String, key)
import Data.Bool (bool)
import Data.Config import Data.Config
import Data.Deriving.Aeson import Data.Deriving.Aeson
import Data.Foldable (for_) import Data.Foldable (for_)
import Data.Functor.Contravariant ((>$<)) import Data.Functor.Contravariant ((>$<))
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text.IO as TI
import qualified Data.Text.Strict.Lens as T import qualified Data.Text.Strict.Lens as T
import qualified Database.SQLite.Simple as SQL import qualified Database.SQLite.Simple as SQL
import GHC.Generics (Generic) import GHC.Generics (Generic)
@ -23,19 +28,21 @@ import qualified Membership
import Network.AMQP import Network.AMQP
( Channel ( Channel
, DeliveryMode(Persistent) , DeliveryMode(Persistent)
, closeConnection
, declareExchange
, exchangeName , exchangeName
, exchangeType , exchangeType
, msgBody , msgBody
, msgDeliveryMode , msgDeliveryMode
, newExchange
, newMsg , newMsg
, publishMsg, openConnection, closeConnection, openChannel, newExchange, declareExchange , openChannel
, openConnection
, publishMsg
) )
import Network.Reddit (RedditId (RedditId), publishEntries) import Network.Reddit (RedditId(RedditId), publishEntries)
import Network.Wreq.Session (newSession) import Network.Wreq.Session (newSession)
import Publish (Publish(..)) import Publish (Publish(..))
import Data.Aeson.Lens (key, _String)
import Data.Bool (bool)
import qualified Data.Text.IO as TI
data MessageType = Create | Update data MessageType = Create | Update
deriving stock (Show, Eq, Generic) deriving stock (Show, Eq, Generic)
@ -86,9 +93,11 @@ defaultMain path = do
let encoder = amqpPublisher sqlConn chan "reddit_posts" let encoder = amqpPublisher sqlConn chan "reddit_posts"
recorder = sqlRecorder sqlConn recorder = sqlRecorder sqlConn
publisher = encoder <> (messageIdentifier >$< recorder) publisher = encoder <> (messageIdentifier >$< recorder)
for_ (conf ^. fetchers) $ \fetcher -> do forever $ do
print fetcher for_ (conf ^. fetchers) $ \fetcher -> do
publishEntries (toMessage >$< publisher) sess fetcher print fetcher
publishEntries (toMessage >$< publisher) sess fetcher
threadDelay (15 * 60_000_000)
getPassword :: Password -> IO Text getPassword :: Password -> IO Text
getPassword (Password p) = pure p getPassword (Password p) = pure p