{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Network.Reddit.Types.Moderation
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Moderation
    ( -- * Item moderation
      ModItem(..)
    , ModItemOpts(..)
    , RemovalMessage(..)
    , RemovalType(..)
    , RemovalReason(..)
    , RemovalReasonID
    , NewRemovalReasonID
    , RemovalReasonList
      -- * Subreddit relationships
    , ModPermission(..)
    , SubredditRelationship(..)
    , RelID(RelID)
    , MuteID(MuteID)
    , ModInvitee(..)
    , ModInviteeList(..)
    , ModList
    , ModAccount(..)
    , RelInfo(..)
    , MuteInfo(..)
    , RelInfoOpts(..)
    , Ban(..)
    , BanNotes(..)
      -- * Subreddit settings
    , SubredditSettings(..)
    , CrowdControlLevel(..)
    , SubredditType(..)
    , SpamFilter(..)
    , Wikimode(..)
    , ContentOptions(..)
      -- * Modmail
    , Modmail(..)
    , ModmailConversation(..)
    , ModmailMessage(..)
    , ModmailID
    , BulkReadIDs
    , ModmailAuthor(..)
    , ModmailObjID(..)
    , ModmailState(..)
    , ModmailSort(..)
    , ModmailOpts(..)
    , defaultModmailOpts
    , ConversationDetails
    , ModmailReply(..)
    , mkModmailReply
    , NewConversation(..)
      -- * Modlog
    , ModAction(..)
    , ModActionID
    , ModActionType(..)
    , ModActionOpts(..)
      -- * Styles and images
    , Stylesheet(..)
    , SubredditImage(..)
    , S3ModerationLease(..)
    , StructuredStyleImage(..)
    , StyleImageAlignment(..)
      -- * Misc
    , TrafficStat(..)
    , Traffic(..)
    , LanguageCode(AF, AR, BE, BG, BS, CA, CS, CY, DA, DE, EL, EN, EO,
             ES, ET, EU, FA, FI, FR, GD, GL, HE, HI, HR, HU, HY, ID, IS, IT, JA,
             KO, LA, LT, LV, MS, NL, NN, NO, PL, PT, RO, RU, SK, SL, SR, SV, TA,
             TH, TR, UK, VI, ZH)
    ) where

import           Control.Applicative            ( Alternative((<|>))
                                                , optional
                                                )
import           Control.Monad                  ( (<=<), (>=>) )

import           Data.Aeson
                 ( (.:)
                 , (.:?)
                 , FromJSON(..)
                 , FromJSONKey(..)
                 , JSONKeyOptions(..)
                 , KeyValue((.=))
                 , Options(..)
                 , Value(Object)
                 , defaultJSONKeyOptions
                 , defaultOptions
                 , genericFromJSONKey
                 , genericParseJSON
                 , withArray
                 , withObject
                 , withScientific
                 , withText
                 )
import           Data.Aeson.Casing              ( snakeCase )
import           Data.Aeson.Types               ( Parser )
import           Data.Char                      ( toLower )
import           Data.Coerce                    ( coerce )
import           Data.Foldable                  ( asum )
import qualified Data.HashMap.Strict            as HM
import           Data.HashMap.Strict            ( HashMap )
import           Data.Hashable                  ( Hashable )
import           Data.Maybe
                 ( catMaybes
                 , fromMaybe
                 , mapMaybe
                 , maybeToList
                 )
import           Data.Sequence                  ( Seq )
import           Data.Text                      ( Text )
import           Data.Time                      ( UTCTime, zonedTimeToUTC )
import           Data.Time.Format.ISO8601       ( iso8601ParseM )

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

import           Lens.Micro

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

import           Web.FormUrlEncoded
                 ( FormOptions(fieldLabelModifier)
                 , ToForm(..)
                 , defaultFormOptions
                 , genericToForm
                 )
import           Web.HttpApiData                ( ToHttpApiData(..)
                                                , showTextData
                                                )

--Item moderation--------------------------------------------------------------
-- | An 'Item' of interest to moderators (spam, modqueue, etc...)
newtype ModItem = ModItem Item
    deriving stock ( Int -> ModItem -> ShowS
[ModItem] -> ShowS
ModItem -> String
(Int -> ModItem -> ShowS)
-> (ModItem -> String) -> ([ModItem] -> ShowS) -> Show ModItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModItem] -> ShowS
$cshowList :: [ModItem] -> ShowS
show :: ModItem -> String
$cshow :: ModItem -> String
showsPrec :: Int -> ModItem -> ShowS
$cshowsPrec :: Int -> ModItem -> ShowS
Show, (forall x. ModItem -> Rep ModItem x)
-> (forall x. Rep ModItem x -> ModItem) -> Generic ModItem
forall x. Rep ModItem x -> ModItem
forall x. ModItem -> Rep ModItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModItem x -> ModItem
$cfrom :: forall x. ModItem -> Rep ModItem x
Generic )
    deriving newtype ( ModItem -> ModItem -> Bool
(ModItem -> ModItem -> Bool)
-> (ModItem -> ModItem -> Bool) -> Eq ModItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModItem -> ModItem -> Bool
$c/= :: ModItem -> ModItem -> Bool
== :: ModItem -> ModItem -> Bool
$c== :: ModItem -> ModItem -> Bool
Eq, Value -> Parser [ModItem]
Value -> Parser ModItem
(Value -> Parser ModItem)
-> (Value -> Parser [ModItem]) -> FromJSON ModItem
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ModItem]
$cparseJSONList :: Value -> Parser [ModItem]
parseJSON :: Value -> Parser ModItem
$cparseJSON :: Value -> Parser ModItem
FromJSON )

instance Paginable ModItem where
    type PaginateOptions ModItem = ModItemOpts

    type PaginateThing ModItem = ItemID

    defaultOpts :: PaginateOptions ModItem
defaultOpts = ModItemOpts :: Maybe ItemType -> ModItemOpts
ModItemOpts { $sel:only:ModItemOpts :: Maybe ItemType
only = Maybe ItemType
forall a. Maybe a
Nothing }

    getFullname :: ModItem -> PaginateThing ModItem
getFullname (ModItem Item
item) = Item -> PaginateThing Item
forall a. Paginable a => a -> PaginateThing a
getFullname Item
item

-- | Options for 'Listing's of 'ModItem's. Only contains one field, @only@ to
-- constrain the request to a single type (i.e. comments or links)
data ModItemOpts = ModItemOpts { ModItemOpts -> Maybe ItemType
only :: Maybe ItemType }
    deriving stock ( Int -> ModItemOpts -> ShowS
[ModItemOpts] -> ShowS
ModItemOpts -> String
(Int -> ModItemOpts -> ShowS)
-> (ModItemOpts -> String)
-> ([ModItemOpts] -> ShowS)
-> Show ModItemOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModItemOpts] -> ShowS
$cshowList :: [ModItemOpts] -> ShowS
show :: ModItemOpts -> String
$cshow :: ModItemOpts -> String
showsPrec :: Int -> ModItemOpts -> ShowS
$cshowsPrec :: Int -> ModItemOpts -> ShowS
Show, ModItemOpts -> ModItemOpts -> Bool
(ModItemOpts -> ModItemOpts -> Bool)
-> (ModItemOpts -> ModItemOpts -> Bool) -> Eq ModItemOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModItemOpts -> ModItemOpts -> Bool
$c/= :: ModItemOpts -> ModItemOpts -> Bool
== :: ModItemOpts -> ModItemOpts -> Bool
$c== :: ModItemOpts -> ModItemOpts -> Bool
Eq, (forall x. ModItemOpts -> Rep ModItemOpts x)
-> (forall x. Rep ModItemOpts x -> ModItemOpts)
-> Generic ModItemOpts
forall x. Rep ModItemOpts x -> ModItemOpts
forall x. ModItemOpts -> Rep ModItemOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModItemOpts x -> ModItemOpts
$cfrom :: forall x. ModItemOpts -> Rep ModItemOpts x
Generic )

instance ToForm ModItemOpts where
    toForm :: ModItemOpts -> Form
toForm ModItemOpts { Maybe ItemType
only :: Maybe ItemType
$sel:only:ModItemOpts :: ModItemOpts -> Maybe ItemType
.. } = [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, 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
"only", ) (Text -> (Text, Text))
-> (ItemType -> Text) -> ItemType -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemType -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (ItemType -> (Text, Text)) -> Maybe ItemType -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ItemType
only)

-- | A message to explain\/note the removal an 'Item'
data RemovalMessage = RemovalMessage
    { RemovalMessage -> ItemID
itemID      :: ItemID
    , RemovalMessage -> Text
message     :: Body
    , RemovalMessage -> Text
title       :: Title
    , RemovalMessage -> RemovalType
removalType :: RemovalType
    }
    deriving stock ( Int -> RemovalMessage -> ShowS
[RemovalMessage] -> ShowS
RemovalMessage -> String
(Int -> RemovalMessage -> ShowS)
-> (RemovalMessage -> String)
-> ([RemovalMessage] -> ShowS)
-> Show RemovalMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemovalMessage] -> ShowS
$cshowList :: [RemovalMessage] -> ShowS
show :: RemovalMessage -> String
$cshow :: RemovalMessage -> String
showsPrec :: Int -> RemovalMessage -> ShowS
$cshowsPrec :: Int -> RemovalMessage -> ShowS
Show, RemovalMessage -> RemovalMessage -> Bool
(RemovalMessage -> RemovalMessage -> Bool)
-> (RemovalMessage -> RemovalMessage -> Bool) -> Eq RemovalMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemovalMessage -> RemovalMessage -> Bool
$c/= :: RemovalMessage -> RemovalMessage -> Bool
== :: RemovalMessage -> RemovalMessage -> Bool
$c== :: RemovalMessage -> RemovalMessage -> Bool
Eq, (forall x. RemovalMessage -> Rep RemovalMessage x)
-> (forall x. Rep RemovalMessage x -> RemovalMessage)
-> Generic RemovalMessage
forall x. Rep RemovalMessage x -> RemovalMessage
forall x. RemovalMessage -> Rep RemovalMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemovalMessage x -> RemovalMessage
$cfrom :: forall x. RemovalMessage -> Rep RemovalMessage x
Generic )

instance ToForm RemovalMessage where
    toForm :: RemovalMessage -> Form
toForm RemovalMessage { Text
ItemID
RemovalType
removalType :: RemovalType
title :: Text
message :: Text
itemID :: ItemID
$sel:removalType:RemovalMessage :: RemovalMessage -> RemovalType
$sel:title:RemovalMessage :: RemovalMessage -> Text
$sel:message:RemovalMessage :: RemovalMessage -> Text
$sel:itemID:RemovalMessage :: RemovalMessage -> ItemID
.. } =
        [Item Form] -> Form
forall l. IsList l => [Item l] -> l
fromList [ ( Text
"model"
                   , [Pair] -> Text
textObject [ Text
"item_id" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [ ItemID -> Text
forall a. Thing a => a -> Text
fullname ItemID
itemID ]
                                , Text
"message" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
message
                                , Text
"title" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
title
                                , Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= RemovalType -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam RemovalType
removalType
                                ]
                   )
                 ]

-- | Controls how the 'RemovalMessage' will be disseminated
data RemovalType
    = PublicComment -- ^ Leaves the message as a public comment
    | PrivateExposed -- ^ Leaves moderator note with exposed username
    | PrivateHidden -- ^ Leaves mod note with hidden username
    deriving stock ( Int -> RemovalType -> ShowS
[RemovalType] -> ShowS
RemovalType -> String
(Int -> RemovalType -> ShowS)
-> (RemovalType -> String)
-> ([RemovalType] -> ShowS)
-> Show RemovalType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemovalType] -> ShowS
$cshowList :: [RemovalType] -> ShowS
show :: RemovalType -> String
$cshow :: RemovalType -> String
showsPrec :: Int -> RemovalType -> ShowS
$cshowsPrec :: Int -> RemovalType -> ShowS
Show, RemovalType -> RemovalType -> Bool
(RemovalType -> RemovalType -> Bool)
-> (RemovalType -> RemovalType -> Bool) -> Eq RemovalType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemovalType -> RemovalType -> Bool
$c/= :: RemovalType -> RemovalType -> Bool
== :: RemovalType -> RemovalType -> Bool
$c== :: RemovalType -> RemovalType -> Bool
Eq, (forall x. RemovalType -> Rep RemovalType x)
-> (forall x. Rep RemovalType x -> RemovalType)
-> Generic RemovalType
forall x. Rep RemovalType x -> RemovalType
forall x. RemovalType -> Rep RemovalType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemovalType x -> RemovalType
$cfrom :: forall x. RemovalType -> Rep RemovalType x
Generic )

instance ToHttpApiData RemovalType where
    toQueryParam :: RemovalType -> Text
toQueryParam = \case
        RemovalType
PublicComment  -> Text
"public"
        RemovalType
PrivateExposed -> Text
"private_exposed"
        RemovalType
PrivateHidden  -> Text
"private"

-- | A subreddit-specific reason for item removal
data RemovalReason = RemovalReason
    { RemovalReason -> Text
removalReasonID :: RemovalReasonID, RemovalReason -> Text
message :: Body, RemovalReason -> Text
title :: Title }
    deriving stock ( Int -> RemovalReason -> ShowS
[RemovalReason] -> ShowS
RemovalReason -> String
(Int -> RemovalReason -> ShowS)
-> (RemovalReason -> String)
-> ([RemovalReason] -> ShowS)
-> Show RemovalReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemovalReason] -> ShowS
$cshowList :: [RemovalReason] -> ShowS
show :: RemovalReason -> String
$cshow :: RemovalReason -> String
showsPrec :: Int -> RemovalReason -> ShowS
$cshowsPrec :: Int -> RemovalReason -> ShowS
Show, RemovalReason -> RemovalReason -> Bool
(RemovalReason -> RemovalReason -> Bool)
-> (RemovalReason -> RemovalReason -> Bool) -> Eq RemovalReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemovalReason -> RemovalReason -> Bool
$c/= :: RemovalReason -> RemovalReason -> Bool
== :: RemovalReason -> RemovalReason -> Bool
$c== :: RemovalReason -> RemovalReason -> Bool
Eq, (forall x. RemovalReason -> Rep RemovalReason x)
-> (forall x. Rep RemovalReason x -> RemovalReason)
-> Generic RemovalReason
forall x. Rep RemovalReason x -> RemovalReason
forall x. RemovalReason -> Rep RemovalReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemovalReason x -> RemovalReason
$cfrom :: forall x. RemovalReason -> Rep RemovalReason x
Generic )

instance FromJSON RemovalReason where
    parseJSON :: Value -> Parser RemovalReason
parseJSON = Options -> Value -> Parser RemovalReason
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { ShowS
fieldLabelModifier :: ShowS
fieldLabelModifier :: ShowS
fieldLabelModifier }
      where
        fieldLabelModifier :: ShowS
fieldLabelModifier = \case
            String
"removalReasonID" -> String
"id"
            String
s                 -> String
s

instance ToForm RemovalReason where
    toForm :: RemovalReason -> Form
toForm RemovalReason { Text
title :: Text
message :: Text
removalReasonID :: Text
$sel:title:RemovalReason :: RemovalReason -> Text
$sel:message:RemovalReason :: RemovalReason -> Text
$sel:removalReasonID:RemovalReason :: RemovalReason -> Text
.. } =
        [Item Form] -> Form
forall l. IsList l => [Item l] -> l
fromList [ (Text
"title", Text
title), (Text
"message", Text
message) ]

newtype RemovalReasonList = RemovalReasonList (Seq RemovalReason)
    deriving stock ( Int -> RemovalReasonList -> ShowS
[RemovalReasonList] -> ShowS
RemovalReasonList -> String
(Int -> RemovalReasonList -> ShowS)
-> (RemovalReasonList -> String)
-> ([RemovalReasonList] -> ShowS)
-> Show RemovalReasonList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemovalReasonList] -> ShowS
$cshowList :: [RemovalReasonList] -> ShowS
show :: RemovalReasonList -> String
$cshow :: RemovalReasonList -> String
showsPrec :: Int -> RemovalReasonList -> ShowS
$cshowsPrec :: Int -> RemovalReasonList -> ShowS
Show, (forall x. RemovalReasonList -> Rep RemovalReasonList x)
-> (forall x. Rep RemovalReasonList x -> RemovalReasonList)
-> Generic RemovalReasonList
forall x. Rep RemovalReasonList x -> RemovalReasonList
forall x. RemovalReasonList -> Rep RemovalReasonList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemovalReasonList x -> RemovalReasonList
$cfrom :: forall x. RemovalReasonList -> Rep RemovalReasonList x
Generic )

instance FromJSON RemovalReasonList where
    parseJSON :: Value -> Parser RemovalReasonList
parseJSON = String
-> (Object -> Parser RemovalReasonList)
-> Value
-> Parser RemovalReasonList
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RemovalReasonList"
        ((Object -> Parser RemovalReasonList)
 -> Value -> Parser RemovalReasonList)
-> (Object -> Parser RemovalReasonList)
-> Value
-> Parser RemovalReasonList
forall a b. (a -> b) -> a -> b
$ (Seq RemovalReason -> RemovalReasonList)
-> Parser (Seq RemovalReason) -> Parser RemovalReasonList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq RemovalReason -> RemovalReasonList
RemovalReasonList (Parser (Seq RemovalReason) -> Parser RemovalReasonList)
-> (Object -> Parser (Seq RemovalReason))
-> Object
-> Parser RemovalReasonList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser (Seq RemovalReason)
removalsP (Value -> Parser (Seq RemovalReason))
-> (Object -> Parser Value) -> Object -> Parser (Seq RemovalReason)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"data"))
      where
        removalsP :: Value -> Parser (Seq RemovalReason)
removalsP = String
-> (Object -> Parser (Seq RemovalReason))
-> Value
-> Parser (Seq RemovalReason)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"HashMap Text RemovalReason" Object -> Parser (Seq RemovalReason)
forall b. FromJSON b => Object -> Parser (Seq b)
getVals

-- | Identifier for a 'RemovalReason'
type RemovalReasonID = Text

newtype NewRemovalReasonID = NewRemovalReasonID RemovalReasonID
    deriving stock ( Int -> NewRemovalReasonID -> ShowS
[NewRemovalReasonID] -> ShowS
NewRemovalReasonID -> String
(Int -> NewRemovalReasonID -> ShowS)
-> (NewRemovalReasonID -> String)
-> ([NewRemovalReasonID] -> ShowS)
-> Show NewRemovalReasonID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewRemovalReasonID] -> ShowS
$cshowList :: [NewRemovalReasonID] -> ShowS
show :: NewRemovalReasonID -> String
$cshow :: NewRemovalReasonID -> String
showsPrec :: Int -> NewRemovalReasonID -> ShowS
$cshowsPrec :: Int -> NewRemovalReasonID -> ShowS
Show, (forall x. NewRemovalReasonID -> Rep NewRemovalReasonID x)
-> (forall x. Rep NewRemovalReasonID x -> NewRemovalReasonID)
-> Generic NewRemovalReasonID
forall x. Rep NewRemovalReasonID x -> NewRemovalReasonID
forall x. NewRemovalReasonID -> Rep NewRemovalReasonID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NewRemovalReasonID x -> NewRemovalReasonID
$cfrom :: forall x. NewRemovalReasonID -> Rep NewRemovalReasonID x
Generic )

instance FromJSON NewRemovalReasonID where
    parseJSON :: Value -> Parser NewRemovalReasonID
parseJSON = String
-> (Object -> Parser NewRemovalReasonID)
-> Value
-> Parser NewRemovalReasonID
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NewRemovalReasonID"
        ((Object -> Parser NewRemovalReasonID)
 -> Value -> Parser NewRemovalReasonID)
-> (Object -> Parser NewRemovalReasonID)
-> Value
-> Parser NewRemovalReasonID
forall a b. (a -> b) -> a -> b
$ (Text -> NewRemovalReasonID)
-> Parser Text -> Parser NewRemovalReasonID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> NewRemovalReasonID
NewRemovalReasonID (Parser Text -> Parser NewRemovalReasonID)
-> (Object -> Parser Text) -> Object -> Parser NewRemovalReasonID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id")

--Relationships----------------------------------------------------------------
-- | Various permissions that can be afforded to moderators and invitees
data ModPermission
    = Access
    | Flair
    | Mail
    | Configuration
    | ChatConfig
    | ChatOperator
    | Posts
    | Wiki
    deriving stock ( Int -> ModPermission -> ShowS
[ModPermission] -> ShowS
ModPermission -> String
(Int -> ModPermission -> ShowS)
-> (ModPermission -> String)
-> ([ModPermission] -> ShowS)
-> Show ModPermission
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModPermission] -> ShowS
$cshowList :: [ModPermission] -> ShowS
show :: ModPermission -> String
$cshow :: ModPermission -> String
showsPrec :: Int -> ModPermission -> ShowS
$cshowsPrec :: Int -> ModPermission -> ShowS
Show, ModPermission -> ModPermission -> Bool
(ModPermission -> ModPermission -> Bool)
-> (ModPermission -> ModPermission -> Bool) -> Eq ModPermission
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModPermission -> ModPermission -> Bool
$c/= :: ModPermission -> ModPermission -> Bool
== :: ModPermission -> ModPermission -> Bool
$c== :: ModPermission -> ModPermission -> Bool
Eq, (forall x. ModPermission -> Rep ModPermission x)
-> (forall x. Rep ModPermission x -> ModPermission)
-> Generic ModPermission
forall x. Rep ModPermission x -> ModPermission
forall x. ModPermission -> Rep ModPermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModPermission x -> ModPermission
$cfrom :: forall x. ModPermission -> Rep ModPermission x
Generic, Eq ModPermission
Eq ModPermission
-> (ModPermission -> ModPermission -> Ordering)
-> (ModPermission -> ModPermission -> Bool)
-> (ModPermission -> ModPermission -> Bool)
-> (ModPermission -> ModPermission -> Bool)
-> (ModPermission -> ModPermission -> Bool)
-> (ModPermission -> ModPermission -> ModPermission)
-> (ModPermission -> ModPermission -> ModPermission)
-> Ord ModPermission
ModPermission -> ModPermission -> Bool
ModPermission -> ModPermission -> Ordering
ModPermission -> ModPermission -> ModPermission
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModPermission -> ModPermission -> ModPermission
$cmin :: ModPermission -> ModPermission -> ModPermission
max :: ModPermission -> ModPermission -> ModPermission
$cmax :: ModPermission -> ModPermission -> ModPermission
>= :: ModPermission -> ModPermission -> Bool
$c>= :: ModPermission -> ModPermission -> Bool
> :: ModPermission -> ModPermission -> Bool
$c> :: ModPermission -> ModPermission -> Bool
<= :: ModPermission -> ModPermission -> Bool
$c<= :: ModPermission -> ModPermission -> Bool
< :: ModPermission -> ModPermission -> Bool
$c< :: ModPermission -> ModPermission -> Bool
compare :: ModPermission -> ModPermission -> Ordering
$ccompare :: ModPermission -> ModPermission -> Ordering
$cp1Ord :: Eq ModPermission
Ord, Int -> ModPermission
ModPermission -> Int
ModPermission -> [ModPermission]
ModPermission -> ModPermission
ModPermission -> ModPermission -> [ModPermission]
ModPermission -> ModPermission -> ModPermission -> [ModPermission]
(ModPermission -> ModPermission)
-> (ModPermission -> ModPermission)
-> (Int -> ModPermission)
-> (ModPermission -> Int)
-> (ModPermission -> [ModPermission])
-> (ModPermission -> ModPermission -> [ModPermission])
-> (ModPermission -> ModPermission -> [ModPermission])
-> (ModPermission
    -> ModPermission -> ModPermission -> [ModPermission])
