{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module      : Network.Reddit.Comment
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Comment
    (  -- * Reading comments
      getComments
    , getComment
    , withReplies
    , loadMoreComments
    , loadMoreCommentsDef
    , unsaveComment
    , saveComment
      -- * Creating, editing, and deleting
    , deleteComment
    , editComment
    , replyToComment
    , getNewComments
    , setCommentReplies
      -- * Voting
      -- $vote
    , upvoteComment
    , downvoteComment
    , unvoteComment
    , reportComment
      -- * Types
    , module M
    ) where

import           Control.Monad.Catch             ( MonadThrow(throwM) )

import           Data.Generics.Wrapped           ( wrappedTo )
import           Data.Sequence                   ( Seq((:<|)) )
import qualified Data.Sequence                   as Seq

import           Lens.Micro

import           Network.Reddit.Internal
import           Network.Reddit.Item
import           Network.Reddit.Types
import           Network.Reddit.Types.Comment
import           Network.Reddit.Types.Comment    as M
                 ( ChildComment(..)
                 , Comment(Comment)
                 , CommentID(CommentID)
                 , MoreComments(MoreComments)
                 )
import           Network.Reddit.Types.Submission
import           Network.Reddit.Types.Subreddit
import           Network.Reddit.Utils

import           Web.FormUrlEncoded              ( ToForm(toForm) )
import           Web.HttpApiData                 ( ToHttpApiData(toQueryParam)
                                                 )

-- | Get the 'Comment's corresponding to a container of 'CommentID's
getComments :: (MonadReddit m, Foldable t)
            => ItemOpts Comment
            -> t CommentID
            -> m (Seq Comment)
getComments :: ItemOpts Comment -> t CommentID -> m (Seq Comment)
getComments = ItemOpts Comment -> t CommentID -> m (Seq Comment)
forall a b (t :: * -> *) (m :: * -> *).
(MonadReddit m, Foldable t, Thing b, FromJSON a, FromJSON b) =>
ItemOpts a -> t b -> m (Seq a)
getMany

-- | Get information on a single 'CommentID'. Throws an exception if no such
-- 'Comment' exists
getComment :: MonadReddit m => CommentID -> m Comment
getComment :: CommentID -> m Comment
getComment CommentID
cid = ItemOpts Comment -> [CommentID] -> m (Seq Comment)
forall (m :: * -> *) (t :: * -> *).
(MonadReddit m, Foldable t) =>
ItemOpts Comment -> t CommentID -> m (Seq Comment)
getComments ItemOpts Comment
forall a. ItemOpts a
defaultItemOpts [ CommentID
cid ] m (Seq Comment) -> (Seq Comment -> m Comment) -> m Comment
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Comment
comment :<| Seq Comment
_ -> Comment -> m Comment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
comment
    Seq Comment
_             -> ClientException -> m Comment
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> m Comment) -> ClientException -> m Comment
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
InvalidResponse Text
"getComment: No results"

-- | Get new 'Comment's, either for the site as a whole or for a single subreddit,
-- given its 'SubredditName'
getNewComments :: MonadReddit m
               => Maybe SubredditName
               -> Paginator CommentID Comment
               -> m (Listing CommentID Comment)
getNewComments :: Maybe SubredditName
-> Paginator CommentID Comment -> m (Listing CommentID Comment)
getNewComments Maybe SubredditName
sname Paginator CommentID Comment
paginator =
    APIAction (Listing CommentID Comment)
