47 lines
1.6 KiB
Haskell
47 lines
1.6 KiB
Haskell
{-# 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)
|