-> Enum ModPermission
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ModPermission -> ModPermission -> ModPermission -> [ModPermission]
$cenumFromThenTo :: ModPermission -> ModPermission -> ModPermission -> [ModPermission]
enumFromTo :: ModPermission -> ModPermission -> [ModPermission]
$cenumFromTo :: ModPermission -> ModPermission -> [ModPermission]
enumFromThen :: ModPermission -> ModPermission -> [ModPermission]
$cenumFromThen :: ModPermission -> ModPermission -> [ModPermission]
enumFrom :: ModPermission -> [ModPermission]
$cenumFrom :: ModPermission -> [ModPermission]
fromEnum :: ModPermission -> Int
$cfromEnum :: ModPermission -> Int
toEnum :: Int -> ModPermission
$ctoEnum :: Int -> ModPermission
pred :: ModPermission -> ModPermission
$cpred :: ModPermission -> ModPermission
succ :: ModPermission -> ModPermission
$csucc :: ModPermission -> ModPermission
Enum, ModPermission
ModPermission -> ModPermission -> Bounded ModPermission
forall a. a -> a -> Bounded a
maxBound :: ModPermission
$cmaxBound :: ModPermission
minBound :: ModPermission
$cminBound :: ModPermission
Bounded )

instance ToHttpApiData ModPermission where
    toQueryParam :: ModPermission -> Text
toQueryParam = \case
        ModPermission
Configuration -> Text
"config"
        ModPermission
ChatOperator  -> Text
"chat_operator"
        ModPermission
ChatConfig    -> Text
"chat_config"
        ModPermission
s             -> ModPermission -> Text
forall a. Show a => a -> Text
showTextData ModPermission
s

instance FromJSON ModPermission where
    parseJSON :: Value -> Parser ModPermission
parseJSON = Options -> Value -> Parser ModPermission
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON --
        Options
defaultOptions { constructorTagModifier :: ShowS
constructorTagModifier = ShowS
modPermissionTagModifier }

instance FromJSONKey ModPermission where
    fromJSONKey :: FromJSONKeyFunction ModPermission
fromJSONKey = JSONKeyOptions -> FromJSONKeyFunction ModPermission
forall a.
(Generic a, GFromJSONKey (Rep a)) =>
JSONKeyOptions -> FromJSONKeyFunction a
genericFromJSONKey --
        JSONKeyOptions
defaultJSONKeyOptions { keyModifier :: ShowS
keyModifier = ShowS
modPermissionTagModifier }

modPermissionTagModifier :: [Char] -> [Char]
modPermissionTagModifier :: ShowS
modPermissionTagModifier = \case
    String
tag
        | String
tag String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"ChatConfig", String
"ChatOperator" ] -> ShowS
snakeCase String
tag
        | String
tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Configuration" -> String
"config"
        | Bool
otherwise -> Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
tag

instance Hashable ModPermission

-- | The types of relationships that mods can manipulate
data SubredditRelationship
    = Mod
    | ModInvitation
    | Contributor
    | BannedFromWiki
    | WikiContributor
    | Banned
    | Muted
    deriving stock ( Int -> SubredditRelationship -> ShowS
[SubredditRelationship] -> ShowS
SubredditRelationship -> String
(Int -> SubredditRelationship -> ShowS)
-> (SubredditRelationship -> String)
-> ([SubredditRelationship] -> ShowS)
-> Show SubredditRelationship
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubredditRelationship] -> ShowS
$cshowList :: [SubredditRelationship] -> ShowS
show :: SubredditRelationship -> String
$cshow :: SubredditRelationship -> String
showsPrec :: Int -> SubredditRelationship -> ShowS
$cshowsPrec :: Int -> SubredditRelationship -> ShowS
Show, SubredditRelationship -> SubredditRelationship -> Bool
(SubredditRelationship -> SubredditRelationship -> Bool)
-> (SubredditRelationship -> SubredditRelationship -> Bool)
-> Eq SubredditRelationship
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubredditRelationship -> SubredditRelationship -> Bool
$c/= :: SubredditRelationship -> SubredditRelationship -> Bool
== :: SubredditRelationship -> SubredditRelationship -> Bool
$c== :: SubredditRelationship -> SubredditRelationship -> Bool
Eq, (forall x. SubredditRelationship -> Rep SubredditRelationship x)
-> (forall x. Rep SubredditRelationship x -> SubredditRelationship)
-> Generic SubredditRelationship
forall x. Rep SubredditRelationship x -> SubredditRelationship
forall x. SubredditRelationship -> Rep SubredditRelationship x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubredditRelationship x -> SubredditRelationship
$cfrom :: forall x. SubredditRelationship -> Rep SubredditRelationship x
Generic )

instance ToHttpApiData SubredditRelationship where
    toQueryParam :: SubredditRelationship -> Text
toQueryParam = \case
        SubredditRelationship
Mod             -> Text
"moderator"
        SubredditRelationship
ModInvitation   -> Text
"moderator_invite"
        SubredditRelationship
Contributor     -> Text
"contributor"
        SubredditRelationship
BannedFromWiki  -> Text
"wikibanned"
        SubredditRelationship
WikiContributor -> Text
"wikicontributor"
        SubredditRelationship
Banned          -> Text
"banned"
        SubredditRelationship
Muted           -> Text
"muted"

    toUrlPiece :: SubredditRelationship -> Text
toUrlPiece = \case
        SubredditRelationship
rel
            | SubredditRelationship
rel SubredditRelationship -> [SubredditRelationship] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ SubredditRelationship
Contributor, SubredditRelationship
WikiContributor ] ->
                SubredditRelationship -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam SubredditRelationship
rel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"s" -- these types are pluralized in
                                        -- get requests
            | Bool
otherwise -> SubredditRelationship -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam SubredditRelationship
rel

-- | Information about a user who has been invited to moderate the subreddit
data ModInvitee = ModInvitee
    { ModInvitee -> UserID
userID      :: UserID
    , ModInvitee -> Username
username    :: Username
      -- | Flair text on this subreddit
    , ModInvitee -> Maybe FlairText
flairText   :: Maybe FlairText
    , ModInvitee -> HashMap ModPermission Bool
permissions :: HashMap ModPermission Bool
    , ModInvitee -> UTCTime
moddedAt    :: UTCTime
    , ModInvitee -> Integer
postKarma   :: Integer
    }
    deriving stock ( Int -> ModInvitee -> ShowS
[ModInvitee] -> ShowS
ModInvitee -> String
(Int -> ModInvitee -> ShowS)
-> (ModInvitee -> String)
-> ([ModInvitee] -> ShowS)
-> Show ModInvitee
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModInvitee] -> ShowS
$cshowList :: [ModInvitee] -> ShowS
show :: ModInvitee -> String
$cshow :: ModInvitee -> String
showsPrec :: Int -> ModInvitee -> ShowS
$cshowsPrec :: Int -> ModInvitee -> ShowS
Show, ModInvitee -> ModInvitee -> Bool
(ModInvitee -> ModInvitee -> Bool)
-> (ModInvitee -> ModInvitee -> Bool) -> Eq ModInvitee
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModInvitee -> ModInvitee -> Bool
$c/= :: ModInvitee -> ModInvitee -> Bool
== :: ModInvitee -> ModInvitee -> Bool
$c== :: ModInvitee -> ModInvitee -> Bool
Eq, (forall x. ModInvitee -> Rep ModInvitee x)
-> (forall x. Rep ModInvitee x -> ModInvitee) -> Generic ModInvitee
forall x. Rep ModInvitee x -> ModInvitee
forall x. ModInvitee -> Rep ModInvitee x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModInvitee x -> ModInvitee
$cfrom :: forall x. ModInvitee -> Rep ModInvitee x
Generic )

instance FromJSON ModInvitee where
    parseJSON :: Value -> Parser ModInvitee
parseJSON = String
-> (Object -> Parser ModInvitee) -> Value -> Parser ModInvitee
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ModInvitee" ((Object -> Parser ModInvitee) -> Value -> Parser ModInvitee)
-> (Object -> Parser ModInvitee) -> Value -> Parser ModInvitee
forall a b. (a -> b) -> a -> b
$ \Object
o -> UserID
-> Username
-> Maybe FlairText
-> HashMap ModPermission Bool
-> UTCTime
-> Integer
-> ModInvitee
ModInvitee (UserID
 -> Username
 -> Maybe FlairText
 -> HashMap ModPermission Bool
 -> UTCTime
 -> Integer
 -> ModInvitee)
-> Parser UserID
-> Parser
     (Username
      -> Maybe FlairText
      -> HashMap ModPermission Bool
      -> UTCTime
      -> Integer
      -> ModInvitee)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser UserID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
        Parser
  (Username
   -> Maybe FlairText
   -> HashMap ModPermission Bool
   -> UTCTime
   -> Integer
   -> ModInvitee)
-> Parser Username
-> Parser
     (Maybe FlairText
      -> HashMap ModPermission Bool -> UTCTime -> Integer -> ModInvitee)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Username
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"username"
        Parser
  (Maybe FlairText
   -> HashMap ModPermission Bool -> UTCTime -> Integer -> ModInvitee)
-> Parser (Maybe FlairText)
-> Parser
     (HashMap ModPermission Bool -> UTCTime -> Integer -> ModInvitee)
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
"authorFlairText"
        Parser
  (HashMap ModPermission Bool -> UTCTime -> Integer -> ModInvitee)
-> Parser (HashMap ModPermission Bool)
-> Parser (UTCTime -> Integer -> ModInvitee)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser (HashMap ModPermission Bool)
handlePerms (Value -> Parser (HashMap ModPermission Bool))
-> Parser Value -> Parser (HashMap ModPermission Bool)
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
"modPermissions")
        Parser (UTCTime -> Integer -> ModInvitee)
-> Parser UTCTime -> Parser (Integer -> ModInvitee)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> UTCTime
integerToUTC (Integer -> UTCTime) -> Parser Integer -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"moddedAtUTC")
        Parser (Integer -> ModInvitee)
-> Parser Integer -> Parser ModInvitee
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"postKarma"
      where
        -- Reddit uses "all" as an permission, but this perm is not exposed
        -- as a constructor for @ModPermission@, as doing so would allow
        -- invalid states where @All@ is selected, but not all permissions
        -- are provided
        handlePerms :: Value -> Parser (HashMap ModPermission Bool)
handlePerms = String
-> (Object -> Parser (HashMap ModPermission Bool))
-> Value
-> Parser (HashMap ModPermission Bool)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"HashMap ModPermission Bool"
            ((Object -> Parser (HashMap ModPermission Bool))
 -> Value -> Parser (HashMap ModPermission Bool))
-> (Object -> Parser (HashMap ModPermission Bool))
-> Value
-> Parser (HashMap ModPermission Bool)
forall a b. (a -> b) -> a -> b
$ \Object
o -> Value -> Parser (HashMap ModPermission Bool)
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser (HashMap ModPermission Bool))
-> (Object -> Value)
-> Object
-> Parser (HashMap ModPermission Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Value
Object (Object -> Parser (HashMap ModPermission Bool))
-> Object -> Parser (HashMap ModPermission Bool)
forall a b. (a -> b) -> a -> b
$ Text -> Object -> Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Text
"all" Object
o

-- | A list containing users invited to moderate the subreddit. For some reason,
-- the endpoints listing moderator invites do not use the same @Listing@ mechanism
-- that most other endpoints do
data ModInviteeList = ModInviteeList
    { -- | At most 25 of the invited moderators
      ModInviteeList -> Seq ModInvitee
invited        :: Seq ModInvitee
      -- | If the list contains all invitees
    , ModInviteeList -> Bool
allUsersLoaded :: Bool
      -- | Pagination controls for the next moderator invites
    , ModInviteeList -> Maybe UserID
after          :: Maybe UserID
      -- | Pagination controls for the previous moderator invites
    , ModInviteeList -> Maybe UserID
before         :: Maybe UserID
    }
    deriving stock ( Int -> ModInviteeList -> ShowS
[ModInviteeList] -> ShowS
ModInviteeList -> String
(Int -> ModInviteeList -> ShowS)
-> (ModInviteeList -> String)
-> ([ModInviteeList] -> ShowS)
-> Show ModInviteeList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModInviteeList] -> ShowS
$cshowList :: [ModInviteeList] -> ShowS
show :: ModInviteeList -> String
$cshow :: ModInviteeList -> String
showsPrec :: Int -> ModInviteeList -> ShowS
$cshowsPrec :: Int -> ModInviteeList -> ShowS
Show, ModInviteeList -> ModInviteeList -> Bool
(ModInviteeList -> ModInviteeList -> Bool)
-> (ModInviteeList -> ModInviteeList -> Bool) -> Eq ModInviteeList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModInviteeList -> ModInviteeList -> Bool
$c/= :: ModInviteeList -> ModInviteeList -> Bool
== :: ModInviteeList -> ModInviteeList -> Bool
$c== :: ModInviteeList -> ModInviteeList -> Bool
Eq, (forall x. ModInviteeList -> Rep ModInviteeList x)
-> (forall x. Rep ModInviteeList x -> ModInviteeList)
-> Generic ModInviteeList
forall x. Rep ModInviteeList x -> ModInviteeList
forall x. ModInviteeList -> Rep ModInviteeList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModInviteeList x -> ModInviteeList
$cfrom :: forall x. ModInviteeList -> Rep ModInviteeList x
Generic )

instance FromJSON ModInviteeList where
    parseJSON :: Value -> Parser ModInviteeList
parseJSON = String
-> (Object -> Parser ModInviteeList)
-> Value
-> Parser ModInviteeList
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ModInviteeList" ((Object -> Parser ModInviteeList)
 -> Value -> Parser ModInviteeList)
-> (Object -> Parser ModInviteeList)
-> Value
-> Parser ModInviteeList
forall a b. (a -> b) -> a -> b
$ \Object
o -> Seq ModInvitee
-> Bool -> Maybe UserID -> Maybe UserID -> ModInviteeList
ModInviteeList
        (Seq ModInvitee
 -> Bool -> Maybe UserID -> Maybe UserID -> ModInviteeList)
-> Parser (Seq ModInvitee)
-> Parser (Bool -> Maybe UserID -> Maybe UserID -> ModInviteeList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object -> Parser (Seq ModInvitee)
forall b. FromJSON b => Object -> Parser (Seq b)
getVals (Object -> Parser (Seq ModInvitee))
-> Parser Object -> Parser (Seq ModInvitee)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"moderators")
        Parser (Bool -> Maybe UserID -> Maybe UserID -> ModInviteeList)
-> Parser Bool
-> Parser (Maybe UserID -> Maybe UserID -> ModInviteeList)
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
"allUsersLoaded"
        Parser (Maybe UserID -> Maybe UserID -> ModInviteeList)
-> Parser (Maybe UserID) -> Parser (Maybe UserID -> ModInviteeList)
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 a
.: Text
"after"
        Parser (Maybe UserID -> ModInviteeList)
-> Parser (Maybe UserID) -> Parser ModInviteeList
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 a
.: Text
"before"

-- | This instance can be used to paginate through the listings, with a bias
-- towards @after@
instance ToForm ModInviteeList where
    toForm :: ModInviteeList -> Form
toForm ModInviteeList { Bool
Maybe UserID
Seq ModInvitee
before :: Maybe UserID
after :: Maybe UserID
allUsersLoaded :: Bool
invited :: Seq ModInvitee
$sel:before:ModInviteeList :: ModInviteeList -> Maybe UserID
$sel:after:ModInviteeList :: ModInviteeList -> Maybe UserID
$sel:allUsersLoaded:ModInviteeList :: ModInviteeList -> Bool
$sel:invited:ModInviteeList :: ModInviteeList -> Seq ModInvitee
.. } = [(Text, Text)] -> Form
forall l. IsList l => [Item l] -> l
fromList ([(Text, Text)] -> Form)
-> (Maybe (Text, Text) -> [(Text, Text)])
-> Maybe (Text, Text)
-> Form
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Text, Text) -> [(Text, Text)]
forall a. Maybe a -> [a]
maybeToList
        (Maybe (Text, Text) -> Form) -> Maybe (Text, Text) -> Form
forall a b. (a -> b) -> a -> b
$ [Maybe (Text, Text)] -> Maybe (Text, Text)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ (Text
"after", ) (Text -> (Text, Text))
-> (UserID -> Text) -> UserID -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserID -> Text
forall a. Thing a => a -> Text
fullname (UserID -> (Text, Text)) -> Maybe UserID -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UserID
after
               , (Text
"before", ) (Text -> (Text, Text))
-> (UserID -> Text) -> UserID -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserID -> Text
forall a. Thing a => a -> Text
fullname (UserID -> (Text, Text)) -> Maybe UserID -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UserID
before
               ]

-- | Account information about a moderator, similar to a 'Account', but
-- with less information
data ModAccount = ModAccount
    { ModAccount -> Username
username    :: Username
    , ModAccount -> UserID
userID      :: UserID
    , ModAccount -> RelID
relID       :: RelID
      -- | Flair text on the subreddit
    , ModAccount -> Maybe FlairText
flairText   :: Maybe FlairText
      -- | Flair CSS class on the subreddit
    , ModAccount -> Maybe Text
flairCSS    :: Maybe CSSClass
    , ModAccount -> UTCTime
date        :: UTCTime
      -- | If @Nothing@, indicates the user has all mod permissions
    , ModAccount -> Maybe [ModPermission]
permissions :: Maybe [ModPermission]
    }
    deriving stock ( Int -> ModAccount -> ShowS
[ModAccount] -> ShowS
ModAccount -> String
(Int -> ModAccount -> ShowS)
-> (ModAccount -> String)
-> ([ModAccount] -> ShowS)
-> Show ModAccount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModAccount] -> ShowS
$cshowList :: [ModAccount] -> ShowS
show :: ModAccount -> String
$cshow :: ModAccount -> String
showsPrec :: Int -> ModAccount -> ShowS
$cshowsPrec :: Int -> ModAccount -> ShowS
Show, ModAccount -> ModAccount -> Bool
(ModAccount -> ModAccount -> Bool)
-> (ModAccount -> ModAccount -> Bool) -> Eq ModAccount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModAccount -> ModAccount -> Bool
$c/= :: ModAccount -> ModAccount -> Bool
== :: ModAccount -> ModAccount -> Bool
$c== :: ModAccount -> ModAccount -> Bool
Eq, (forall x. ModAccount -> Rep ModAccount x)
-> (forall x. Rep ModAccount x -> ModAccount) -> Generic ModAccount
forall x. Rep ModAccount x -> ModAccount
forall x. ModAccount -> Rep ModAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModAccount x -> ModAccount
$cfrom :: forall x. ModAccount -> Rep ModAccount x
Generic )

instance FromJSON ModAccount where
    parseJSON :: Value -> Parser ModAccount
parseJSON = String
-> (Object -> Parser ModAccount) -> Value -> Parser ModAccount
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ModAccount" ((Object -> Parser ModAccount) -> Value -> Parser ModAccount)
-> (Object -> Parser ModAccount) -> Value -> Parser ModAccount
forall a b. (a -> b) -> a -> b
$ \Object
o -> Username
-> UserID
-> RelID
-> Maybe FlairText
-> Maybe Text
-> UTCTime
-> Maybe [ModPermission]
-> ModAccount
ModAccount (Username
 -> UserID
 -> RelID
 -> Maybe FlairText
 -> Maybe Text
 -> UTCTime
 -> Maybe [ModPermission]
 -> ModAccount)
-> Parser Username
-> Parser
     (UserID
      -> RelID
      -> Maybe FlairText
      -> Maybe Text
      -> UTCTime
      -> Maybe [ModPermission]
      -> ModAccount)
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
"name"
        Parser
  (UserID
   -> RelID
   -> Maybe FlairText
   -> Maybe Text
   -> UTCTime
   -> Maybe [ModPermission]
   -> ModAccount)
-> Parser UserID
-> Parser
     (RelID
      -> Maybe FlairText
      -> Maybe Text
      -> UTCTime
      -> Maybe [ModPermission]
      -> ModAccount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser UserID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
        Parser
  (RelID
   -> Maybe FlairText
   -> Maybe Text
   -> UTCTime
   -> Maybe [ModPermission]
   -> ModAccount)
-> Parser RelID
-> Parser
     (Maybe FlairText
      -> Maybe Text -> UTCTime -> Maybe [ModPermission] -> ModAccount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser RelID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"rel_id"
        Parser
  (Maybe FlairText
   -> Maybe Text -> UTCTime -> Maybe [ModPermission] -> ModAccount)
-> Parser (Maybe FlairText)
-> Parser
     (Maybe Text -> UTCTime -> Maybe [ModPermission] -> ModAccount)
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 a
.: Text
"author_flair_text"
        Parser
  (Maybe Text -> UTCTime -> Maybe [ModPermission] -> ModAccount)
-> Parser (Maybe Text)
-> Parser (UTCTime -> Maybe [ModPermission] -> ModAccount)
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
"author_flair_css_class"
        Parser (UTCTime -> Maybe [ModPermission] -> ModAccount)
-> Parser UTCTime -> Parser (Maybe [ModPermission] -> ModAccount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> UTCTime
integerToUTC (Integer -> UTCTime) -> Parser Integer -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"date")
        Parser (Maybe [ModPermission] -> ModAccount)
-> Parser (Maybe [ModPermission]) -> Parser ModAccount
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ModPermission] -> Parser (Maybe [ModPermission])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Object
o Object -> Text -> Parser [ModPermission]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"mod_permissions")

-- | Wrapped for list of moderators, which resembles a 'Listing', but cannot be
-- paginated or filtered
newtype ModList = ModList (Seq ModAccount)
    deriving stock ( Int -> ModList -> ShowS
[ModList] -> ShowS
ModList -> String
(Int -> ModList -> ShowS)
-> (ModList -> String) -> ([ModList] -> ShowS) -> Show ModList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModList] -> ShowS
$cshowList :: [ModList] -> ShowS
show :: ModList -> String
$cshow :: ModList -> String
showsPrec :: Int -> ModList -> ShowS
$cshowsPrec :: Int -> ModList -> ShowS
Show, (forall x. ModList -> Rep ModList x)
-> (forall x. Rep ModList x -> ModList) -> Generic ModList
forall x. Rep ModList x -> ModList
forall x. ModList -> Rep ModList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModList x -> ModList
$cfrom :: forall x. ModList -> Rep ModList x
Generic )

instance FromJSON ModList where
    parseJSON :: Value -> Parser ModList
parseJSON =
        RedditKind
