Copyright | (c) 2021 Rory Tyler Hayford |
---|---|
License | BSD-3-Clause |
Maintainer | rory.hayford@protonmail.com |
Stability | experimental |
Portability | GHC |
Safe Haskell | None |
Language | Haskell2010 |
Network.Reddit.Comment
Description
Synopsis
- getComments :: (MonadReddit m, Foldable t) => ItemOpts Comment -> t CommentID -> m (Seq Comment)
- getComment :: MonadReddit m => CommentID -> m Comment
- withReplies :: MonadReddit m => ItemOpts a -> Comment -> m Comment
- loadMoreComments :: forall m. MonadReddit m => Maybe Word -> ItemOpts Comment -> SubmissionID -> MoreComments -> m (Seq ChildComment)
- loadMoreCommentsDef :: MonadReddit m => SubmissionID -> MoreComments -> m (Seq ChildComment)
- unsaveComment :: MonadReddit m => CommentID -> m ()
- saveComment :: MonadReddit m => CommentID -> m ()
- deleteComment :: MonadReddit m => CommentID -> m ()
- editComment :: MonadReddit m => CommentID -> Body -> m Comment
- replyToComment :: MonadReddit m => CommentID -> Body -> m Comment
- getNewComments :: MonadReddit m => Maybe SubredditName -> Paginator CommentID Comment -> m (Listing CommentID Comment)
- setCommentReplies :: MonadReddit m => Bool -> CommentID -> m ()
- upvoteComment :: MonadReddit m => CommentID -> m ()
- downvoteComment :: MonadReddit m => CommentID -> m ()
- unvoteComment :: MonadReddit m => CommentID -> m ()
- reportComment :: MonadReddit m => Report -> CommentID -> m ()
- data MoreComments = MoreComments (Seq CommentID) Integer
- data ChildComment
- data Comment = Comment CommentID Username Body Body (Seq ChildComment) (Maybe Integer) (Maybe Integer) (Maybe Integer) UTCTime (Maybe UTCTime) SubredditName SubredditID Int (Maybe Bool) SubmissionID (Maybe URL) (Maybe Username) URL (Seq ItemReport) (Seq ItemReport) (Maybe Integer) (Maybe Distinction) Bool Bool
- newtype CommentID = CommentID Text
Reading comments
getComments :: (MonadReddit m, Foldable t) => ItemOpts Comment -> t CommentID -> m (Seq Comment) Source #
getComment :: MonadReddit m => CommentID -> m Comment Source #
withReplies :: MonadReddit m => ItemOpts a -> Comment -> m Comment Source #
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...
loadMoreComments :: forall m. MonadReddit m => Maybe Word -> ItemOpts Comment -> SubmissionID -> MoreComments -> m (Seq ChildComment) Source #
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
loadMoreCommentsDef :: MonadReddit m => SubmissionID -> MoreComments -> m (Seq ChildComment) Source #
A version of loadMoreComments
with default parameters for the limit
(Nothing
) and options (defaultItemOpts
)
unsaveComment :: MonadReddit m => CommentID -> m () Source #
Unsave a comment
saveComment :: MonadReddit m => CommentID -> m () Source #
Save a comment
Creating, editing, and deleting
deleteComment :: MonadReddit m => CommentID -> m () Source #
Delete a comment that the currently authenticated user has authored, given its
CommentID
editComment :: MonadReddit m => CommentID -> Body -> m Comment Source #
replyToComment :: MonadReddit m => CommentID -> Body -> m Comment Source #
getNewComments :: MonadReddit m => Maybe SubredditName -> Paginator CommentID Comment -> m (Listing CommentID Comment) Source #
Get new Comment
s, either for the site as a whole or for a single subreddit,
given its SubredditName
setCommentReplies :: MonadReddit m => Bool -> CommentID -> m () Source #
Enable/disable inbox replies for a comment
Voting
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.
upvoteComment :: MonadReddit m => CommentID -> m () Source #
Upvote a comment.
downvoteComment :: MonadReddit m => CommentID -> m () Source #
Downvote a comment.
unvoteComment :: MonadReddit m => CommentID -> m () Source #
Remove an existing vote on a comment.
reportComment :: MonadReddit m => Report -> CommentID -> m () Source #
Report a comment to the subreddit's mods
Types
data MoreComments Source #
A link to load more children Comment
s
Constructors
MoreComments (Seq CommentID) Integer |
Instances
Eq MoreComments Source # | |
Defined in Network.Reddit.Types.Comment | |
Show MoreComments Source # | |
Defined in Network.Reddit.Types.Comment Methods showsPrec :: Int -> MoreComments -> ShowS # show :: MoreComments -> String # showList :: [MoreComments] -> ShowS # | |
Generic MoreComments Source # | |
Defined in Network.Reddit.Types.Comment Associated Types type Rep MoreComments :: Type -> Type # | |
FromJSON MoreComments Source # | |
Defined in Network.Reddit.Types.Comment | |
type Rep MoreComments Source # | |
Defined in Network.Reddit.Types.Comment type Rep MoreComments = D1 ('MetaData "MoreComments" "Network.Reddit.Types.Comment" "heddit-0.0.1-76ROQ5tOAm3CpLSaFw8ccb" 'False) (C1 ('MetaCons "MoreComments" 'PrefixI 'True) (S1 ('MetaSel ('Just "childIDs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Seq CommentID)) :*: S1 ('MetaSel ('Just "count") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Integer))) |
data ChildComment Source #
Represents a comments on a submission or replies to a comment, which can
be actual Comment
s, or a list of children corresponding to "load more"
or "continue this thread" links on Reddit's UI
Constructors
TopLevel Comment | |
More MoreComments |
Instances
Eq ChildComment Source # | |
Defined in Network.Reddit.Types.Comment | |
Show ChildComment Source # | |
Defined in Network.Reddit.Types.Comment Methods showsPrec :: Int -> ChildComment -> ShowS # show :: ChildComment -> String # showList :: [ChildComment] -> ShowS # | |
Generic ChildComment Source # | |
Defined in Network.Reddit.Types.Comment Associated Types type Rep ChildComment :: Type -> Type # | |
FromJSON ChildComment Source # | |
Defined in Network.Reddit.Types.Comment | |
type Rep ChildComment Source # | |
Defined in Network.Reddit.Types.Comment type Rep ChildComment = D1 ('MetaData "ChildComment" "Network.Reddit.Types.Comment" "heddit-0.0.1-76ROQ5tOAm3CpLSaFw8ccb" 'False) (C1 ('MetaCons "TopLevel" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Comment)) :+: C1 ('MetaCons "More" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 MoreComments))) |
A Reddit comment
Constructors
Comment CommentID Username Body Body (Seq ChildComment) (Maybe Integer) (Maybe Integer) (Maybe Integer) UTCTime (Maybe UTCTime) SubredditName SubredditID Int (Maybe Bool) SubmissionID (Maybe URL) (Maybe Username) URL (Seq ItemReport) (Seq ItemReport) (Maybe Integer) (Maybe Distinction) Bool Bool |
Instances
A Comment
ID
Instances
Eq CommentID Source # | |
Ord CommentID Source # | |
Show CommentID Source # | |
Generic CommentID Source # | |
FromJSON CommentID Source # | |
ToHttpApiData CommentID Source # | |
Defined in Network.Reddit.Types.Comment Methods toUrlPiece :: CommentID -> Text # toEncodedUrlPiece :: CommentID -> Builder # toHeader :: CommentID -> ByteString # toQueryParam :: CommentID -> Text # | |
Thing CommentID Source # | |
type Rep CommentID Source # | |
Defined in Network.Reddit.Types.Comment |