module Reddit.Routes.Thing where

import Reddit.Types.Thing

import Data.Text (Text)
import Network.API.Builder.Routes

reply :: Thing a => a -> Text -> Route
reply :: a -> Text -> Route
reply a
thingID Text
body = [Text] -> [URLParam] -> Method -> Route
Route [ Text
"api", Text
"comment" ]
                           [ Text
"parent" Text -> Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. a -> Text
forall a. Thing a => a -> Text
fullName a
thingID
                           , Text
"text" Text -> Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Text
body ]
                           Method
"POST"

delete :: Thing a => a -> Route
delete :: a -> Route
delete a
t = [Text] -> [URLParam] -> Method -> Route
Route [ Text
"api", Text
"del" ]
                 [ Text
"id" Text -> Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. a -> Text
forall a. Thing a => a -> Text
fullName a
t ]
                 Method
"POST"

edit :: Thing a => a -> Text -> Route
edit :: a -> Text -> Route
edit a
t Text
newText = [Text] -> [URLParam] -> Method -> Route
Route [ Text
"api", Text
"editusertext" ]
                       [ Text
"thing_id" Text -> Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. a -> Text
forall a. Thing a => a -> Text
fullName a
t
                       , Text
"text" Text -> Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Text
newText ]
                       Method
"POST"

report :: Thing a => a -> Text -> Route
report :: a -> Text -> Route
report a
t Text
r = [Text] -> [URLParam] -> Method -> Route
Route [ Text
"api", Text
"report" ]
                   [ Text
"thing_id" Text -> Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. a -> Text
forall a. Thing a => a -> Text
fullName a
t
                   , Text
"reason" Text -> Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Text
r ]
                   Method
"POST"