-> String -> (Object -> Parser ModList) -> Value -> Parser ModList
forall b a.
FromJSON b =>
RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind RedditKind
UserListKind String
"ModList" ((Object -> Parser ModList) -> Value -> Parser ModList)
-> (Object -> Parser ModList) -> Value -> Parser ModList
forall a b. (a -> b) -> a -> b
$ \Object
o -> Seq ModAccount -> ModList
ModList (Seq ModAccount -> ModList)
-> Parser (Seq ModAccount) -> Parser ModList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Seq ModAccount)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"children"

-- | Information about a contributor on the subreddit
data RelInfo = RelInfo
    { RelInfo -> UserID
userID   :: UserID
    , RelInfo -> RelID
relID    :: RelID
    , RelInfo -> Username
username :: Username
    , RelInfo -> UTCTime
date     :: UTCTime
    }
    deriving stock ( Int -> RelInfo -> ShowS
[RelInfo] -> ShowS
RelInfo -> String
(Int -> RelInfo -> ShowS)
-> (RelInfo -> String) -> ([RelInfo] -> ShowS) -> Show RelInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelInfo] -> ShowS
$cshowList :: [RelInfo] -> ShowS
show :: RelInfo -> String
$cshow :: RelInfo -> String
showsPrec :: Int -> RelInfo -> ShowS
$cshowsPrec :: Int -> RelInfo -> ShowS
Show, RelInfo -> RelInfo -> Bool
(RelInfo -> RelInfo -> Bool)
-> (RelInfo -> RelInfo -> Bool) -> Eq RelInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelInfo -> RelInfo -> Bool
$c/= :: RelInfo -> RelInfo -> Bool
== :: RelInfo -> RelInfo -> Bool
$c== :: RelInfo -> RelInfo -> Bool
Eq, (forall x. RelInfo -> Rep RelInfo x)
-> (forall x. Rep RelInfo x -> RelInfo) -> Generic RelInfo
forall x. Rep RelInfo x -> RelInfo
forall x. RelInfo -> Rep RelInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RelInfo x -> RelInfo
$cfrom :: forall x. RelInfo -> Rep RelInfo x
Generic )

instance FromJSON RelInfo where
    parseJSON :: Value -> Parser RelInfo
parseJSON = String -> (Object -> Parser RelInfo) -> Value -> Parser RelInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RelInfo" ((Object -> Parser RelInfo) -> Value -> Parser RelInfo)
-> (Object -> Parser RelInfo) -> Value -> Parser RelInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> UserID -> RelID -> Username -> UTCTime -> RelInfo
RelInfo (UserID -> RelID -> Username -> UTCTime -> RelInfo)
-> Parser UserID
-> Parser (RelID -> Username -> UTCTime -> RelInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser UserID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
        Parser (RelID -> Username -> UTCTime -> RelInfo)
-> Parser RelID -> Parser (Username -> UTCTime -> RelInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser RelID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"rel_id"
        Parser (Username -> UTCTime -> RelInfo)
-> Parser Username -> Parser (UTCTime -> RelInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Username
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
        Parser (UTCTime -> RelInfo) -> Parser UTCTime -> Parser RelInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> UTCTime
integerToUTC (Integer -> UTCTime) -> Parser Integer -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"date")

instance Paginable RelInfo where
    type PaginateOptions RelInfo = RelInfoOpts

    type PaginateThing RelInfo = RelID

    defaultOpts :: PaginateOptions RelInfo
defaultOpts = RelInfoOpts :: Maybe Username -> RelInfoOpts
RelInfoOpts { $sel:username:RelInfoOpts :: Maybe Username
username = Maybe Username
forall a. Maybe a
Nothing }

    getFullname :: RelInfo -> PaginateThing RelInfo
getFullname RelInfo { RelID
relID :: RelID
$sel:relID:RelInfo :: RelInfo -> RelID
relID } = PaginateThing RelInfo
RelID
relID

-- | Information about a muted user
data MuteInfo = MuteInfo
    { MuteInfo -> UserID
userID   :: UserID
    , MuteInfo -> MuteID
muteID   :: MuteID
    , MuteInfo -> Username
username :: Username
    , MuteInfo -> UTCTime
date     :: UTCTime
    }
    deriving stock ( Int -> MuteInfo -> ShowS
[MuteInfo] -> ShowS
MuteInfo -> String
(Int -> MuteInfo -> ShowS)
-> (MuteInfo -> String) -> ([MuteInfo] -> ShowS) -> Show MuteInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MuteInfo] -> ShowS
$cshowList :: [MuteInfo] -> ShowS
show :: MuteInfo -> String
$cshow :: MuteInfo -> String
showsPrec :: Int -> MuteInfo -> ShowS
$cshowsPrec :: Int -> MuteInfo -> ShowS
Show, MuteInfo -> MuteInfo -> Bool
(MuteInfo -> MuteInfo -> Bool)
-> (MuteInfo -> MuteInfo -> Bool) -> Eq MuteInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MuteInfo -> MuteInfo -> Bool
$c/= :: MuteInfo -> MuteInfo -> Bool
== :: MuteInfo -> MuteInfo -> Bool
$c== :: MuteInfo -> MuteInfo -> Bool
Eq, (forall x. MuteInfo -> Rep MuteInfo x)
-> (forall x. Rep MuteInfo x -> MuteInfo) -> Generic MuteInfo
forall x. Rep MuteInfo x -> MuteInfo
forall x. MuteInfo -> Rep MuteInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MuteInfo x -> MuteInfo
$cfrom :: forall x. MuteInfo -> Rep MuteInfo x
Generic )

instance FromJSON MuteInfo where
    parseJSON :: Value -> Parser MuteInfo
parseJSON = String -> (Object -> Parser MuteInfo) -> Value -> Parser MuteInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"MuteInfo" ((Object -> Parser MuteInfo) -> Value -> Parser MuteInfo)
-> (Object -> Parser MuteInfo) -> Value -> Parser MuteInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> UserID -> MuteID -> Username -> UTCTime -> MuteInfo
MuteInfo (UserID -> MuteID -> Username -> UTCTime -> MuteInfo)
-> Parser UserID
-> Parser (MuteID -> Username -> UTCTime -> MuteInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser UserID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
        Parser (MuteID -> Username -> UTCTime -> MuteInfo)
-> Parser MuteID -> Parser (Username -> UTCTime -> MuteInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser MuteID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"rel_id"
        Parser (Username -> UTCTime -> MuteInfo)
-> Parser Username -> Parser (UTCTime -> MuteInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Username
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
        Parser (UTCTime -> MuteInfo) -> Parser UTCTime -> Parser MuteInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> UTCTime
integerToUTC (Integer -> UTCTime) -> Parser Integer -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"date")

instance Paginable MuteInfo where
    type PaginateOptions MuteInfo = RelInfoOpts

    type PaginateThing MuteInfo = MuteID

    defaultOpts :: PaginateOptions MuteInfo
defaultOpts = RelInfoOpts :: Maybe Username -> RelInfoOpts
RelInfoOpts { $sel:username:RelInfoOpts :: Maybe Username
username = Maybe Username
forall a. Maybe a
Nothing }

    getFullname :: MuteInfo -> PaginateThing MuteInfo
getFullname MuteInfo { MuteID
muteID :: MuteID
$sel:muteID:MuteInfo :: MuteInfo -> MuteID
muteID } = PaginateThing MuteInfo
MuteID
muteID

-- | Options for 'Listing's of 'RelInfo'. Currently only takes a single
-- field, @user@, to limit the listing to a single user
data RelInfoOpts = RelInfoOpts { RelInfoOpts -> Maybe Username
username :: Maybe Username }
    deriving stock ( Int -> RelInfoOpts -> ShowS
[RelInfoOpts] -> ShowS
RelInfoOpts -> String
(Int -> RelInfoOpts -> ShowS)
-> (RelInfoOpts -> String)
-> ([RelInfoOpts] -> ShowS)
-> Show RelInfoOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelInfoOpts] -> ShowS
$cshowList :: [RelInfoOpts] -> ShowS
show :: RelInfoOpts -> String
$cshow :: RelInfoOpts -> String
showsPrec :: Int -> RelInfoOpts -> ShowS
$cshowsPrec :: Int -> RelInfoOpts -> ShowS
Show, RelInfoOpts -> RelInfoOpts -> Bool
(RelInfoOpts -> RelInfoOpts -> Bool)
-> (RelInfoOpts -> RelInfoOpts -> Bool) -> Eq RelInfoOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelInfoOpts -> RelInfoOpts -> Bool
$c/= :: RelInfoOpts -> RelInfoOpts -> Bool
== :: RelInfoOpts -> RelInfoOpts -> Bool
$c== :: RelInfoOpts -> RelInfoOpts -> Bool
Eq, (forall x. RelInfoOpts -> Rep RelInfoOpts x)
-> (forall x. Rep RelInfoOpts x -> RelInfoOpts)
-> Generic RelInfoOpts
forall x. Rep RelInfoOpts x -> RelInfoOpts
forall x. RelInfoOpts -> Rep RelInfoOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RelInfoOpts x -> RelInfoOpts
$cfrom :: forall x. RelInfoOpts -> Rep RelInfoOpts x
Generic )

instance ToForm RelInfoOpts where
    toForm :: RelInfoOpts -> Form
toForm RelInfoOpts { Maybe Username
username :: Maybe Username
$sel:username:RelInfoOpts :: RelInfoOpts -> Maybe Username
.. } = [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, 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
"user", ) (Text -> (Text, Text))
-> (Username -> Text) -> Username -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Username -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (Username -> (Text, Text)) -> Maybe Username -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Username
username)

--Subreddit settings-----------------------------------------------------------
-- | The settings that may be configured for a particular subreddit
data SubredditSettings = SubredditSettings
    { SubredditSettings -> SubredditID
subredditID             :: SubredditID
    , SubredditSettings -> Text
title                   :: Title
    , SubredditSettings -> Text
description             :: Body
      -- | The text that appears on the submission page
    , SubredditSettings -> Text
submitText              :: Text
      -- | Custom label for creating submissions
    , SubredditSettings -> Text
submitTextLabel         :: Text
      -- | The text seen when hovering over the snoo
    , SubredditSettings -> Text
headerHoverText         :: Text
    , SubredditSettings -> LanguageCode
language                :: LanguageCode
    , SubredditSettings -> SubredditType
subredditType           :: SubredditType
    , SubredditSettings -> ContentOptions
contentOptions          :: ContentOptions
      -- | A hex string specifying the color theme on mobile
    , SubredditSettings -> Text
keyColor                :: RGBText
    , SubredditSettings -> Wikimode
wikimode                :: Wikimode
    , SubredditSettings -> Integer
wikiEditKarma           :: Integer
    , SubredditSettings -> Integer
wikiEditAge             :: Integer
    , SubredditSettings -> Integer
commentScoreHideMins    :: Integer
    , SubredditSettings -> SpamFilter
spamComments            :: SpamFilter
    , SubredditSettings -> SpamFilter
spamSelfposts           :: SpamFilter
    , SubredditSettings -> SpamFilter
spamLinks               :: SpamFilter
    , SubredditSettings -> CrowdControlLevel
crowdControlLevel       :: CrowdControlLevel
    , SubredditSettings -> CrowdControlLevel
crowdControlChatLevel   :: CrowdControlLevel
    , SubredditSettings -> Bool
crowdControlMode        :: Bool
    , SubredditSettings -> Maybe ItemSort
suggestedCommentSort    :: Maybe ItemSort
    , SubredditSettings -> Maybe Text
welcomeMessageText      :: Maybe Text
    , SubredditSettings -> Bool
welcomeMessageEnabled   :: Bool
    , SubredditSettings -> Bool
allowImages             :: Bool
    , SubredditSettings -> Bool
allowVideos             :: Bool
    , SubredditSettings -> Bool
allowPolls              :: Bool
    , SubredditSettings -> Bool
allowCrossposts         :: Bool
    , SubredditSettings -> Bool
allowChatPostCreation   :: Bool
    , SubredditSettings -> Bool
spoilersEnabled         :: Bool
    , SubredditSettings -> Bool
showMedia               :: Bool
    , SubredditSettings -> Bool
showMediaPreview        :: Bool
      -- | Restrict all posting to only approved users
    , SubredditSettings -> Bool
restrictPosting         :: Bool
      -- | Restrict all commenting to only approved users
    , SubredditSettings -> Bool
restrictCommenting      :: Bool
    , SubredditSettings -> Bool
over18                  :: Bool
    , SubredditSettings -> Bool
collapseDeletedComments :: Bool
      -- | Allows the sub to appear in \"r/all\" and trending subs
    , SubredditSettings -> Bool
defaultSet              :: Bool
      -- | Whether users may send modmail messages approval as a submitter
    , SubredditSettings -> Bool
disableContribRequests  :: Bool
      -- | Allow users to enter custom report reasons
    , SubredditSettings -> Bool
freeFormReports         :: Bool
      -- | Exclude posts from site-wide banned users in the modqueue
    , SubredditSettings -> Bool
excludeBannedModqueue   :: Bool
      -- | Whether the \"original content\" tag is enabled
    , SubredditSettings -> Bool
ocTagEnabled            :: Bool
      -- | Whether to mandate that all submissions be OC
    , SubredditSettings -> Bool
allOC                   :: Bool
    }
    deriving stock ( Int -> SubredditSettings -> ShowS
[SubredditSettings] -> ShowS
SubredditSettings -> String
(Int -> SubredditSettings -> ShowS)
-> (SubredditSettings -> String)
-> ([SubredditSettings] -> ShowS)
-> Show SubredditSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubredditSettings] -> ShowS
$cshowList :: [SubredditSettings] -> ShowS
show :: SubredditSettings -> String
$cshow :: SubredditSettings -> String
showsPrec :: Int -> SubredditSettings -> ShowS
$cshowsPrec :: Int -> SubredditSettings -> ShowS
Show, SubredditSettings -> SubredditSettings -> Bool
(SubredditSettings -> SubredditSettings -> Bool)
-> (SubredditSettings -> SubredditSettings -> Bool)
-> Eq SubredditSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubredditSettings -> SubredditSettings -> Bool
$c/= :: SubredditSettings -> SubredditSettings -> Bool
== :: SubredditSettings -> SubredditSettings -> Bool
$c== :: SubredditSettings -> SubredditSettings -> Bool
Eq, (forall x. SubredditSettings -> Rep SubredditSettings x)
-> (forall x. Rep SubredditSettings x -> SubredditSettings)
-> Generic SubredditSettings
forall x. Rep SubredditSettings x -> SubredditSettings
forall x. SubredditSettings -> Rep SubredditSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubredditSettings x -> SubredditSettings
$cfrom :: forall x. SubredditSettings -> Rep SubredditSettings x
Generic )

instance FromJSON SubredditSettings where
    parseJSON :: Value -> Parser SubredditSettings
parseJSON = RedditKind
-> String
-> (Object -> Parser SubredditSettings)
-> Value
-> Parser SubredditSettings
forall b a.
FromJSON b =>
RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind RedditKind
SubredditSettingsKind
                         String
"SubredditSettings"
                         (Value -> Parser SubredditSettings
subredditSettingsP (Value -> Parser SubredditSettings)
-> (Object -> Value) -> Object -> Parser SubredditSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Value
Object)
      where
        subredditSettingsP :: Value -> Parser SubredditSettings
subredditSettingsP =
            Options -> Value -> Parser SubredditSettings
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { ShowS
fieldLabelModifier :: ShowS
fieldLabelModifier :: ShowS
fieldLabelModifier }

        fieldLabelModifier :: ShowS
fieldLabelModifier = \case
            String
"allowCrossposts" -> String
"allow_post_crossposts"
            String
"over18" -> String
"over_18"
            String
"subredditID" -> String
"subreddit_id"
            String
"disableContribRequests" -> String
"disable_contributor_requests"
            String
"ocTagEnabled" -> String
"original_content_tag_enabled"
            String
"allOC" -> String
"all_original_content"
            String
s -> ShowS
snakeCase String
s

instance ToForm SubredditSettings where
    toForm :: SubredditSettings -> Form
toForm SubredditSettings { Bool
Integer
Maybe Text
Maybe ItemSort
Text
SubredditType
SubredditID
LanguageCode
Wikimode
SpamFilter
ContentOptions
CrowdControlLevel
allOC :: Bool
ocTagEnabled :: Bool
excludeBannedModqueue :: Bool
freeFormReports :: Bool
disableContribRequests :: Bool
defaultSet :: Bool
collapseDeletedComments :: Bool
over18 :: Bool
restrictCommenting :: Bool
restrictPosting :: Bool
showMediaPreview :: Bool
showMedia :: Bool
spoilersEnabled :: Bool
allowChatPostCreation :: Bool
allowCrossposts :: Bool
allowPolls :: Bool
allowVideos :: Bool
allowImages :: Bool
welcomeMessageEnabled :: Bool
welcomeMessageText :: Maybe Text
suggestedCommentSort :: Maybe ItemSort
crowdControlMode :: Bool
crowdControlChatLevel :: CrowdControlLevel
crowdControlLevel :: CrowdControlLevel
spamLinks :: SpamFilter
spamSelfposts :: SpamFilter
spamComments :: SpamFilter
commentScoreHideMins :: Integer
wikiEditAge :: Integer
wikiEditKarma :: Integer
wikimode :: Wikimode
keyColor :: Text
contentOptions :: ContentOptions
subredditType :: SubredditType
language :: LanguageCode
headerHoverText :: Text
submitTextLabel :: Text
submitText :: Text
description :: Text
title :: Text
subredditID :: SubredditID
$sel:allOC:SubredditSettings :: SubredditSettings -> Bool
$sel:ocTagEnabled:SubredditSettings :: SubredditSettings -> Bool
$sel:excludeBannedModqueue:SubredditSettings :: SubredditSettings -> Bool
$sel:freeFormReports:SubredditSettings :: SubredditSettings -> Bool
$sel:disableContribRequests:SubredditSettings :: SubredditSettings -> Bool
$sel:defaultSet:SubredditSettings :: SubredditSettings -> Bool
$sel:collapseDeletedComments:SubredditSettings :: SubredditSettings -> Bool
$sel:over18:SubredditSettings :: SubredditSettings -> Bool
$sel:restrictCommenting:SubredditSettings :: SubredditSettings -> Bool
$sel:restrictPosting:SubredditSettings :: SubredditSettings -> Bool
$sel:showMediaPreview:SubredditSettings :: SubredditSettings -> Bool
$sel:showMedia:SubredditSettings :: SubredditSettings -> Bool
$sel:spoilersEnabled:SubredditSettings :: SubredditSettings -> Bool
$sel:allowChatPostCreation:SubredditSettings :: SubredditSettings -> Bool
$sel:allowCrossposts:SubredditSettings :: SubredditSettings -> Bool
$sel:allowPolls:SubredditSettings :: SubredditSettings -> Bool
$sel:allowVideos:SubredditSettings :: SubredditSettings -> Bool
$sel:allowImages:SubredditSettings :: SubredditSettings -> Bool
$sel:welcomeMessageEnabled:SubredditSettings :: SubredditSettings -> Bool
$sel:welcomeMessageText:SubredditSettings :: SubredditSettings -> Maybe Text
$sel:suggestedCommentSort:SubredditSettings :: SubredditSettings -> Maybe ItemSort
$sel:crowdControlMode:SubredditSettings :: SubredditSettings -> Bool
$sel:crowdControlChatLevel:SubredditSettings :: SubredditSettings -> CrowdControlLevel
$sel:crowdControlLevel:SubredditSettings :: SubredditSettings -> CrowdControlLevel
$sel:spamLinks:SubredditSettings :: SubredditSettings -> SpamFilter
$sel:spamSelfposts:SubredditSettings :: SubredditSettings -> SpamFilter
$sel:spamComments:SubredditSettings :: SubredditSettings -> SpamFilter
$sel:commentScoreHideMins:SubredditSettings :: SubredditSettings -> Integer
$sel:wikiEditAge:SubredditSettings :: SubredditSettings -> Integer
$sel:wikiEditKarma:SubredditSettings :: SubredditSettings -> Integer
$sel:wikimode:SubredditSettings :: SubredditSettings -> Wikimode
$sel:keyColor:SubredditSettings :: SubredditSettings -> Text
$sel:contentOptions:SubredditSettings :: SubredditSettings -> ContentOptions
$sel:subredditType:SubredditSettings :: SubredditSettings -> SubredditType
$sel:language:SubredditSettings :: SubredditSettings -> LanguageCode
$sel:headerHoverText:SubredditSettings :: SubredditSettings -> Text
$sel:submitTextLabel:SubredditSettings :: SubredditSettings -> Text
$sel:submitText:SubredditSettings :: SubredditSettings -> Text
$sel:description:SubredditSettings :: SubredditSettings -> Text
$sel:title:SubredditSettings :: SubredditSettings -> Text
$sel:subredditID:SubredditSettings :: SubredditSettings -> SubredditID
.. } = [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
"sr", SubredditID -> Text
forall a. Thing a => a -> Text
fullname SubredditID
subredditID)
          , (Text
"api_type", Text
"json")
          , (Text
"title", Text
title)
          , (Text
"description", Text
description)
          , (Text
"submit_text", Text
submitText)
          , (Text
"submit_text_label", Text
submitTextLabel)
          , (Text
"header_hover_text", Text
headerHoverText)
          , (Text
"language", LanguageCode -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam LanguageCode
language)
          , (Text
"type", SubredditType -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam SubredditType
subredditType)
          , (Text
"link_type", ContentOptions -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam ContentOptions
contentOptions)
          , (Text
"key_color", Text
keyColor)
          , (Text
"wikimode", Wikimode -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Wikimode
wikimode)
          , (Text
"wiki_edit_karma", Integer -> Text
forall a. Show a => a -> Text
tshow Integer
wikiEditKarma)
          , (Text
"wiki_edit_age", Integer -> Text
forall a. Show a => a -> Text
tshow Integer
wikiEditAge)
          , (Text
"comment_score_hide_mins", Integer -> Text
forall a. Show a => a -> Text
tshow Integer
commentScoreHideMins)
          , (Text
"spam_comments", SpamFilter -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam SpamFilter
spamComments)
          , (Text
"spam_selfposts", SpamFilter -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam SpamFilter
spamSelfposts)
          , (Text
"spam_links", SpamFilter -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam SpamFilter
spamLinks)
          , (Text
"crowd_control_level", CrowdControlLevel -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam CrowdControlLevel
crowdControlLevel)
          , (Text
"crowd_control_chat_level", CrowdControlLevel -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam CrowdControlLevel
crowdControlChatLevel)
          , (Text
"crowd_control_mode", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
crowdControlMode)
          , (Text
"welcome_message_text", Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty Maybe Text
welcomeMessageText)
          , (Text
"welcome_message_enabled", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
welcomeMessageEnabled)
          , (Text
"allow_images", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
allowImages)
          , (Text
"allow_videos", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
allowVideos)
          , (Text
"allow_polls", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
allowPolls)
          , (Text
"allow_post_crossposts", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
allowCrossposts)
          , (Text
"allow_chat_post_creation", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
allowChatPostCreation)
          , (Text
"spoilers_enabled", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
spoilersEnabled)
          , (Text
"show_media", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
showMedia)
          , (Text
"show_media_preview", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
showMediaPreview)
          , (Text
"restrict_posting", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
restrictPosting)
          , (Text
"restrict_commenting", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
restrictCommenting)
          , (Text
"over_18", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
over18)
          , (Text
"collapse_delete_comments", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
collapseDeletedComments)
          , (Text
"default_se", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
defaultSet)
          , ( Text
"disable_contributor_requests"
            , Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
disableContribRequests
            )
          , (Text
"free_form_report", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
freeFormReports)
          , (Text
"exclude_banned_modqueu", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
excludeBannedModqueue)
          , (Text
"oc_tag_enable", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
ocTagEnabled)
          , (Text
"all_original_conten", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
allOC)
          ]
        [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> ((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
"suggested_comment_sort", ) (Text -> (Text, Text))
-> (ItemSort -> Text) -> ItemSort -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemSort -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
                    (ItemSort -> (Text, Text)) -> Maybe ItemSort -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ItemSort
suggestedCommentSort)

-- | The setting for crowd controls, from lenient to strict
data CrowdControlLevel
    = Zero
    | One
    | Two
    | Three
    deriving stock ( Int -> CrowdControlLevel -> ShowS
[CrowdControlLevel] -> ShowS
CrowdControlLevel -> String
(Int -> CrowdControlLevel -> ShowS)
-> (CrowdControlLevel -> String)
-> ([CrowdControlLevel] -> ShowS)
-> Show CrowdControlLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CrowdControlLevel] -> ShowS
$cshowList :: [CrowdControlLevel] -> ShowS
show :: CrowdControlLevel -> String
$cshow :: CrowdControlLevel -> String
showsPrec :: Int -> CrowdControlLevel -> ShowS
$cshowsPrec :: Int -> CrowdControlLevel -> ShowS
Show, CrowdControlLevel -> CrowdControlLevel -> Bool
(CrowdControlLevel -> CrowdControlLevel -> Bool)
-> (CrowdControlLevel -> CrowdControlLevel -> Bool)
-> Eq CrowdControlLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CrowdControlLevel -> CrowdControlLevel -> Bool
$c/= :: CrowdControlLevel -> CrowdControlLevel -> Bool
== :: CrowdControlLevel -> CrowdControlLevel -> Bool
$c== :: CrowdControlLevel -> CrowdControlLevel -> Bool
Eq, (forall x. CrowdControlLevel -> Rep CrowdControlLevel x)
-> (forall x. Rep CrowdControlLevel x -> CrowdControlLevel)
-> Generic CrowdControlLevel
forall x. Rep CrowdControlLevel x -> CrowdControlLevel
forall x. CrowdControlLevel -> Rep CrowdControlLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CrowdControlLevel x -> CrowdControlLevel
$cfrom :: forall x. CrowdControlLevel -> Rep CrowdControlLevel x
Generic, Eq CrowdControlLevel
Eq CrowdControlLevel
-> (CrowdControlLevel -> CrowdControlLevel -> Ordering)
-> (CrowdControlLevel -> CrowdControlLevel -> Bool)
-> (CrowdControlLevel -> CrowdControlLevel -> Bool)
-> (CrowdControlLevel -> CrowdControlLevel -> Bool)
-> (CrowdControlLevel -> CrowdControlLevel -> Bool)
-> (CrowdControlLevel -> CrowdControlLevel -> CrowdControlLevel)
-> (CrowdControlLevel -> CrowdControlLevel -> CrowdControlLevel)
-> Ord CrowdControlLevel
CrowdControlLevel -> CrowdControlLevel -> Bool
CrowdControlLevel -> CrowdControlLevel -> Ordering
CrowdControlLevel -> CrowdControlLevel -> CrowdControlLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CrowdControlLevel -> CrowdControlLevel -> CrowdControlLevel
$cmin :: CrowdControlLevel -> CrowdControlLevel -> CrowdControlLevel
max :: CrowdControlLevel -> CrowdControlLevel -> CrowdControlLevel
$cmax :: CrowdControlLevel -> CrowdControlLevel -> CrowdControlLevel
>= :: CrowdControlLevel -> CrowdControlLevel -> Bool
$c>= :: CrowdControlLevel -> CrowdControlLevel -> Bool
> :: CrowdControlLevel -> CrowdControlLevel -> Bool
$c> :: CrowdControlLevel -> CrowdControlLevel -> Bool
<= :: CrowdControlLevel -> CrowdControlLevel -> Bool
$c<= :: CrowdControlLevel -> CrowdControlLevel -> Bool
< :: CrowdControlLevel -> CrowdControlLevel -> Bool
$c< :: CrowdControlLevel -> CrowdControlLevel -> Bool
compare :: CrowdControlLevel -> CrowdControlLevel -> Ordering
$ccompare :: CrowdControlLevel -> CrowdControlLevel -> Ordering
$cp1Ord :: Eq CrowdControlLevel
Ord, Int -> CrowdControlLevel
CrowdControlLevel -> Int
CrowdControlLevel -> [CrowdControlLevel]
CrowdControlLevel -> CrowdControlLevel
CrowdControlLevel -> CrowdControlLevel -> [CrowdControlLevel]
CrowdControlLevel
-> CrowdControlLevel -> CrowdControlLevel -> [CrowdControlLevel]
(CrowdControlLevel -> CrowdControlLevel)
-> (CrowdControlLevel -> CrowdControlLevel)
-> (Int -> CrowdControlLevel)
-> (CrowdControlLevel -> Int)
-> (CrowdControlLevel -> [CrowdControlLevel])
-> (CrowdControlLevel -> CrowdControlLevel -> [CrowdControlLevel])
-> (CrowdControlLevel -> CrowdControlLevel -> [CrowdControlLevel])
-> (CrowdControlLevel
    -> CrowdControlLevel -> CrowdControlLevel -> [CrowdControlLevel])
-> Enum CrowdControlLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CrowdControlLevel
-> CrowdControlLevel -> CrowdControlLevel -> [CrowdControlLevel]
$cenumFromThenTo :: CrowdControlLevel
-> CrowdControlLevel -> CrowdControlLevel -> [CrowdControlLevel]
enumFromTo :: CrowdControlLevel -> CrowdControlLevel -> [CrowdControlLevel]
$cenumFromTo :: CrowdControlLevel -> CrowdControlLevel -> [CrowdControlLevel]
enumFromThen :: CrowdControlLevel -> CrowdControlLevel -> [CrowdControlLevel]
$cenumFromThen :: CrowdControlLevel -> CrowdControlLevel -> [CrowdControlLevel]
enumFrom :: CrowdControlLevel -> [CrowdControlLevel]
$cenumFrom :: CrowdControlLevel -> [CrowdControlLevel]
fromEnum :: CrowdControlLevel -> Int
$cfromEnum :: CrowdControlLevel -> Int
toEnum :: Int -> CrowdControlLevel
$ctoEnum :: Int -> CrowdControlLevel
pred :: CrowdControlLevel -> CrowdControlLevel
$cpred :: CrowdControlLevel -> CrowdControlLevel
succ :: CrowdControlLevel -> CrowdControlLevel
$csucc :: CrowdControlLevel -> CrowdControlLevel
Enum )

