module Reddit.Routes.Flair where

import Reddit.Types.Options
import Reddit.Types.Subreddit
import Reddit.Types.User

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

flairList :: Options UserID -> SubredditName -> Route
flairList :: Options UserID -> SubredditName -> Route
flairList Options UserID
opts (R Text
r) =
  [Text] -> [URLParam] -> Method -> Route
Route [ Text
"r", Text
r, Text
"api", Text
"flairlist" ]
        [ Text
"after" Text -> Maybe UserID -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Options UserID -> Maybe UserID
forall a. Options a -> Maybe a
after Options UserID
opts
        , Text
"before" Text -> Maybe UserID -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Options UserID -> Maybe UserID
forall a. Options a -> Maybe a
before Options UserID
opts
        , Text
"limit" Text -> Maybe Int -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Options UserID -> Maybe Int
forall a. Options a -> Maybe Int
limit Options UserID
opts ]
        Method
"GET"

addLinkFlairTemplate :: SubredditName -> Text -> Text -> Bool -> Route
addLinkFlairTemplate :: SubredditName -> Text -> Text -> Bool -> Route
addLinkFlairTemplate (R Text
sub) Text
css Text
label Bool
editable =
  [Text] -> [URLParam] -> Method -> Route
Route [ Text
"r", Text
sub, Text
"api", Text
"flairtemplate" ]
        [ Text
"css_class" Text -> Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Text
css
        , Text
"flair_type" Text -> Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. (Text
"LINK_FLAIR" :: Text)
        , Text
"text" Text -> Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Text
label
        , Text
"text_editable" Text -> Bool -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Bool
editable ]
        Method
"POST"

flairCSVRoute :: SubredditName -> [(Username, Text, Text)] -> Route
flairCSVRoute :: SubredditName -> [(Username, Text, Text)] -> Route
flairCSVRoute (R Text
sub) [(Username, Text, Text)]
sets =
  [Text] -> [URLParam] -> Method -> Route
Route [ Text
"r", Text
sub, Text
"api", Text
"flaircsv" ]
        [ Text
"flair_csv" Text -> Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. [Text] -> Text
Text.unlines (((Username, Text, Text) -> Text)
-> [(Username, Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Username, Text, Text) -> Text
f [(Username, Text, Text)]
sets) ]
        Method
"POST"
  where
    f :: (Username, Text, Text) -> Text
f (Username Text
u, Text
t, Text
c) =
      Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
Text.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show) [Text
u,Text
t,Text
c]