{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Network.Reddit.Types.Flair
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Flair
    ( AssignedFlair(..)
    , FlairTemplate(..)
    , defaultFlairTemplate
    , PostedFlairTemplate
    , FlairID
    , FlairText
    , mkFlairText
    , FlairSelection(..)
    , FlairChoice(..)
    , UserFlair(..)
    , ForegroundColor(..)
    , FlairResult(..)
    , CurrentUserFlair
    , FlairChoiceList
    , FlairList(..)
    , flairlistToListing
    , FlairContent(..)
    , FlairType(..)
    , CSSClass
    , FlairConfig(..)
    , FlairPosition(..)
    , defaultFlairConfig
    ) where

import           Control.Monad.Catch            ( MonadThrow(throwM) )

import           Data.Aeson
                 ( (.:)
                 , (.:?)
                 , FromJSON(..)
                 , Options(constructorTagModifier)
                 , ToJSON(..)
                 , Value(String)
                 , defaultOptions
                 , genericParseJSON
                 , withArray
                 , withObject
                 , withText
                 )
import           Data.Char                      ( toLower )
import           Data.HashMap.Strict            ( HashMap )
import           Data.Maybe                     ( catMaybes )
import           Data.Sequence                  ( Seq )
import           Data.Text                      ( Text )
import qualified Data.Text                      as T

import           GHC.Exts                       ( IsList(fromList, toList) )
import           GHC.Generics                   ( Generic )

import           Network.Reddit.Types.Account
import           Network.Reddit.Types.Internal
import           Network.Reddit.Types.Subreddit

import           Web.FormUrlEncoded             ( ToForm(..) )
import           Web.HttpApiData                ( ToHttpApiData(toQueryParam)
                                                , showTextData
                                                )

-- | The text displayed by the 'FlairTemplate'
newtype FlairText = FlairText Text
    deriving stock ( Int -> FlairText -> ShowS
[FlairText] -> ShowS
FlairText -> String
(Int -> FlairText -> ShowS)
-> (FlairText -> String)
-> ([FlairText] -> ShowS)
-> Show FlairText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlairText] -> ShowS
$cshowList :: [FlairText] -> ShowS
show :: FlairText -> String
$cshow :: FlairText -> String
showsPrec :: Int -> FlairText -> ShowS
$cshowsPrec :: Int -> FlairText -> ShowS
Show, (forall x. FlairText -> Rep FlairText x)
-> (forall x. Rep FlairText x -> FlairText) -> Generic FlairText
forall x. Rep FlairText x -> FlairText
forall x. FlairText -> Rep FlairText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlairText x -> FlairText
$cfrom :: forall x. FlairText -> Rep FlairText x
Generic )
    deriving newtype ( FlairText -> FlairText -> Bool
(FlairText -> FlairText -> Bool)
-> (FlairText -> FlairText -> Bool) -> Eq FlairText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlairText -> FlairText -> Bool
$c/= :: FlairText -> FlairText -> Bool
== :: FlairText -> FlairText -> Bool
$c== :: FlairText -> FlairText -> Bool
Eq, Value -> Parser [FlairText]
Value -> Parser FlairText
(Value -> Parser FlairText)
-> (Value -> Parser [FlairText]) -> FromJSON FlairText
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FlairText]
$cparseJSONList :: Value -> Parser [FlairText]
parseJSON :: Value -> Parser FlairText
$cparseJSON :: Value -> Parser FlairText
FromJSON, [FlairText] -> Encoding
[FlairText] -> Value
FlairText -> Encoding
FlairText -> Value
(FlairText -> Value)
-> (FlairText -> Encoding)
-> ([FlairText] -> Value)
-> ([FlairText] -> Encoding)
-> ToJSON FlairText
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FlairText] -> Encoding
$ctoEncodingList :: [FlairText] -> Encoding
toJSONList :: [FlairText] -> Value
$ctoJSONList :: [FlairText] -> Value
toEncoding :: FlairText -> Encoding
$ctoEncoding :: FlairText -> Encoding
toJSON :: FlairText -> Value
$ctoJSON :: FlairText -> Value
ToJSON, FlairText -> ByteString
FlairText -> Builder
FlairText -> Text
(FlairText -> Text)
-> (FlairText -> Builder)
-> (FlairText -> ByteString)
-> (FlairText -> Text)
-> ToHttpApiData FlairText
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: FlairText -> Text
$ctoQueryParam :: FlairText -> Text
toHeader :: FlairText -> ByteString
$ctoHeader :: FlairText -> ByteString
toEncodedUrlPiece :: FlairText -> Builder
$ctoEncodedUrlPiece :: FlairText -> Builder
toUrlPiece :: FlairText -> Text
$ctoUrlPiece :: FlairText -> Text
ToHttpApiData, b -> FlairText -> FlairText
NonEmpty FlairText -> FlairText
FlairText -> FlairText -> FlairText
(FlairText -> FlairText -> FlairText)
-> (NonEmpty FlairText -> FlairText)
-> (forall b. Integral b => b -> FlairText -> FlairText)
-> Semigroup FlairText
forall b. Integral b => b -> FlairText -> FlairText
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> FlairText -> FlairText
$cstimes :: forall b. Integral b => b -> FlairText -> FlairText
sconcat :: NonEmpty FlairText -> FlairText
$csconcat :: NonEmpty FlairText -> FlairText
<> :: FlairText -> FlairText -> FlairText
$c<> :: FlairText -> FlairText -> FlairText
Semigroup, Semigroup FlairText
FlairText
Semigroup FlairText
-> FlairText
-> (FlairText -> FlairText -> FlairText)
-> ([FlairText] -> FlairText)
-> Monoid FlairText
[FlairText] -> FlairText
FlairText -> FlairText -> FlairText
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [FlairText] -> FlairText
$cmconcat :: [FlairText] -> FlairText
mappend :: FlairText -> FlairText -> FlairText
$cmappend :: FlairText -> FlairText -> FlairText
mempty :: FlairText
$cmempty :: FlairText
$cp1Monoid :: Semigroup FlairText
Monoid )

-- | Smart constructor for 'FlairText', the length of which not exceed 64
-- characters
mkFlairText :: MonadThrow m => Text -> m FlairText
mkFlairText :: Text -> m FlairText
mkFlairText Text
txt
    | Text -> Int
T.length Text
txt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64 = ClientException -> m FlairText
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
        (ClientException -> m FlairText) -> ClientException -> m FlairText
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
OtherError Text
"mkFlairText: Text length may not exceed 64 characters"
    | Bool
otherwise = FlairText -> m FlairText
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FlairText -> m FlairText) -> FlairText -> m FlairText
forall a b. (a -> b) -> a -> b
$ Text -> FlairText
FlairText Text
txt

-- | CSS class for flair
type CSSClass = Text