instance FromJSON CrowdControlLevel where
    parseJSON :: Value -> Parser CrowdControlLevel
parseJSON = String
-> (Scientific -> Parser CrowdControlLevel)
-> Value
-> Parser CrowdControlLevel
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"CrowdControlLevel" ((Scientific -> Parser CrowdControlLevel)
 -> Value -> Parser CrowdControlLevel)
-> (Scientific -> Parser CrowdControlLevel)
-> Value
-> Parser CrowdControlLevel
forall a b. (a -> b) -> a -> b
$ \case
        Scientific
0 -> CrowdControlLevel -> Parser CrowdControlLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure CrowdControlLevel
Zero
        Scientific
1 -> CrowdControlLevel -> Parser CrowdControlLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure CrowdControlLevel
One
        Scientific
2 -> CrowdControlLevel -> Parser CrowdControlLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure CrowdControlLevel
Two
        Scientific
3 -> CrowdControlLevel -> Parser CrowdControlLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure CrowdControlLevel
Three
        Scientific
_ -> Parser CrowdControlLevel
forall a. Monoid a => a
mempty

instance ToHttpApiData CrowdControlLevel where
    toQueryParam :: CrowdControlLevel -> Text
toQueryParam = Int -> Text
forall a. Show a => a -> Text
showTextData (Int -> Text)
-> (CrowdControlLevel -> Int) -> CrowdControlLevel -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CrowdControlLevel -> Int
forall a. Enum a => a -> Int
fromEnum

-- | Permissible submissions on the subreddit
data ContentOptions
    = AnyContent
    | LinkOnly
    | SelfOnly
    deriving stock ( Int -> ContentOptions -> ShowS
[ContentOptions] -> ShowS
ContentOptions -> String
(Int -> ContentOptions -> ShowS)
-> (ContentOptions -> String)
-> ([ContentOptions] -> ShowS)
-> Show ContentOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentOptions] -> ShowS
$cshowList :: [ContentOptions] -> ShowS
show :: ContentOptions -> String
$cshow :: ContentOptions -> String
showsPrec :: Int -> ContentOptions -> ShowS
$cshowsPrec :: Int -> ContentOptions -> ShowS
Show, ContentOptions -> ContentOptions -> Bool
(ContentOptions -> ContentOptions -> Bool)
-> (ContentOptions -> ContentOptions -> Bool) -> Eq ContentOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentOptions -> ContentOptions -> Bool
$c/= :: ContentOptions -> ContentOptions -> Bool
== :: ContentOptions -> ContentOptions -> Bool
$c== :: ContentOptions -> ContentOptions -> Bool
Eq, (forall x. ContentOptions -> Rep ContentOptions x)
-> (forall x. Rep ContentOptions x -> ContentOptions)
-> Generic ContentOptions
forall x. Rep ContentOptions x -> ContentOptions
forall x. ContentOptions -> Rep ContentOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContentOptions x -> ContentOptions
$cfrom :: forall x. ContentOptions -> Rep ContentOptions x
Generic )

instance FromJSON ContentOptions where
    parseJSON :: Value -> Parser ContentOptions
parseJSON = String
-> (Text -> Parser ContentOptions)
-> Value
-> Parser ContentOptions
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ContentOptions" ((Text -> Parser ContentOptions) -> Value -> Parser ContentOptions)
-> (Text -> Parser ContentOptions)
-> Value
-> Parser ContentOptions
forall a b. (a -> b) -> a -> b
$ \case
        Text
"any"  -> ContentOptions -> Parser ContentOptions
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContentOptions
AnyContent
        Text
"link" -> ContentOptions -> Parser ContentOptions
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContentOptions
LinkOnly
        Text
"self" -> ContentOptions -> Parser ContentOptions
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContentOptions
SelfOnly
        Text
_      -> Parser ContentOptions
forall a. Monoid a => a
mempty

instance ToHttpApiData ContentOptions where
    toQueryParam :: ContentOptions -> Text
toQueryParam = \case
        ContentOptions
AnyContent -> Text
"any"
        ContentOptions
LinkOnly   -> Text
"link"
        ContentOptions
SelfOnly   -> Text
"self"

-- | The strength of the subreddit's spam filter
data SpamFilter
    = LowFilter
    | HighFilter
    | AllFilter
    deriving stock ( Int -> SpamFilter -> ShowS
[SpamFilter] -> ShowS
SpamFilter -> String
(Int -> SpamFilter -> ShowS)
-> (SpamFilter -> String)
-> ([SpamFilter] -> ShowS)
-> Show SpamFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpamFilter] -> ShowS
$cshowList :: [SpamFilter] -> ShowS
show :: SpamFilter -> String
$cshow :: SpamFilter -> String
showsPrec :: Int -> SpamFilter -> ShowS
$cshowsPrec :: Int -> SpamFilter -> ShowS
Show, SpamFilter -> SpamFilter -> Bool
(SpamFilter -> SpamFilter -> Bool)
-> (SpamFilter -> SpamFilter -> Bool) -> Eq SpamFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpamFilter -> SpamFilter -> Bool
$c/= :: SpamFilter -> SpamFilter -> Bool
== :: SpamFilter -> SpamFilter -> Bool
$c== :: SpamFilter -> SpamFilter -> Bool
Eq, (forall x. SpamFilter -> Rep SpamFilter x)
-> (forall x. Rep SpamFilter x -> SpamFilter) -> Generic SpamFilter
forall x. Rep SpamFilter x -> SpamFilter
forall x. SpamFilter -> Rep SpamFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpamFilter x -> SpamFilter
$cfrom :: forall x. SpamFilter -> Rep SpamFilter x
Generic )

instance ToHttpApiData SpamFilter where
    toQueryParam :: SpamFilter -> Text
toQueryParam = \case
        SpamFilter
LowFilter  -> Text
"low"
        SpamFilter
HighFilter -> Text
"high"
        SpamFilter
AllFilter  -> Text
"all"

instance FromJSON SpamFilter where
    parseJSON :: Value -> Parser SpamFilter
parseJSON = String -> (Text -> Parser SpamFilter) -> Value -> Parser SpamFilter
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"SpamFilter" ((Text -> Parser SpamFilter) -> Value -> Parser SpamFilter)
-> (Text -> Parser SpamFilter) -> Value -> Parser SpamFilter
forall a b. (a -> b) -> a -> b
$ \case
        Text
"low"  -> SpamFilter -> Parser SpamFilter
forall (f :: * -> *) a. Applicative f => a -> f a
pure SpamFilter
LowFilter
        Text
"high" -> SpamFilter -> Parser SpamFilter
forall (f :: * -> *) a. Applicative f => a -> f a
pure SpamFilter
HighFilter
        Text
"all"  -> SpamFilter -> Parser SpamFilter
forall (f :: * -> *) a. Applicative f => a -> f a
pure SpamFilter
AllFilter
        Text
_      -> Parser SpamFilter
forall a. Monoid a => a
mempty

-- | The editing mode for a subreddit\'s wiki
data Wikimode
    = EditDisabled
      -- ^ Only mods can edit
    | ApprovedEdit
      -- ^ Only mods and approved editors can edit
    | ContributorEdit
      -- ^ Any sub contributor can edit
    deriving stock ( Int -> Wikimode -> ShowS
[Wikimode] -> ShowS
Wikimode -> String
(Int -> Wikimode -> ShowS)
-> (Wikimode -> String) -> ([Wikimode] -> ShowS) -> Show Wikimode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Wikimode] -> ShowS
$cshowList :: [Wikimode] -> ShowS
show :: Wikimode -> String
$cshow :: Wikimode -> String
showsPrec :: Int -> Wikimode -> ShowS
$cshowsPrec :: Int -> Wikimode -> ShowS
Show, Wikimode -> Wikimode -> Bool
(Wikimode -> Wikimode -> Bool)
-> (Wikimode -> Wikimode -> Bool) -> Eq Wikimode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wikimode -> Wikimode -> Bool
$c/= :: Wikimode -> Wikimode -> Bool
== :: Wikimode -> Wikimode -> Bool
$c== :: Wikimode -> Wikimode -> Bool
Eq, (forall x. Wikimode -> Rep Wikimode x)
-> (forall x. Rep Wikimode x -> Wikimode) -> Generic Wikimode
forall x. Rep Wikimode x -> Wikimode
forall x. Wikimode -> Rep Wikimode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Wikimode x -> Wikimode
$cfrom :: forall x. Wikimode -> Rep Wikimode x
Generic, Eq Wikimode
Eq Wikimode
-> (Wikimode -> Wikimode -> Ordering)
-> (Wikimode -> Wikimode -> Bool)
-> (Wikimode -> Wikimode -> Bool)
-> (Wikimode -> Wikimode -> Bool)
-> (Wikimode -> Wikimode -> Bool)
-> (Wikimode -> Wikimode -> Wikimode)
-> (Wikimode -> Wikimode -> Wikimode)
-> Ord Wikimode
Wikimode -> Wikimode -> Bool
Wikimode -> Wikimode -> Ordering
Wikimode -> Wikimode -> Wikimode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Wikimode -> Wikimode -> Wikimode
$cmin :: Wikimode -> Wikimode -> Wikimode
max :: Wikimode -> Wikimode -> Wikimode
$cmax :: Wikimode -> Wikimode -> Wikimode
>= :: Wikimode -> Wikimode -> Bool
$c>= :: Wikimode -> Wikimode -> Bool
> :: Wikimode -> Wikimode -> Bool
$c> :: Wikimode -> Wikimode -> Bool
<= :: Wikimode -> Wikimode -> Bool
$c<= :: Wikimode -> Wikimode -> Bool
< :: Wikimode -> Wikimode -> Bool
$c< :: Wikimode -> Wikimode -> Bool
compare :: Wikimode -> Wikimode -> Ordering
$ccompare :: Wikimode -> Wikimode -> Ordering
$cp1Ord :: Eq Wikimode
Ord )

instance FromJSON Wikimode where
    parseJSON :: Value -> Parser Wikimode
parseJSON = String -> (Text -> Parser Wikimode) -> Value -> Parser Wikimode
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"WikiMode" ((Text -> Parser Wikimode) -> Value -> Parser Wikimode)
-> (Text -> Parser Wikimode) -> Value -> Parser Wikimode
forall a b. (a -> b) -> a -> b
$ \case
        Text
"disabled" -> Wikimode -> Parser Wikimode
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wikimode
EditDisabled
        Text
"modonly"  -> Wikimode -> Parser Wikimode
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wikimode
ApprovedEdit
        Text
"anyone"   -> Wikimode -> Parser Wikimode
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wikimode
ContributorEdit
        Text
_          -> Parser Wikimode
forall a. Monoid a => a
mempty

instance ToHttpApiData Wikimode where
    toQueryParam :: Wikimode -> Text
toQueryParam = \case
        Wikimode
EditDisabled    -> Text
"disabled"
        Wikimode
ApprovedEdit    -> Text
"modonly"
        Wikimode
ContributorEdit -> Text
"anyone"

-- | Represents an account that has been banned from a particular subreddit
data Ban = Ban
    { Ban -> RelID
banID    :: RelID
    , Ban -> Username
username :: Username
    , Ban -> UserID
userID   :: UserID
    , Ban -> Maybe Text
note     :: Maybe Text
    , Ban -> UTCTime
since    :: UTCTime
      -- | The number of days remaining until the ban expires
    , Ban -> Maybe Word
daysLeft :: Maybe Word
    }
    deriving stock ( Int -> Ban -> ShowS
[Ban] -> ShowS
Ban -> String
(Int -> Ban -> ShowS)
-> (Ban -> String) -> ([Ban] -> ShowS) -> Show Ban
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ban] -> ShowS
$cshowList :: [Ban] -> ShowS
show :: Ban -> String
$cshow :: Ban -> String
showsPrec :: Int -> Ban -> ShowS
$cshowsPrec :: Int -> Ban -> ShowS
Show, Ban -> Ban -> Bool
(Ban -> Ban -> Bool) -> (Ban -> Ban -> Bool) -> Eq Ban
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ban -> Ban -> Bool
$c/= :: Ban -> Ban -> Bool
== :: Ban -> Ban -> Bool
$c== :: Ban -> Ban -> Bool
Eq, (forall x. Ban -> Rep Ban x)
-> (forall x. Rep Ban x -> Ban) -> Generic Ban
forall x. Rep Ban x -> Ban
forall x. Ban -> Rep Ban x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ban x -> Ban
$cfrom :: forall x. Ban -> Rep Ban x
Generic )

instance FromJSON Ban where
    parseJSON :: Value -> Parser Ban
parseJSON = String -> (Object -> Parser Ban) -> Value -> Parser Ban
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Ban" ((Object -> Parser Ban) -> Value -> Parser Ban)
-> (Object -> Parser Ban) -> Value -> Parser Ban
forall a b. (a -> b) -> a -> b
$ \Object
o -> RelID
-> Username -> UserID -> Maybe Text -> UTCTime -> Maybe Word -> Ban
Ban (RelID
 -> Username
 -> UserID
 -> Maybe Text
 -> UTCTime
 -> Maybe Word
 -> Ban)
-> Parser RelID
-> Parser
     (Username -> UserID -> Maybe Text -> UTCTime -> Maybe Word -> Ban)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RelID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"rel_id"
        Parser
  (Username -> UserID -> Maybe Text -> UTCTime -> Maybe Word -> Ban)
-> Parser Username
-> Parser (UserID -> Maybe Text -> UTCTime -> Maybe Word -> Ban)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Username
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
        Parser (UserID -> Maybe Text -> UTCTime -> Maybe Word -> Ban)
-> Parser UserID
-> Parser (Maybe Text -> UTCTime -> Maybe Word -> Ban)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser UserID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
        Parser (Maybe Text -> UTCTime -> Maybe Word -> Ban)
-> Parser (Maybe Text) -> Parser (UTCTime -> Maybe Word -> Ban)
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
"note"
        Parser (UTCTime -> Maybe Word -> Ban)
-> Parser UTCTime -> Parser (Maybe Word -> Ban)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> UTCTime
integerToUTC (Integer -> UTCTime) -> Parser Integer -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"date")
        Parser (Maybe Word -> Ban) -> Parser (Maybe Word) -> Parser Ban
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"days_left"

-- The endpoints that list bans are a @Listing@, but only take a single option
-- to limit the listing to a single user
instance Paginable Ban where
    type PaginateOptions Ban = RelInfoOpts

    type PaginateThing Ban = RelID

    defaultOpts :: PaginateOptions Ban
defaultOpts = RelInfoOpts :: Maybe Username -> RelInfoOpts
RelInfoOpts { $sel:username:RelInfoOpts :: Maybe Username
username = Maybe Username
forall a. Maybe a
Nothing }

    getFullname :: Ban -> PaginateThing Ban
getFullname Ban { RelID
banID :: RelID
$sel:banID:Ban :: Ban -> RelID
banID } = PaginateThing Ban
RelID
banID

-- | Uniquely identifies a subreddit relationship, excluding mutes (see 'MuteID')
newtype RelID = RelID Text
    deriving stock ( Int -> RelID -> ShowS
[RelID] -> ShowS
RelID -> String
(Int -> RelID -> ShowS)
-> (RelID -> String) -> ([RelID] -> ShowS) -> Show RelID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelID] -> ShowS
$cshowList :: [RelID] -> ShowS
show :: RelID -> String
$cshow :: RelID -> String
showsPrec :: Int -> RelID -> ShowS
$cshowsPrec :: Int -> RelID -> ShowS
Show, (forall x. RelID -> Rep RelID x)
-> (forall x. Rep RelID x -> RelID) -> Generic RelID
forall x. Rep RelID x -> RelID
forall x. RelID -> Rep RelID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RelID x -> RelID
$cfrom :: forall x. RelID -> Rep RelID x
Generic )
    deriving newtype ( RelID -> RelID -> Bool
(RelID -> RelID -> Bool) -> (RelID -> RelID -> Bool) -> Eq RelID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelID -> RelID -> Bool
$c/= :: RelID -> RelID -> Bool
== :: RelID -> RelID -> Bool
$c== :: RelID -> RelID -> Bool
Eq )

instance FromJSON RelID where
    parseJSON :: Value -> Parser RelID
