heddit-0.0.2: examples/Streaming.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLabels #-}

-- | This example will show how to use the 'stream' action to get an infinite
-- stream of new 'Paginable' things. In this example, we will stream new
-- submissions, filter them based on some criteria, and print out some information
-- about them. In a real program, instead of simply printing information, we could
-- take some 'MonadReddit' action instead, such as replying to them
--
-- Running this example will produce the following type of output (truncated for
-- readability here):
--
-- > On 2021-07-18 07:32:21 UTC u/Pututu_Life posted "What is your go to comfort ..
-- > On 2021-07-18 07:32:29 UTC u/Kenney93 posted "What do you do when you are ...
-- > On 2021-07-18 07:32:45 UTC u/CYS801 posted "What is your proudest ...
-- > On 2021-07-18 07:32:53 UTC u/Ambitious-Ad8598 posted "What is the name of ...
-- > On 2021-07-18 07:33:08 UTC u/Additional_Quantity5 posted "What is your ...
--
module Streaming where

import           Conduit

import           Data.Generics.Labels  ()
import           Data.Generics.Wrapped
import           Data.Text             ( Text )
import qualified Data.Text             as T
import qualified Data.Text.IO          as T

import           Lens.Micro.Platform

import           Network.Reddit

main :: IO ()
main = loadClient Nothing >>= (`runReddit` streamed)
  where
    -- We can use r/askreddit, which has a fairly high and steady
    -- volume of new submissions being posted
    streamed = streamSubmissions =<< mkSubredditName "askreddit"

-- | Run the stream until interrupted
streamSubmissions :: MonadReddit m => SubredditName -> m ()
streamSubmissions subname = runConduit
    $ stream (Just True) -- This will discard elements that were
                         -- already "in" the stream before starting,
                         -- so we only get actually new submissions
             action
    .| filterC isAskingWhat
    .| submissionInfo
    .| mapM_C (liftIO . T.putStrLn) -- This will look nicer than
                                    -- @printC@
  where
    action = getNewSubmissions subname

-- | A silly heuristic to detect questions asking "what ... ?". Of course
-- this will miss questions using the popular format "...s of Reddit,
-- what...?", but r/askreddit is high-volume enough that it will still
-- catch a lot of submissions
isAskingWhat :: Submission -> Bool
isAskingWhat s = case s ^? #title . to (T.words . T.toLower) . _head of
    Just "what" -> True
    _           -> False

-- | Print some information about the submission
submissionInfo :: Monad m => ConduitT Submission Text m ()
submissionInfo = awaitForever $ \s -> yield
    $ mconcat [ "On "
              , s ^. #created . to show . packed
              , " u/"
              , s ^. #author & wrappedTo
              , " posted "
              , "\""
              , s ^. #title
              , "\""
              ]