-- | Flair that has been, or will be, assigned to a user
data AssignedFlair = AssignedFlair
    { AssignedFlair -> Username
user     :: Username
    , AssignedFlair -> Maybe FlairText
text     :: Maybe FlairText
    , AssignedFlair -> Maybe Text
cssClass :: Maybe CSSClass --
    }
    deriving stock ( Int -> AssignedFlair -> ShowS
[AssignedFlair] -> ShowS
AssignedFlair -> String
(Int -> AssignedFlair -> ShowS)
-> (AssignedFlair -> String)
-> ([AssignedFlair] -> ShowS)
-> Show AssignedFlair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssignedFlair] -> ShowS
$cshowList :: [AssignedFlair] -> ShowS
show :: AssignedFlair -> String
$cshow :: AssignedFlair -> String
showsPrec :: Int -> AssignedFlair -> ShowS
$cshowsPrec :: Int -> AssignedFlair -> ShowS
Show, AssignedFlair -> AssignedFlair -> Bool
(AssignedFlair -> AssignedFlair -> Bool)
-> (AssignedFlair -> AssignedFlair -> Bool) -> Eq AssignedFlair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssignedFlair -> AssignedFlair -> Bool
$c/= :: AssignedFlair -> AssignedFlair -> Bool
== :: AssignedFlair -> AssignedFlair -> Bool
$c== :: AssignedFlair -> AssignedFlair -> Bool
Eq, (forall x. AssignedFlair -> Rep AssignedFlair x)
-> (forall x. Rep AssignedFlair x -> AssignedFlair)
-> Generic AssignedFlair
forall x. Rep AssignedFlair x -> AssignedFlair
forall x. AssignedFlair -> Rep AssignedFlair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssignedFlair x -> AssignedFlair
$cfrom :: forall x. AssignedFlair -> Rep AssignedFlair x
Generic )

instance FromJSON AssignedFlair where
    parseJSON :: Value -> Parser AssignedFlair
parseJSON = String
-> (Object -> Parser AssignedFlair)
-> Value
-> Parser AssignedFlair
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AssignedFlair" ((Object -> Parser AssignedFlair) -> Value -> Parser AssignedFlair)
-> (Object -> Parser AssignedFlair)
-> Value
-> Parser AssignedFlair
forall a b. (a -> b) -> a -> b
$ \Object
o -> Username -> Maybe FlairText -> Maybe Text -> AssignedFlair
AssignedFlair
        (Username -> Maybe FlairText -> Maybe Text -> AssignedFlair)
-> Parser Username
-> Parser (Maybe FlairText -> Maybe Text -> AssignedFlair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Username
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user"
        Parser (Maybe FlairText -> Maybe Text -> AssignedFlair)
-> Parser (Maybe FlairText) -> Parser (Maybe Text -> AssignedFlair)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe FlairText)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"flair_text"
        Parser (Maybe Text -> AssignedFlair)
-> Parser (Maybe Text) -> Parser AssignedFlair
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"flair_css_class"

-- The endpoints that list assigned flairs are a @Listing@, but there are no
-- additional options that can be passed to them. Giving this dummy instance at
-- least allows using a @Listing ... AssignedFlair@ with existing convenience
-- functions
instance Paginable AssignedFlair where
    type PaginateOptions AssignedFlair = ()

    type PaginateThing AssignedFlair = Text

    defaultOpts :: PaginateOptions AssignedFlair
defaultOpts = ()

    optsToForm :: PaginateOptions AssignedFlair -> Form
optsToForm PaginateOptions AssignedFlair
_ = Form
forall a. Monoid a => a
mempty

-- | Reddit strangely does /not/ use their usual @Listing@ mechanism for paginating
-- assigned flairs, but a different data structure
data FlairList = FlairList
    { FlairList -> Maybe UserID
prev  :: Maybe UserID
    , FlairList -> Maybe UserID
next  :: Maybe UserID
    , FlairList -> Seq AssignedFlair
users :: Seq AssignedFlair  --
    }
    deriving stock ( Int -> FlairList -> ShowS
[FlairList] -> ShowS
FlairList -> String
(Int -> FlairList -> ShowS)
-> (FlairList -> String)
-> ([FlairList] -> ShowS)
-> Show FlairList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlairList] -> ShowS
$cshowList :: [FlairList] -> ShowS
show :: FlairList -> String
$cshow :: FlairList -> String
showsPrec :: Int -> FlairList -> ShowS
$cshowsPrec :: Int -> FlairList -> ShowS
Show, FlairList -> FlairList -> Bool
(FlairList -> FlairList -> Bool)
-> (FlairList -> FlairList -> Bool) -> Eq FlairList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlairList -> FlairList -> Bool
$c/= :: FlairList -> FlairList -> Bool
== :: FlairList -> FlairList -> Bool
$c== :: FlairList -> FlairList -> Bool
Eq, (forall x. FlairList -> Rep FlairList x)
-> (forall x. Rep FlairList x -> FlairList) -> Generic FlairList
forall x. Rep FlairList x -> FlairList
forall x. FlairList -> Rep FlairList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlairList x -> FlairList
$cfrom :: forall x. FlairList -> Rep FlairList x
Generic )

instance FromJSON FlairList where
    parseJSON :: Value -> Parser FlairList
parseJSON = String -> (Object -> Parser FlairList) -> Value -> Parser FlairList
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FlairList"
        ((Object -> Parser FlairList) -> Value -> Parser FlairList)
-> (Object -> Parser FlairList) -> Value -> Parser FlairList
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe UserID -> Maybe UserID -> Seq AssignedFlair -> FlairList
FlairList (Maybe UserID -> Maybe UserID -> Seq AssignedFlair -> FlairList)
-> Parser (Maybe UserID)
-> Parser (Maybe UserID -> Seq AssignedFlair -> FlairList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe UserID)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"prev" Parser (Maybe UserID -> Seq AssignedFlair -> FlairList)
-> Parser (Maybe UserID) -> Parser (Seq AssignedFlair -> FlairList)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe UserID)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"next" Parser (Seq AssignedFlair -> FlairList)
-> Parser (Seq AssignedFlair) -> Parser FlairList
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Seq AssignedFlair)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"users"

-- | Convert a 'FlairList' to a 'Listing', allowing it to be used with other
-- functions/actions expecting a listing
flairlistToListing :: FlairList -> Listing UserID AssignedFlair
flairlistToListing :: FlairList -> Listing UserID AssignedFlair
flairlistToListing (FlairList Maybe UserID
p Maybe UserID
n Seq AssignedFlair
us) = Maybe UserID
-> Maybe UserID
-> Seq AssignedFlair
-> Listing UserID AssignedFlair
forall t a. Maybe t -> Maybe t -> Seq a -> Listing t a
Listing Maybe UserID
p Maybe UserID
n Seq AssignedFlair
us

-- | An identifier for a 'FlairTemplate'
type FlairID = Text

