module Reddit.Routes.Vote where

import Reddit.Types.Thing

import Network.API.Builder.Query
import Network.API.Builder.Routes

data VoteDirection = UpVote
                   | RemoveVote
                   | DownVote
  deriving (Int -> VoteDirection -> ShowS
[VoteDirection] -> ShowS
VoteDirection -> String
(Int -> VoteDirection -> ShowS)
-> (VoteDirection -> String)
-> ([VoteDirection] -> ShowS)
-> Show VoteDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VoteDirection] -> ShowS
$cshowList :: [VoteDirection] -> ShowS
show :: VoteDirection -> String
$cshow :: VoteDirection -> String
showsPrec :: Int -> VoteDirection -> ShowS
$cshowsPrec :: Int -> VoteDirection -> ShowS
Show, ReadPrec [VoteDirection]
ReadPrec VoteDirection
Int -> ReadS VoteDirection
ReadS [VoteDirection]
(Int -> ReadS VoteDirection)
-> ReadS [VoteDirection]
-> ReadPrec VoteDirection
-> ReadPrec [VoteDirection]
-> Read VoteDirection
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VoteDirection]
$creadListPrec :: ReadPrec [VoteDirection]
readPrec :: ReadPrec VoteDirection
$creadPrec :: ReadPrec VoteDirection
readList :: ReadS [VoteDirection]
$creadList :: ReadS [VoteDirection]
readsPrec :: Int -> ReadS VoteDirection
$creadsPrec :: Int -> ReadS VoteDirection
Read, VoteDirection -> VoteDirection -> Bool
(VoteDirection -> VoteDirection -> Bool)
-> (VoteDirection -> VoteDirection -> Bool) -> Eq VoteDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VoteDirection -> VoteDirection -> Bool
$c/= :: VoteDirection -> VoteDirection -> Bool
== :: VoteDirection -> VoteDirection -> Bool
$c== :: VoteDirection -> VoteDirection -> Bool
Eq)

instance ToQuery VoteDirection where
  toQuery :: Text -> VoteDirection -> [(Text, Text)]
toQuery Text
k VoteDirection
UpVote = [(Text
k, Text
"1")]
  toQuery Text
k VoteDirection
RemoveVote = [(Text
k, Text
"0")]
  toQuery Text
k VoteDirection
DownVote = [(Text
k, Text
"-1")]

vote :: Thing a => VoteDirection -> a -> Route
vote :: VoteDirection -> a -> Route
vote VoteDirection
direction a
tID = [Text] -> [[(Text, Text)]] -> Method -> Route
Route [ Text
"api", Text
"vote" ]
                           [ Text
"id" Text -> Maybe Text -> [(Text, Text)]
forall a. ToQuery a => Text -> a -> [(Text, Text)]
=. Text -> Maybe Text
forall a. a -> Maybe a
Just (a -> Text
forall a. Thing a => a -> Text
fullName a
tID)
                           , Text
"dir" Text -> VoteDirection -> [(Text, Text)]
forall a. ToQuery a => Text -> a -> [(Text, Text)]
=. VoteDirection
direction ]
                           Method
"POST"