-- | Contains post-related actions, like submitting a post, getting
--   information for an existing post, and performing moderator actions
--   on posts.
module Reddit.Actions.Post
  ( getPosts
  , getPosts'
  , getPostComments
  , getPostSubComments
  , getComments
  , getPostInfo
  , getPostsInfo
  , submitLink
  , submitLinkWithCaptcha
  , submitSelfPost
  , submitSelfPostWithCaptcha
  , setInboxReplies
  , savePost
  , unsavePost
  , editPost
  , deletePost
  , setPostFlair
  , removePost
  , markPostSpam
  , stickyPost
  , unstickyPost
  , setContestMode ) where

import qualified Reddit.Routes as Route
import Reddit.Types
import Reddit.Types.Captcha
import Reddit.Types.Comment
import Reddit.Types.Empty
import Reddit.Types.Listing
import Reddit.Types.Reddit

import Data.Default.Class
import Data.Text (Text)
import Network.API.Builder.Error (APIError(..))
import qualified Data.Char as Char
import qualified Data.Text as Text

-- | Given a 'PostID', 'getPostInfo' will return the full details for that post.
getPostInfo :: Monad m => PostID -> RedditT m Post
getPostInfo :: PostID -> RedditT m Post
getPostInfo PostID
p = do
  PostListing
res <- [PostID] -> RedditT m PostListing
forall (m :: * -> *). Monad m => [PostID] -> RedditT m PostListing
getPostsInfo [PostID
p]
  case PostListing
res of
    Listing Maybe PostID
_ Maybe PostID
_ [Post
post] -> Post -> RedditT m Post
forall (m :: * -> *) a. Monad m => a -> m a
return Post
post
    PostListing
_ -> APIError RedditError -> RedditT m Post
forall (m :: * -> *) a.
Monad m =>
APIError RedditError -> RedditT m a
failWith (APIError RedditError -> RedditT m Post)
-> APIError RedditError -> RedditT m Post
forall a b. (a -> b) -> a -> b
$ RedditError -> APIError RedditError
forall a. a -> APIError a
APIError RedditError
InvalidResponseError

-- | Given a list of 'PostID's, 'getPostsInfo' will return another list containing
--   the full details for all the posts. Note that Reddit's
--   API imposes a limitation of 100 posts per request, so this function will fail immediately if given a list of more than 100 IDs.
getPostsInfo :: Monad m => [PostID] -> RedditT m PostListing
getPostsInfo :: [PostID] -> RedditT m PostListing
getPostsInfo [PostID]
ps =
  -- we can only get 100 posts at a time or the api shits itself
  if [PostID] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([PostID] -> Bool) -> [PostID] -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> [PostID] -> [PostID]
forall a. Int -> [a] -> [a]
drop Int
100 [PostID]
ps
    then do
      PostListing
res <- Route -> RedditT m PostListing
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m PostListing) -> Route -> RedditT m PostListing
forall a b. (a -> b) -> a -> b
$ [PostID] -> Route
Route.aboutPosts [PostID]
ps
      case PostListing
res of
        Listing Maybe PostID
_ Maybe PostID
_ [Post]
posts | [Post] -> [PostID] -> Bool
forall a a. [a] -> [a] -> Bool
sameLength [Post]
posts [PostID]
ps ->
          PostListing -> RedditT m PostListing
forall (m :: * -> *) a. Monad m => a -> m a
return PostListing
res
        PostListing
_ -> APIError RedditError -> RedditT m PostListing
forall (m :: * -> *) a.
Monad m =>
APIError RedditError -> RedditT m a
failWith (APIError RedditError -> RedditT m PostListing)
-> APIError RedditError -> RedditT m PostListing
forall a b. (a -> b) -> a -> b
$ RedditError -> APIError RedditError
forall a. a -> APIError a
APIError RedditError
InvalidResponseError
    else APIError RedditError -> RedditT m PostListing
forall (m :: * -> *) a.
Monad m =>
APIError RedditError -> RedditT m a
failWith (APIError RedditError -> RedditT m PostListing)
-> APIError RedditError -> RedditT m PostListing
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

-- | Get a 'PostListing' for the 'Hot' posts on the site overall.
--   This maps to <http://reddit.com>.
getPosts :: Monad m => RedditT m PostListing
getPosts :: RedditT m PostListing
getPosts = Options PostID
-> ListingType -> Maybe SubredditName -> RedditT m PostListing
forall (m :: * -> *).
Monad m =>
Options PostID
-> ListingType -> Maybe SubredditName -> RedditT m PostListing
getPosts' Options PostID
forall a. Default a => a
def ListingType
Hot Maybe SubredditName
forall a. Maybe a
Nothing