-- | Flair \"templates\" that describe choices for self-assigned flair, for both
-- users and submissions
data FlairTemplate = FlairTemplate
    { FlairTemplate -> Maybe Text
flairID          :: Maybe FlairID
    , FlairTemplate -> FlairText
text             :: FlairText
    , FlairTemplate -> Bool
textEditable     :: Bool
    , FlairTemplate -> Maybe ForegroundColor
textColor        :: Maybe ForegroundColor
    , FlairTemplate -> Maybe Text
backgroundColor  :: Maybe RGBText
    , FlairTemplate -> Maybe Text
cssClass         :: Maybe CSSClass
    , FlairTemplate -> Maybe Bool
overrideCSS      :: Maybe Bool
      -- | Should be between 1 and 10; 10 is the default
    , FlairTemplate -> Word
maxEmojis        :: Word
    , FlairTemplate -> Bool
modOnly          :: Bool
    , FlairTemplate -> FlairContent
allowableContent :: FlairContent
    }
    deriving stock ( Int -> FlairTemplate -> ShowS
[FlairTemplate] -> ShowS
FlairTemplate -> String
(Int -> FlairTemplate -> ShowS)
-> (FlairTemplate -> String)
-> ([FlairTemplate] -> ShowS)
-> Show FlairTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlairTemplate] -> ShowS
$cshowList :: [FlairTemplate] -> ShowS
show :: FlairTemplate -> String
$cshow :: FlairTemplate -> String
showsPrec :: Int -> FlairTemplate -> ShowS
$cshowsPrec :: Int -> FlairTemplate -> ShowS
Show, FlairTemplate -> FlairTemplate -> Bool
(FlairTemplate -> FlairTemplate -> Bool)
-> (FlairTemplate -> FlairTemplate -> Bool) -> Eq FlairTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlairTemplate -> FlairTemplate -> Bool
$c/= :: FlairTemplate -> FlairTemplate -> Bool
== :: FlairTemplate -> FlairTemplate -> Bool
$c== :: FlairTemplate -> FlairTemplate -> Bool
Eq, (forall x. FlairTemplate -> Rep FlairTemplate x)
-> (forall x. Rep FlairTemplate x -> FlairTemplate)
-> Generic FlairTemplate
forall x. Rep FlairTemplate x -> FlairTemplate
forall x. FlairTemplate -> Rep FlairTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlairTemplate x -> FlairTemplate
$cfrom :: forall x. FlairTemplate -> Rep FlairTemplate x
Generic )

instance FromJSON FlairTemplate where
    parseJSON :: Value -> Parser FlairTemplate
parseJSON = String
-> (Object -> Parser FlairTemplate)
-> Value
-> Parser FlairTemplate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FlairTemplate" ((Object -> Parser FlairTemplate) -> Value -> Parser FlairTemplate)
-> (Object -> Parser FlairTemplate)
-> Value
-> Parser FlairTemplate
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text
-> FlairText
-> Bool
-> Maybe ForegroundColor
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Word
-> Bool
-> FlairContent
-> FlairTemplate
FlairTemplate (Maybe Text
 -> FlairText
 -> Bool
 -> Maybe ForegroundColor
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Word
 -> Bool
 -> FlairContent
 -> FlairTemplate)
