reddit-pub/reddit_pub/src/Network/Reddit.hs

{-# 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)