module Reddit.Routes.Comment where

import Reddit.Types.Comment
import Reddit.Types.Options
import Reddit.Types.Post
import Reddit.Types.Subreddit

import Network.API.Builder.Routes

aboutComment :: CommentID -> Route
aboutComment :: CommentID -> Route
aboutComment CommentID
pID = [URLPiece] -> [URLParam] -> Method -> Route
Route [ URLPiece
"api", URLPiece
"info" ]
                         [ URLPiece
"id" URLPiece -> CommentID -> URLParam
forall a. ToQuery a => URLPiece -> a -> URLParam
=. CommentID
pID ]
                         Method
"GET"

moreChildren :: PostID -> [CommentID] -> Route
moreChildren :: PostID -> [CommentID] -> Route
moreChildren PostID
p [CommentID]
cs = [URLPiece] -> [URLParam] -> Method -> Route
Route [ URLPiece
"api", URLPiece
"morechildren" ]
                          [ URLPiece
"link_id" URLPiece -> PostID -> URLParam
forall a. ToQuery a => URLPiece -> a -> URLParam
=. PostID
p
                          , URLPiece
"children" URLPiece -> [URLPiece] -> URLParam
forall a. ToQuery a => URLPiece -> a -> URLParam
=. (CommentID -> URLPiece) -> [CommentID] -> [URLPiece]
forall a b. (a -> b) -> [a] -> [b]
map (\(CommentID URLPiece
x) -> URLPiece
x) [CommentID]
cs ]
                          Method
"POST"

newComments :: Options CommentID -> Maybe SubredditName -> Route
newComments :: Options CommentID -> Maybe SubredditName -> Route
newComments Options CommentID
opts Maybe SubredditName
r =
  [URLPiece] -> [URLParam] -> Method -> Route
Route [URLPiece]
url
        [ URLPiece
"before" URLPiece -> Maybe CommentID -> URLParam
forall a. ToQuery a => URLPiece -> a -> URLParam
=. Options CommentID -> Maybe CommentID
forall a. Options a -> Maybe a
before Options CommentID
opts
        , URLPiece
"after" URLPiece -> Maybe CommentID -> URLParam
forall a. ToQuery a => URLPiece -> a -> URLParam
=. Options CommentID -> Maybe CommentID
forall a. Options a -> Maybe a
after Options CommentID
opts
        , URLPiece
"limit" URLPiece -> Maybe Int -> URLParam
forall a. ToQuery a => URLPiece -> a -> URLParam
=. Options CommentID -> Maybe Int
forall a. Options a -> Maybe Int
limit Options CommentID
opts ]
        Method
"GET"
  where
    url :: [URLPiece]
url = case Maybe SubredditName
r of
      Just (R URLPiece
sub) -> [ URLPiece
"r", URLPiece
sub, URLPiece
"comments" ]
      Maybe SubredditName
Nothing -> [ URLPiece
"comments" ]

commentsInfo :: [CommentID] -> Route
commentsInfo :: [CommentID] -> Route
commentsInfo [CommentID]
cs =
  [URLPiece] -> [URLParam] -> Method -> Route
Route [ URLPiece
"api", URLPiece
"info" ]
        [ URLPiece
"id" URLPiece -> [CommentID] -> URLParam
forall a. ToQuery a => URLPiece -> a -> URLParam
=. [CommentID]
cs ]
        Method
"GET"