-> Parser (Maybe Text)
-> Parser
     (FlairText
      -> Bool
      -> Maybe ForegroundColor
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Word
      -> Bool
      -> FlairContent
      -> FlairTemplate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
        Parser
  (FlairText
   -> Bool
   -> Maybe ForegroundColor
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Word
   -> Bool
   -> FlairContent
   -> FlairTemplate)
-> Parser FlairText
-> Parser
     (Bool
      -> Maybe ForegroundColor
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Word
      -> Bool
      -> FlairContent
      -> FlairTemplate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser FlairText
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"text"
        Parser
  (Bool
   -> Maybe ForegroundColor
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Word
   -> Bool
   -> FlairContent
   -> FlairTemplate)
-> Parser Bool
-> Parser
     (Maybe ForegroundColor
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Word
      -> Bool
      -> FlairContent
      -> FlairTemplate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"text_editable"
        Parser
  (Maybe ForegroundColor
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Word
   -> Bool
   -> FlairContent
   -> FlairTemplate)
-> Parser (Maybe ForegroundColor)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Word
      -> Bool
      -> FlairContent
      -> FlairTemplate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser (Maybe ForegroundColor)
forall a. FromJSON a => Text -> Parser (Maybe a)
nothingTxtNull (Text -> Parser (Maybe ForegroundColor))
-> Parser Text -> Parser (Maybe ForegroundColor)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"text_color")
        Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Word
   -> Bool
   -> FlairContent
   -> FlairTemplate)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool -> Word -> Bool -> FlairContent -> FlairTemplate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser (Maybe Text)
forall a. FromJSON a => Text -> Parser (Maybe a)
nothingTxtNull (Text -> Parser (Maybe Text)) -> Parser Text -> Parser (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"background_color")
        Parser
  (Maybe Text
   -> Maybe Bool -> Word -> Bool -> FlairContent -> FlairTemplate)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool -> Word -> Bool -> FlairContent -> FlairTemplate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser (Maybe Text)
forall a. FromJSON a => Text -> Parser (Maybe a)
nothingTxtNull (Text -> Parser (Maybe Text)) -> Parser Text -> Parser (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"css_class")
        Parser
  (Maybe Bool -> Word -> Bool -> FlairContent -> FlairTemplate)
-> Parser (Maybe Bool)
-> Parser (Word -> Bool -> FlairContent -> FlairTemplate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"override_css"
        Parser (Word -> Bool -> FlairContent -> FlairTemplate)
-> Parser Word -> Parser (Bool -> FlairContent -> FlairTemplate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"max_emojis"
        Parser (Bool -> FlairContent -> FlairTemplate)
-> Parser Bool -> Parser (FlairContent -> FlairTemplate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"mod_only"
        Parser (FlairContent -> FlairTemplate)
-> Parser FlairContent -> Parser FlairTemplate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser FlairContent
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"allowable_content"

-- | Wrapper around @FlairTemplates@ for posting via the API. If the @flairID@ field
-- is @Nothing@, a new template will be created. Otherwise, the template with the
-- matching ID will be updated
newtype PostedFlairTemplate = PostedFlairTemplate FlairTemplate
    deriving stock ( Int -> PostedFlairTemplate -> ShowS
[PostedFlairTemplate] -> ShowS
PostedFlairTemplate -> String
(Int -> PostedFlairTemplate -> ShowS)
-> (PostedFlairTemplate -> String)
-> ([PostedFlairTemplate] -> ShowS)
-> Show PostedFlairTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostedFlairTemplate] -> ShowS
$cshowList :: [PostedFlairTemplate] -> ShowS
show :: PostedFlairTemplate -> String
$cshow :: PostedFlairTemplate -> String
showsPrec :: Int -> PostedFlairTemplate -> ShowS
$cshowsPrec :: Int -> PostedFlairTemplate -> ShowS
Show, (forall x. PostedFlairTemplate -> Rep PostedFlairTemplate x)
-> (forall x. Rep PostedFlairTemplate x -> PostedFlairTemplate)
-> Generic PostedFlairTemplate
forall x. Rep PostedFlairTemplate x -> PostedFlairTemplate
forall x. PostedFlairTemplate -> Rep PostedFlairTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PostedFlairTemplate x -> PostedFlairTemplate
$cfrom :: forall x. PostedFlairTemplate -> Rep PostedFlairTemplate x
Generic )
    deriving newtype ( PostedFlairTemplate -> PostedFlairTemplate -> Bool
(PostedFlairTemplate -> PostedFlairTemplate -> Bool)
-> (PostedFlairTemplate -> PostedFlairTemplate -> Bool)
-> Eq PostedFlairTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostedFlairTemplate -> PostedFlairTemplate -> Bool
$c/= :: PostedFlairTemplate -> PostedFlairTemplate -> Bool
== :: PostedFlairTemplate -> PostedFlairTemplate -> Bool
$c== :: PostedFlairTemplate -> PostedFlairTemplate -> Bool
Eq )

instance ToForm PostedFlairTemplate where
    toForm :: PostedFlairTemplate -> Form
toForm (PostedFlairTemplate ft :: FlairTemplate
ft@FlairTemplate { Maybe Text
flairID :: Maybe Text
$sel:flairID:FlairTemplate :: FlairTemplate -> Maybe Text
flairID }) = FlairTemplate -> Form
forall a. ToForm a => a -> Form
toForm FlairTemplate
ft
        Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> [Item Form] -> Form
forall l. IsList l => [Item l] -> l
fromList (((Text, Text) -> [(Text, Text)])
-> Maybe (Text, Text) -> [(Text, Text)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, Text) -> [(Text, Text)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text
"flair_template_id", ) (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
flairID))

instance ToForm FlairTemplate where
    toForm :: FlairTemplate -> Form
toForm FlairTemplate { Bool
Maybe Bool
Maybe Text
Maybe ForegroundColor
Word
FlairContent
FlairText
allowableContent :: FlairContent
modOnly :: Bool
maxEmojis :: Word
overrideCSS :: Maybe Bool
cssClass :: Maybe Text
backgroundColor :: Maybe Text
textColor :: Maybe ForegroundColor
textEditable :: Bool
text :: FlairText
flairID :: Maybe Text
$sel:allowableContent:FlairTemplate :: FlairTemplate -> FlairContent
$sel:modOnly:FlairTemplate :: FlairTemplate -> Bool
$sel:maxEmojis:FlairTemplate :: FlairTemplate -> Word
$sel:overrideCSS:FlairTemplate :: FlairTemplate -> Maybe Bool
$sel:cssClass:FlairTemplate :: FlairTemplate -> Maybe Text
$sel:backgroundColor:FlairTemplate :: FlairTemplate -> Maybe Text
$sel:textColor:FlairTemplate :: FlairTemplate -> Maybe ForegroundColor
$sel:textEditable:FlairTemplate :: FlairTemplate -> Bool
$sel:text:FlairTemplate :: FlairTemplate -> FlairText
$sel:flairID:FlairTemplate :: FlairTemplate -> Maybe Text
.. } = [Item Form] -> Form
forall l. IsList l => [Item l] -> l
fromList
        ([Item Form] -> Form) -> [Item Form] -> Form
forall a b. (a -> b) -> a -> b
$ [ (Text
"allowable_content", FlairContent -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam FlairContent
allowableContent)
          , (Text
"max_emojis", Word -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Word
maxEmojis)
          , (Text
"mod_only", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
modOnly)
          , (Text
"override_css", Maybe Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Maybe Bool
overrideCSS)
          , (Text
"text", FlairText -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam FlairText
text)
          , (Text
"text_editable", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
textEditable)
          , (Text
"api_type", Text
"json")
          ]
        [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [Maybe (Text, Text)] -> [(Text, Text)]
forall a. [Maybe a] -> [a]
catMaybes [ (Text
"background_color", ) (Text -> (Text, Text)) -> (Text -> Text) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
                       (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
backgroundColor
                     , (Text
"text_color", ) (Text -> (Text, Text))
-> (ForegroundColor -> Text) -> ForegroundColor -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForegroundColor -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (ForegroundColor -> (Text, Text))
-> Maybe ForegroundColor -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ForegroundColor
textColor
                     , (Text
"css_class", ) (Text -> (Text, Text)) -> (Text -> Text) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
cssClass
                     ]

-- | A 'FlairTemplate' with default fields, for convenience when creating new
-- templates
defaultFlairTemplate :: FlairTemplate
defaultFlairTemplate :: FlairTemplate
defaultFlairTemplate = FlairTemplate :: Maybe Text
-> FlairText
-> Bool
-> Maybe ForegroundColor
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Word
-> Bool
-> FlairContent
-> FlairTemplate
FlairTemplate
    { $sel:flairID:FlairTemplate :: Maybe Text
flairID          = Maybe Text
forall a. Maybe a
Nothing
    , $sel:text:FlairTemplate :: FlairText
text             = FlairText
forall a. Monoid a => a
mempty
    , $sel:textEditable:FlairTemplate :: Bool
textEditable     = Bool
False
    , $sel:textColor:FlairTemplate :: Maybe ForegroundColor
textColor        = ForegroundColor -> Maybe ForegroundColor
forall a. a -> Maybe a
Just ForegroundColor
Light
    , $sel:backgroundColor:FlairTemplate :: Maybe Text
backgroundColor  = Maybe Text
forall a. Maybe a
Nothing
    , $sel:cssClass:FlairTemplate :: Maybe Text
cssClass         = Maybe Text
forall a. Maybe a
Nothing
    , $sel:overrideCSS:FlairTemplate :: Maybe Bool
overrideCSS      = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    , $sel:maxEmojis:FlairTemplate :: Word
maxEmojis        = Word
10
    , $sel:modOnly:FlairTemplate :: Bool
modOnly          = Bool
False
    , $sel:allowableContent:FlairTemplate :: FlairContent
allowableContent = FlairContent
AllContent
    }

-- | Information about flair that a user can choose. The @templateID@ corresponds
-- to the @flairID@ field of a 'FlairTemplate'
data FlairChoice = FlairChoice
    { FlairChoice -> Text
templateID   :: FlairID
    , FlairChoice -> FlairText
text         :: FlairText
    , FlairChoice -> Bool
textEditable :: Bool
    , FlairChoice -> Maybe Text
cssClass     :: Maybe CSSClass
    }
    deriving stock ( Int -> FlairChoice -> ShowS
[FlairChoice] -> ShowS
FlairChoice -> String
(Int -> FlairChoice -> ShowS)
-> (FlairChoice -> String)
-> ([FlairChoice] -> ShowS)
-> Show FlairChoice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlairChoice] -> ShowS
$cshowList :: [FlairChoice] -> ShowS
show :: FlairChoice -> String
$cshow :: FlairChoice -> String
showsPrec :: Int -> FlairChoice -> ShowS
$cshowsPrec :: Int -> FlairChoice -> ShowS
Show, FlairChoice -> FlairChoice -> Bool
(FlairChoice -> FlairChoice -> Bool)
-> (FlairChoice -> FlairChoice -> Bool) -> Eq FlairChoice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlairChoice -> FlairChoice -> Bool
$c/= :: FlairChoice -> FlairChoice -> Bool
== :: FlairChoice -> FlairChoice -> Bool
$c== :: FlairChoice -> FlairChoice -> Bool
Eq, (forall x. FlairChoice -> Rep FlairChoice x)
-> (forall x. Rep FlairChoice x -> FlairChoice)
-> Generic FlairChoice
forall x. Rep FlairChoice x -> FlairChoice
forall x. FlairChoice -> Rep FlairChoice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlairChoice x -> FlairChoice
$cfrom :: forall x. FlairChoice -> Rep FlairChoice x
Generic )

instance FromJSON FlairChoice where
    parseJSON :: Value -> Parser FlairChoice
parseJSON = String
-> (Object -> Parser FlairChoice) -> Value -> Parser FlairChoice
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FlairChoice" ((Object -> Parser FlairChoice) -> Value -> Parser FlairChoice)
-> (Object -> Parser FlairChoice) -> Value -> Parser FlairChoice
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> FlairText -> Bool -> Maybe Text -> FlairChoice
FlairChoice
        (Text -> FlairText -> Bool -> Maybe Text -> FlairChoice)
-> Parser Text
-> Parser (FlairText -> Bool -> Maybe Text -> FlairChoice)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"flair_template_id"
        Parser (FlairText -> Bool -> Maybe Text -> FlairChoice)
-> Parser FlairText -> Parser (Bool -> Maybe Text -> FlairChoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser FlairText
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"flair_text"
        Parser (Bool -> Maybe Text -> FlairChoice)
-> Parser Bool -> Parser (Maybe Text -> FlairChoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"flair_text_editable"
        Parser (Maybe Text -> FlairChoice)
-> Parser (Maybe Text) -> Parser FlairChoice
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser (Maybe Text)
forall a. FromJSON a => Text -> Parser (Maybe a)
nothingTxtNull (Text -> Parser (Maybe Text)) -> Parser Text -> Parser (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"flair_css_class")

-- Reddit returns both the current flair for the user along with the choices for
-- flair on the given subreddit. This wrapper extracts the possible choices from
-- the returned JSON
newtype FlairChoiceList = FlairChoiceList (Seq FlairChoice)
    deriving stock ( Int -> FlairChoiceList -> ShowS
[FlairChoiceList] -> ShowS
FlairChoiceList -> String
(Int -> FlairChoiceList -> ShowS)
-> (FlairChoiceList -> String)
-> ([FlairChoiceList] -> ShowS)
-> Show FlairChoiceList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlairChoiceList] -> ShowS
$cshowList :: [FlairChoiceList] -> ShowS
show :: FlairChoiceList -> String
$cshow :: FlairChoiceList -> String
showsPrec :: Int -> FlairChoiceList -> ShowS
$cshowsPrec :: Int -> FlairChoiceList -> ShowS
Show, (forall x. FlairChoiceList -> Rep FlairChoiceList x)
-> (forall x. Rep FlairChoiceList x -> FlairChoiceList)
-> Generic FlairChoiceList
forall x. Rep FlairChoiceList x -> FlairChoiceList
forall x. FlairChoiceList -> Rep FlairChoiceList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlairChoiceList x -> FlairChoiceList
$cfrom :: forall x. FlairChoiceList -> Rep FlairChoiceList x
Generic )

instance FromJSON FlairChoiceList where
    parseJSON :: Value -> Parser FlairChoiceList
parseJSON = String
-> (Object -> Parser FlairChoiceList)
-> Value
-> Parser FlairChoiceList
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FlairChoiceList" ((Object -> Parser FlairChoiceList)
 -> Value -> Parser FlairChoiceList)
-> (Object -> Parser FlairChoiceList)
-> Value
-> Parser FlairChoiceList
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        Seq FlairChoice -> FlairChoiceList
FlairChoiceList (Seq FlairChoice -> FlairChoiceList)
-> ([FlairChoice] -> Seq FlairChoice)
-> [FlairChoice]
-> FlairChoiceList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FlairChoice] -> Seq FlairChoice
forall l. IsList l => [Item l] -> l
fromList ([FlairChoice] -> FlairChoiceList)
-> Parser [FlairChoice] -> Parser FlairChoiceList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser [FlairChoice]
flairChoiceP (Value -> Parser [FlairChoice])
-> Parser Value -> Parser [FlairChoice]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"choices"))
      where
        flairChoiceP :: Value -> Parser [FlairChoice]
flairChoiceP = String
-> (Array -> Parser [FlairChoice]) -> Value -> Parser [FlairChoice]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"[FlairChoice]" ((Value -> Parser FlairChoice) -> [Value] -> Parser [FlairChoice]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser FlairChoice
forall a. FromJSON a => Value -> Parser a
parseJSON ([Value] -> Parser [FlairChoice])
-> (Array -> [Value]) -> Array -> Parser [FlairChoice]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall l. IsList l => l -> [Item l]
toList)

-- | Flair that is currently assigned to a user
data UserFlair = UserFlair
    { UserFlair -> Maybe FlairText
text     :: Maybe FlairText  --
    , UserFlair -> Maybe Text
cssClass :: Maybe CSSClass
    }
    deriving stock ( Int -> UserFlair -> ShowS
[UserFlair] -> ShowS
UserFlair -> String
(Int -> UserFlair -> ShowS)
-> (UserFlair -> String)
-> ([UserFlair] -> ShowS)
-> Show UserFlair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserFlair] -> ShowS
$cshowList :: [UserFlair] -> ShowS
show :: UserFlair -> String
$cshow :: UserFlair -> String
showsPrec :: Int -> UserFlair -> ShowS
$cshowsPrec :: Int -> UserFlair -> ShowS
Show, UserFlair -> UserFlair -> Bool
(UserFlair -> UserFlair -> Bool)
-> (UserFlair -> UserFlair -> Bool) -> Eq UserFlair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserFlair -> UserFlair -> Bool
$c/= :: UserFlair -> UserFlair -> Bool
== :: UserFlair -> UserFlair -> Bool
$c== :: UserFlair -> UserFlair -> Bool
Eq, (forall x. UserFlair -> Rep UserFlair x)
-> (forall x. Rep UserFlair x -> UserFlair) -> Generic UserFlair
forall x. Rep UserFlair x -> UserFlair
forall x. UserFlair -> Rep UserFlair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserFlair x -> UserFlair
$cfrom :: forall x. UserFlair -> Rep UserFlair x
Generic )

