-- | Contains comment-related actions, like editing comments
--   and performing moderator actions on posts.
module Reddit.Actions.Comment
  ( getNewComments
  , getNewComments'
  , getMoreChildren
  , getCommentInfo
  , getCommentsInfo
  , editComment
  , deleteComment
  , removeComment ) where

import Reddit.Types.Comment
import Reddit.Types.Empty
import Reddit.Types.Error
import Reddit.Types.Listing
import Reddit.Types.Options
import Reddit.Types.Post
import Reddit.Types.Reddit
import Reddit.Types.Subreddit
import qualified Reddit.Routes as Route

import Data.Default.Class
import Data.Text (Text)
import Network.API.Builder (APIError(..))

-- | Get a 'CommentListing' for the most recent comments on the site overall.
--   This maps to <http://reddit.com/r/$SUBREDDIT/comments>, or <http://reddit.com/comments>
--   if the subreddit is not specified.
--   Note that none of the comments returned will have any child comments.
getNewComments :: Monad m => Maybe SubredditName -> RedditT m CommentListing
getNewComments :: Maybe SubredditName -> RedditT m CommentListing
getNewComments = Options CommentID
-> Maybe SubredditName -> RedditT m CommentListing
forall (m :: * -> *).
Monad m =>
Options CommentID
-> Maybe SubredditName -> RedditT m CommentListing
getNewComments' Options CommentID
forall a. Default a => a
def

-- | Get a 'CommentListing' for the most recent comments with the specified 'Options' and
--   'SubredditName'. Note that none of the comments returned will have any child comments.
--   If the 'Options' is 'def', then this function is identical to 'getNewComments'.
getNewComments' :: Monad m => Options CommentID -> Maybe SubredditName -> RedditT m CommentListing
getNewComments' :: Options CommentID
-> Maybe SubredditName -> RedditT m CommentListing
getNewComments' Options CommentID
opts Maybe SubredditName
r = Route -> RedditT m CommentListing
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m CommentListing)
-> Route -> RedditT m CommentListing
forall a b. (a -> b) -> a -> b
$ Options CommentID -> Maybe SubredditName -> Route
Route.newComments Options CommentID
opts Maybe SubredditName
r

-- | Expand children comments that weren't fetched on initial load.
--   Equivalent to the web UI's "load more comments" button.
getMoreChildren :: Monad m
                => PostID -- ^ @PostID@ for the top-level
                -> [CommentID] -- ^ List of @CommentID@s to expand
                -> RedditT m [CommentReference]
getMoreChildren :: PostID -> [CommentID] -> RedditT m [CommentReference]
getMoreChildren PostID
_ [] = [CommentReference] -> RedditT m [CommentReference]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getMoreChildren PostID
p [CommentID]
cs = do
  let ([CommentID]
now, [CommentID]
next) = Int -> [CommentID] -> ([CommentID], [CommentID])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
20 [CommentID]
cs
  POSTWrapped [CommentReference]
rs <- Route -> RedditT m (POSTWrapped [CommentReference])
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m (POSTWrapped [CommentReference]))
-> Route -> RedditT m (POSTWrapped [CommentReference])
forall a b. (a -> b) -> a -> b
$ PostID -> [CommentID] -> Route
Route.moreChildren PostID
p [CommentID]
now
  [CommentReference]
more <- PostID -> [CommentID] -> RedditT m [CommentReference]
forall (m :: * -> *).
Monad m =>
PostID -> [CommentID] -> RedditT m [CommentReference]
getMoreChildren PostID
p [CommentID]
next
  [CommentReference] -> RedditT m [CommentReference]
forall (m :: * -> *) a. Monad m => a -> m a
return ([CommentReference] -> RedditT m [CommentReference])
-> [CommentReference] -> RedditT m [CommentReference]
forall a b. (a -> b) -> a -> b
$ [CommentReference]
rs [CommentReference] -> [CommentReference] -> [CommentReference]
forall a. [a] -> [a] -> [a]
++ [CommentReference]
more

-- | Given a 'CommentID', 'getCommentInfo' will return the full details for that comment.
getCommentInfo :: Monad m => CommentID -> RedditT m Comment
getCommentInfo :: CommentID -> RedditT m Comment
getCommentInfo CommentID
c = do
  CommentListing
res <- [CommentID] -> RedditT m CommentListing
forall (m :: * -> *).
Monad m =>
[CommentID] -> RedditT m CommentListing
getCommentsInfo [CommentID
c]
  case CommentListing
res of
    Listing Maybe CommentID
_ Maybe CommentID
_ [Comment
comment] -> Comment -> RedditT m Comment
forall (m :: * -> *) a. Monad m => a -> m a
return Comment
comment
    CommentListing