-> m (Listing CommentID Comment)
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction APIAction Any
forall a. APIAction a
defaultAPIAction
              { $sel:requestData:APIAction :: WithData
requestData  = Paginator CommentID Comment -> WithData
forall t a. (Thing t, Paginable a) => Paginator t a -> WithData
paginatorToFormData Paginator CommentID Comment
paginator
              , $sel:pathSegments:APIAction :: [Text]
pathSegments = [ Text
"comments" ]
                    [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& ([Text] -> [Text])
-> (SubredditName -> [Text] -> [Text])
-> Maybe SubredditName
-> [Text]
-> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text] -> [Text]
forall a. a -> a
id (\SubredditName
s -> [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
(<>) [ Text
"r", SubredditName -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam SubredditName
s ]) Maybe SubredditName
sname
              }

-- | Update a 'Comment' to include its 'ChildComment's, returning the updated
-- 'Comment'. This will probably be necessary if the original 'Comment' was obtained
-- by getting a 'Username'\'s or 'Subreddit'\'s comments, etc...
withReplies :: MonadReddit m => ItemOpts a -> Comment -> m Comment
withReplies :: ItemOpts a -> Comment -> m Comment
withReplies ItemOpts { Maybe Word
Maybe Time
Maybe ItemType
Maybe ItemSort
$sel:context:ItemOpts :: forall a. ItemOpts a -> Maybe Word
$sel:itemTime:ItemOpts :: forall a. ItemOpts a -> Maybe Time
$sel:itemType:ItemOpts :: forall a. ItemOpts a -> Maybe ItemType
$sel:itemSort:ItemOpts :: forall a. ItemOpts a -> Maybe ItemSort
context :: Maybe Word
itemTime :: Maybe Time
itemType :: Maybe ItemType
itemSort :: Maybe ItemSort
.. } Comment { Bool
Int
Maybe Bool
Maybe Integer
Maybe Text
Maybe UTCTime
Maybe Distinction
Maybe Username
Text
UTCTime
Seq ItemReport
Seq ChildComment
SubredditID
SubredditName
Username
SubmissionID
CommentID
$sel:stickied:Comment :: Comment -> Bool
$sel:isSubmitter:Comment :: Comment -> Bool
$sel:distinguished:Comment :: Comment -> Maybe Distinction
$sel:numReports:Comment :: Comment -> Maybe Integer
$sel:modReports:Comment :: Comment -> Seq ItemReport
$sel:userReports:Comment :: Comment -> Seq ItemReport
$sel:permaLink:Comment :: Comment -> Text
$sel:linkAuthor:Comment :: Comment -> Maybe Username
$sel:linkURL:Comment :: Comment -> Maybe Text
$sel:linkID:Comment :: Comment -> SubmissionID
$sel:scoreHidden:Comment :: Comment -> Maybe Bool
$sel:gilded:Comment :: Comment -> Int
$sel:subredditID:Comment :: Comment -> SubredditID
$sel:subreddit:Comment :: Comment -> SubredditName
$sel:edited:Comment :: Comment -> Maybe UTCTime
$sel:created:Comment :: Comment -> UTCTime
$sel:downs:Comment :: Comment -> Maybe Integer
$sel:ups:Comment :: Comment -> Maybe Integer
$sel:score:Comment :: Comment -> Maybe Integer
$sel:replies:Comment :: Comment -> Seq ChildComment
$sel:bodyHTML:Comment :: Comment -> Text
$sel:body:Comment :: Comment -> Text
$sel:author:Comment :: Comment -> Username
$sel:commentID:Comment :: Comment -> CommentID
stickied :: Bool
isSubmitter :: Bool
distinguished :: Maybe Distinction
numReports :: Maybe Integer
modReports :: Seq ItemReport
userReports :: Seq ItemReport
permaLink :: Text
linkAuthor :: Maybe Username
linkURL :: Maybe Text
linkID :: SubmissionID
scoreHidden :: Maybe Bool
gilded :: Int
subredditID :: SubredditID
subreddit :: SubredditName
edited :: Maybe UTCTime
created :: UTCTime
downs :: Maybe Integer
ups :: Maybe Integer
score :: Maybe Integer
replies :: Seq ChildComment
bodyHTML :: Text
body :: Text
author :: Username
commentID :: CommentID
.. } =
    APIAction WithReplies -> m WithReplies
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @WithReplies APIAction WithReplies
forall a. APIAction a
r m WithReplies -> (WithReplies -> Comment) -> m Comment
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> WithReplies -> Comment
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
  where
    r :: APIAction a
r = APIAction Any
forall a. APIAction a
defaultAPIAction
        { $sel:pathSegments:APIAction :: [Text]
pathSegments =
              [ Text
"comments", SubmissionID -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam SubmissionID
linkID, Text
"_", CommentID -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam CommentID
commentID ]
        , $sel:requestData:APIAction :: WithData
requestData  = [(Text, Text)] -> WithData
mkTextFormData
              ([(Text, Text)] -> WithData) -> [(Text, Text)] -> WithData
forall a b. (a -> b) -> a -> b
$ [ (Text
"context", Text
"100") ] -- asking for extra context
              [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> ((Text, Text) -> [(Text, Text)])
-> Maybe (Text, Text) -> [(Text, Text)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, Text) -> [(Text, Text)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text
"sort", ) (Text -> (Text, Text))
-> (ItemSort -> Text) -> ItemSort -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemSort -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (ItemSort -> (Text, Text)) -> Maybe ItemSort -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ItemSort
itemSort)
        }

-- | Save a comment
saveComment :: MonadReddit m => CommentID -> m ()
saveComment :: CommentID -> m ()
saveComment = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
save (ItemID -> m ()) -> (CommentID -> ItemID) -> CommentID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

-- | Unsave a comment
unsaveComment :: MonadReddit m => CommentID -> m ()
unsaveComment :: CommentID -> m ()
unsaveComment = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
unsave (ItemID -> m ()) -> (CommentID -> ItemID) -> CommentID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

-- | Delete a comment that the currently authenticated user has authored, given its
-- 'CommentID'
deleteComment :: MonadReddit m => CommentID -> m ()
deleteComment :: CommentID -> m ()
deleteComment = ItemID -> m ()
forall (m :: * -> *). MonadReddit m => ItemID -> m ()
delete (ItemID -> m ()) -> (CommentID -> ItemID) -> CommentID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

-- | Edit a comment given its 'CommentID', receving an updated 'Comment' in response
editComment :: MonadReddit m => CommentID -> Body -> m Comment
editComment :: CommentID -> Text -> m Comment
editComment (CommentID -> ItemID
CommentItemID -> ItemID
cid) Text
txt = ItemID -> Text -> m Item
forall (m :: * -> *). MonadReddit m => ItemID -> Text -> m Item
edit ItemID
cid Text
txt m Item -> (Item -> m Comment) -> m Comment
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    CommentItem Comment
c    -> Comment -> m Comment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
c
    SubmissionItem Submission
_ -> ClientException -> m Comment
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
        (ClientException -> m Comment) -> ClientException -> m Comment
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
InvalidResponse Text
"editComment: Expected a Comment, got a Submission"

-- | Reply to a comment given its 'CommentID', returning the newly created 'Comment'
replyToComment :: MonadReddit m => CommentID -> Body -> m Comment
replyToComment :: CommentID -> Text -> m Comment
replyToComment = ItemID -> Text -> m Comment
forall (m :: * -> *). MonadReddit m => ItemID -> Text -> m Comment
reply (ItemID -> Text -> m Comment)
-> (CommentID -> ItemID) -> CommentID -> Text -> m Comment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

-- | Enable/disable inbox replies for a comment
setCommentReplies :: MonadReddit m => Bool -> CommentID -> m ()
setCommentReplies :: Bool -> CommentID -> m ()
setCommentReplies Bool
p (CommentID -> ItemID
CommentItemID -> ItemID
cid) = Bool -> ItemID -> m ()
forall (m :: * -> *). MonadReddit m => Bool -> ItemID -> m ()
setInboxReplies Bool
p ItemID
cid

-- | Upvote a comment.
upvoteComment :: MonadReddit m => CommentID -> m ()
upvoteComment :: CommentID -> m ()
upvoteComment = Vote -> ItemID -> m ()
forall (m :: * -> *). MonadReddit m => Vote -> ItemID -> m ()
vote Vote
Upvote (ItemID -> m ()) -> (CommentID -> ItemID) -> CommentID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

-- | Downvote a comment.
downvoteComment :: MonadReddit m => CommentID -> m ()
downvoteComment :: CommentID -> m ()
downvoteComment = Vote -> ItemID -> m ()
forall (m :: * -> *). MonadReddit m => Vote -> ItemID -> m ()
vote Vote
Downvote (ItemID -> m ()) -> (CommentID -> ItemID) -> CommentID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

-- | Remove an existing vote on a comment.
unvoteComment :: MonadReddit m => CommentID -> m ()
unvoteComment :: CommentID -> m ()
unvoteComment = Vote -> ItemID -> m ()
forall (m :: * -> *). MonadReddit m => Vote -> ItemID -> m ()
vote Vote
Unvote (ItemID -> m ()) -> (CommentID -> ItemID) -> CommentID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

-- | Report a comment to the subreddit\'s mods
reportComment :: MonadReddit m => Report -> CommentID -> m ()
reportComment :: Report -> CommentID -> m ()
reportComment Report
r = Report -> ItemID -> m ()
forall (m :: * -> *). MonadReddit m => Report -> ItemID -> m ()
report Report
r (ItemID -> m ()) -> (CommentID -> ItemID) -> CommentID -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> ItemID
CommentItemID

{- HLINT ignore "Use mconcat" -}
-- | Transform 'MoreComments', loading the actual comments they refer to, up to
-- the limit passed in (pass 'Nothing' for no limit). If 'CommentID's still remain
-- from the original 'MoreComments', they will be returned in a new 'MoreComments'
-- inserted into the resulting sequence of 'ChildComment's, along with an updated
-- count
loadMoreComments
    :: forall m.
    MonadReddit m
    => Maybe Word
    -> ItemOpts Comment
    -> SubmissionID
    -> MoreComments
    -> m (Seq ChildComment)
loadMoreComments :: Maybe Word
-> ItemOpts Comment
-> SubmissionID
-> MoreComments
-> m (Seq ChildComment)
loadMoreComments Maybe Word
limitM ItemOpts Comment
opts SubmissionID
sid MoreComments { Integer
Seq CommentID
$sel:count:MoreComments :: MoreComments -> Integer
$sel:childIDs:MoreComments :: MoreComments -> Seq CommentID
count :: Integer
childIDs :: Seq CommentID
.. } = (Seq ChildComment -> Seq ChildComment -> Seq ChildComment)
-> Seq ChildComment -> Seq (Seq ChildComment) -> Seq ChildComment
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Seq ChildComment -> Seq ChildComment -> Seq ChildComment
forall a. Semigroup a => a -> a -> a
(<>) Seq ChildComment
forall a. Monoid a => a
mempty
    (Seq (Seq ChildComment) -> Seq ChildComment)
-> m (Seq (Seq ChildComment)) -> m (Seq ChildComment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Seq CommentID -> m (Seq ChildComment))
-> Seq (Seq CommentID) -> m (Seq (Seq ChildComment))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Seq CommentID -> m (Seq ChildComment)
fetchMore (Int -> Seq CommentID -> Seq (Seq CommentID)
forall a. Int -> Seq a -> Seq (Seq a)
Seq.chunksOf Int
100 Seq CommentID
toFetch)
    m (Seq ChildComment)
-> (Seq ChildComment -> Seq ChildComment) -> m (Seq ChildComment)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Seq ChildComment -> Seq ChildComment -> Seq ChildComment
forall a. Semigroup a => a -> a -> a
<> Seq ChildComment
more) -- appending this way, after the fold, will put @more@ at the end
  where
    fetchMore :: Seq CommentID -> m (Seq ChildComment)
    fetchMore :: Seq CommentID -> m (Seq ChildComment)