instance FromJSON UserFlair where
    parseJSON :: Value -> Parser UserFlair
parseJSON = String -> (Object -> Parser UserFlair) -> Value -> Parser UserFlair
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UserFlair" ((Object -> Parser UserFlair) -> Value -> Parser UserFlair)
-> (Object -> Parser UserFlair) -> Value -> Parser UserFlair
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        Maybe FlairText -> Maybe Text -> UserFlair
UserFlair (Maybe FlairText -> Maybe Text -> UserFlair)
-> Parser (Maybe FlairText) -> Parser (Maybe Text -> UserFlair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe FlairText)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"flair_text") Parser (Maybe Text -> UserFlair)
-> Parser (Maybe Text) -> Parser UserFlair
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"flair_css_class")

-- | Wrapper around @UserFlair@ for fetching the current flair. This uses the same
-- endpoint as the @FlairChoiceList@ above
newtype CurrentUserFlair = CurrentUserFlair UserFlair
    deriving stock ( Int -> CurrentUserFlair -> ShowS
[CurrentUserFlair] -> ShowS
CurrentUserFlair -> String
(Int -> CurrentUserFlair -> ShowS)
-> (CurrentUserFlair -> String)
-> ([CurrentUserFlair] -> ShowS)
-> Show CurrentUserFlair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CurrentUserFlair] -> ShowS
$cshowList :: [CurrentUserFlair] -> ShowS
show :: CurrentUserFlair -> String
$cshow :: CurrentUserFlair -> String
showsPrec :: Int -> CurrentUserFlair -> ShowS
$cshowsPrec :: Int -> CurrentUserFlair -> ShowS
Show, (forall x. CurrentUserFlair -> Rep CurrentUserFlair x)
-> (forall x. Rep CurrentUserFlair x -> CurrentUserFlair)
-> Generic CurrentUserFlair
forall x. Rep CurrentUserFlair x -> CurrentUserFlair
forall x. CurrentUserFlair -> Rep CurrentUserFlair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CurrentUserFlair x -> CurrentUserFlair
$cfrom :: forall x. CurrentUserFlair -> Rep CurrentUserFlair x
Generic )

