{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} module Network.Reddit where import Control.Lens import Data.Aeson (FromJSON, ToJSON, Value) import Data.Aeson.Lens import Data.Config import Data.SubReddit import Data.Text (Text) import Network.Wreq hiding (getWith) import Network.Wreq.Session (Session, getWith) import Pipes (Producer, (>->), for, runEffect) import qualified Pipes.Prelude as P import Reddit.Publish import Data.Maybe (maybeToList) import Control.Monad.Trans (liftIO) import Database.SQLite.Simple.ToField (ToField) import Database.SQLite.Simple.FromField (FromField) newtype RedditId = RedditId Text deriving stock (Show, Eq) deriving (ToJSON, FromJSON, ToField, FromField) via Text messages :: Session -> SubReddit -> Producer Value IO () messages sess sre = P.unfoldr go Nothing >-> P.concat where go :: Maybe Text -> IO (Either () ([Value], Maybe Text)) go after = do let opts = defaults & header "User-Agent" .~ ["reddit-pubsub"] & param "after" .~ maybeToList after r <- getWith opts sess ("https://www.reddit.com/r/" <> getSubReddit sre <> ".json") let msgs = r ^.. responseBody . key "data" . key "children" . _Array . traversed . key "data" next = r ^? responseBody . key "data" . key "after" . _String print next pure $ Right (msgs, next) publishEntries :: Publish IO Value -> Session -> Fetcher -> IO () publishEntries publisher sess fetcher = runEffect $ for (messages sess (fetcher ^. subreddit) >-> P.take (fromIntegral $ fetcher ^. entries)) (liftIO . publish publisher)