parseJSON = String -> (Text -> Parser RelID) -> Value -> Parser RelID
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"RelID" (Parser Text -> Parser RelID
coerce (Parser Text -> Parser RelID)
-> (Text -> Parser Text) -> Text -> Parser RelID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedditKind -> Text -> Parser Text
dropTypePrefix RedditKind
RelKind)

instance Thing RelID where
    fullname :: RelID -> Text
fullname (RelID Text
bid) = RedditKind -> Text -> Text
prependType RedditKind
RelKind Text
bid

-- | Identifies relationships representing muted users
newtype MuteID = MuteID Text
    deriving stock ( Int -> MuteID -> ShowS
[MuteID] -> ShowS
MuteID -> String
(Int -> MuteID -> ShowS)
-> (MuteID -> String) -> ([MuteID] -> ShowS) -> Show MuteID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MuteID] -> ShowS
$cshowList :: [MuteID] -> ShowS
show :: MuteID -> String
$cshow :: MuteID -> String
showsPrec :: Int -> MuteID -> ShowS
$cshowsPrec :: Int -> MuteID -> ShowS
Show, (forall x. MuteID -> Rep MuteID x)
-> (forall x. Rep MuteID x -> MuteID) -> Generic MuteID
forall x. Rep MuteID x -> MuteID
forall x. MuteID -> Rep MuteID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MuteID x -> MuteID
$cfrom :: forall x. MuteID -> Rep MuteID x
Generic )
    deriving newtype ( MuteID -> MuteID -> Bool
(MuteID -> MuteID -> Bool)
-> (MuteID -> MuteID -> Bool) -> Eq MuteID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MuteID -> MuteID -> Bool
$c/= :: MuteID -> MuteID -> Bool
== :: MuteID -> MuteID -> Bool
$c== :: MuteID -> MuteID -> Bool
Eq )

instance FromJSON MuteID where
    parseJSON :: Value -> Parser MuteID
parseJSON = String -> (Text -> Parser MuteID) -> Value -> Parser MuteID
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"MuteID" (Text -> Text -> Parser MuteID
forall a. Coercible a Text => Text -> Text -> Parser a
breakOnType Text
"Mute")

instance Thing MuteID where
    fullname :: MuteID -> Text
fullname (MuteID Text
bid) = Text
"Mute_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bid

-- | Details of a new ban to apply to a user
data BanNotes = BanNotes
    {  -- | The message sent to the user
      BanNotes -> Text
banMessage :: Body
      -- | Reason for the ban, not sent to the user
    , BanNotes -> Text
banReason  :: Body
      -- | Duration in days for the ban. @Nothing@ implies infinite ban
    , BanNotes -> Maybe Word
duration   :: Maybe Word
      -- | A note about the ban. Not sent to the user
    , BanNotes -> Text
note       :: Body
    }
    deriving stock ( Int -> BanNotes -> ShowS
[BanNotes] -> ShowS
BanNotes -> String
(Int -> BanNotes -> ShowS)
-> (BanNotes -> String) -> ([BanNotes] -> ShowS) -> Show BanNotes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BanNotes] -> ShowS
$cshowList :: [BanNotes] -> ShowS
show :: BanNotes -> String
$cshow :: BanNotes -> String
showsPrec :: Int -> BanNotes -> ShowS
$cshowsPrec :: Int -> BanNotes -> ShowS
Show, BanNotes -> BanNotes -> Bool
(BanNotes -> BanNotes -> Bool)
-> (BanNotes -> BanNotes -> Bool) -> Eq BanNotes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BanNotes -> BanNotes -> Bool
$c/= :: BanNotes -> BanNotes -> Bool
== :: BanNotes -> BanNotes -> Bool
$c== :: BanNotes -> BanNotes -> Bool
Eq, (forall x. BanNotes -> Rep BanNotes x)
-> (forall x. Rep BanNotes x -> BanNotes) -> Generic BanNotes
forall x. Rep BanNotes x -> BanNotes
forall x. BanNotes -> Rep BanNotes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BanNotes x -> BanNotes
$cfrom :: forall x. BanNotes -> Rep BanNotes x
Generic )

instance ToForm BanNotes where
    toForm :: BanNotes -> Form
toForm BanNotes { Maybe Word
Text
note :: Text
duration :: Maybe Word
banReason :: Text
banMessage :: Text
$sel:note:BanNotes :: BanNotes -> Text
$sel:duration:BanNotes :: BanNotes -> Maybe Word
$sel:banReason:BanNotes :: BanNotes -> Text
$sel:banMessage:BanNotes :: BanNotes -> 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
"ban_message", Text
banMessage)
          , (Text
"ban_reason", Text
banReason)
          , (Text
"note", Text
note)
          ]
        [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> ((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
"duration", ) (Text -> (Text, Text)) -> (Word -> Text) -> Word -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Text
forall a. Show a => a -> Text
tshow (Word -> (Text, Text)) -> Maybe Word -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word
duration)

--Modmail----------------------------------------------------------------------
-- | Moderator mail. Reddit no longer supports the older, message-based interface
-- for modmail
newtype Modmail = Modmail { Modmail -> Seq ModmailConversation
conversations :: Seq ModmailConversation }
    deriving stock ( Int -> Modmail -> ShowS
[Modmail] -> ShowS
Modmail -> String
(Int -> Modmail -> ShowS)
-> (Modmail -> String) -> ([Modmail] -> ShowS) -> Show Modmail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Modmail] -> ShowS
$cshowList :: [Modmail] -> ShowS
show :: Modmail -> String
$cshow :: Modmail -> String
showsPrec :: Int -> Modmail -> ShowS
$cshowsPrec :: Int -> Modmail -> ShowS
Show, Modmail -> Modmail -> Bool
(Modmail -> Modmail -> Bool)
-> (Modmail -> Modmail -> Bool) -> Eq Modmail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Modmail -> Modmail -> Bool
$c/= :: Modmail -> Modmail -> Bool
== :: Modmail -> Modmail -> Bool
$c== :: Modmail -> Modmail -> Bool
Eq, (forall x. Modmail -> Rep Modmail x)
-> (forall x. Rep Modmail x -> Modmail) -> Generic Modmail
forall x. Rep Modmail x -> Modmail
forall x. Modmail -> Rep Modmail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Modmail x -> Modmail
$cfrom :: forall x. Modmail -> Rep Modmail x
Generic )

instance FromJSON Modmail where
    parseJSON :: Value -> Parser Modmail
parseJSON = String -> (Object -> Parser Modmail) -> Value -> Parser Modmail
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Modmail" ((Object -> Parser Modmail) -> Value -> Parser Modmail)
-> (Object -> Parser Modmail) -> Value -> Parser Modmail
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Seq ModmailConversation
cs <- Object -> Parser (Seq ModmailConversation)
forall b. FromJSON b => Object -> Parser (Seq b)
getVals (Object -> Parser (Seq ModmailConversation))
-> Parser Object -> Parser (Seq ModmailConversation)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"conversations"
        HashMap Text ModmailMessage
ms <- Object
o Object -> Text -> Parser (HashMap Text ModmailMessage)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"messages"
        Modmail -> Parser Modmail
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Modmail -> Parser Modmail)
-> (Seq ModmailConversation -> Modmail)
-> Seq ModmailConversation
-> Parser Modmail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq ModmailConversation -> Modmail
Modmail (Seq ModmailConversation -> Parser Modmail)
-> Seq ModmailConversation -> Parser Modmail
forall a b. (a -> b) -> a -> b
$ Seq ModmailConversation
cs Seq ModmailConversation
-> (ModmailConversation -> ModmailConversation)
-> Seq ModmailConversation
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \c :: ModmailConversation
c@ModmailConversation { Seq ModmailObjID
$sel:objIDs:ModmailConversation :: ModmailConversation -> Seq ModmailObjID
objIDs :: Seq ModmailObjID
objIDs } ->
            let messages :: Seq ModmailMessage
messages = [ModmailMessage] -> Seq ModmailMessage
forall l. IsList l => [Item l] -> l
fromList ([ModmailMessage] -> Seq ModmailMessage)
-> ((ModmailObjID -> Maybe ModmailMessage) -> [ModmailMessage])
-> (ModmailObjID -> Maybe ModmailMessage)
-> Seq ModmailMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ModmailObjID -> Maybe ModmailMessage)
 -> [ModmailObjID] -> [ModmailMessage])
-> [ModmailObjID]
-> (ModmailObjID -> Maybe ModmailMessage)
-> [ModmailMessage]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ModmailObjID -> Maybe ModmailMessage)
-> [ModmailObjID] -> [ModmailMessage]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Seq ModmailObjID -> [Item (Seq ModmailObjID)]
forall l. IsList l => l -> [Item l]
toList Seq ModmailObjID
objIDs)
                    ((ModmailObjID -> Maybe ModmailMessage) -> Seq ModmailMessage)
-> (ModmailObjID -> Maybe ModmailMessage) -> Seq ModmailMessage
forall a b. (a -> b) -> a -> b
$ \ModmailObjID { Text
$sel:objID:ModmailObjID :: ModmailObjID -> Text
objID :: Text
objID } -> Text -> HashMap Text ModmailMessage -> Maybe ModmailMessage
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
objID HashMap Text ModmailMessage
ms
            in
                ModmailConversation
c { Seq ModmailMessage
$sel:messages:ModmailConversation :: Seq ModmailMessage
messages :: Seq ModmailMessage
messages }

-- | A single modmail conversation
data ModmailConversation = ModmailConversation
    { ModmailConversation -> Text
modmailID      :: ModmailID
    , ModmailConversation -> Text
subject        :: Subject
      -- | This field may be empty, depending on how the 'ModmailConversation' was
      -- obtained. When parsed as part of a 'Modmail' or 'ConversationDetails', the
      -- messages will be present
    , ModmailConversation -> Seq ModmailMessage
messages       :: Seq ModmailMessage
    , ModmailConversation -> Integer
numMessages    :: Integer
    , ModmailConversation -> SubredditName
subreddit      :: SubredditName
      -- | The non-mod user participating in the conversation
    , ModmailConversation -> Maybe ModmailAuthor
participant    :: Maybe ModmailAuthor
    , ModmailConversation -> Seq ModmailObjID
objIDs         :: Seq ModmailObjID
    , ModmailConversation -> UTCTime
lastUpdated    :: UTCTime
    , ModmailConversation -> Maybe UTCTime
lastUserUpdate :: Maybe UTCTime
    , ModmailConversation -> Maybe UTCTime
lastModUpdate  :: Maybe UTCTime
    , ModmailConversation -> Bool
isHighlighted  :: Bool
    , ModmailConversation -> Bool
isInternal     :: Bool
    }
    deriving stock ( Int -> ModmailConversation -> ShowS
[ModmailConversation] -> ShowS
ModmailConversation -> String
(Int -> ModmailConversation -> ShowS)
-> (ModmailConversation -> String)
-> ([ModmailConversation] -> ShowS)
-> Show ModmailConversation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModmailConversation] -> ShowS
$cshowList :: [ModmailConversation] -> ShowS
show :: ModmailConversation -> String
$cshow :: ModmailConversation -> String
showsPrec :: Int -> ModmailConversation -> ShowS
$cshowsPrec :: Int -> ModmailConversation -> ShowS
Show, ModmailConversation -> ModmailConversation -> Bool
(ModmailConversation -> ModmailConversation -> Bool)
-> (ModmailConversation -> ModmailConversation -> Bool)
-> Eq ModmailConversation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModmailConversation -> ModmailConversation -> Bool
$c/= :: ModmailConversation -> ModmailConversation -> Bool
== :: ModmailConversation -> ModmailConversation -> Bool
$c== :: ModmailConversation -> ModmailConversation -> Bool
Eq, (forall x. ModmailConversation -> Rep ModmailConversation x)
-> (forall x. Rep ModmailConversation x -> ModmailConversation)
-> Generic ModmailConversation
forall x. Rep ModmailConversation x -> ModmailConversation
forall x. ModmailConversation -> Rep ModmailConversation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModmailConversation x -> ModmailConversation
$cfrom :: forall x. ModmailConversation -> Rep ModmailConversation x
Generic )

instance FromJSON ModmailConversation where
    parseJSON :: Value -> Parser ModmailConversation
parseJSON = String
-> (Object -> Parser ModmailConversation)
-> Value
-> Parser ModmailConversation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ModmailConversation" ((Object -> Parser ModmailConversation)
 -> Value -> Parser ModmailConversation)
-> (Object -> Parser ModmailConversation)
-> Value
-> Parser ModmailConversation
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> Seq ModmailMessage
-> Integer
-> SubredditName
-> Maybe ModmailAuthor
-> Seq ModmailObjID
-> UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Bool
-> Bool
-> ModmailConversation
ModmailConversation
        (Text
 -> Text
 -> Seq ModmailMessage
 -> Integer
 -> SubredditName
 -> Maybe ModmailAuthor
 -> Seq ModmailObjID
 -> UTCTime
 -> Maybe UTCTime
 -> Maybe UTCTime
 -> Bool
 -> Bool
 -> ModmailConversation)
-> Parser Text
-> Parser
     (Text
      -> Seq ModmailMessage
      -> Integer
      -> SubredditName
      -> Maybe ModmailAuthor
      -> Seq ModmailObjID
      -> UTCTime
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> ModmailConversation)
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
"id"
        Parser
  (Text
   -> Seq ModmailMessage
   -> Integer
   -> SubredditName
   -> Maybe ModmailAuthor
   -> Seq ModmailObjID
   -> UTCTime
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> ModmailConversation)
-> Parser Text
-> Parser
     (Seq ModmailMessage
      -> Integer
      -> SubredditName
      -> Maybe ModmailAuthor
      -> Seq ModmailObjID
      -> UTCTime
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> ModmailConversation)
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
"subject"
        -- There are no messages at the moment; they will be added later when the entire
        -- @Modmail@ or @ConversationDetails@ is parsed
        Parser
  (Seq ModmailMessage
   -> Integer
   -> SubredditName
   -> Maybe ModmailAuthor
   -> Seq ModmailObjID
   -> UTCTime
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> ModmailConversation)
-> Parser (Seq ModmailMessage)
-> Parser
     (Integer
      -> SubredditName
      -> Maybe ModmailAuthor
      -> Seq ModmailObjID
      -> UTCTime
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> ModmailConversation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Seq ModmailMessage -> Parser (Seq ModmailMessage)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq ModmailMessage
forall a. Monoid a => a
mempty
        Parser
  (Integer
   -> SubredditName
   -> Maybe ModmailAuthor
   -> Seq ModmailObjID
   -> UTCTime
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> ModmailConversation)
-> Parser Integer
-> Parser
     (SubredditName
      -> Maybe ModmailAuthor
      -> Seq ModmailObjID
      -> UTCTime
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> ModmailConversation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"numMessages"
        Parser
  (SubredditName
   -> Maybe ModmailAuthor
   -> Seq ModmailObjID
   -> UTCTime
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> ModmailConversation)
-> Parser SubredditName
-> Parser
     (Maybe ModmailAuthor
      -> Seq ModmailObjID
      -> UTCTime
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> ModmailConversation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object -> Text -> Parser SubredditName
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"displayName") (Object -> Parser SubredditName)
-> Parser Object -> Parser SubredditName
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner")
        Parser
  (Maybe ModmailAuthor
   -> Seq ModmailObjID
   -> UTCTime
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> ModmailConversation)
-> Parser (Maybe ModmailAuthor)
-> Parser
     (Seq ModmailObjID
      -> UTCTime
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> ModmailConversation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ModmailAuthor -> Parser (Maybe ModmailAuthor)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Object
o Object -> Text -> Parser ModmailAuthor
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"participant")
        Parser
  (Seq ModmailObjID
   -> UTCTime
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> ModmailConversation)
-> Parser (Seq ModmailObjID)
-> Parser
     (UTCTime
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> ModmailConversation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Seq ModmailObjID)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"objIds"
        Parser
  (UTCTime
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> ModmailConversation)
-> Parser UTCTime
-> Parser
     (Maybe UTCTime
      -> Maybe UTCTime -> Bool -> Bool -> ModmailConversation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Parser UTCTime
iso8601P (String -> Parser UTCTime) -> Parser String -> Parser UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"lastUpdated")
        Parser
  (Maybe UTCTime
   -> Maybe UTCTime -> Bool -> Bool -> ModmailConversation)
-> Parser (Maybe UTCTime)
-> Parser (Maybe UTCTime -> Bool -> Bool -> ModmailConversation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Text -> Parser (Maybe UTCTime)
tryISO Object
o Text
"lastUserUpdate"
        Parser (Maybe UTCTime -> Bool -> Bool -> ModmailConversation)
-> Parser (Maybe UTCTime)
-> Parser (Bool -> Bool -> ModmailConversation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Text -> Parser (Maybe UTCTime)
tryISO Object
o Text
"lastModUpdate"
        Parser (Bool -> Bool -> ModmailConversation)
-> Parser Bool -> Parser (Bool -> ModmailConversation)
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
"isHighlighted"
        Parser (Bool -> ModmailConversation)
-> Parser Bool -> Parser ModmailConversation
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
"isInternal"
      where
        tryISO :: Object -> Text -> Parser (Maybe UTCTime)
tryISO Object
o Text
fld = Parser (Maybe UTCTime)
-> (String -> Parser (Maybe UTCTime))
-> Maybe String
-> Parser (Maybe UTCTime)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe UTCTime -> Parser (Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UTCTime
forall a. Maybe a
Nothing) (String -> Parser UTCTime
iso8601P (String -> Parser UTCTime)
-> (UTCTime -> Parser (Maybe UTCTime))
-> String
-> Parser (Maybe UTCTime)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Maybe UTCTime -> Parser (Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UTCTime -> Parser (Maybe UTCTime))
-> (UTCTime -> Maybe UTCTime) -> UTCTime -> Parser (Maybe UTCTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just)
            (Maybe String -> Parser (Maybe UTCTime))
-> Parser (Maybe String) -> Parser (Maybe UTCTime)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
fld

iso8601P :: [Char] -> Parser UTCTime
iso8601P :: String -> Parser UTCTime
iso8601P = (ZonedTime -> UTCTime) -> Parser ZonedTime -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ZonedTime -> UTCTime
zonedTimeToUTC (Parser ZonedTime -> Parser UTCTime)
-> (String -> Parser ZonedTime) -> String -> Parser UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser ZonedTime
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM

-- | Wrapper for parsing the JSON returned from the conversation details API endpoint.
-- This is formatted differently and has different fields than the modmail overview
-- endpoint
newtype ConversationDetails = ConversationDetails ModmailConversation
    deriving stock ( Int -> ConversationDetails -> ShowS
[ConversationDetails] -> ShowS
ConversationDetails -> String
(Int -> ConversationDetails -> ShowS)
-> (ConversationDetails -> String)
-> ([ConversationDetails] -> ShowS)
-> Show ConversationDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConversationDetails] -> ShowS
$cshowList :: [ConversationDetails] -> ShowS
show :: ConversationDetails -> String
$cshow :: ConversationDetails -> String
showsPrec :: Int -> ConversationDetails -> ShowS
$cshowsPrec :: Int -> ConversationDetails -> ShowS
Show, (forall x. ConversationDetails -> Rep ConversationDetails x)
-> (forall x. Rep ConversationDetails x -> ConversationDetails)
-> Generic ConversationDetails
forall x. Rep ConversationDetails x -> ConversationDetails
forall x. ConversationDetails -> Rep ConversationDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConversationDetails x -> ConversationDetails
$cfrom :: forall x. ConversationDetails -> Rep ConversationDetails x
Generic )

instance FromJSON ConversationDetails where
    parseJSON :: Value -> Parser ConversationDetails
parseJSON = String
-> (Object -> Parser ConversationDetails)
-> Value
-> Parser ConversationDetails
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ConversationDetails" ((Object -> Parser ConversationDetails)
 -> Value -> Parser ConversationDetails)
-> (Object -> Parser ConversationDetails)
-> Value
-> Parser ConversationDetails
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        ModmailConversation
conversation <- Object
o Object -> Text -> Parser ModmailConversation
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"conversation" Parser ModmailConversation
-> Parser ModmailConversation -> Parser ModmailConversation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Text -> Parser ModmailConversation
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"conversations"
        Seq ModmailMessage
messages <- Object -> Parser (Seq ModmailMessage)
forall b. FromJSON b => Object -> Parser (Seq b)
getVals (Object -> Parser (Seq ModmailMessage))
-> Parser Object -> Parser (Seq ModmailMessage)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"messages"
        ConversationDetails -> Parser ConversationDetails
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConversationDetails -> Parser ConversationDetails)
-> (ModmailConversation -> ConversationDetails)
-> ModmailConversation
-> Parser ConversationDetails
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModmailConversation -> ConversationDetails
ConversationDetails (ModmailConversation -> Parser ConversationDetails)
-> ModmailConversation -> Parser ConversationDetails
forall a b. (a -> b) -> a -> b
$ ModmailConversation
conversation { Seq ModmailMessage
messages :: Seq ModmailMessage
$sel:messages:ModmailConversation :: Seq ModmailMessage
messages }

-- | The ID of a particular modmail conversation
type ModmailID = Text

newtype BulkReadIDs = BulkReadIDs (Seq ModmailID)
    deriving stock ( Int -> BulkReadIDs -> ShowS
[BulkReadIDs] -> ShowS
BulkReadIDs -> String
(Int -> BulkReadIDs -> ShowS)
-> (BulkReadIDs -> String)
-> ([BulkReadIDs] -> ShowS)
-> Show BulkReadIDs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BulkReadIDs] -> ShowS
$cshowList :: [BulkReadIDs] -> ShowS
show :: BulkReadIDs -> String
$cshow :: BulkReadIDs -> String
showsPrec :: Int -> BulkReadIDs -> ShowS
$cshowsPrec :: Int -> BulkReadIDs -> ShowS
Show, (forall x. BulkReadIDs -> Rep BulkReadIDs x)
-> (forall x. Rep BulkReadIDs x -> BulkReadIDs)
-> Generic BulkReadIDs
forall x. Rep BulkReadIDs x -> BulkReadIDs
forall x. BulkReadIDs -> Rep BulkReadIDs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BulkReadIDs x -> BulkReadIDs
$cfrom :: forall x. BulkReadIDs -> Rep BulkReadIDs x
Generic )

instance FromJSON BulkReadIDs where
    parseJSON :: Value -> Parser BulkReadIDs
parseJSON = String
-> (Object -> Parser BulkReadIDs) -> Value -> Parser BulkReadIDs
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BulkReadIDs"
        ((Object -> Parser BulkReadIDs) -> Value -> Parser BulkReadIDs)
-> (Object -> Parser BulkReadIDs) -> Value -> Parser BulkReadIDs
forall a b. (a -> b) -> a -> b
$ \Object
o -> Seq Text -> BulkReadIDs
BulkReadIDs (Seq Text -> BulkReadIDs)
-> Parser (Seq Text) -> Parser BulkReadIDs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Seq Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"conversation_ids"

-- | A mapping to a modmail action to its ID
data ModmailObjID = ModmailObjID { ModmailObjID -> Text
objID :: Text, ModmailObjID -> Text
key :: Text }
    deriving stock ( Int -> ModmailObjID -> ShowS
[ModmailObjID] -> ShowS
ModmailObjID -> String
(Int -> ModmailObjID -> ShowS)
-> (ModmailObjID -> String)
-> ([ModmailObjID] -> ShowS)
-> Show ModmailObjID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModmailObjID] -> ShowS
$cshowList :: [ModmailObjID] -> ShowS
show :: ModmailObjID -> String
$cshow :: ModmailObjID -> String
showsPrec :: Int -> ModmailObjID -> ShowS
$cshowsPrec :: Int -> ModmailObjID -> ShowS
Show, ModmailObjID -> ModmailObjID -> Bool
(ModmailObjID -> ModmailObjID -> Bool)
-> (ModmailObjID -> ModmailObjID -> Bool) -> Eq ModmailObjID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModmailObjID -> ModmailObjID -> Bool
$c/= :: ModmailObjID -> ModmailObjID -> Bool
== :: ModmailObjID -> ModmailObjID -> Bool
$c== :: ModmailObjID -> ModmailObjID -> Bool
Eq, (forall x. ModmailObjID -> Rep ModmailObjID x)
-> (forall x. Rep ModmailObjID x -> ModmailObjID)
-> Generic ModmailObjID
forall x. Rep ModmailObjID x -> ModmailObjID
forall x. ModmailObjID -> Rep ModmailObjID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModmailObjID x -> ModmailObjID
$cfrom :: forall x. ModmailObjID -> Rep ModmailObjID x
Generic )