instance FromJSON CurrentUserFlair where
    parseJSON :: Value -> Parser CurrentUserFlair
parseJSON = String
-> (Object -> Parser CurrentUserFlair)
-> Value
-> Parser CurrentUserFlair
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CurrentUserFlair" ((Object -> Parser CurrentUserFlair)
 -> Value -> Parser CurrentUserFlair)
-> (Object -> Parser CurrentUserFlair)
-> Value
-> Parser CurrentUserFlair
forall a b. (a -> b) -> a -> b
$ \Object
o -> UserFlair -> CurrentUserFlair
CurrentUserFlair
        (UserFlair -> CurrentUserFlair)
-> Parser UserFlair -> Parser CurrentUserFlair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser UserFlair
currentP (Value -> Parser UserFlair) -> Parser Value -> Parser UserFlair
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"current"))
      where
        currentP :: Value -> Parser UserFlair
currentP = Value -> Parser UserFlair
forall a. FromJSON a => Value -> Parser a
parseJSON

-- | Select a 'FlairChoice' for a submission or for the user
data FlairSelection = FlairSelection
    { FlairSelection -> FlairChoice
flairChoice :: FlairChoice
      -- | If @Just@ and if the @textEditable@ field of the 'FlairChoice' is
      -- @True@, this will be sent. It is otherwise ignored
    , FlairSelection -> Maybe Text
text        :: Maybe Text
    , FlairSelection -> SubredditName
subreddit   :: SubredditName
    }
    deriving stock ( Int -> FlairSelection -> ShowS
[FlairSelection] -> ShowS
FlairSelection -> String
(Int -> FlairSelection -> ShowS)
-> (FlairSelection -> String)
-> ([FlairSelection] -> ShowS)
-> Show FlairSelection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlairSelection] -> ShowS
$cshowList :: [FlairSelection] -> ShowS
show :: FlairSelection -> String
$cshow :: FlairSelection -> String
showsPrec :: Int -> FlairSelection -> ShowS
$cshowsPrec :: Int -> FlairSelection -> ShowS
Show, FlairSelection -> FlairSelection -> Bool
(FlairSelection -> FlairSelection -> Bool)
-> (FlairSelection -> FlairSelection -> Bool) -> Eq FlairSelection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlairSelection -> FlairSelection -> Bool
$c/= :: FlairSelection -> FlairSelection -> Bool
== :: FlairSelection -> FlairSelection -> Bool
$c== :: FlairSelection -> FlairSelection -> Bool
Eq, (forall x. FlairSelection -> Rep FlairSelection x)
-> (forall x. Rep FlairSelection x -> FlairSelection)
-> Generic FlairSelection
forall x. Rep FlairSelection x -> FlairSelection
forall x. FlairSelection -> Rep FlairSelection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlairSelection x -> FlairSelection
$cfrom :: forall x. FlairSelection -> Rep FlairSelection x
Generic )

-- | The result of bulk setting of users\' flairs as a mod action. The @warnings@
-- and @errors@ fields may be dynamically generated by Reddit, so they are
-- represented here as 'HashMap's
data FlairResult = FlairResult
    {  -- | If the flair was applied or not
      FlairResult -> Bool
ok       :: Bool
      -- | A human-readable description of the transaction
    , FlairResult -> Text
status   :: Text
    , FlairResult -> HashMap Text Text
warnings :: HashMap Text Text
    , FlairResult -> HashMap Text Text
errors   :: HashMap Text Text
    }
    deriving stock ( Int -> FlairResult -> ShowS
[FlairResult] -> ShowS
FlairResult -> String
(Int -> FlairResult -> ShowS)
-> (FlairResult -> String)
-> ([FlairResult] -> ShowS)
-> Show FlairResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlairResult] -> ShowS
$cshowList :: [FlairResult] -> ShowS
show :: FlairResult -> String
$cshow :: FlairResult -> String
showsPrec :: Int -> FlairResult -> ShowS
$cshowsPrec :: Int -> FlairResult -> ShowS
Show, FlairResult -> FlairResult -> Bool
(FlairResult -> FlairResult -> Bool)
-> (FlairResult -> FlairResult -> Bool) -> Eq FlairResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlairResult -> FlairResult -> Bool
$c/= :: FlairResult -> FlairResult -> Bool
== :: FlairResult -> FlairResult -> Bool
$c== :: FlairResult -> FlairResult -> Bool
Eq, (forall x. FlairResult -> Rep FlairResult x)
-> (forall x. Rep FlairResult x -> FlairResult)
-> Generic FlairResult
forall x. Rep FlairResult x -> FlairResult
forall x. FlairResult -> Rep FlairResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlairResult x -> FlairResult
$cfrom :: forall x. FlairResult -> Rep FlairResult x
Generic )