-- | Get a 'PostListing' for a specified listing.
getPosts' :: Monad m => Options PostID -> ListingType -> Maybe SubredditName -> RedditT m PostListing
getPosts' :: Options PostID
-> ListingType -> Maybe SubredditName -> RedditT m PostListing
getPosts' Options PostID
o ListingType
l Maybe SubredditName
r = Route -> RedditT m PostListing
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m PostListing) -> Route -> RedditT m PostListing
forall a b. (a -> b) -> a -> b
$ Options PostID -> Maybe SubredditName -> Text -> Route
Route.postsListing Options PostID
o Maybe SubredditName
r (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
lower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ListingType -> String
forall a. Show a => a -> String
show ListingType
l)
  where lower :: String -> String
lower = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Char.toLower

-- | Save a post.
savePost :: Monad m => PostID -> RedditT m ()
savePost :: PostID -> RedditT m ()
savePost = RedditT m Empty -> RedditT m ()
forall (m :: * -> *). Monad m => m Empty -> m ()
nothing (RedditT m Empty -> RedditT m ())
-> (PostID -> RedditT m Empty) -> PostID -> 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)
-> (PostID -> Route) -> PostID -> RedditT m Empty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostID -> Route
Route.savePost

-- | Remove a saved post from your "saved posts" list.
unsavePost :: Monad m => PostID -> RedditT m ()
unsavePost :: PostID -> RedditT m ()
unsavePost = RedditT m Empty -> RedditT m ()
forall (m :: * -> *). Monad m => m Empty -> m ()
nothing (RedditT m Empty -> RedditT m ())
-> (PostID -> RedditT m Empty) -> PostID -> 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)
-> (PostID -> Route) -> PostID -> RedditT m Empty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostID -> Route
Route.unsavePost

-- | Submit a new link to Reddit.
submitLink :: Monad m
           => SubredditName -- ^ The subreddit to which you're posting the link
           -> Text -- ^ The title of the link post
           -> Text -- ^ The link that you're posting
           -> RedditT m PostID
submitLink :: SubredditName -> Text -> Text -> RedditT m PostID
submitLink SubredditName
r Text
title Text
url = do
  POSTWrapped PostID
res <- Route -> RedditT m (POSTWrapped PostID)
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m (POSTWrapped PostID))
-> Route -> RedditT m (POSTWrapped PostID)
forall a b. (a -> b) -> a -> b
$ SubredditName -> Text -> Text -> Route
Route.submitLink SubredditName
r Text
title Text
url
  PostID -> RedditT m PostID
forall (m :: * -> *) a. Monad m => a -> m a
return PostID
res

-- | Submit a new link to Reddit (answering a Captcha to prove we aren't a robot).
submitLinkWithCaptcha :: Monad m
                      => SubredditName -- ^ The subreddit to which you're posting the link
                      -> Text -- ^ The title of the link post
                      -> Text -- ^ The link that you're posting
                      -> CaptchaID -- ^ The ID of the captcha we're answering
                      -> Text -- ^ The answer to the provided captcha
                      -> RedditT m PostID
submitLinkWithCaptcha :: SubredditName
-> Text -> Text -> CaptchaID -> Text -> RedditT m PostID
submitLinkWithCaptcha SubredditName
r Text
title Text
url CaptchaID
iden Text
captcha = do
  POSTWrapped PostID
res <- Route -> RedditT m (POSTWrapped PostID)
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m (POSTWrapped PostID))
-> Route -> RedditT m (POSTWrapped PostID)
forall a b. (a -> b) -> a -> b
$ SubredditName -> Text -> Text -> Route
Route.submitLink SubredditName
r Text
title Text
url Route -> (CaptchaID, Text) -> Route
`withCaptcha` (CaptchaID
iden, Text
captcha)
  PostID -> RedditT m PostID
forall (m :: * -> *) a. Monad m => a -> m a
return PostID
res

-- | Submit a new selfpost to Reddit.
submitSelfPost :: Monad m
               => SubredditName -- ^ The subreddit to which you're posting the selfpost
               -> Text -- ^ The title of the selfpost
               -> Text -- ^ The body of the selfpost
               -> RedditT m PostID
submitSelfPost :: SubredditName -> Text -> Text -> RedditT m PostID
submitSelfPost SubredditName
r Text
title Text
postBody = do
  POSTWrapped PostID
res <- Route -> RedditT m (POSTWrapped PostID)
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m (POSTWrapped PostID))
-> Route -> RedditT m (POSTWrapped PostID)
forall a b. (a -> b) -> a -> b
$ SubredditName -> Text -> Text -> Route
Route.submitSelfPost SubredditName
r Text
title Text
postBody
  PostID -> RedditT m PostID
forall (m :: * -> *) a. Monad m => a -> m a
return PostID
res