fetchMore Seq CommentID
cids = APIAction LoadedChildren -> m LoadedChildren
forall a (m :: * -> *).
(MonadReddit m, FromJSON a) =>
APIAction a -> m a
runAction @LoadedChildren APIAction LoadedChildren
forall a. APIAction a
r m LoadedChildren
-> (LoadedChildren -> Seq ChildComment) -> m (Seq ChildComment)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> LoadedChildren -> Seq ChildComment
forall s t a b. Wrapped s t a b => s -> a
wrappedTo
      where
        r :: APIAction a
r = APIAction Any
forall a. APIAction a
defaultAPIAction
            { $sel:pathSegments:APIAction :: [Text]
pathSegments = [ Text
"api", Text
"morechildren" ]
            , $sel:method:APIAction :: Method
method       = Method
POST
            , $sel:requestData:APIAction :: WithData
requestData  = Form -> WithData
WithForm
                  (Form -> WithData) -> Form -> WithData
forall a b. (a -> b) -> a -> b
$ ItemOpts Comment -> Form
forall a. ToForm a => a -> Form
toForm ItemOpts Comment
opts
                  Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)] -> Form
mkTextForm [ (Text
"link_id", SubmissionID -> Text
forall a. Thing a => a -> Text
fullname SubmissionID
sid)
                                , (Text
"api_type", Text
"json")
                                , (Text
"children", Seq CommentID -> Text
forall (t :: * -> *) a.
(Foldable t, ToHttpApiData a) =>
t a -> Text
joinParams Seq CommentID
cids)
                                ]
            }

    more :: Seq ChildComment