instance FromJSON FlairResult where
    parseJSON :: Value -> Parser FlairResult
parseJSON = String
-> (Object -> Parser FlairResult) -> Value -> Parser FlairResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FlairResult" ((Object -> Parser FlairResult) -> Value -> Parser FlairResult)
-> (Object -> Parser FlairResult) -> Value -> Parser FlairResult
forall a b. (a -> b) -> a -> b
$ \Object
o -> Bool
-> Text -> HashMap Text Text -> HashMap Text Text -> FlairResult
FlairResult (Bool
 -> Text -> HashMap Text Text -> HashMap Text Text -> FlairResult)
-> Parser Bool
-> Parser
     (Text -> HashMap Text Text -> HashMap Text Text -> FlairResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ok"
        Parser
  (Text -> HashMap Text Text -> HashMap Text Text -> FlairResult)
-> Parser Text
-> Parser (HashMap Text Text -> HashMap Text Text -> FlairResult)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"status"
        Parser (HashMap Text Text -> HashMap Text Text -> FlairResult)
-> Parser (HashMap Text Text)
-> Parser (HashMap Text Text -> FlairResult)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (HashMap Text Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"warnings"
        Parser (HashMap Text Text -> FlairResult)
-> Parser (HashMap Text Text) -> Parser FlairResult
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (HashMap Text Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"errors"

-- | The type of flair, when creating a new template
data FlairType
    = UserFlairType
    | SubmissionFlairType
    deriving stock ( Int -> FlairType -> ShowS
[FlairType] -> ShowS
FlairType -> String
(Int -> FlairType -> ShowS)
-> (FlairType -> String)
-> ([FlairType] -> ShowS)
-> Show FlairType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlairType] -> ShowS
$cshowList :: [FlairType] -> ShowS
show :: FlairType -> String
$cshow :: FlairType -> String
showsPrec :: Int -> FlairType -> ShowS
$cshowsPrec :: Int -> FlairType -> ShowS
Show, FlairType -> FlairType -> Bool
(FlairType -> FlairType -> Bool)
-> (FlairType -> FlairType -> Bool) -> Eq FlairType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlairType -> FlairType -> Bool
$c/= :: FlairType -> FlairType -> Bool
== :: FlairType -> FlairType -> Bool
$c== :: FlairType -> FlairType -> Bool
Eq, (forall x. FlairType -> Rep FlairType x)
-> (forall x. Rep FlairType x -> FlairType) -> Generic FlairType
forall x. Rep FlairType x -> FlairType
forall x. FlairType -> Rep FlairType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlairType x -> FlairType
$cfrom :: forall x. FlairType -> Rep FlairType x
Generic )

instance ToHttpApiData FlairType where
    toQueryParam :: FlairType -> Text
toQueryParam = \case
        FlairType
UserFlairType       -> Text
"USER_FLAIR"
        FlairType
SubmissionFlairType -> Text
"LINK_FLAIR"

-- | The type of content that is allowed in a flair template
data FlairContent
    = AllContent
    | EmojisOnly
    | TextOnly
    deriving stock ( Int -> FlairContent -> ShowS
[FlairContent] -> ShowS
FlairContent -> String
(Int -> FlairContent -> ShowS)
-> (FlairContent -> String)
-> ([FlairContent] -> ShowS)
-> Show FlairContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlairContent] -> ShowS
$cshowList :: [FlairContent] -> ShowS
show :: FlairContent -> String
$cshow :: FlairContent -> String
showsPrec :: Int -> FlairContent -> ShowS
$cshowsPrec :: Int -> FlairContent -> ShowS
Show, FlairContent -> FlairContent -> Bool
(FlairContent -> FlairContent -> Bool)
-> (FlairContent -> FlairContent -> Bool) -> Eq FlairContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlairContent -> FlairContent -> Bool
$c/= :: FlairContent -> FlairContent -> Bool
== :: FlairContent -> FlairContent -> Bool
$c== :: FlairContent -> FlairContent -> Bool
Eq, (forall x. FlairContent -> Rep FlairContent x)
-> (forall x. Rep FlairContent x -> FlairContent)
-> Generic FlairContent
forall x. Rep FlairContent x -> FlairContent
forall x. FlairContent -> Rep FlairContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlairContent x -> FlairContent
$cfrom :: forall x. FlairContent -> Rep FlairContent x
Generic )

instance FromJSON FlairContent where
    parseJSON :: Value -> Parser FlairContent
parseJSON = String
-> (Text -> Parser FlairContent) -> Value -> Parser FlairContent
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"FlairContent" ((Text -> Parser FlairContent) -> Value -> Parser FlairContent)
-> (Text -> Parser FlairContent) -> Value -> Parser FlairContent
forall a b. (a -> b) -> a -> b
$ \case
        Text
"all"   -> FlairContent -> Parser FlairContent
forall (f :: * -> *) a. Applicative f => a -> f a
pure FlairContent
AllContent
        Text
"emoji" -> FlairContent -> Parser FlairContent
forall (f :: * -> *) a. Applicative f => a -> f a
pure FlairContent
EmojisOnly
        Text
"text"  -> FlairContent -> Parser FlairContent
forall (f :: * -> *) a. Applicative f => a -> f a
pure FlairContent
TextOnly
        Text
_       -> Parser FlairContent
forall a. Monoid a => a
mempty

instance ToHttpApiData FlairContent where
    toQueryParam :: FlairContent -> Text
toQueryParam = \case
        FlairContent
AllContent -> Text
"all"
        FlairContent
EmojisOnly -> Text
"emoji"
        FlairContent
TextOnly   -> Text
"text"

-- | Foreground color for v2 flair
data ForegroundColor
    = Dark
    | Light
    deriving stock ( Int -> ForegroundColor -> ShowS
[ForegroundColor] -> ShowS
ForegroundColor -> String
(Int -> ForegroundColor -> ShowS)
-> (ForegroundColor -> String)
-> ([ForegroundColor] -> ShowS)
-> Show ForegroundColor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForegroundColor] -> ShowS
$cshowList :: [ForegroundColor] -> ShowS
show :: ForegroundColor -> String
$cshow :: ForegroundColor -> String
showsPrec :: Int -> ForegroundColor -> ShowS
$cshowsPrec :: Int -> ForegroundColor -> ShowS
Show, ForegroundColor -> ForegroundColor -> Bool
(ForegroundColor -> ForegroundColor -> Bool)
-> (ForegroundColor -> ForegroundColor -> Bool)
-> Eq ForegroundColor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForegroundColor -> ForegroundColor -> Bool
$c/= :: ForegroundColor -> ForegroundColor -> Bool
== :: ForegroundColor -> ForegroundColor -> Bool
$c== :: ForegroundColor -> ForegroundColor -> Bool
Eq, (forall x. ForegroundColor -> Rep ForegroundColor x)
-> (forall x. Rep ForegroundColor x -> ForegroundColor)
-> Generic ForegroundColor
forall x. Rep ForegroundColor x -> ForegroundColor
forall x. ForegroundColor -> Rep ForegroundColor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ForegroundColor x -> ForegroundColor
$cfrom :: forall x. ForegroundColor -> Rep ForegroundColor x
Generic )