instance FromJSON ModmailObjID where
    parseJSON :: Value -> Parser ModmailObjID
parseJSON = String
-> (Object -> Parser ModmailObjID) -> Value -> Parser ModmailObjID
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ModmailObjID"
        ((Object -> Parser ModmailObjID) -> Value -> Parser ModmailObjID)
-> (Object -> Parser ModmailObjID) -> Value -> Parser ModmailObjID
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> ModmailObjID
ModmailObjID (Text -> Text -> ModmailObjID)
-> Parser Text -> Parser (Text -> ModmailObjID)
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
"id" Parser (Text -> ModmailObjID) -> Parser Text -> Parser ModmailObjID
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
"key"

-- | A single message in a 'ModmailConversation'
data ModmailMessage = ModmailMessage
    { ModmailMessage -> Text
modmailMessageID :: Text
    , ModmailMessage -> ModmailAuthor
author           :: ModmailAuthor
    , ModmailMessage -> Text
body             :: Body
    , ModmailMessage -> Text
bodyHTML         :: Body
    , ModmailMessage -> UTCTime
date             :: UTCTime
    , ModmailMessage -> Bool
isInternal       :: Bool
    }
    deriving stock ( Int -> ModmailMessage -> ShowS
[ModmailMessage] -> ShowS
ModmailMessage -> String
(Int -> ModmailMessage -> ShowS)
-> (ModmailMessage -> String)
-> ([ModmailMessage] -> ShowS)
-> Show ModmailMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModmailMessage] -> ShowS
$cshowList :: [ModmailMessage] -> ShowS
show :: ModmailMessage -> String
$cshow :: ModmailMessage -> String
showsPrec :: Int -> ModmailMessage -> ShowS
$cshowsPrec :: Int -> ModmailMessage -> ShowS
Show, ModmailMessage -> ModmailMessage -> Bool
(ModmailMessage -> ModmailMessage -> Bool)
-> (ModmailMessage -> ModmailMessage -> Bool) -> Eq ModmailMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModmailMessage -> ModmailMessage -> Bool
$c/= :: ModmailMessage -> ModmailMessage -> Bool
== :: ModmailMessage -> ModmailMessage -> Bool
$c== :: ModmailMessage -> ModmailMessage -> Bool
Eq, (forall x. ModmailMessage -> Rep ModmailMessage x)
-> (forall x. Rep ModmailMessage x -> ModmailMessage)
-> Generic ModmailMessage
forall x. Rep ModmailMessage x -> ModmailMessage
forall x. ModmailMessage -> Rep ModmailMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModmailMessage x -> ModmailMessage
$cfrom :: forall x. ModmailMessage -> Rep ModmailMessage x
Generic )

instance FromJSON ModmailMessage where
    parseJSON :: Value -> Parser ModmailMessage
parseJSON = String
-> (Object -> Parser ModmailMessage)
-> Value
-> Parser ModmailMessage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ModmailMessage" ((Object -> Parser ModmailMessage)
 -> Value -> Parser ModmailMessage)
-> (Object -> Parser ModmailMessage)
-> Value
-> Parser ModmailMessage
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> ModmailAuthor
-> Text
-> Text
-> UTCTime
-> Bool
-> ModmailMessage
ModmailMessage
        (Text
 -> ModmailAuthor
 -> Text
 -> Text
 -> UTCTime
 -> Bool
 -> ModmailMessage)
-> Parser Text
-> Parser
     (ModmailAuthor
      -> Text -> Text -> UTCTime -> Bool -> ModmailMessage)
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
"id"
        Parser
  (ModmailAuthor
   -> Text -> Text -> UTCTime -> Bool -> ModmailMessage)
-> Parser ModmailAuthor
-> Parser (Text -> Text -> UTCTime -> Bool -> ModmailMessage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser ModmailAuthor
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"author"
        Parser (Text -> Text -> UTCTime -> Bool -> ModmailMessage)
-> Parser Text
-> Parser (Text -> UTCTime -> Bool -> ModmailMessage)
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
"bodyMarkdown"
        Parser (Text -> UTCTime -> Bool -> ModmailMessage)
-> Parser Text -> Parser (UTCTime -> Bool -> ModmailMessage)
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
"body"
        Parser (UTCTime -> Bool -> ModmailMessage)
-> Parser UTCTime -> Parser (Bool -> ModmailMessage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Parser UTCTime
iso8601P (String -> Parser UTCTime) -> Parser String -> Parser UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"date")
        Parser (Bool -> ModmailMessage)
-> Parser Bool -> Parser ModmailMessage
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
"isInternal"

-- | An author in a 'ModmailConversation'; can be either a mod or a non-mod user
data ModmailAuthor = ModmailAuthor
    { ModmailAuthor -> Username
name          :: Username
    , ModmailAuthor -> Bool
isAdmin       :: Bool
    , ModmailAuthor -> Bool
isDeleted     :: Bool
    , ModmailAuthor -> Bool
isHidden      :: Bool
    , ModmailAuthor -> Bool
isMod         :: Bool
    , ModmailAuthor -> Bool
isOP          :: Bool
    , ModmailAuthor -> Bool
isParticipant :: Bool
    }
    deriving stock ( Int -> ModmailAuthor -> ShowS
[ModmailAuthor] -> ShowS
ModmailAuthor -> String
(Int -> ModmailAuthor -> ShowS)
-> (ModmailAuthor -> String)
-> ([ModmailAuthor] -> ShowS)
-> Show ModmailAuthor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModmailAuthor] -> ShowS
$cshowList :: [ModmailAuthor] -> ShowS
show :: ModmailAuthor -> String
$cshow :: ModmailAuthor -> String
showsPrec :: Int -> ModmailAuthor -> ShowS
$cshowsPrec :: Int -> ModmailAuthor -> ShowS
Show, ModmailAuthor -> ModmailAuthor -> Bool
(ModmailAuthor -> ModmailAuthor -> Bool)
-> (ModmailAuthor -> ModmailAuthor -> Bool) -> Eq ModmailAuthor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModmailAuthor -> ModmailAuthor -> Bool
$c/= :: ModmailAuthor -> ModmailAuthor -> Bool
== :: ModmailAuthor -> ModmailAuthor -> Bool
$c== :: ModmailAuthor -> ModmailAuthor -> Bool
Eq, (forall x. ModmailAuthor -> Rep ModmailAuthor x)
-> (forall x. Rep ModmailAuthor x -> ModmailAuthor)
-> Generic ModmailAuthor
forall x. Rep ModmailAuthor x -> ModmailAuthor
forall x. ModmailAuthor -> Rep ModmailAuthor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModmailAuthor x -> ModmailAuthor
$cfrom :: forall x. ModmailAuthor -> Rep ModmailAuthor x
Generic )

instance FromJSON ModmailAuthor where
    parseJSON :: Value -> Parser ModmailAuthor
parseJSON = Options -> Value -> Parser ModmailAuthor
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { ShowS
fieldLabelModifier :: ShowS
fieldLabelModifier :: ShowS
fieldLabelModifier }
      where
        fieldLabelModifier :: ShowS
fieldLabelModifier = \case
            String
"isOP" -> String
"isOp"
            String
s      -> String
s

-- | Options for filtering\/paginating modmail endpoints. Notably, this is an
-- entirely different mechanism than the usual @Listing@s elsewhere on Reddit
data ModmailOpts = ModmailOpts
    { ModmailOpts -> Maybe Text
after      :: Maybe ModmailID
    , ModmailOpts -> Maybe [SubredditName]
subreddits :: Maybe [SubredditName]
      -- | Should be between 0 and 100. The implicit API default is 25
    , ModmailOpts -> Maybe Word
limit      :: Maybe Word
    , ModmailOpts -> Maybe ModmailSort
itemSort   :: Maybe ModmailSort
    , ModmailOpts -> Maybe ModmailState
state      :: Maybe ModmailState
    }
    deriving stock ( Int -> ModmailOpts -> ShowS
[ModmailOpts] -> ShowS
ModmailOpts -> String
(Int -> ModmailOpts -> ShowS)
-> (ModmailOpts -> String)
-> ([ModmailOpts] -> ShowS)
-> Show ModmailOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModmailOpts] -> ShowS
$cshowList :: [ModmailOpts] -> ShowS
show :: ModmailOpts -> String
$cshow :: ModmailOpts -> String
showsPrec :: Int -> ModmailOpts -> ShowS
$cshowsPrec :: Int -> ModmailOpts -> ShowS
Show, ModmailOpts -> ModmailOpts -> Bool
(ModmailOpts -> ModmailOpts -> Bool)
-> (ModmailOpts -> ModmailOpts -> Bool) -> Eq ModmailOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModmailOpts -> ModmailOpts -> Bool
$c/= :: ModmailOpts -> ModmailOpts -> Bool
== :: ModmailOpts -> ModmailOpts -> Bool
$c== :: ModmailOpts -> ModmailOpts -> Bool
Eq, (forall x. ModmailOpts -> Rep ModmailOpts x)
-> (forall x. Rep ModmailOpts x -> ModmailOpts)
-> Generic ModmailOpts
forall x. Rep ModmailOpts x -> ModmailOpts
forall x. ModmailOpts -> Rep ModmailOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModmailOpts x -> ModmailOpts
$cfrom :: forall x. ModmailOpts -> Rep ModmailOpts x
Generic )

instance ToForm ModmailOpts where
    toForm :: ModmailOpts -> Form
toForm ModmailOpts { Maybe [SubredditName]
Maybe Word
Maybe Text
Maybe ModmailState
Maybe ModmailSort
state :: Maybe ModmailState
itemSort :: Maybe ModmailSort
limit :: Maybe Word
subreddits :: Maybe [SubredditName]
after :: Maybe Text
$sel:state:ModmailOpts :: ModmailOpts -> Maybe ModmailState
$sel:itemSort:ModmailOpts :: ModmailOpts -> Maybe ModmailSort
$sel:limit:ModmailOpts :: ModmailOpts -> Maybe Word
$sel:subreddits:ModmailOpts :: ModmailOpts -> Maybe [SubredditName]
$sel:after:ModmailOpts :: ModmailOpts -> 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
$ [Maybe (Text, Text)] -> [(Text, Text)]
forall a. [Maybe a] -> [a]
catMaybes [ (Text
"after", ) (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
after
                    , (Text
"entity", ) (Text -> (Text, Text))
-> ([SubredditName] -> Text) -> [SubredditName] -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SubredditName] -> Text
forall (t :: * -> *) a.
(Foldable t, ToHttpApiData a) =>
t a -> Text
joinParams ([SubredditName] -> (Text, Text))
-> Maybe [SubredditName] -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [SubredditName]
subreddits
                    , (Text
"limit", ) (Text -> (Text, Text)) -> (Word -> Text) -> Word -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (Word -> (Text, Text)) -> Maybe Word -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word
limit
                    , (Text
"sort", ) (Text -> (Text, Text))
-> (ModmailSort -> Text) -> ModmailSort -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModmailSort -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (ModmailSort -> (Text, Text))
-> Maybe ModmailSort -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModmailSort
itemSort
                    , (Text
"state", ) (Text -> (Text, Text))
-> (ModmailState -> Text) -> ModmailState -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModmailState -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (ModmailState -> (Text, Text))
-> Maybe ModmailState -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModmailState
state
                    ]

-- | Default options for filtering modmail
defaultModmailOpts :: ModmailOpts
defaultModmailOpts :: ModmailOpts
defaultModmailOpts = ModmailOpts :: Maybe Text
-> Maybe [SubredditName]
-> Maybe Word
-> Maybe ModmailSort
-> Maybe ModmailState
-> ModmailOpts
ModmailOpts
    { $sel:after:ModmailOpts :: Maybe Text
after      = Maybe Text
forall a. Maybe a
Nothing
    , $sel:subreddits:ModmailOpts :: Maybe [SubredditName]
subreddits = Maybe [SubredditName]
forall a. Maybe a
Nothing
    , $sel:limit:ModmailOpts :: Maybe Word
limit      = Maybe Word
forall a. Maybe a
Nothing
    , $sel:itemSort:ModmailOpts :: Maybe ModmailSort
itemSort   = Maybe ModmailSort
forall a. Maybe a
Nothing
    , $sel:state:ModmailOpts :: Maybe ModmailState
state      = Maybe ModmailState
forall a. Maybe a
Nothing
    }

-- | Order to sort modmail in
data ModmailSort
    = FromUser
    | FromMod
    | RecentMail
    | UnreadMail
    deriving stock ( Int -> ModmailSort -> ShowS
[ModmailSort] -> ShowS
ModmailSort -> String
(Int -> ModmailSort -> ShowS)
-> (ModmailSort -> String)
-> ([ModmailSort] -> ShowS)
-> Show ModmailSort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModmailSort] -> ShowS
$cshowList :: [ModmailSort] -> ShowS
show :: ModmailSort -> String
$cshow :: ModmailSort -> String
showsPrec :: Int -> ModmailSort -> ShowS
$cshowsPrec :: Int -> ModmailSort -> ShowS
Show, ModmailSort -> ModmailSort -> Bool
(ModmailSort -> ModmailSort -> Bool)
-> (ModmailSort -> ModmailSort -> Bool) -> Eq ModmailSort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModmailSort -> ModmailSort -> Bool
$c/= :: ModmailSort -> ModmailSort -> Bool
== :: ModmailSort -> ModmailSort -> Bool
$c== :: ModmailSort -> ModmailSort -> Bool
Eq, (forall x. ModmailSort -> Rep ModmailSort x)
-> (forall x. Rep ModmailSort x -> ModmailSort)
-> Generic ModmailSort
forall x. Rep ModmailSort x -> ModmailSort
forall x. ModmailSort -> Rep ModmailSort x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModmailSort x -> ModmailSort
$cfrom :: forall x. ModmailSort -> Rep ModmailSort x
Generic )

instance ToHttpApiData ModmailSort where
    toQueryParam :: ModmailSort -> Text
toQueryParam = \case
        ModmailSort
FromUser   -> Text
"user"
        ModmailSort
FromMod    -> Text
"mod"
        ModmailSort
RecentMail -> Text
"recent"
        ModmailSort
UnreadMail -> Text
"unread"

-- | The state of the modmail, for use when filtering mail
data ModmailState
    = AllModmail
    | NewModmail
    | Appeals
    | Notifications
    | Inbox
    | InProgress
    | ArchivedMail
    | Highlighted
    | JoinRequests
    | ModModmail
    deriving stock ( Int -> ModmailState -> ShowS
[ModmailState] -> ShowS
ModmailState -> String
(Int -> ModmailState -> ShowS)
-> (ModmailState -> String)
-> ([ModmailState] -> ShowS)
-> Show ModmailState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModmailState] -> ShowS
$cshowList :: [ModmailState] -> ShowS
show :: ModmailState -> String
$cshow :: ModmailState -> String
showsPrec :: Int -> ModmailState -> ShowS
$cshowsPrec :: Int -> ModmailState -> ShowS
Show, ModmailState -> ModmailState -> Bool
(ModmailState -> ModmailState -> Bool)
-> (ModmailState -> ModmailState -> Bool) -> Eq ModmailState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModmailState -> ModmailState -> Bool
$c/= :: ModmailState -> ModmailState -> Bool
== :: ModmailState -> ModmailState -> Bool
$c== :: ModmailState -> ModmailState -> Bool
Eq, (forall x. ModmailState -> Rep ModmailState x)
-> (forall x. Rep ModmailState x -> ModmailState)
-> Generic ModmailState
forall x. Rep ModmailState x -> ModmailState
forall x. ModmailState -> Rep ModmailState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModmailState x -> ModmailState
$cfrom :: forall x. ModmailState -> Rep ModmailState x
Generic )

instance Hashable ModmailState

instance ToHttpApiData ModmailState where
    toQueryParam :: ModmailState -> Text
toQueryParam = \case
        ModmailState
AllModmail    -> Text
"all"
        ModmailState
NewModmail    -> Text
"new"
        ModmailState
Appeals       -> Text
"appeals"
        ModmailState
Notifications -> Text
"notifications"
        ModmailState
Inbox         -> Text
"inbox"
        ModmailState
InProgress    -> Text
"inprogress"
        ModmailState
ArchivedMail  -> Text
"archived"
        ModmailState
Highlighted   -> Text
"highlighted"
        ModmailState
JoinRequests  -> Text
"join_requests"
        ModmailState
ModModmail    -> Text
"mod"

instance FromJSON ModmailState where
    parseJSON :: Value -> Parser ModmailState
parseJSON =
        Options -> Value -> Parser ModmailState
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions
                         { constructorTagModifier :: ShowS
constructorTagModifier = ShowS
modmailStateTagModifier }

instance FromJSONKey ModmailState where
    fromJSONKey :: FromJSONKeyFunction ModmailState
fromJSONKey = JSONKeyOptions -> FromJSONKeyFunction ModmailState
forall a.
(Generic a, GFromJSONKey (Rep a)) =>
JSONKeyOptions -> FromJSONKeyFunction a
genericFromJSONKey --
        JSONKeyOptions
defaultJSONKeyOptions { keyModifier :: ShowS
keyModifier = ShowS
modmailStateTagModifier }

modmailStateTagModifier :: [Char] -> [Char]
modmailStateTagModifier :: ShowS
modmailStateTagModifier = \case
    String
"AllModmail"     -> String
"all"
    String
"NewModmail"     -> String
"new"
    String
"ArchivedMail"   -> String
"archived"
    String
"ModModmail"     -> String
"mod"
    s :: String
s@String
"JoinRequests" -> ShowS
snakeCase String
s
    String
s                -> Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
s

-- | A new reply to a 'ModmailConversation'
data ModmailReply = ModmailReply
    { -- | Markdown-formatted body
      ModmailReply -> Text
body           :: Body
      -- | Hides the identity of the reply author from non-mods
    , ModmailReply -> Bool
isAuthorHidden :: Bool
      -- | Indicates that this is a private moderator note, and thus
      -- hides it from non-mod users
    , ModmailReply -> Bool
isInternal     :: Bool
    }
    deriving stock ( Int -> ModmailReply -> ShowS
[ModmailReply] -> ShowS
ModmailReply -> String
(Int -> ModmailReply -> ShowS)
-> (ModmailReply -> String)
-> ([ModmailReply] -> ShowS)
-> Show ModmailReply
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModmailReply] -> ShowS
$cshowList :: [ModmailReply] -> ShowS
show :: ModmailReply -> String
$cshow :: ModmailReply -> String
showsPrec :: Int -> ModmailReply -> ShowS
$cshowsPrec :: Int -> ModmailReply -> ShowS
Show, ModmailReply -> ModmailReply -> Bool
(ModmailReply -> ModmailReply -> Bool)
-> (ModmailReply -> ModmailReply -> Bool) -> Eq ModmailReply
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModmailReply -> ModmailReply -> Bool
$c/= :: ModmailReply -> ModmailReply -> Bool
== :: ModmailReply -> ModmailReply -> Bool
$c== :: ModmailReply -> ModmailReply -> Bool
Eq, (forall x. ModmailReply -> Rep ModmailReply x)
-> (forall x. Rep ModmailReply x -> ModmailReply)
-> Generic ModmailReply
forall x. Rep ModmailReply x -> ModmailReply
forall x. ModmailReply -> Rep ModmailReply x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModmailReply x -> ModmailReply
$cfrom :: forall x. ModmailReply -> Rep ModmailReply x
Generic )

instance ToForm ModmailReply where
    toForm :: ModmailReply -> Form
toForm = FormOptions -> ModmailReply -> Form
forall a.
(Generic a, GToForm a (Rep a)) =>
FormOptions -> a -> Form
genericToForm FormOptions
defaultFormOptions

-- | 'ModmailReply' with default values for boolean fields
mkModmailReply :: Body -> ModmailReply
mkModmailReply :: Text -> ModmailReply
mkModmailReply Text
body =
    ModmailReply :: Text -> Bool -> Bool -> ModmailReply
ModmailReply { Text
body :: Text
$sel:body:ModmailReply :: Text
body, $sel:isAuthorHidden:ModmailReply :: Bool
isAuthorHidden = Bool
False, $sel:isInternal:ModmailReply :: Bool
isInternal = Bool
False }

-- | A new, mod-created modmail conversation
data NewConversation = NewConversation
    { -- | Must not be empty
      NewConversation -> Text
body           :: Body
      -- | Must not be empty, and should be less than 100 characters
    , NewConversation -> Text
subject        :: Subject
      -- | The intended recipient of the message
    , NewConversation -> Username
dest           :: Username
    , NewConversation -> SubredditName
subreddit      :: SubredditName
      -- | Hides the identity of the reply author from non-mods
    , NewConversation -> Bool
isAuthorHidden :: Bool
    }
    deriving stock ( Int -> NewConversation -> ShowS
[NewConversation] -> ShowS
NewConversation -> String
(Int -> NewConversation -> ShowS)
-> (NewConversation -> String)
-> ([NewConversation] -> ShowS)
-> Show NewConversation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewConversation] -> ShowS
$cshowList :: [NewConversation] -> ShowS
show :: NewConversation -> String
$cshow :: NewConversation -> String
showsPrec :: Int -> NewConversation -> ShowS
$cshowsPrec :: Int -> NewConversation -> ShowS
Show, NewConversation -> NewConversation -> Bool
(NewConversation -> NewConversation -> Bool)
-> (NewConversation -> NewConversation -> Bool)
-> Eq NewConversation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewConversation -> NewConversation -> Bool
$c/= :: NewConversation -> NewConversation -> Bool
== :: NewConversation -> NewConversation -> Bool
$c== :: NewConversation -> NewConversation -> Bool
Eq, (forall x. NewConversation -> Rep NewConversation x)
-> (forall x. Rep NewConversation x -> NewConversation)
-> Generic NewConversation
forall x. Rep NewConversation x -> NewConversation
forall x. NewConversation -> Rep NewConversation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NewConversation x -> NewConversation
$cfrom :: forall x. NewConversation -> Rep NewConversation x
Generic )