-- | Submit a new selfpost to Reddit (answering a Captcha to prove we aren't a robot).
submitSelfPostWithCaptcha :: Monad m
                          => SubredditName -- ^ The subreddit to which you're posting the selfpost
                          -> Text -- ^ The title of the selfpost
                          -> Text -- ^ The body of the selfpost
                          -> CaptchaID -- ^ The ID of the captcha we're answering
                          -> Text -- ^ The answer to the provided captcha
                          -> RedditT m PostID
submitSelfPostWithCaptcha :: SubredditName
-> Text -> Text -> CaptchaID -> Text -> RedditT m PostID
submitSelfPostWithCaptcha SubredditName
r Text
title Text
postBody CaptchaID
iden Text
captcha = do
  POSTWrapped PostID
res <- Route -> RedditT m (POSTWrapped PostID)
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m (POSTWrapped PostID))
-> Route -> RedditT m (POSTWrapped PostID)
forall a b. (a -> b) -> a -> b
$ SubredditName -> Text -> Text -> Route
Route.submitSelfPost SubredditName
r Text
title Text
postBody Route -> (CaptchaID, Text) -> Route
`withCaptcha` (CaptchaID
iden, Text
captcha)
  PostID -> RedditT m PostID
forall (m :: * -> *) a. Monad m => a -> m a
return PostID
res

-- | Deletes one of your own posts. Note that this is different from
--   removing a post as a moderator action.
deletePost :: Monad m => PostID -> RedditT m ()
deletePost :: PostID -> RedditT m ()
deletePost = RedditT m Empty -> RedditT m ()
forall (m :: * -> *). Monad m => m Empty -> m ()
nothing (RedditT m Empty -> RedditT m ())
-> (PostID -> RedditT m Empty) -> PostID -> 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)
-> (PostID -> Route) -> PostID -> RedditT m Empty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostID -> Route
forall a. Thing a => a -> Route
Route.delete

-- | Set the link flair for a post you've submitted (or any post on a subreddit
--   that you moderate).
setPostFlair :: Monad m
             => SubredditName -- ^ The subreddit on which to set the flair
             -> PostID -- ^ The post whose flair should be set
             -> Text -- ^ The text label for the post's new flair
             -> Text -- ^ The CSS class for the post's new flair
             -> RedditT m ()
setPostFlair :: SubredditName -> PostID -> Text -> Text -> RedditT m ()
setPostFlair SubredditName
r PostID
p Text
text Text
css = RedditT m Empty -> RedditT m ()
forall (m :: * -> *). Monad m => m Empty -> m ()
nothing (RedditT m Empty -> RedditT m ())
-> RedditT m Empty -> RedditT m ()
forall a b. (a -> b) -> a -> b
$ Route -> RedditT m Empty
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m Empty) -> Route -> RedditT m Empty
forall a b. (a -> b) -> a -> b
$ SubredditName -> PostID -> Text -> Text -> Route
Route.postFlair SubredditName
r PostID
p Text
text Text
css

-- | Edit the text of a self-post.
editPost :: Monad m => PostID -> Text -> RedditT m ()
editPost :: PostID -> Text -> RedditT m ()
editPost PostID
thing Text
text = RedditT m Empty -> RedditT m ()
forall (m :: * -> *). Monad m => m Empty -> m ()
nothing (RedditT m Empty -> RedditT m ())
-> RedditT m Empty -> RedditT m ()
forall a b. (a -> b) -> a -> b
$ Route -> RedditT m Empty
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m Empty) -> Route -> RedditT m Empty
forall a b. (a -> b) -> a -> b
$ PostID -> Text -> Route
forall a. Thing a => a -> Text -> Route
Route.edit PostID
thing Text
text

-- | Get a post and all its comments.
getPostComments :: Monad m => PostID -> RedditT m PostComments
getPostComments :: PostID -> RedditT m PostComments
getPostComments PostID
p = Route -> RedditT m PostComments
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m PostComments)
-> Route -> RedditT m PostComments
forall a b. (a -> b) -> a -> b
$ PostID -> Maybe CommentID -> Route
Route.getComments PostID
p Maybe CommentID
forall a. Maybe a
Nothing

-- | Get a post and a specific sub-tree of comments.
getPostSubComments :: Monad m => PostID -> CommentID -> RedditT m PostComments
getPostSubComments :: PostID -> CommentID -> RedditT m PostComments
getPostSubComments PostID
p CommentID
c = Route -> RedditT m PostComments
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m PostComments)
-> Route -> RedditT m PostComments
forall a b. (a -> b) -> a -> b
$ PostID -> Maybe CommentID -> Route
Route.getComments PostID
p (CommentID -> Maybe CommentID
forall a. a -> Maybe a
Just CommentID
c)

-- | Get the comments for a post. Ignore the actual post itself.
getComments :: Monad m => PostID -> RedditT m [CommentReference]
getComments :: PostID -> RedditT m [CommentReference]
getComments PostID
p = do
  PostComments Post