more = case Seq CommentID
remaining of
        Seq CommentID
Seq.Empty -> Seq ChildComment
forall a. Monoid a => a
mempty
        Seq CommentID
cids      -> ChildComment -> Seq ChildComment
forall a. a -> Seq a
Seq.singleton (ChildComment -> Seq ChildComment)
-> (MoreComments -> ChildComment)
-> MoreComments
-> Seq ChildComment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoreComments -> ChildComment
More
            (MoreComments -> Seq ChildComment)
-> MoreComments -> Seq ChildComment
forall a b. (a -> b) -> a -> b
$ Seq CommentID -> Integer -> MoreComments
MoreComments Seq CommentID
cids (Integer
count Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
limit)

    (Seq CommentID
toFetch, Seq CommentID
remaining) = Int -> Seq CommentID -> (Seq CommentID, Seq CommentID)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
limit Seq CommentID
childIDs

    limit :: Int
limit = Int -> (Word -> Int) -> Maybe Word -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Seq CommentID -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq CommentID
childIDs) Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word
limitM

-- | A version of 'loadMoreComments' with default parameters for the limit
-- (@Nothing@) and options ('defaultItemOpts')
loadMoreCommentsDef
    :: MonadReddit m => SubmissionID -> MoreComments -> m (Seq ChildComment)
loadMoreCommentsDef :: SubmissionID -> MoreComments -> m (Seq ChildComment)
loadMoreCommentsDef = Maybe Word
-> ItemOpts Comment
-> SubmissionID
-> MoreComments
-> m (Seq ChildComment)
forall (m :: * -> *).
MonadReddit m =>
Maybe Word
-> ItemOpts Comment
-> SubmissionID
-> MoreComments
-> m (Seq ChildComment)
loadMoreComments Maybe Word
forall a. Maybe a
Nothing ItemOpts Comment
forall a. ItemOpts a
defaultItemOpts
--
-- $vote
-- __Note__: According to Reddit\'s API rules:
--
-- votes must be cast by humans. That is, API clients proxying a human's
-- action one-for-one are OK, but bots deciding how to vote on content or amplifying
-- a human's vote are not. See the reddit rules for more details on what constitutes
-- vote cheating.
--