instance ToForm NewConversation where
    toForm :: NewConversation -> Form
toForm = FormOptions -> NewConversation -> Form
forall a.
(Generic a, GToForm a (Rep a)) =>
FormOptions -> a -> Form
genericToForm FormOptions
defaultFormOptions { ShowS
fieldLabelModifier :: ShowS
fieldLabelModifier :: ShowS
fieldLabelModifier }
      where
        fieldLabelModifier :: ShowS
fieldLabelModifier = \case
            String
"dest"      -> String
"to"
            String
"subreddit" -> String
"srName"
            String
s           -> String
s

--Modlog-----------------------------------------------------------------------
-- | An action issued by a moderator. The various fields prefixed @target@ can
-- refer to comments or submissions, where applicable
data ModAction = ModAction
    { ModAction -> ModActionID
modActionID     :: ModActionID
    , ModAction -> Username
moderator       :: Username
    , ModAction -> ModActionType
action          :: ModActionType
    , ModAction -> UTCTime
created         :: UTCTime
    , ModAction -> Maybe Text
description     :: Maybe Body
    , ModAction -> Maybe Text
details         :: Maybe Text
    , ModAction -> Maybe ItemID
targetID        :: Maybe ItemID
    , ModAction -> Maybe Username
targetAuthor    :: Maybe Username
    , ModAction -> Maybe Text
targetTitle     :: Maybe Title
    , ModAction -> Maybe Text
targetPermalink :: Maybe URL
    }
    deriving stock ( Int -> ModAction -> ShowS
[ModAction] -> ShowS
ModAction -> String
(Int -> ModAction -> ShowS)
-> (ModAction -> String)
-> ([ModAction] -> ShowS)
-> Show ModAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModAction] -> ShowS
$cshowList :: [ModAction] -> ShowS
show :: ModAction -> String
$cshow :: ModAction -> String
showsPrec :: Int -> ModAction -> ShowS
$cshowsPrec :: Int -> ModAction -> ShowS
Show, ModAction -> ModAction -> Bool
(ModAction -> ModAction -> Bool)
-> (ModAction -> ModAction -> Bool) -> Eq ModAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModAction -> ModAction -> Bool
$c/= :: ModAction -> ModAction -> Bool
== :: ModAction -> ModAction -> Bool
$c== :: ModAction -> ModAction -> Bool
Eq, (forall x. ModAction -> Rep ModAction x)
-> (forall x. Rep ModAction x -> ModAction) -> Generic ModAction
forall x. Rep ModAction x -> ModAction
forall x. ModAction -> Rep ModAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModAction x -> ModAction
$cfrom :: forall x. ModAction -> Rep ModAction x
Generic )

instance FromJSON ModAction where
    parseJSON :: Value -> Parser ModAction
parseJSON = RedditKind
-> String
-> (Object -> Parser ModAction)
-> Value
-> Parser ModAction
forall b a.
FromJSON b =>
RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind RedditKind
ModActionKind String
"ModAction" ((Object -> Parser ModAction) -> Value -> Parser ModAction)
-> (Object -> Parser ModAction) -> Value -> Parser ModAction
forall a b. (a -> b) -> a -> b
$ \Object
o -> ModActionID
-> Username
-> ModActionType
-> UTCTime
-> Maybe Text
-> Maybe Text
-> Maybe ItemID
-> Maybe Username
-> Maybe Text
-> Maybe Text
-> ModAction
ModAction
        (ModActionID
 -> Username
 -> ModActionType
 -> UTCTime
 -> Maybe Text
 -> Maybe Text
 -> Maybe ItemID
 -> Maybe Username
 -> Maybe Text
 -> Maybe Text
 -> ModAction)
-> Parser ModActionID
-> Parser
     (Username
      -> ModActionType
      -> UTCTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe ItemID
      -> Maybe Username
      -> Maybe Text
      -> Maybe Text
      -> ModAction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser ModActionID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
        Parser
  (Username
   -> ModActionType
   -> UTCTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe ItemID
   -> Maybe Username
   -> Maybe Text
   -> Maybe Text
   -> ModAction)
-> Parser Username
-> Parser
     (ModActionType
      -> UTCTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe ItemID
      -> Maybe Username
      -> Maybe Text
      -> Maybe Text
      -> ModAction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Username
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"mod"
        -- In case an uknown mod action field is encountered. Perhaps
        -- just make the field a @Maybe ModActionType@?
        Parser
  (ModActionType
   -> UTCTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe ItemID
   -> Maybe Username
   -> Maybe Text
   -> Maybe Text
   -> ModAction)
-> Parser ModActionType
-> Parser
     (UTCTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe ItemID
      -> Maybe Username
      -> Maybe Text
      -> Maybe Text
      -> ModAction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser ModActionType
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"action" Parser ModActionType
-> Parser ModActionType -> Parser ModActionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ModActionType -> Parser ModActionType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModActionType
OtherModAction)
        Parser
  (UTCTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe ItemID
   -> Maybe Username
   -> Maybe Text
   -> Maybe Text
   -> ModAction)
-> Parser UTCTime
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe ItemID
      -> Maybe Username
      -> Maybe Text
      -> Maybe Text
      -> ModAction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> UTCTime
integerToUTC (Integer -> UTCTime) -> Parser Integer -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_utc")
        Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe ItemID
   -> Maybe Username
   -> Maybe Text
   -> Maybe Text
   -> ModAction)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe ItemID
      -> Maybe Username
      -> Maybe Text
      -> Maybe Text
      -> ModAction)
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
"description"
        Parser
  (Maybe Text
   -> Maybe ItemID
   -> Maybe Username
   -> Maybe Text
   -> Maybe Text
   -> ModAction)
-> Parser (Maybe Text)
-> Parser
     (Maybe ItemID
      -> Maybe Username -> Maybe Text -> Maybe Text -> ModAction)
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
"details"
        -- It appears that the @target@ fields are only present
        -- when the mod action is taken on comments or submissions.
        -- Nevertheless, @optional@ can be applied here to make
        -- sure that parsing doesn't fail in case that assumption
        -- is mistaken
        Parser
  (Maybe ItemID
   -> Maybe Username -> Maybe Text -> Maybe Text -> ModAction)
-> Parser (Maybe ItemID)
-> Parser (Maybe Username -> Maybe Text -> Maybe Text -> ModAction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ItemID -> Parser (Maybe ItemID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Object
o Object -> Text -> Parser ItemID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"target_fullname")
        Parser (Maybe Username -> Maybe Text -> Maybe Text -> ModAction)
-> Parser (Maybe Username)
-> Parser (Maybe Text -> Maybe Text -> ModAction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Username -> Parser (Maybe Username)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Object
o Object -> Text -> Parser Username
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"target_author")
        Parser (Maybe Text -> Maybe Text -> ModAction)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ModAction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"target_title")
        Parser (Maybe Text -> ModAction)
-> Parser (Maybe Text) -> Parser ModAction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"target_permalink")

instance Paginable ModAction where
    type PaginateOptions ModAction = ModActionOpts

    type PaginateThing ModAction = ModActionID

    defaultOpts :: PaginateOptions ModAction
defaultOpts = ModActionOpts :: Maybe ModActionType -> Maybe Username -> ModActionOpts
ModActionOpts { $sel:action:ModActionOpts :: Maybe ModActionType
action = Maybe ModActionType
forall a. Maybe a
Nothing, $sel:moderator:ModActionOpts :: Maybe Username
moderator = Maybe Username
forall a. Maybe a
Nothing }

    optsToForm :: PaginateOptions ModAction -> Form
optsToForm ModActionOpts { .. } = [Item Form] -> Form
forall l. IsList l => [Item l] -> l
fromList
        ([Item Form] -> Form) -> [Item Form] -> Form
forall a b. (a -> b) -> a -> b
$ [Maybe (Text, Text)] -> [(Text, Text)]
forall a. [Maybe a] -> [a]
catMaybes [ (Text
"type", ) (Text -> (Text, Text))
-> (ModActionType -> Text) -> ModActionType -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModActionType -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (ModActionType -> (Text, Text))
-> Maybe ModActionType -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModActionType
action
                    , (Text
"mod", ) (Text -> (Text, Text))
-> (Username -> Text) -> Username -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Username -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (Username -> (Text, Text)) -> Maybe Username -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Username
moderator
                    ]

    getFullname :: ModAction -> PaginateThing ModAction
getFullname ModAction { ModActionID
modActionID :: ModActionID
$sel:modActionID:ModAction :: ModAction -> ModActionID
modActionID } = PaginateThing ModAction
ModActionID
modActionID

-- | Options for filtering\/paginating 'Listing's of 'ModAction's
data ModActionOpts = ModActionOpts
    { -- | Limits the returned 'Listing' to only this type of action
      ModActionOpts -> Maybe ModActionType
action    :: Maybe ModActionType
      -- | Limits the returned 'Listing' to only those issued by this
      -- moderator
    , ModActionOpts -> Maybe Username
moderator :: Maybe Username
    }
    deriving stock ( Int -> ModActionOpts -> ShowS
[ModActionOpts] -> ShowS
ModActionOpts -> String
(Int -> ModActionOpts -> ShowS)
-> (ModActionOpts -> String)
-> ([ModActionOpts] -> ShowS)
-> Show ModActionOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModActionOpts] -> ShowS
$cshowList :: [ModActionOpts] -> ShowS
show :: ModActionOpts -> String
$cshow :: ModActionOpts -> String
showsPrec :: Int -> ModActionOpts -> ShowS
$cshowsPrec :: Int -> ModActionOpts -> ShowS
Show, ModActionOpts -> ModActionOpts -> Bool
(ModActionOpts -> ModActionOpts -> Bool)
-> (ModActionOpts -> ModActionOpts -> Bool) -> Eq ModActionOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModActionOpts -> ModActionOpts -> Bool
$c/= :: ModActionOpts -> ModActionOpts -> Bool
== :: ModActionOpts -> ModActionOpts -> Bool
$c== :: ModActionOpts -> ModActionOpts -> Bool
Eq, (forall x. ModActionOpts -> Rep ModActionOpts x)
-> (forall x. Rep ModActionOpts x -> ModActionOpts)
-> Generic ModActionOpts
forall x. Rep ModActionOpts x -> ModActionOpts
forall x. ModActionOpts -> Rep ModActionOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModActionOpts x -> ModActionOpts
$cfrom :: forall x. ModActionOpts -> Rep ModActionOpts x
Generic )

-- | Identifier for an issued 'ModAction'
newtype ModActionID = ModActionID Text
    deriving stock ( Int -> ModActionID -> ShowS
[ModActionID] -> ShowS
ModActionID -> String
(Int -> ModActionID -> ShowS)
-> (ModActionID -> String)
-> ([ModActionID] -> ShowS)
-> Show ModActionID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModActionID] -> ShowS
$cshowList :: [ModActionID] -> ShowS
show :: ModActionID -> String
$cshow :: ModActionID -> String
showsPrec :: Int -> ModActionID -> ShowS
$cshowsPrec :: Int -> ModActionID -> ShowS
Show, (forall x. ModActionID -> Rep ModActionID x)
-> (forall x. Rep ModActionID x -> ModActionID)
-> Generic ModActionID
forall x. Rep ModActionID x -> ModActionID
forall x. ModActionID -> Rep ModActionID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModActionID x -> ModActionID
$cfrom :: forall x. ModActionID -> Rep ModActionID x
Generic )
    deriving newtype ( ModActionID -> ModActionID -> Bool
(ModActionID -> ModActionID -> Bool)
-> (ModActionID -> ModActionID -> Bool) -> Eq ModActionID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModActionID -> ModActionID -> Bool
$c/= :: ModActionID -> ModActionID -> Bool
== :: ModActionID -> ModActionID -> Bool
$c== :: ModActionID -> ModActionID -> Bool
Eq, ModActionID -> ByteString
ModActionID -> Builder
ModActionID -> Text
(ModActionID -> Text)
-> (ModActionID -> Builder)
-> (ModActionID -> ByteString)
-> (ModActionID -> Text)
-> ToHttpApiData ModActionID
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: ModActionID -> Text
$ctoQueryParam :: ModActionID -> Text
toHeader :: ModActionID -> ByteString
$ctoHeader :: ModActionID -> ByteString
toEncodedUrlPiece :: ModActionID -> Builder
$ctoEncodedUrlPiece :: ModActionID -> Builder
toUrlPiece :: ModActionID -> Text
$ctoUrlPiece :: ModActionID -> Text
ToHttpApiData )

instance FromJSON ModActionID where
    parseJSON :: Value -> Parser ModActionID
parseJSON = String
-> (Text -> Parser ModActionID) -> Value -> Parser ModActionID
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ModActionID" (Text -> Text -> Parser ModActionID
forall a. Coercible a Text => Text -> Text -> Parser a
breakOnType Text
"ModAction")

instance Thing ModActionID where
    fullname :: ModActionID -> Text
fullname (ModActionID Text
mid) = Text
"ModAction_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mid

-- | Classification for 'ModAction's
data ModActionType
    = BanUser
    | UnbanUser
    | SpamLink
    | RemoveLink
    | ApproveLink
    | SpamComment
    | RemoveComment
    | ApproveComment
    | AddModerator
    | ShowComment
    | InviteModerator
    | UninviteModerator
    | AcceptModeratorInvite
    | RemoveModerator
    | AddContributor
    | RemoveContributor
    | EditSettings
    | EditFlair
    | Distinguish
    | MarkNSFW
    | WikiBanned
    | WikiContrib
    | WikiUnbanned
    | WikiPageListed
    | RemoveWikiContributor
    | WikiRevise
    | WikiPermLevel
    | IgnoreReports
    | UnignoreReports
    | SetPermissions
    | SetSuggestedSort
    | Sticky
    | Unsticky
    | SetContestMode
    | UnsetContestMode
    | Lock
    | Unlock
    | MuteUser
    | UnmuteUser
    | CreateRule
    | EditRule
    | ReorderRules
    | DeleteRule
    | Spoiler
    | Unspoiler
    | MarkOriginalContent
    | Collections
    | Events
    | DeleteOverriddenClassification
    | OverrideClassification
    | ReorderModerators
    | SnoozeReports
    | UnsnoozeReports
      -- In case the preceding is not exhaustive:
    | OtherModAction
    deriving stock ( Int -> ModActionType -> ShowS
[ModActionType] -> ShowS
ModActionType -> String
(Int -> ModActionType -> ShowS)
-> (ModActionType -> String)
-> ([ModActionType] -> ShowS)
-> Show ModActionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModActionType] -> ShowS
$cshowList :: [ModActionType] -> ShowS
show :: ModActionType -> String
$cshow :: ModActionType -> String
showsPrec :: Int -> ModActionType -> ShowS
$cshowsPrec :: Int -> ModActionType -> ShowS
Show, ModActionType -> ModActionType -> Bool
(ModActionType -> ModActionType -> Bool)
-> (ModActionType -> ModActionType -> Bool) -> Eq ModActionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModActionType -> ModActionType -> Bool
$c/= :: ModActionType -> ModActionType -> Bool
== :: ModActionType -> ModActionType -> Bool
$c== :: ModActionType -> ModActionType -> Bool
Eq, Eq ModActionType
Eq ModActionType
-> (ModActionType -> ModActionType -> Ordering)
-> (ModActionType -> ModActionType -> Bool)
-> (ModActionType -> ModActionType -> Bool)
-> (ModActionType -> ModActionType -> Bool)
-> (ModActionType -> ModActionType -> Bool)
-> (ModActionType -> ModActionType -> ModActionType)
-> (ModActionType -> ModActionType -> ModActionType)
-> Ord ModActionType
ModActionType -> ModActionType -> Bool
ModActionType -> ModActionType -> Ordering
ModActionType -> ModActionType -> ModActionType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModActionType -> ModActionType -> ModActionType
$cmin :: ModActionType -> ModActionType -> ModActionType
max :: ModActionType -> ModActionType -> ModActionType
$cmax :: ModActionType -> ModActionType -> ModActionType
>= :: ModActionType -> ModActionType -> Bool
$c>= :: ModActionType -> ModActionType -> Bool
> :: ModActionType -> ModActionType -> Bool
$c> :: ModActionType -> ModActionType -> Bool
<= :: ModActionType -> ModActionType -> Bool
$c<= :: ModActionType -> ModActionType -> Bool
< :: ModActionType -> ModActionType -> Bool
$c< :: ModActionType -> ModActionType -> Bool
compare :: ModActionType -> ModActionType -> Ordering
$ccompare :: ModActionType -> ModActionType -> Ordering
$cp1Ord :: Eq ModActionType
Ord, (forall x. ModActionType -> Rep ModActionType x)
-> (forall x. Rep ModActionType x -> ModActionType)
-> Generic ModActionType
forall x. Rep ModActionType x -> ModActionType
forall x. ModActionType -> Rep ModActionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModActionType x -> ModActionType
$cfrom :: forall x. ModActionType -> Rep ModActionType x
Generic )

instance FromJSON ModActionType where
    parseJSON :: Value -> Parser ModActionType
parseJSON = Options -> Value -> Parser ModActionType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON --
        Options
defaultOptions { ShowS
constructorTagModifier :: ShowS
constructorTagModifier :: ShowS
constructorTagModifier }
      where
        constructorTagModifier :: ShowS
constructorTagModifier = \case
            String
"WikiContrib" -> String
"wikicontributor"
            String
s             -> Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
s

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

--Styles and images------------------------------------------------------------
-- | The CSS stylesheet and images for a subreddit
data Stylesheet = Stylesheet
    { Stylesheet -> Text
stylesheet  :: Text
    , Stylesheet -> Seq SubredditImage
images      :: Seq SubredditImage
    , Stylesheet -> SubredditID
subredditID :: SubredditID
    }
    deriving stock ( Int -> Stylesheet -> ShowS
[Stylesheet] -> ShowS
Stylesheet -> String
(Int -> Stylesheet -> ShowS)
-> (Stylesheet -> String)
-> ([Stylesheet] -> ShowS)
-> Show Stylesheet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stylesheet] -> ShowS
$cshowList :: [Stylesheet] -> ShowS
show :: Stylesheet -> String
$cshow :: Stylesheet -> String
showsPrec :: Int -> Stylesheet -> ShowS
$cshowsPrec :: Int -> Stylesheet -> ShowS
Show, Stylesheet -> Stylesheet -> Bool
(Stylesheet -> Stylesheet -> Bool)
-> (Stylesheet -> Stylesheet -> Bool) -> Eq Stylesheet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stylesheet -> Stylesheet -> Bool
$c/= :: Stylesheet -> Stylesheet -> Bool
== :: Stylesheet -> Stylesheet -> Bool
$c== :: Stylesheet -> Stylesheet -> Bool
Eq, (forall x. Stylesheet -> Rep Stylesheet x)
-> (forall x. Rep Stylesheet x -> Stylesheet) -> Generic Stylesheet
forall x. Rep Stylesheet x -> Stylesheet
forall x. Stylesheet -> Rep Stylesheet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Stylesheet x -> Stylesheet
$cfrom :: forall x. Stylesheet -> Rep Stylesheet x
Generic )

instance FromJSON Stylesheet where
    parseJSON :: Value -> Parser Stylesheet
parseJSON = RedditKind
-> String
-> (Object -> Parser Stylesheet)
-> Value
-> Parser Stylesheet
forall b a.
FromJSON b =>
RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind RedditKind
StylesheetKind String
"Stylesheet" ((Object -> Parser Stylesheet) -> Value -> Parser Stylesheet)
-> (Object -> Parser Stylesheet) -> Value -> Parser Stylesheet
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Seq SubredditImage -> SubredditID -> Stylesheet
Stylesheet
        (Text -> Seq SubredditImage -> SubredditID -> Stylesheet)
-> Parser Text
-> Parser (Seq SubredditImage -> SubredditID -> Stylesheet)
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
"stylesheet"
        Parser (Seq SubredditImage -> SubredditID -> Stylesheet)
-> Parser (Seq SubredditImage)
-> Parser (SubredditID -> Stylesheet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Seq SubredditImage)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"images"
        Parser (SubredditID -> Stylesheet)
-> Parser SubredditID -> Parser Stylesheet
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser SubredditID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"subreddit_id"

-- | An image belonging to a 'Stylesheet'
data SubredditImage = SubredditImage
    { SubredditImage -> Text
name :: Name
    , SubredditImage -> Text
link :: Text -- ^ CSS link
    , SubredditImage -> Text
url  :: URL
    }
    deriving stock ( Int -> SubredditImage -> ShowS
[SubredditImage] -> ShowS
SubredditImage -> String
(Int -> SubredditImage -> ShowS)
-> (SubredditImage -> String)
-> ([SubredditImage] -> ShowS)
-> Show SubredditImage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubredditImage] -> ShowS
$cshowList :: [SubredditImage] -> ShowS
show :: SubredditImage -> String
$cshow :: SubredditImage -> String
showsPrec :: Int -> SubredditImage -> ShowS
$cshowsPrec :: Int -> SubredditImage -> ShowS
Show, SubredditImage -> SubredditImage -> Bool
(SubredditImage -> SubredditImage -> Bool)
-> (SubredditImage -> SubredditImage -> Bool) -> Eq SubredditImage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubredditImage -> SubredditImage -> Bool
$c/= :: SubredditImage -> SubredditImage -> Bool
== :: SubredditImage -> SubredditImage -> Bool
$c== :: SubredditImage -> SubredditImage -> Bool
Eq, (forall x. SubredditImage -> Rep SubredditImage x)
-> (forall x. Rep SubredditImage x -> SubredditImage)
-> Generic SubredditImage
forall x. Rep SubredditImage x -> SubredditImage
forall x. SubredditImage -> Rep SubredditImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubredditImage x -> SubredditImage
$cfrom :: forall x. SubredditImage -> Rep SubredditImage x
Generic )

instance FromJSON SubredditImage where
    parseJSON :: Value -> Parser SubredditImage
parseJSON = Options -> Value -> Parser SubredditImage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions

-- | Used to upload style assets and images to Reddit\'s servers with moderator
-- privileges
data S3ModerationLease = S3ModerationLease
    { S3ModerationLease -> Text
action       :: URL
      -- | S3 metadata and headers
    , S3ModerationLease -> HashMap Text Text
fields       :: HashMap Text Text
      -- | This is required to get the final upload URL
    , S3ModerationLease -> Text
key          :: Text
    , S3ModerationLease -> Text
websocketURL :: URL
    }
    deriving stock ( Int -> S3ModerationLease -> ShowS
[S3ModerationLease] -> ShowS
S3ModerationLease -> String
(Int -> S3ModerationLease -> ShowS)
-> (S3ModerationLease -> String)
-> ([S3ModerationLease] -> ShowS)
-> Show S3ModerationLease
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S3ModerationLease] -> ShowS
$cshowList :: [S3ModerationLease] -> ShowS
show :: S3ModerationLease -> String
$cshow :: S3ModerationLease -> String
showsPrec :: Int -> S3ModerationLease -> ShowS
$cshowsPrec :: Int -> S3ModerationLease -> ShowS
Show, S3ModerationLease -> S3ModerationLease -> Bool
(S3ModerationLease -> S3ModerationLease -> Bool)
-> (S3ModerationLease -> S3ModerationLease -> Bool)
-> Eq S3ModerationLease
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S3ModerationLease -> S3ModerationLease -> Bool
$c/= :: S3ModerationLease -> S3ModerationLease -> Bool
== :: S3ModerationLease -> S3ModerationLease -> Bool
$c== :: S3ModerationLease -> S3ModerationLease -> Bool
Eq, (forall x. S3ModerationLease -> Rep S3ModerationLease x)
-> (forall x. Rep S3ModerationLease x -> S3ModerationLease)
-> Generic S3ModerationLease
forall x. Rep S3ModerationLease x -> S3ModerationLease
forall x. S3ModerationLease -> Rep S3ModerationLease x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep S3ModerationLease x -> S3ModerationLease
$cfrom :: forall x. S3ModerationLease -> Rep S3ModerationLease x
Generic )

instance FromJSON S3ModerationLease where
    parseJSON :: Value -> Parser S3ModerationLease
parseJSON = String
-> (Object -> Parser S3ModerationLease)
-> Value
-> Parser S3ModerationLease
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"S3ModerationLease" ((Object -> Parser S3ModerationLease)
 -> Value -> Parser S3ModerationLease)
-> (Object -> Parser S3ModerationLease)
-> Value
-> Parser S3ModerationLease
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Object
lease <- Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"s3ModerationLease"
        -- The protocol isn't included, for some reason
        Text
action <- (Text
"https:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
lease Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"action"
        HashMap Text Text
fields <- Value -> Parser (HashMap Text Text)
fieldsP (Value -> Parser (HashMap Text Text))
-> Parser Value -> Parser (HashMap Text Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
lease Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"fields"
        Text
key <- Parser Text -> (Text -> Parser Text) -> Maybe Text -> Parser Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Missing key") Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Parser Text) -> Maybe Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
"key" HashMap Text Text
fields
        Text
websocketURL <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"websocketUrl"
        S3ModerationLease -> Parser S3ModerationLease
forall (f :: * -> *) a. Applicative f => a -> f a
pure S3ModerationLease :: Text -> HashMap Text Text -> Text -> Text -> S3ModerationLease
S3ModerationLease { Text
HashMap Text Text
websocketURL :: Text
key :: Text
fields :: HashMap Text Text
action :: Text
$sel:websocketURL:S3ModerationLease :: Text
$sel:key:S3ModerationLease :: Text
$sel:fields:S3ModerationLease :: HashMap Text Text
$sel:action:S3ModerationLease :: Text
.. }
      where
        fieldsP :: Value -> Parser (HashMap Text Text)
fieldsP = String
-> (Array -> Parser (HashMap Text Text))
-> Value
-> Parser (HashMap Text Text)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"S3ModerationLease.fields"
            ((Array -> Parser (HashMap Text Text))
 -> Value -> Parser (HashMap Text Text))
-> (Array -> Parser (HashMap Text Text))
-> Value
-> Parser (HashMap Text Text)
forall a b. (a -> b) -> a -> b
$ ([(Text, Text)] -> HashMap Text Text)
-> Parser [(Text, Text)] -> Parser (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList (Parser [(Text, Text)] -> Parser (HashMap Text Text))
-> (Array -> Parser [(Text, Text)])
-> Array
-> Parser (HashMap Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser (Text, Text)) -> [Value] -> Parser [(Text, Text)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser (Text, Text)
fieldP ([Value] -> Parser [(Text, Text)])
-> (Array -> [Value]) -> Array -> Parser [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall l. IsList l => l -> [Item l]
toList

        fieldP :: Value -> Parser (Text, Text)
fieldP  = String
-> (Object -> Parser (Text, Text)) -> Value -> Parser (Text, Text)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"S3ModerationLease.fields.field"
            ((Object -> Parser (Text, Text)) -> Value -> Parser (Text, Text))
-> (Object -> Parser (Text, Text)) -> Value -> Parser (Text, Text)
forall a b. (a -> b) -> a -> b
$ \Object
o -> (,) (Text -> Text -> (Text, Text))
-> Parser Text -> Parser (Text -> (Text, Text))
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
"name" Parser (Text -> (Text, Text)) -> Parser Text -> Parser (Text, Text)
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
"value"

-- | Represents one of the style images that may be uploaded
data StructuredStyleImage
    = BannerBackground
    | BannerAdditional
    | BannerHover
    deriving stock ( Int -> StructuredStyleImage -> ShowS
[StructuredStyleImage] -> ShowS
StructuredStyleImage -> String
(Int -> StructuredStyleImage -> ShowS)
-> (StructuredStyleImage -> String)
-> ([StructuredStyleImage] -> ShowS)
-> Show StructuredStyleImage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StructuredStyleImage] -> ShowS
$cshowList :: [StructuredStyleImage] -> ShowS
show :: StructuredStyleImage -> String
$cshow :: StructuredStyleImage -> String
showsPrec :: Int -> StructuredStyleImage -> ShowS
$cshowsPrec :: Int -> StructuredStyleImage -> ShowS
Show, StructuredStyleImage -> StructuredStyleImage -> Bool
(StructuredStyleImage -> StructuredStyleImage -> Bool)
-> (StructuredStyleImage -> StructuredStyleImage -> Bool)
-> Eq StructuredStyleImage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StructuredStyleImage -> StructuredStyleImage -> Bool
$c/= :: StructuredStyleImage -> StructuredStyleImage -> Bool
== :: StructuredStyleImage -> StructuredStyleImage -> Bool
$c== :: StructuredStyleImage -> StructuredStyleImage -> Bool
Eq, (forall x. StructuredStyleImage -> Rep StructuredStyleImage x)
-> (forall x. Rep StructuredStyleImage x -> StructuredStyleImage)
-> Generic StructuredStyleImage
forall x. Rep StructuredStyleImage x -> StructuredStyleImage
forall x. StructuredStyleImage -> Rep StructuredStyleImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StructuredStyleImage x -> StructuredStyleImage
$cfrom :: forall x. StructuredStyleImage -> Rep StructuredStyleImage x
Generic )

instance ToHttpApiData StructuredStyleImage where
    toQueryParam :: StructuredStyleImage -> Text
toQueryParam = \case
        StructuredStyleImage
BannerBackground -> Text
"bannerBackgroundImage"
        StructuredStyleImage
BannerHover      -> Text
"secondaryBannerPositionedImage"
        StructuredStyleImage
BannerAdditional -> Text
"bannerPositionedImage"

-- | Alignment for certain 'StructuredStyleImage's
data StyleImageAlignment
    = LeftAligned
    | CenterAligned
    | RightAligned
    deriving stock ( Int -> StyleImageAlignment -> ShowS
[StyleImageAlignment] -> ShowS
StyleImageAlignment -> String
(Int -> StyleImageAlignment -> ShowS)
-> (StyleImageAlignment -> String)
-> ([StyleImageAlignment] -> ShowS)
-> Show StyleImageAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StyleImageAlignment] -> ShowS
$cshowList :: [StyleImageAlignment] -> ShowS
show :: StyleImageAlignment -> String
$cshow :: StyleImageAlignment -> String
showsPrec :: Int -> StyleImageAlignment -> ShowS
$cshowsPrec :: Int -> StyleImageAlignment -> ShowS
Show, StyleImageAlignment -> StyleImageAlignment -> Bool
(StyleImageAlignment -> StyleImageAlignment -> Bool)
-> (StyleImageAlignment -> StyleImageAlignment -> Bool)
-> Eq StyleImageAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StyleImageAlignment -> StyleImageAlignment -> Bool
$c/= :: StyleImageAlignment -> StyleImageAlignment -> Bool
== :: StyleImageAlignment -> StyleImageAlignment -> Bool
$c== :: StyleImageAlignment -> StyleImageAlignment -> Bool
Eq, (forall x. StyleImageAlignment -> Rep StyleImageAlignment x)
-> (forall x. Rep StyleImageAlignment x -> StyleImageAlignment)
-> Generic StyleImageAlignment
forall x. Rep StyleImageAlignment x -> StyleImageAlignment
forall x. StyleImageAlignment -> Rep StyleImageAlignment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StyleImageAlignment x -> StyleImageAlignment
$cfrom :: forall x. StyleImageAlignment -> Rep StyleImageAlignment x
Generic )

instance ToHttpApiData StyleImageAlignment where
    toQueryParam :: StyleImageAlignment -> Text
toQueryParam = \case
        StyleImageAlignment
LeftAligned   -> Text
"left"
        StyleImageAlignment
CenterAligned -> Text
"center"
        StyleImageAlignment
RightAligned  -> Text
"right"

--Misc-------------------------------------------------------------------------
-- | An individual statistic for a subreddit\'s traffic
data TrafficStat = TrafficStat
    { TrafficStat -> UTCTime
timestamp   :: UTCTime
    , TrafficStat -> Integer
uniqueViews :: Integer
    , TrafficStat -> Integer
totalViews  :: Integer
      -- | This statistic is only available in the @day@ and @month@ fields
      -- of a 'Traffic'
    , TrafficStat -> Maybe Integer
subscribers :: Maybe Integer
    }
    deriving stock ( Int -> TrafficStat -> ShowS
[TrafficStat] -> ShowS
TrafficStat -> String
(Int -> TrafficStat -> ShowS)
-> (TrafficStat -> String)
-> ([TrafficStat] -> ShowS)
-> Show TrafficStat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrafficStat] -> ShowS
$cshowList :: [TrafficStat] -> ShowS
show :: TrafficStat -> String
$cshow :: TrafficStat -> String
showsPrec :: Int -> TrafficStat -> ShowS
$cshowsPrec :: Int -> TrafficStat -> ShowS
Show, TrafficStat -> TrafficStat -> Bool
(TrafficStat -> TrafficStat -> Bool)
-> (TrafficStat -> TrafficStat -> Bool) -> Eq TrafficStat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrafficStat -> TrafficStat -> Bool
$c/= :: TrafficStat -> TrafficStat -> Bool
== :: TrafficStat -> TrafficStat -> Bool
$c== :: TrafficStat -> TrafficStat -> Bool
Eq, (forall x. TrafficStat -> Rep TrafficStat x)
-> (forall x. Rep TrafficStat x -> TrafficStat)
-> Generic TrafficStat
forall x. Rep TrafficStat x -> TrafficStat
forall x. TrafficStat -> Rep TrafficStat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TrafficStat x -> TrafficStat
$cfrom :: forall x. TrafficStat -> Rep TrafficStat x
Generic )

instance FromJSON TrafficStat where
    parseJSON :: Value -> Parser TrafficStat
parseJSON = String
-> (Array -> Parser TrafficStat) -> Value -> Parser TrafficStat
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"TrafficStat" ([Value] -> Parser TrafficStat
statP ([Value] -> Parser TrafficStat)
-> (Array -> [Value]) -> Array -> Parser TrafficStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall l. IsList l => l -> [Item l]
toList)
      where
        statP :: [Value] -> Parser TrafficStat
statP (Value
timestamp : Value
uniqueViews : Value
totalViews : [Value]
rest) = UTCTime -> Integer -> Integer -> Maybe Integer -> TrafficStat
TrafficStat
            (UTCTime -> Integer -> Integer -> Maybe Integer -> TrafficStat)
-> Parser UTCTime
-> Parser (Integer -> Integer -> Maybe Integer -> TrafficStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer -> UTCTime
integerToUTC (Integer -> UTCTime) -> Parser Integer -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON Value
timestamp)
            Parser (Integer -> Integer -> Maybe Integer -> TrafficStat)
-> Parser Integer
-> Parser (Integer -> Maybe Integer -> TrafficStat)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON Value
uniqueViews
            Parser (Integer -> Maybe Integer -> TrafficStat)
-> Parser Integer -> Parser (Maybe Integer -> TrafficStat)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON Value
totalViews
            Parser (Maybe Integer -> TrafficStat)
-> Parser (Maybe Integer) -> Parser TrafficStat
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> case [Value]
rest of
                Value
subscribers : [Value]
_ -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> Parser Integer -> Parser (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON Value
subscribers
                [Value]
_               -> Maybe Integer -> Parser (Maybe Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Integer
forall a. Maybe a
Nothing
        statP [Value]
_ = Parser TrafficStat
forall a. Monoid a => a
mempty

-- | Traffic statistics for a given subreddit
data Traffic = Traffic
    { -- | Does not contain subscriber information
      Traffic -> Seq TrafficStat
hour  :: Seq TrafficStat
    , Traffic -> Seq TrafficStat
day   :: Seq TrafficStat
    , Traffic -> Seq TrafficStat
month :: Seq TrafficStat
    }
    deriving stock ( Int -> Traffic -> ShowS
[Traffic] -> ShowS
Traffic -> String
(Int -> Traffic -> ShowS)
-> (Traffic -> String) -> ([Traffic] -> ShowS) -> Show Traffic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Traffic] -> ShowS
$cshowList :: [Traffic] -> ShowS
show :: Traffic -> String
$cshow :: Traffic -> String
showsPrec :: Int -> Traffic -> ShowS
$cshowsPrec :: Int -> Traffic -> ShowS
Show, Traffic -> Traffic -> Bool
(Traffic -> Traffic -> Bool)
-> (Traffic -> Traffic -> Bool) -> Eq Traffic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Traffic -> Traffic -> Bool
$c/= :: Traffic -> Traffic -> Bool
== :: Traffic -> Traffic -> Bool
$c== :: Traffic -> Traffic -> Bool
Eq, (forall x. Traffic -> Rep Traffic x)
-> (forall x. Rep Traffic x -> Traffic) -> Generic Traffic
forall x. Rep Traffic x -> Traffic
forall x. Traffic -> Rep Traffic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Traffic x -> Traffic
$cfrom :: forall x. Traffic -> Rep Traffic x
Generic )

instance FromJSON Traffic where
    parseJSON :: Value -> Parser Traffic
parseJSON = Options -> Value -> Parser Traffic
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions

-- | The language in which the subreddit is available, as configured in the
-- 'SubredditSettings'
newtype LanguageCode = LanguageCode Text
    deriving stock ( Int -> LanguageCode -> ShowS
[LanguageCode] -> ShowS
LanguageCode -> String
(Int -> LanguageCode -> ShowS)
-> (LanguageCode -> String)
-> ([LanguageCode] -> ShowS)
-> Show LanguageCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LanguageCode] -> ShowS
$cshowList :: [LanguageCode] -> ShowS
show :: LanguageCode -> String
$cshow :: LanguageCode -> String
showsPrec :: Int -> LanguageCode -> ShowS
$cshowsPrec :: Int -> LanguageCode -> ShowS
Show, (forall x. LanguageCode -> Rep LanguageCode x)
-> (forall x. Rep LanguageCode x -> LanguageCode)
-> Generic LanguageCode
forall x. Rep LanguageCode x -> LanguageCode
forall x. LanguageCode -> Rep LanguageCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LanguageCode x -> LanguageCode
$cfrom :: forall x. LanguageCode -> Rep LanguageCode x
Generic )
    deriving newtype ( LanguageCode -> LanguageCode -> Bool
(LanguageCode -> LanguageCode -> Bool)
-> (LanguageCode -> LanguageCode -> Bool) -> Eq LanguageCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LanguageCode -> LanguageCode -> Bool
$c/= :: LanguageCode -> LanguageCode -> Bool
== :: LanguageCode -> LanguageCode -> Bool
$c== :: LanguageCode -> LanguageCode -> Bool
Eq, Value -> Parser [LanguageCode]
Value -> Parser LanguageCode
(Value -> Parser LanguageCode)
-> (Value -> Parser [LanguageCode]) -> FromJSON LanguageCode
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LanguageCode]
$cparseJSONList :: Value -> Parser [LanguageCode]
parseJSON :: Value -> Parser LanguageCode
$cparseJSON :: Value -> Parser LanguageCode
FromJSON, LanguageCode -> ByteString
LanguageCode -> Builder
LanguageCode -> Text
(LanguageCode -> Text)
-> (LanguageCode -> Builder)
-> (LanguageCode -> ByteString)
-> (LanguageCode -> Text)
-> ToHttpApiData LanguageCode
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: LanguageCode -> Text
$ctoQueryParam :: LanguageCode -> Text
toHeader :: LanguageCode -> ByteString
$ctoHeader :: LanguageCode -> ByteString
toEncodedUrlPiece :: LanguageCode -> Builder
$ctoEncodedUrlPiece :: LanguageCode -> Builder
toUrlPiece :: LanguageCode -> Text
$ctoUrlPiece :: LanguageCode -> Text
ToHttpApiData )

pattern AF :: LanguageCode
pattern $bAF :: LanguageCode
$mAF :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
AF = LanguageCode "af"

pattern AR :: LanguageCode
pattern $bAR :: LanguageCode
$mAR :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
AR = LanguageCode "ar"

pattern BE :: LanguageCode
pattern $bBE :: LanguageCode
$mBE :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
BE = LanguageCode "be"

pattern BG :: LanguageCode
pattern $bBG :: LanguageCode
$mBG :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
BG = LanguageCode "bg"

pattern BS :: LanguageCode
pattern $bBS :: LanguageCode
$mBS :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
BS = LanguageCode "bs"

pattern CA :: LanguageCode
pattern $bCA :: LanguageCode
$mCA :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
CA = LanguageCode "ca"

pattern CS :: LanguageCode
pattern $bCS :: LanguageCode
$mCS :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
CS = LanguageCode "cs"

pattern CY :: LanguageCode
pattern $bCY :: LanguageCode
$mCY :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
CY = LanguageCode "cy"

pattern DA :: LanguageCode
pattern $bDA :: LanguageCode
$mDA :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
DA = LanguageCode "da"

pattern DE :: LanguageCode
pattern $bDE :: LanguageCode
$mDE :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
DE = LanguageCode "de"

pattern EL :: LanguageCode
pattern $bEL :: LanguageCode
$mEL :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
EL = LanguageCode "el"

pattern EN :: LanguageCode
pattern $bEN :: LanguageCode
$mEN :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
EN = LanguageCode "en"

pattern EO :: LanguageCode
pattern $bEO :: LanguageCode
$mEO :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
EO = LanguageCode "eo"

pattern ES :: LanguageCode
pattern $bES :: LanguageCode
$mES :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
ES = LanguageCode "es"

pattern ET :: LanguageCode
pattern $bET :: LanguageCode
$mET :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
ET = LanguageCode "et"

pattern EU :: LanguageCode
pattern $bEU :: LanguageCode
$mEU :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
EU = LanguageCode "eu"

pattern FA :: LanguageCode
pattern $bFA :: LanguageCode
$mFA :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
FA = LanguageCode "fa"

pattern FI :: LanguageCode
pattern $bFI :: LanguageCode
$mFI :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
FI = LanguageCode "fi"

pattern FR :: LanguageCode
pattern $bFR :: LanguageCode
$mFR :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
FR = LanguageCode "fr"

pattern GD :: LanguageCode
pattern $bGD :: LanguageCode
$mGD :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
GD = LanguageCode "gd"

pattern GL :: LanguageCode
pattern $bGL :: LanguageCode
$mGL :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
GL = LanguageCode "gl"

pattern HE :: LanguageCode
pattern $bHE :: LanguageCode
$mHE :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
HE = LanguageCode "he"

pattern HI :: LanguageCode
pattern $bHI :: LanguageCode
$mHI :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
HI = LanguageCode "hi"

pattern HR :: LanguageCode
pattern $bHR :: LanguageCode
$mHR :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
HR = LanguageCode "hr"

pattern HU :: LanguageCode
pattern $bHU :: LanguageCode
$mHU :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
HU = LanguageCode "hu"

pattern HY :: LanguageCode
pattern $bHY :: LanguageCode
$mHY :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
HY = LanguageCode "hy"

pattern ID :: LanguageCode
pattern $bID :: LanguageCode
$mID :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
ID = LanguageCode "id"

pattern IS :: LanguageCode
pattern $bIS :: LanguageCode
$mIS :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
IS = LanguageCode "is"

pattern IT :: LanguageCode
pattern $bIT :: LanguageCode
$mIT :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
IT = LanguageCode "it"

pattern JA :: LanguageCode
pattern $bJA :: LanguageCode
$mJA :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
JA = LanguageCode "ja"

pattern KO :: LanguageCode
pattern $bKO :: LanguageCode
$mKO :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
KO = LanguageCode "ko"

pattern LA :: LanguageCode
pattern $bLA :: LanguageCode
$mLA :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
LA = LanguageCode "la"

pattern LT :: LanguageCode
pattern $bLT :: LanguageCode
$mLT :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
LT = LanguageCode "lt"

pattern LV :: LanguageCode
pattern $bLV :: LanguageCode
$mLV :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
LV = LanguageCode "lv"

pattern MS :: LanguageCode
pattern $bMS :: LanguageCode
$mMS :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
MS = LanguageCode "ms"

pattern NL :: LanguageCode
pattern $bNL :: LanguageCode
$mNL :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
NL = LanguageCode "nl"

pattern NN :: LanguageCode
pattern $bNN :: LanguageCode
$mNN :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
NN = LanguageCode "nn"

pattern NO :: LanguageCode
pattern $bNO :: LanguageCode
$mNO :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
NO = LanguageCode "no"

pattern PL :: LanguageCode
pattern $bPL :: LanguageCode
$mPL :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
PL = LanguageCode "pl"

pattern PT :: LanguageCode
pattern $bPT :: LanguageCode
$mPT :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
PT = LanguageCode "pt"

pattern RO :: LanguageCode
pattern $bRO :: LanguageCode
$mRO :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
RO = LanguageCode "ro"

pattern RU :: LanguageCode
pattern $bRU :: LanguageCode
$mRU :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
RU = LanguageCode "ru"

pattern SK :: LanguageCode
pattern $bSK :: LanguageCode
$mSK :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
SK = LanguageCode "sk"

pattern SL :: LanguageCode
pattern $bSL :: LanguageCode
$mSL :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
SL = LanguageCode "sl"

pattern SR :: LanguageCode
pattern $bSR :: LanguageCode
$mSR :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
SR = LanguageCode "sr"

pattern SV :: LanguageCode
pattern $bSV :: LanguageCode
$mSV :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
SV = LanguageCode "sv"

pattern TA :: LanguageCode
pattern $bTA :: LanguageCode
$mTA :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
TA = LanguageCode "ta"

pattern TH :: LanguageCode
pattern $bTH :: LanguageCode
$mTH :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
TH = LanguageCode "th"

pattern TR :: LanguageCode
pattern $bTR :: LanguageCode
$mTR :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
TR = LanguageCode "tr"

pattern UK :: LanguageCode
pattern $bUK :: LanguageCode
$mUK :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
UK = LanguageCode "uk"

pattern VI :: LanguageCode
pattern $bVI :: LanguageCode
$mVI :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
VI = LanguageCode "vi"

pattern ZH :: LanguageCode
pattern $bZH :: LanguageCode
$mZH :: forall r. LanguageCode -> (Void# -> r) -> (Void# -> r) -> r
ZH = LanguageCode "zh"