_ -> APIError RedditError -> RedditT m Comment
forall (m :: * -> *) a.
Monad m =>
APIError RedditError -> RedditT m a
failWith (APIError RedditError -> RedditT m Comment)
-> APIError RedditError -> RedditT m Comment
forall a b. (a -> b) -> a -> b
$ RedditError -> APIError RedditError
forall a. a -> APIError a
APIError RedditError
InvalidResponseError

-- | Given a list of 'CommentID's, 'getCommentsInfo' will return another list containing
--   the full details for all the comments. Note that Reddit's
--   API imposes a limitation of 100 comments per request, so this function will fail immediately if given a list of more than 100 IDs.
getCommentsInfo :: Monad m => [CommentID] -> RedditT m CommentListing
getCommentsInfo :: [CommentID] -> RedditT m CommentListing
getCommentsInfo [CommentID]
cs =
  if [CommentID] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([CommentID] -> Bool) -> [CommentID] -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> [CommentID] -> [CommentID]
forall a. Int -> [a] -> [a]
drop Int
100 [CommentID]
cs
    then do
      CommentListing
res <- Route -> RedditT m CommentListing
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m CommentListing)
-> Route -> RedditT m CommentListing
forall a b. (a -> b) -> a -> b
$ [CommentID] -> Route
Route.commentsInfo [CommentID]
cs
      case CommentListing
res of
        Listing Maybe CommentID
_ Maybe CommentID
_ [Comment]
comments | [Comment] -> [CommentID] -> Bool
forall a a. [a] -> [a] -> Bool
sameLength [Comment]
comments [CommentID]
cs ->
          CommentListing -> RedditT m CommentListing
forall (m :: * -> *) a. Monad m => a -> m a
return CommentListing
res
        CommentListing
_ -> APIError RedditError -> RedditT m CommentListing
forall (m :: * -> *) a.
Monad m =>
APIError RedditError -> RedditT m a
failWith (APIError RedditError -> RedditT m CommentListing)
-> APIError RedditError -> RedditT m CommentListing
forall a b. (a -> b) -> a -> b
$ RedditError -> APIError RedditError
forall a. a -> APIError a
APIError RedditError
InvalidResponseError
    else APIError RedditError -> RedditT m CommentListing
forall (m :: * -> *) a.
Monad m =>
APIError RedditError -> RedditT m a
failWith (APIError RedditError -> RedditT m CommentListing)
-> APIError RedditError -> RedditT m CommentListing
forall a b. (a -> b) -> a -> b
$ RedditError -> APIError RedditError
forall a. a -> APIError a
APIError RedditError
TooManyRequests
  where
    sameLength :: [a] -> [a] -> Bool
sameLength (a
_:[a]
xs) (a
_:[a]
ys) = [a] -> [a] -> Bool
sameLength [a]
xs [a]
ys
    sameLength [] [] = Bool
True
    sameLength [a]
_ [a]
_ = Bool
False

-- | Edit a comment.
editComment :: Monad m
            => CommentID -- ^ Comment to edit
            -> Text -- ^ New comment text
            -> RedditT m Comment
editComment :: CommentID -> Text -> RedditT m Comment
editComment CommentID
thing Text
text = do
  POSTWrapped Comment
res <- Route -> RedditT m (POSTWrapped Comment)
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m (POSTWrapped Comment))
-> Route -> RedditT m (POSTWrapped Comment)
forall a b. (a -> b) -> a -> b
$ CommentID -> Text -> Route
forall a. Thing a => a -> Text -> Route
Route.edit CommentID
thing Text
text
  Comment -> RedditT m Comment
forall (m :: * -> *) a. Monad m => a -> m a
return Comment
res

-- | Deletes one of your own comments. Note that this is different from
--   removing a comment as a moderator action.
deleteComment :: Monad m => CommentID -> RedditT m ()
deleteComment :: CommentID -> RedditT m ()
deleteComment = RedditT m Empty -> RedditT m ()
forall (m :: * -> *). Monad m => m Empty -> m ()
nothing (RedditT m Empty -> RedditT m ())
-> (CommentID -> RedditT m Empty) -> CommentID -> RedditT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Route -> RedditT m Empty
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m Empty)
-> (CommentID -> Route) -> CommentID -> RedditT m Empty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentID -> Route
forall a. Thing a => a -> Route
Route.delete

-- | Removes a comment (as a moderator action). Note that this is different
--   from deleting a comment.
removeComment :: Monad m => CommentID -> RedditT m ()
removeComment :: CommentID -> RedditT m ()
removeComment = RedditT m Empty -> RedditT m ()
forall (m :: * -> *). Monad m => m Empty -> m ()
nothing (RedditT m Empty -> RedditT m ())
-> (CommentID -> RedditT m Empty) -> CommentID -> RedditT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Route -> RedditT m Empty
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m Empty)
-> (CommentID -> Route) -> CommentID -> RedditT m Empty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CommentID -> Route
forall a. (ToQuery a, Thing a) => Bool -> a -> Route
Route.removePost Bool
False