_ [CommentReference]
c <- PostID -> RedditT m PostComments
forall (m :: * -> *). Monad m => PostID -> RedditT m PostComments
getPostComments PostID
p
  [CommentReference] -> RedditT m [CommentReference]
forall (m :: * -> *) a. Monad m => a -> m a
return [CommentReference]
c

-- | Set the state of inbox replies for the specified thread.
setInboxReplies :: Monad m => Bool -> PostID -> RedditT m ()
setInboxReplies :: Bool -> PostID -> RedditT m ()
setInboxReplies Bool
enabled = RedditT m Empty -> RedditT m ()
forall (m :: * -> *). Monad m => m Empty -> m ()
nothing (RedditT m Empty -> RedditT m ())
-> (PostID -> RedditT m Empty) -> PostID -> 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)
-> (PostID -> Route) -> PostID -> RedditT m Empty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> PostID -> Route
Route.sendReplies Bool
enabled

-- | Set the state of contest for the specified thread as a moderator action.
setContestMode :: Monad m => Bool -> PostID -> RedditT m ()
setContestMode :: Bool -> PostID -> RedditT m ()
setContestMode Bool
enabled = RedditT m Empty -> RedditT m ()
forall (m :: * -> *). Monad m => m Empty -> m ()
nothing (RedditT m Empty -> RedditT m ())
-> (PostID -> RedditT m Empty) -> PostID -> 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)
-> (PostID -> Route) -> PostID -> RedditT m Empty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> PostID -> Route
Route.setContestMode Bool
enabled

-- | Removes a post (as a moderator action). Note that this is different
--   from deleting a post.
removePost :: Monad m => PostID -> RedditT m ()
removePost :: PostID -> RedditT m ()
removePost = RedditT m Empty -> RedditT m ()
forall (m :: * -> *). Monad m => m Empty -> m ()
nothing (RedditT m Empty -> RedditT m ())
-> (PostID -> RedditT m Empty) -> PostID -> 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)
-> (PostID -> Route) -> PostID -> RedditT m Empty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> PostID -> Route
forall a. (ToQuery a, Thing a) => Bool -> a -> Route
Route.removePost Bool
False

-- | Mark a post as spam as a moderator action.
markPostSpam :: Monad m => PostID -> RedditT m ()
markPostSpam :: PostID -> RedditT m ()
markPostSpam = RedditT m Empty -> RedditT m ()
forall (m :: * -> *). Monad m => m Empty -> m ()
nothing (RedditT m Empty -> RedditT m ())
-> (PostID -> RedditT m Empty) -> PostID -> 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)
-> (PostID -> Route) -> PostID -> RedditT m Empty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> PostID -> Route
forall a. (ToQuery a, Thing a) => Bool -> a -> Route
Route.removePost Bool
True

-- | Sticky a post on the subreddit on which it's posted.
stickyPost :: Monad m
           => PostID -- ^ The post to be stickied
           -> Maybe Integer -- ^ The position to which it should be stickied
           -> RedditT m ()
stickyPost :: PostID -> Maybe Integer -> RedditT m ()
stickyPost PostID
p Maybe Integer
n = RedditT m Empty -> RedditT m ()
forall (m :: * -> *). Monad m => m Empty -> m ()
nothing (RedditT m Empty -> RedditT m ())
-> RedditT m Empty -> RedditT m ()
forall a b. (a -> b) -> a -> b
$ Route -> RedditT m Empty
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m Empty) -> Route -> RedditT m Empty
forall a b. (a -> b) -> a -> b
$ Bool -> PostID -> Maybe Integer -> Route
Route.stickyPost Bool
True PostID
p Maybe Integer
n

-- | Unsticky a post from the subreddit on which it's posted.
unstickyPost :: Monad m
           => PostID -- ^ The post to be unstickied
           -> Maybe Integer -- ^ The position from which it should be unstickied
           -> RedditT m ()
unstickyPost :: PostID -> Maybe Integer -> RedditT m ()
unstickyPost PostID
p Maybe Integer
n = RedditT m Empty -> RedditT m ()
forall (m :: * -> *). Monad m => m Empty -> m ()
nothing (RedditT m Empty -> RedditT m ())
-> RedditT m Empty -> RedditT m ()
forall a b. (a -> b) -> a -> b
$ Route -> RedditT m Empty
forall a (m :: * -> *).
(FromJSON a, Monad m) =>
Route -> RedditT m a
runRoute (Route -> RedditT m Empty) -> Route -> RedditT m Empty
forall a b. (a -> b) -> a -> b
$ Bool -> PostID -> Maybe Integer -> Route
Route.stickyPost Bool
False PostID
p Maybe Integer
n