instance FromJSON ForegroundColor where
    parseJSON :: Value -> Parser ForegroundColor
parseJSON = Options -> Value -> Parser ForegroundColor
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON --
        Options
defaultOptions { constructorTagModifier :: ShowS
constructorTagModifier = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower }

instance ToJSON ForegroundColor where
    toJSON :: ForegroundColor -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (ForegroundColor -> Text) -> ForegroundColor -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForegroundColor -> Text
forall a. Show a => a -> Text
showTextData

instance ToHttpApiData ForegroundColor where
    toQueryParam :: ForegroundColor -> Text
toQueryParam = ForegroundColor -> Text
forall a. Show a => a -> Text
showTextData

-- | Configuration options for subreddit flair, including both user and submission
-- flair. Also see 'defaultFlairConfig'
data FlairConfig = FlairConfig
    { FlairConfig -> Bool
enabled        :: Bool
      -- | Allow user flair self-assignment
    , FlairConfig -> Bool
selfAssign     :: Bool
      -- | Allow submission flair self-assignment
    , FlairConfig -> Bool
linkSelfAssign :: Bool
      -- | Position of user flair
    , FlairConfig -> FlairPosition
position       :: FlairPosition
      -- | Position of submission flair
    , FlairConfig -> FlairPosition
linkPosition   :: FlairPosition
    }
    deriving stock ( Int -> FlairConfig -> ShowS
[FlairConfig] -> ShowS
FlairConfig -> String
(Int -> FlairConfig -> ShowS)
-> (FlairConfig -> String)
-> ([FlairConfig] -> ShowS)
-> Show FlairConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlairConfig] -> ShowS
$cshowList :: [FlairConfig] -> ShowS
show :: FlairConfig -> String
$cshow :: FlairConfig -> String
showsPrec :: Int -> FlairConfig -> ShowS
$cshowsPrec :: Int -> FlairConfig -> ShowS
Show, FlairConfig -> FlairConfig -> Bool
(FlairConfig -> FlairConfig -> Bool)
-> (FlairConfig -> FlairConfig -> Bool) -> Eq FlairConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlairConfig -> FlairConfig -> Bool
$c/= :: FlairConfig -> FlairConfig -> Bool
== :: FlairConfig -> FlairConfig -> Bool
$c== :: FlairConfig -> FlairConfig -> Bool
Eq, (forall x. FlairConfig -> Rep FlairConfig x)
-> (forall x. Rep FlairConfig x -> FlairConfig)
-> Generic FlairConfig
forall x. Rep FlairConfig x -> FlairConfig
forall x. FlairConfig -> Rep FlairConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlairConfig x -> FlairConfig
$cfrom :: forall x. FlairConfig -> Rep FlairConfig x
Generic )

instance ToForm FlairConfig where
    toForm :: FlairConfig -> Form
toForm FlairConfig { Bool
FlairPosition
linkPosition :: FlairPosition
position :: FlairPosition
linkSelfAssign :: Bool
selfAssign :: Bool
enabled :: Bool
$sel:linkPosition:FlairConfig :: FlairConfig -> FlairPosition
$sel:position:FlairConfig :: FlairConfig -> FlairPosition
$sel:linkSelfAssign:FlairConfig :: FlairConfig -> Bool
$sel:selfAssign:FlairConfig :: FlairConfig -> Bool
$sel:enabled:FlairConfig :: FlairConfig -> Bool
.. } =
        [Item Form] -> Form
forall l. IsList l => [Item l] -> l
fromList [ (Text
"flair_enabled", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
enabled)
                 , (Text
"flair_self_assign_enabled", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
selfAssign)
                 , ( Text
"link_flair_self_assign_enabled"
                   , Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
linkSelfAssign
                   )
                 , (Text
"flair_position", FlairPosition -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam FlairPosition
position)
                 , (Text
"link_flair_position", FlairPosition -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam FlairPosition
linkPosition)
                 , (Text
"api_type", Text
"json")
                 ]

-- | A 'FlairConfig' with default values
defaultFlairConfig :: FlairConfig
defaultFlairConfig :: FlairConfig
defaultFlairConfig = FlairConfig :: Bool
-> Bool -> Bool -> FlairPosition -> FlairPosition -> FlairConfig
FlairConfig
    { $sel:enabled:FlairConfig :: Bool
enabled        = Bool
True
    , $sel:selfAssign:FlairConfig :: Bool
selfAssign     = Bool
False
    , $sel:linkSelfAssign:FlairConfig :: Bool
linkSelfAssign = Bool
False
    , $sel:position:FlairConfig :: FlairPosition
position       = FlairPosition
OnRight
    , $sel:linkPosition:FlairConfig :: FlairPosition
linkPosition   = FlairPosition
OnLeft
    }

-- | Position for subreddit flair
data FlairPosition
    = OnLeft
    | OnRight
    deriving stock ( Int -> FlairPosition -> ShowS
[FlairPosition] -> ShowS
FlairPosition -> String
(Int -> FlairPosition -> ShowS)
-> (FlairPosition -> String)
-> ([FlairPosition] -> ShowS)
-> Show FlairPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlairPosition] -> ShowS
$cshowList :: [FlairPosition] -> ShowS
show :: FlairPosition -> String
$cshow :: FlairPosition -> String
showsPrec :: Int -> FlairPosition -> ShowS
$cshowsPrec :: Int -> FlairPosition -> ShowS
Show, FlairPosition -> FlairPosition -> Bool
(FlairPosition -> FlairPosition -> Bool)
-> (FlairPosition -> FlairPosition -> Bool) -> Eq FlairPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlairPosition -> FlairPosition -> Bool
$c/= :: FlairPosition -> FlairPosition -> Bool
== :: FlairPosition -> FlairPosition -> Bool
$c== :: FlairPosition -> FlairPosition -> Bool
Eq, (forall x. FlairPosition -> Rep FlairPosition x)
-> (forall x. Rep FlairPosition x -> FlairPosition)
-> Generic FlairPosition
forall x. Rep FlairPosition x -> FlairPosition
forall x. FlairPosition -> Rep FlairPosition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlairPosition x -> FlairPosition
$cfrom :: forall x. FlairPosition -> Rep FlairPosition x
Generic )

instance ToHttpApiData FlairPosition where
    toQueryParam :: FlairPosition -> Text
toQueryParam = Int -> Text -> Text
T.drop Int
2 (Text -> Text) -> (FlairPosition -> Text) -> FlairPosition -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlairPosition -> Text
forall a. Show a => a -> Text
showTextData