{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}

{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      : Network.Reddit.Types.Subreddit
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Subreddit
    ( SubredditName
    , mkSubredditName
    , SubredditID(SubredditID)
    , Subreddit(..)
    , RecsList
    , NameSearchResults
      -- * Rules\/requirements
    , SubredditRule(..)
    , RuleList
    , NewSubredditRule(..)
    , PostedSubredditRule
    , RuleType(..)
    , PostRequirements(..)
    , BodyRestriction(..)
    ) where

import           Control.Applicative           ( Alternative((<|>)) )
import           Control.Monad                 ( (<=<) )
import           Control.Monad.Catch           ( MonadThrow )

import           Data.Aeson
                 ( (.!=)
                 , (.:)
                 , (.:?)
                 , FromJSON(..)
                 , Options(..)
                 , ToJSON
                 , ToJSON(..)
                 , Value(Object)
                 , decodeStrict
                 , defaultOptions
                 , genericParseJSON
                 , withArray
                 , withObject
                 , withText
                 )
import           Data.Aeson.Casing             ( snakeCase )
import           Data.Coerce                   ( coerce )
import           Data.Foldable                 ( asum )
import           Data.Maybe                    ( catMaybes, fromMaybe )
import           Data.Sequence                 ( Seq )
import           Data.Text                     ( Text )
import qualified Data.Text.Encoding            as T
import           Data.Time                     ( UTCTime )

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

import           Lens.Micro

import           Network.Reddit.Types.Internal

import           Web.FormUrlEncoded            ( ToForm(toForm) )
import           Web.HttpApiData               ( ToHttpApiData(..) )

-- | Information about a subreddit. Fields prefixed with @userIs@ below apply to
-- the currently authenticated user
data Subreddit = Subreddit
    { Subreddit -> SubredditID
subredditID        :: SubredditID
    , Subreddit -> SubredditName
name               :: SubredditName
    , Subreddit -> Title
title              :: Title
    , Subreddit -> UTCTime
created            :: UTCTime
    , Subreddit -> SubredditType
subredditType      :: SubredditType
    , Subreddit -> Integer
subscribers        :: Integer
      -- | Description as shown in searches
    , Subreddit -> Title
publicDescription  :: Body
      -- | The description of the subreddit in markdown
    , Subreddit -> Maybe Title
keyColor           :: Maybe RGBText
    , Subreddit -> Title
description        :: Body
    , Subreddit -> Maybe Title
descriptionHTML    :: Maybe Body
      -- | Text shown when submitting, in markdown
    , Subreddit -> Maybe Title
submitText         :: Maybe Text
    , Subreddit -> Maybe Title
submitTextHTML     :: Maybe Text
      -- | The label shown on the submit button
    , Subreddit -> Maybe Title
submitTextLabel    :: Maybe Text
    , Subreddit -> Maybe Title
iconImg            :: Maybe URL
      -- -- | The sub banner image
    , Subreddit -> Maybe Title
bannerImg          :: Maybe URL
      -- | The dimensions (w, h) for the banner image, if it exists
    , Subreddit -> Maybe (Int, Int)
bannerSize         :: Maybe (Int, Int)
    , Subreddit -> Maybe Title
headerImg          :: Maybe URL
      -- | The dimensions (w, h) for the header image, if it exists
    , Subreddit -> Maybe (Int, Int)
headerSize         :: Maybe (Int, Int)
    , Subreddit -> Bool
over18             :: Bool
      -- | Whether the subreddit is quarantined
    , Subreddit -> Bool
quarantine         :: Bool
    , Subreddit -> Bool
userIsBanned       :: Bool
    , Subreddit -> Bool
userIsMuted        :: Bool
    , Subreddit -> Bool
userIsModerator    :: Bool
    , Subreddit -> Bool
userIsContributor  :: Bool
    , Subreddit -> Bool
userIsSubscriber   :: Bool
    , Subreddit -> Bool
allowImages        :: Bool
    , Subreddit -> Bool
allowPolls         :: Bool
    , Subreddit -> Bool
allowVideos        :: Bool
    , Subreddit -> Bool
allowVideoGIFs     :: Bool
      -- | Whether users can specify custom reasons in reports
    , Subreddit -> Bool
freeFormReports    :: Bool
      -- | Whether users are forbidden from posting submissions
    , Subreddit -> Bool
restrictPosting    :: Bool
      -- | Whether users are forbidden from posting comments
    , Subreddit -> Bool
restrictCommenting :: Bool
      -- | Whether link flair is enabled at all
    , Subreddit -> Bool
linkFlairEnabled   :: Bool
      -- | Whether users can assign their own link flair
    , Subreddit -> Maybe Bool
canAssignLinkFlair :: Maybe Bool
      -- | Whether users can assign their own user flair
    , Subreddit -> Maybe Bool
canAssignUserFlair :: Maybe Bool
      -- | Whether the sub supports marking posts with the
      -- spoiler tag
    , Subreddit -> Maybe Bool
spoilersEnabled    :: Maybe Bool
    }
    deriving stock ( Int -> Subreddit -> ShowS
[Subreddit] -> ShowS
Subreddit -> String
(Int -> Subreddit -> ShowS)
-> (Subreddit -> String)
-> ([Subreddit] -> ShowS)
-> Show Subreddit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subreddit] -> ShowS
$cshowList :: [Subreddit] -> ShowS
show :: Subreddit -> String
$cshow :: Subreddit -> String
showsPrec :: Int -> Subreddit -> ShowS
$cshowsPrec :: Int -> Subreddit -> ShowS
Show, Subreddit -> Subreddit -> Bool
(Subreddit -> Subreddit -> Bool)
-> (Subreddit -> Subreddit -> Bool) -> Eq Subreddit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subreddit -> Subreddit -> Bool
$c/= :: Subreddit -> Subreddit -> Bool
== :: Subreddit -> Subreddit -> Bool
$c== :: Subreddit -> Subreddit -> Bool
Eq, (forall x. Subreddit -> Rep Subreddit x)
-> (forall x. Rep Subreddit x -> Subreddit) -> Generic Subreddit
forall x. Rep Subreddit x -> Subreddit
forall x. Subreddit -> Rep Subreddit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Subreddit x -> Subreddit
$cfrom :: forall x. Subreddit -> Rep Subreddit x
Generic )

instance FromJSON Subreddit where
    parseJSON :: Value -> Parser Subreddit
parseJSON Value
v = [Parser Subreddit] -> Parser Subreddit
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ RedditKind
-> String
-> (Object -> Parser Subreddit)
-> Value
-> Parser Subreddit
forall b a.
FromJSON b =>
RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind RedditKind
SubredditKind String
"Subreddit" Object -> Parser Subreddit
subredditP Value
v
                       , String -> (Object -> Parser Subreddit) -> Value -> Parser Subreddit
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Subreddit" Object -> Parser Subreddit
subredditP Value
v
                       ]
      where
        subredditP :: Object -> Parser Subreddit
subredditP Object
o = do
            SubredditID
subredditID <- Object
o Object -> Title -> Parser SubredditID
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"id" Parser SubredditID -> Parser SubredditID -> Parser SubredditID
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Title -> Parser SubredditID
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"name"
            SubredditName
name <- Object
o Object -> Title -> Parser SubredditName
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"display_name"
            Title
title <- Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"title"
            -- This field is only missing when getting a user's subreddit.
            -- We can use the user's creation date in that case, after
            -- setting an (arbitrary) default here
            UTCTime
created <- Integer -> UTCTime
integerToUTC (Integer -> UTCTime) -> Parser Integer -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Title -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"created_utc" Parser (Maybe Integer) -> Integer -> Parser Integer
forall a. Parser (Maybe a) -> a -> Parser a
.!= Integer
0
            SubredditType
subredditType <- Object
o Object -> Title -> Parser SubredditType
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"subreddit_type"
            Maybe Title
keyColor <- Title -> Parser (Maybe Title)
forall a. FromJSON a => Title -> Parser (Maybe a)
nothingTxtNull (Title -> Parser (Maybe Title))
-> Parser Title -> Parser (Maybe Title)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"key_color"
            Title
description <- Object
o Object -> Title -> Parser (Maybe Title)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"description" Parser (Maybe Title) -> Title -> Parser Title
forall a. Parser (Maybe a) -> a -> Parser a
.!= Title
forall a. Monoid a => a
mempty
            Maybe Title
descriptionHTML <- Object
o Object -> Title -> Parser (Maybe Title)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"description_html"
            Title
publicDescription <- Object
o Object -> Title -> Parser (Maybe Title)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"public_description" Parser (Maybe Title) -> Title -> Parser Title
forall a. Parser (Maybe a) -> a -> Parser a
.!= Title
forall a. Monoid a => a
mempty
            Maybe Title
submitTextLabel <- Object
o Object -> Title -> Parser (Maybe Title)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"submit_text_label"
            Maybe Title
submitText <- Object
o Object -> Title -> Parser (Maybe Title)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"submit_text"
            Maybe Title
submitTextHTML <- Object
o Object -> Title -> Parser (Maybe Title)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"submit_text_html"
            Integer
subscribers <- Object
o Object -> Title -> Parser Integer
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"subscribers"
            Maybe Title
iconImg <- Parser (Maybe Title)
-> (Title -> Parser (Maybe Title))
-> Maybe Title
-> Parser (Maybe Title)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Title -> Parser (Maybe Title)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Title
forall a. Maybe a
Nothing) Title -> Parser (Maybe Title)
forall a. FromJSON a => Title -> Parser (Maybe a)
nothingTxtNull
                (Maybe Title -> Parser (Maybe Title))
-> Parser (Maybe Title) -> Parser (Maybe Title)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Title -> Parser (Maybe Title)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"icon_img"
            Maybe Title
bannerImg <- Parser (Maybe Title)
-> (Title -> Parser (Maybe Title))
-> Maybe Title
-> Parser (Maybe Title)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Title -> Parser (Maybe Title)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Title
forall a. Maybe a
Nothing) Title -> Parser (Maybe Title)
forall a. FromJSON a => Title -> Parser (Maybe a)
nothingTxtNull
                (Maybe Title -> Parser (Maybe Title))
-> Parser (Maybe Title) -> Parser (Maybe Title)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Title -> Parser (Maybe Title)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"banner_img"
            Maybe (Int, Int)
bannerSize <- Object
o Object -> Title -> Parser (Maybe (Int, Int))
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"banner_size"
            Maybe Title
headerImg <- Object
o Object -> Title -> Parser (Maybe Title)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"header_img"
            Maybe (Int, Int)
headerSize <- Object
o Object -> Title -> Parser (Maybe (Int, Int))
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"header_size"
            Bool
over18 <- Object
o Object -> Title -> Parser Bool
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"over_18" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Title -> Parser Bool
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"over18"
            Bool
quarantine <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"quarantine" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Bool
userIsBanned <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"user_is_banned" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Bool
userIsMuted <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"user_is_muted"Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Bool
userIsModerator <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"user_is_moderator"Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Bool
userIsContributor <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"user_is_contributor"Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Bool
userIsSubscriber <- Object
o Object -> Title -> Parser Bool
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"user_is_subscriber"
            Bool
allowImages <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"allow_images" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
True
            Bool
allowVideos <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"allow_videos" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
True
            Bool
allowPolls <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"allow_polls" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
True
            Bool
allowVideoGIFs <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"allow_videogifs" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
True
            Bool
freeFormReports <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"free_form_reports" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
True
            Bool
restrictPosting <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"restrict_posting"Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Bool
restrictCommenting <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"restrict_commenting"Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Bool
linkFlairEnabled <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"link_flair_enabled"Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Maybe Bool
canAssignLinkFlair <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"can_assign_link_flair"
            Maybe Bool
canAssignUserFlair <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"can_assign_user_flair"
            Maybe Bool
spoilersEnabled <- Object
o Object -> Title -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"spoilers_enabled"
            Subreddit -> Parser Subreddit
forall (f :: * -> *) a. Applicative f => a -> f a
pure Subreddit :: SubredditID
-> SubredditName
-> Title
-> UTCTime
-> SubredditType
-> Integer
-> Title
-> Maybe Title
-> Title
-> Maybe Title
-> Maybe Title
-> Maybe Title
-> Maybe Title
-> Maybe Title
-> Maybe Title
-> Maybe (Int, Int)
-> Maybe Title
-> Maybe (Int, Int)
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Subreddit
Subreddit { Bool
Integer
Maybe Bool
Maybe (Int, Int)
Maybe Title
Title
UTCTime
SubredditType
SubredditID
SubredditName
spoilersEnabled :: Maybe Bool
canAssignUserFlair :: Maybe Bool
canAssignLinkFlair :: Maybe Bool
linkFlairEnabled :: Bool
restrictCommenting :: Bool
restrictPosting :: Bool
freeFormReports :: Bool
allowVideoGIFs :: Bool
allowPolls :: Bool
allowVideos :: Bool
allowImages :: Bool
userIsSubscriber :: Bool
userIsContributor :: Bool
userIsModerator :: Bool
userIsMuted :: Bool
userIsBanned :: Bool
quarantine :: Bool
over18 :: Bool
headerSize :: Maybe (Int, Int)
headerImg :: Maybe Title
bannerSize :: Maybe (Int, Int)
bannerImg :: Maybe Title
iconImg :: Maybe Title
subscribers :: Integer
submitTextHTML :: Maybe Title
submitText :: Maybe Title
submitTextLabel :: Maybe Title
publicDescription :: Title
descriptionHTML :: Maybe Title
description :: Title
keyColor :: Maybe Title
subredditType :: SubredditType
created :: UTCTime
title :: Title
name :: SubredditName
subredditID :: SubredditID
$sel:spoilersEnabled:Subreddit :: Maybe Bool
$sel:canAssignUserFlair:Subreddit :: Maybe Bool
$sel:canAssignLinkFlair:Subreddit :: Maybe Bool
$sel:linkFlairEnabled:Subreddit :: Bool
$sel:restrictCommenting:Subreddit :: Bool
$sel:restrictPosting:Subreddit :: Bool
$sel:freeFormReports:Subreddit :: Bool
$sel:allowVideoGIFs:Subreddit :: Bool
$sel:allowVideos:Subreddit :: Bool
$sel:allowPolls:Subreddit :: Bool
$sel:allowImages:Subreddit :: Bool
$sel:userIsSubscriber:Subreddit :: Bool
$sel:userIsContributor:Subreddit :: Bool
$sel:userIsModerator:Subreddit :: Bool
$sel:userIsMuted:Subreddit :: Bool
$sel:userIsBanned:Subreddit :: Bool
$sel:quarantine:Subreddit :: Bool
$sel:over18:Subreddit :: Bool
$sel:headerSize:Subreddit :: Maybe (Int, Int)
$sel:headerImg:Subreddit :: Maybe Title
$sel:bannerSize:Subreddit :: Maybe (Int, Int)
$sel:bannerImg:Subreddit :: Maybe Title
$sel:iconImg:Subreddit :: Maybe Title
$sel:submitTextLabel:Subreddit :: Maybe Title
$sel:submitTextHTML:Subreddit :: Maybe Title
$sel:submitText:Subreddit :: Maybe Title
$sel:descriptionHTML:Subreddit :: Maybe Title
$sel:description:Subreddit :: Title
$sel:keyColor:Subreddit :: Maybe Title
$sel:publicDescription:Subreddit :: Title
$sel:subscribers:Subreddit :: Integer
$sel:subredditType:Subreddit :: SubredditType
$sel:created:Subreddit :: UTCTime
$sel:title:Subreddit :: Title
$sel:name:Subreddit :: SubredditName
$sel:subredditID:Subreddit :: SubredditID
.. }

-- Dummy instance so that @Listing ... Subreddit@ can work with convenience
-- actions
instance Paginable Subreddit where
    type PaginateOptions Subreddit = ()

    type PaginateThing Subreddit = SubredditID

    defaultOpts :: PaginateOptions Subreddit
defaultOpts = ()

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

    getFullname :: Subreddit -> PaginateThing Subreddit
getFullname Subreddit { SubredditID
subredditID :: SubredditID
$sel:subredditID:Subreddit :: Subreddit -> SubredditID
subredditID } = PaginateThing Subreddit
SubredditID
subredditID

-- | The name of a subreddit
newtype SubredditName = SubredditName Text
    deriving stock ( Int -> SubredditName -> ShowS
[SubredditName] -> ShowS
SubredditName -> String
(Int -> SubredditName -> ShowS)
-> (SubredditName -> String)
-> ([SubredditName] -> ShowS)
-> Show SubredditName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubredditName] -> ShowS
$cshowList :: [SubredditName] -> ShowS
show :: SubredditName -> String
$cshow :: SubredditName -> String
showsPrec :: Int -> SubredditName -> ShowS
$cshowsPrec :: Int -> SubredditName -> ShowS
Show, (forall x. SubredditName -> Rep SubredditName x)
-> (forall x. Rep SubredditName x -> SubredditName)
-> Generic SubredditName
forall x. Rep SubredditName x -> SubredditName
forall x. SubredditName -> Rep SubredditName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubredditName x -> SubredditName
$cfrom :: forall x. SubredditName -> Rep SubredditName x
Generic )
    deriving newtype ( Value -> Parser [SubredditName]
Value -> Parser SubredditName
(Value -> Parser SubredditName)
-> (Value -> Parser [SubredditName]) -> FromJSON SubredditName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SubredditName]
$cparseJSONList :: Value -> Parser [SubredditName]
parseJSON :: Value -> Parser SubredditName
$cparseJSON :: Value -> Parser SubredditName
FromJSON, [SubredditName] -> Encoding
[SubredditName] -> Value
SubredditName -> Encoding
SubredditName -> Value
(SubredditName -> Value)
-> (SubredditName -> Encoding)
-> ([SubredditName] -> Value)
-> ([SubredditName] -> Encoding)
-> ToJSON SubredditName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SubredditName] -> Encoding
$ctoEncodingList :: [SubredditName] -> Encoding
toJSONList :: [SubredditName] -> Value
$ctoJSONList :: [SubredditName] -> Value
toEncoding :: SubredditName -> Encoding
$ctoEncoding :: SubredditName -> Encoding
toJSON :: SubredditName -> Value
$ctoJSON :: SubredditName -> Value
ToJSON, SubredditName -> ByteString
SubredditName -> Builder
SubredditName -> Title
(SubredditName -> Title)
-> (SubredditName -> Builder)
-> (SubredditName -> ByteString)
-> (SubredditName -> Title)
-> ToHttpApiData SubredditName
forall a.
(a -> Title)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Title)
-> ToHttpApiData a
toQueryParam :: SubredditName -> Title
$ctoQueryParam :: SubredditName -> Title
toHeader :: SubredditName -> ByteString
$ctoHeader :: SubredditName -> ByteString
toEncodedUrlPiece :: SubredditName -> Builder
$ctoEncodedUrlPiece :: SubredditName -> Builder
toUrlPiece :: SubredditName -> Title
$ctoUrlPiece :: SubredditName -> Title
ToHttpApiData )
    deriving ( SubredditName -> SubredditName -> Bool
(SubredditName -> SubredditName -> Bool)
-> (SubredditName -> SubredditName -> Bool) -> Eq SubredditName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubredditName -> SubredditName -> Bool
$c/= :: SubredditName -> SubredditName -> Bool
== :: SubredditName -> SubredditName -> Bool
$c== :: SubredditName -> SubredditName -> Bool
Eq ) via CIText SubredditName

-- | Smart constructor for 'SubredditName', which must be between 3 and 20 chars,
-- and may only include upper/lowercase alphanumeric chars, underscores, and
-- hyphens
mkSubredditName :: MonadThrow m => Text -> m SubredditName
mkSubredditName :: Title -> m SubredditName
mkSubredditName = Maybe String
-> Maybe (Int, Int) -> Title -> Title -> m SubredditName
forall (m :: * -> *) a.
(MonadThrow m, Coercible a Title) =>
Maybe String -> Maybe (Int, Int) -> Title -> Title -> m a
validateName Maybe String
forall a. Maybe a
Nothing Maybe (Int, Int)
forall a. Maybe a
Nothing Title
"SubredditName"

-- | Unique site-wide identifier for a subreddit
newtype SubredditID = SubredditID Text
    deriving stock ( Int -> SubredditID -> ShowS
[SubredditID] -> ShowS
SubredditID -> String
(Int -> SubredditID -> ShowS)
-> (SubredditID -> String)
-> ([SubredditID] -> ShowS)
-> Show SubredditID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubredditID] -> ShowS
$cshowList :: [SubredditID] -> ShowS
show :: SubredditID -> String
$cshow :: SubredditID -> String
showsPrec :: Int -> SubredditID -> ShowS
$cshowsPrec :: Int -> SubredditID -> ShowS
Show, (forall x. SubredditID -> Rep SubredditID x)
-> (forall x. Rep SubredditID x -> SubredditID)
-> Generic SubredditID
forall x. Rep SubredditID x -> SubredditID
forall x. SubredditID -> Rep SubredditID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubredditID x -> SubredditID
$cfrom :: forall x. SubredditID -> Rep SubredditID x
Generic )
    deriving newtype ( SubredditID -> SubredditID -> Bool
(SubredditID -> SubredditID -> Bool)
-> (SubredditID -> SubredditID -> Bool) -> Eq SubredditID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubredditID -> SubredditID -> Bool
$c/= :: SubredditID -> SubredditID -> Bool
== :: SubredditID -> SubredditID -> Bool
$c== :: SubredditID -> SubredditID -> Bool
Eq )

instance FromJSON SubredditID where
    parseJSON :: Value -> Parser SubredditID
parseJSON = String
-> (Title -> Parser SubredditID) -> Value -> Parser SubredditID
forall a. String -> (Title -> Parser a) -> Value -> Parser a
withText String
"SubredditID" ((Title -> Parser SubredditID) -> Value -> Parser SubredditID)
-> (Title -> Parser SubredditID) -> Value -> Parser SubredditID
forall a b. (a -> b) -> a -> b
$ Parser Title -> Parser SubredditID
coerce (Parser Title -> Parser SubredditID)
-> (Title -> Parser Title) -> Title -> Parser SubredditID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedditKind -> Title -> Parser Title
dropTypePrefix RedditKind
SubredditKind

instance Thing SubredditID where
    fullname :: SubredditID -> Title
fullname (SubredditID Title
sid) = RedditKind -> Title -> Title
prependType RedditKind
SubredditKind Title
sid

-- | Wrapper for parsing an array of recommended @SubredditName@s, which are
-- given as single-field JSON objects
newtype RecsList = RecsList (Seq SubredditName)
    deriving stock ( Int -> RecsList -> ShowS
[RecsList] -> ShowS
RecsList -> String
(Int -> RecsList -> ShowS)
-> (RecsList -> String) -> ([RecsList] -> ShowS) -> Show RecsList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecsList] -> ShowS
$cshowList :: [RecsList] -> ShowS
show :: RecsList -> String
$cshow :: RecsList -> String
showsPrec :: Int -> RecsList -> ShowS
$cshowsPrec :: Int -> RecsList -> ShowS
Show, (forall x. RecsList -> Rep RecsList x)
-> (forall x. Rep RecsList x -> RecsList) -> Generic RecsList
forall x. Rep RecsList x -> RecsList
forall x. RecsList -> Rep RecsList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RecsList x -> RecsList
$cfrom :: forall x. RecsList -> Rep RecsList x
Generic )

instance FromJSON RecsList where
    parseJSON :: Value -> Parser RecsList
parseJSON = String -> (Array -> Parser RecsList) -> Value -> Parser RecsList
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"RecsList"
        ((Array -> Parser RecsList) -> Value -> Parser RecsList)
-> (Array -> Parser RecsList) -> Value -> Parser RecsList
forall a b. (a -> b) -> a -> b
$ ([SubredditName] -> RecsList)
-> Parser [SubredditName] -> Parser RecsList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq SubredditName -> RecsList
RecsList (Seq SubredditName -> RecsList)
-> ([SubredditName] -> Seq SubredditName)
-> [SubredditName]
-> RecsList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SubredditName] -> Seq SubredditName
forall l. IsList l => [Item l] -> l
fromList) (Parser [SubredditName] -> Parser RecsList)
-> (Array -> Parser [SubredditName]) -> Array -> Parser RecsList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser SubredditName)
-> [Value] -> Parser [SubredditName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser SubredditName
snameP ([Value] -> Parser [SubredditName])
-> (Array -> [Value]) -> Array -> Parser [SubredditName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall l. IsList l => l -> [Item l]
toList
      where
        snameP :: Value -> Parser SubredditName
snameP = String
-> (Object -> Parser SubredditName)
-> Value
-> Parser SubredditName
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Object" (Object -> Title -> Parser SubredditName
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"sr_name")

-- | Wrapper for parsing an object of @SubredditName@ results when searching
-- subreddits by name
newtype NameSearchResults = NameSearchResults (Seq SubredditName)
    deriving stock ( Int -> NameSearchResults -> ShowS
[NameSearchResults] -> ShowS
NameSearchResults -> String
(Int -> NameSearchResults -> ShowS)
-> (NameSearchResults -> String)
-> ([NameSearchResults] -> ShowS)
-> Show NameSearchResults
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameSearchResults] -> ShowS
$cshowList :: [NameSearchResults] -> ShowS
show :: NameSearchResults -> String
$cshow :: NameSearchResults -> String
showsPrec :: Int -> NameSearchResults -> ShowS
$cshowsPrec :: Int -> NameSearchResults -> ShowS
Show, (forall x. NameSearchResults -> Rep NameSearchResults x)
-> (forall x. Rep NameSearchResults x -> NameSearchResults)
-> Generic NameSearchResults
forall x. Rep NameSearchResults x -> NameSearchResults
forall x. NameSearchResults -> Rep NameSearchResults x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NameSearchResults x -> NameSearchResults
$cfrom :: forall x. NameSearchResults -> Rep NameSearchResults x
Generic )

instance FromJSON NameSearchResults where
    parseJSON :: Value -> Parser NameSearchResults
parseJSON = String
-> (Object -> Parser NameSearchResults)
-> Value
-> Parser NameSearchResults
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NameSearchResults"
        ((Object -> Parser NameSearchResults)
 -> Value -> Parser NameSearchResults)
-> (Object -> Parser NameSearchResults)
-> Value
-> Parser NameSearchResults
forall a b. (a -> b) -> a -> b
$ (Seq SubredditName -> NameSearchResults)
-> Parser (Seq SubredditName) -> Parser NameSearchResults
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq SubredditName -> NameSearchResults
NameSearchResults (Parser (Seq SubredditName) -> Parser NameSearchResults)
-> (Object -> Parser (Seq SubredditName))
-> Object
-> Parser NameSearchResults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Title -> Parser (Seq SubredditName)
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"names")

-- | A 'Subreddit' rule. If you are a moderator, you can update the @shortName@,
-- @description@, @violationReason@, and @ruleType@ fields. See
-- 'Network.Reddit.Actions.Moderation.reorderSubredditRules'. New rules may also
-- be created with 'NewSubredditRule's
data SubredditRule = SubredditRule
    { SubredditRule -> Title
description     :: Body
    , SubredditRule -> Title
descriptionHTML :: Body
    , SubredditRule -> Title
shortName       :: Name
    , SubredditRule -> UTCTime
created         :: UTCTime
    , SubredditRule -> Word
priority        :: Word
    , SubredditRule -> Maybe Title
violationReason :: Maybe Text
    , SubredditRule -> Maybe RuleType
ruleType        :: Maybe RuleType
    }
    deriving stock ( Int -> SubredditRule -> ShowS
[SubredditRule] -> ShowS
SubredditRule -> String
(Int -> SubredditRule -> ShowS)
-> (SubredditRule -> String)
-> ([SubredditRule] -> ShowS)
-> Show SubredditRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubredditRule] -> ShowS
$cshowList :: [SubredditRule] -> ShowS
show :: SubredditRule -> String
$cshow :: SubredditRule -> String
showsPrec :: Int -> SubredditRule -> ShowS
$cshowsPrec :: Int -> SubredditRule -> ShowS
Show, SubredditRule -> SubredditRule -> Bool
(SubredditRule -> SubredditRule -> Bool)
-> (SubredditRule -> SubredditRule -> Bool) -> Eq SubredditRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubredditRule -> SubredditRule -> Bool
$c/= :: SubredditRule -> SubredditRule -> Bool
== :: SubredditRule -> SubredditRule -> Bool
$c== :: SubredditRule -> SubredditRule -> Bool
Eq, (forall x. SubredditRule -> Rep SubredditRule x)
-> (forall x. Rep SubredditRule x -> SubredditRule)
-> Generic SubredditRule
forall x. Rep SubredditRule x -> SubredditRule
forall x. SubredditRule -> Rep SubredditRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubredditRule x -> SubredditRule
$cfrom :: forall x. SubredditRule -> Rep SubredditRule x
Generic )

-- | Depending on the endpoint, the JSON fields are either camel- or
-- snake-cased
instance FromJSON SubredditRule where
    parseJSON :: Value -> Parser SubredditRule
parseJSON = String
-> (Object -> Parser SubredditRule)
-> Value
-> Parser SubredditRule
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SubredditRule" ((Object -> Parser SubredditRule) -> Value -> Parser SubredditRule)
-> (Object -> Parser SubredditRule)
-> Value
-> Parser SubredditRule
forall a b. (a -> b) -> a -> b
$ \Object
o -> Title
-> Title
-> Title
-> UTCTime
-> Word
-> Maybe Title
-> Maybe RuleType
-> SubredditRule
SubredditRule
        (Title
 -> Title
 -> Title
 -> UTCTime
 -> Word
 -> Maybe Title
 -> Maybe RuleType
 -> SubredditRule)
-> Parser Title
-> Parser
     (Title
      -> Title
      -> UTCTime
      -> Word
      -> Maybe Title
      -> Maybe RuleType
      -> SubredditRule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"description"
        Parser
  (Title
   -> Title
   -> UTCTime
   -> Word
   -> Maybe Title
   -> Maybe RuleType
   -> SubredditRule)
-> Parser Title
-> Parser
     (Title
      -> UTCTime
      -> Word
      -> Maybe Title
      -> Maybe RuleType
      -> SubredditRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"description_html" Parser Title -> Parser Title -> Parser Title
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"descriptionHtml")
        Parser
  (Title
   -> UTCTime
   -> Word
   -> Maybe Title
   -> Maybe RuleType
   -> SubredditRule)
-> Parser Title
-> Parser
     (UTCTime -> Word -> Maybe Title -> Maybe RuleType -> SubredditRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"short_name" Parser Title -> Parser Title -> Parser Title
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"shortName")
        Parser
  (UTCTime -> Word -> Maybe Title -> Maybe RuleType -> SubredditRule)
-> Parser UTCTime
-> Parser (Word -> Maybe Title -> Maybe RuleType -> SubredditRule)
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 -> Title -> Parser Integer
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"created_utc" Parser Integer -> Parser Integer -> Parser Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Title -> Parser Integer
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"createdUtc"))
        Parser (Word -> Maybe Title -> Maybe RuleType -> SubredditRule)
-> Parser Word
-> Parser (Maybe Title -> Maybe RuleType -> SubredditRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Title -> Parser Word
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"priority"
        Parser (Maybe Title -> Maybe RuleType -> SubredditRule)
-> Parser (Maybe Title) -> Parser (Maybe RuleType -> SubredditRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Title -> Parser (Maybe Title)
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"violation_reason" Parser (Maybe Title)
-> Parser (Maybe Title) -> Parser (Maybe Title)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Title -> Parser (Maybe Title)
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"violationReason")
        Parser (Maybe RuleType -> SubredditRule)
-> Parser (Maybe RuleType) -> Parser SubredditRule
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Title -> Parser (Maybe RuleType)
forall a. FromJSON a => Object -> Title -> Parser (Maybe a)
.:? Title
"kind"

instance ToForm SubredditRule where
    toForm :: SubredditRule -> Form
toForm SubredditRule { Maybe Title
Maybe RuleType
Word
Title
UTCTime
ruleType :: Maybe RuleType
violationReason :: Maybe Title
priority :: Word
created :: UTCTime
shortName :: Title
descriptionHTML :: Title
description :: Title
$sel:ruleType:SubredditRule :: SubredditRule -> Maybe RuleType
$sel:violationReason:SubredditRule :: SubredditRule -> Maybe Title
$sel:priority:SubredditRule :: SubredditRule -> Word
$sel:created:SubredditRule :: SubredditRule -> UTCTime
$sel:shortName:SubredditRule :: SubredditRule -> Title
$sel:descriptionHTML:SubredditRule :: SubredditRule -> Title
$sel:description:SubredditRule :: SubredditRule -> Title
.. } = [Item Form] -> Form
forall l. IsList l => [Item l] -> l
fromList
        ([Item Form] -> Form) -> [Item Form] -> Form
forall a b. (a -> b) -> a -> b
$ [ (Title
"description", Title
description), (Title
"short_name", Title
shortName) ]
        [(Title, Title)] -> [(Title, Title)] -> [(Title, Title)]
forall a. Semigroup a => a -> a -> a
<> [Maybe (Title, Title)] -> [(Title, Title)]
forall a. [Maybe a] -> [a]
catMaybes [ (Title
"violation_reason", ) (Title -> (Title, Title)) -> Maybe Title -> Maybe (Title, Title)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Title
violationReason
                     , (Title
"kind", ) (Title -> (Title, Title))
-> (RuleType -> Title) -> RuleType -> (Title, Title)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleType -> Title
forall a. ToHttpApiData a => a -> Title
toQueryParam (RuleType -> (Title, Title))
-> Maybe RuleType -> Maybe (Title, Title)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RuleType
ruleType
                     ]

-- | Wrapper to parse JSON from endpoints that list 'SubredditRule's
newtype RuleList = RuleList (Seq SubredditRule)
    deriving stock ( Int -> RuleList -> ShowS
[RuleList] -> ShowS
RuleList -> String
(Int -> RuleList -> ShowS)
-> (RuleList -> String) -> ([RuleList] -> ShowS) -> Show RuleList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuleList] -> ShowS
$cshowList :: [RuleList] -> ShowS
show :: RuleList -> String
$cshow :: RuleList -> String
showsPrec :: Int -> RuleList -> ShowS
$cshowsPrec :: Int -> RuleList -> ShowS
Show, (forall x. RuleList -> Rep RuleList x)
-> (forall x. Rep RuleList x -> RuleList) -> Generic RuleList
forall x. Rep RuleList x -> RuleList
forall x. RuleList -> Rep RuleList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RuleList x -> RuleList
$cfrom :: forall x. RuleList -> Rep RuleList x
Generic )

instance FromJSON RuleList where
    parseJSON :: Value -> Parser RuleList
parseJSON = String -> (Object -> Parser RuleList) -> Value -> Parser RuleList
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RuleList"
        ((Object -> Parser RuleList) -> Value -> Parser RuleList)
-> (Object -> Parser RuleList) -> Value -> Parser RuleList
forall a b. (a -> b) -> a -> b
$ ([SubredditRule] -> RuleList)
-> Parser [SubredditRule] -> Parser RuleList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq SubredditRule -> RuleList
RuleList (Seq SubredditRule -> RuleList)
-> ([SubredditRule] -> Seq SubredditRule)
-> [SubredditRule]
-> RuleList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SubredditRule] -> Seq SubredditRule
forall l. IsList l => [Item l] -> l
fromList) (Parser [SubredditRule] -> Parser RuleList)
-> (Object -> Parser [SubredditRule]) -> Object -> Parser RuleList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser [SubredditRule]
parseRules (Value -> Parser [SubredditRule])
-> (Object -> Parser Value) -> Object -> Parser [SubredditRule]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Object -> Title -> Parser Value
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"rules"))
      where
        parseRules :: Value -> Parser [SubredditRule]
parseRules = String
-> (Array -> Parser [SubredditRule])
-> Value
-> Parser [SubredditRule]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"[SubredditRule]" ((Value -> Parser SubredditRule)
-> [Value] -> Parser [SubredditRule]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser SubredditRule
forall a. FromJSON a => Value -> Parser a
parseJSON ([Value] -> Parser [SubredditRule])
-> (Array -> [Value]) -> Array -> Parser [SubredditRule]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall l. IsList l => l -> [Item l]
toList)

-- | Represents a new 'SubredditRule' that can be created by moderators
data NewSubredditRule = NewSubredditRule
    { NewSubredditRule -> Title
shortName       :: Name
    , NewSubredditRule -> RuleType
ruleType        :: RuleType
    , NewSubredditRule -> Title
description     :: Body
      -- | If @Nothing@, will be set to the same text as
      -- the @shortName@ provided
    , NewSubredditRule -> Maybe Title
violationReason :: Maybe Text
    }
    deriving stock ( Int -> NewSubredditRule -> ShowS
[NewSubredditRule] -> ShowS
NewSubredditRule -> String
(Int -> NewSubredditRule -> ShowS)
-> (NewSubredditRule -> String)
-> ([NewSubredditRule] -> ShowS)
-> Show NewSubredditRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewSubredditRule] -> ShowS
$cshowList :: [NewSubredditRule] -> ShowS
show :: NewSubredditRule -> String
$cshow :: NewSubredditRule -> String
showsPrec :: Int -> NewSubredditRule -> ShowS
$cshowsPrec :: Int -> NewSubredditRule -> ShowS
Show, NewSubredditRule -> NewSubredditRule -> Bool
(NewSubredditRule -> NewSubredditRule -> Bool)
-> (NewSubredditRule -> NewSubredditRule -> Bool)
-> Eq NewSubredditRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewSubredditRule -> NewSubredditRule -> Bool
$c/= :: NewSubredditRule -> NewSubredditRule -> Bool
== :: NewSubredditRule -> NewSubredditRule -> Bool
$c== :: NewSubredditRule -> NewSubredditRule -> Bool
Eq, (forall x. NewSubredditRule -> Rep NewSubredditRule x)
-> (forall x. Rep NewSubredditRule x -> NewSubredditRule)
-> Generic NewSubredditRule
forall x. Rep NewSubredditRule x -> NewSubredditRule
forall x. NewSubredditRule -> Rep NewSubredditRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NewSubredditRule x -> NewSubredditRule
$cfrom :: forall x. NewSubredditRule -> Rep NewSubredditRule x
Generic )

instance ToForm NewSubredditRule where
    toForm :: NewSubredditRule -> Form
toForm NewSubredditRule { Maybe Title
Title
RuleType
violationReason :: Maybe Title
description :: Title
ruleType :: RuleType
shortName :: Title
$sel:violationReason:NewSubredditRule :: NewSubredditRule -> Maybe Title
$sel:description:NewSubredditRule :: NewSubredditRule -> Title
$sel:ruleType:NewSubredditRule :: NewSubredditRule -> RuleType
$sel:shortName:NewSubredditRule :: NewSubredditRule -> Title
.. } =
        [Item Form] -> Form
forall l. IsList l => [Item l] -> l
fromList [ (Title
"description", Title
description)
                 , (Title
"short_name", Title
shortName)
                 , (Title
"kind", RuleType -> Title
forall a. ToHttpApiData a => a -> Title
toQueryParam RuleType
ruleType)
                 , (Title
"violation_reason", Title -> Maybe Title -> Title
forall a. a -> Maybe a -> a
fromMaybe Title
shortName Maybe Title
violationReason)
                 ]

-- | Wrapper for parsing newly created 'SubredditRule's, after POSTing a
-- 'NewSubredditRule'. Rather unbelievably, Reddit transmits these new
-- rules as a JSON object ... in a single element array ... /encoded as a string/
-- ... inside another object!
newtype PostedSubredditRule = PostedSubredditRule SubredditRule
    deriving stock ( Int -> PostedSubredditRule -> ShowS
[PostedSubredditRule] -> ShowS
PostedSubredditRule -> String
(Int -> PostedSubredditRule -> ShowS)
-> (PostedSubredditRule -> String)
-> ([PostedSubredditRule] -> ShowS)
-> Show PostedSubredditRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostedSubredditRule] -> ShowS
$cshowList :: [PostedSubredditRule] -> ShowS
show :: PostedSubredditRule -> String
$cshow :: PostedSubredditRule -> String
showsPrec :: Int -> PostedSubredditRule -> ShowS
$cshowsPrec :: Int -> PostedSubredditRule -> ShowS
Show, (forall x. PostedSubredditRule -> Rep PostedSubredditRule x)
-> (forall x. Rep PostedSubredditRule x -> PostedSubredditRule)
-> Generic PostedSubredditRule
forall x. Rep PostedSubredditRule x -> PostedSubredditRule
forall x. PostedSubredditRule -> Rep PostedSubredditRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PostedSubredditRule x -> PostedSubredditRule
$cfrom :: forall x. PostedSubredditRule -> Rep PostedSubredditRule x
Generic )

instance FromJSON PostedSubredditRule where
    parseJSON :: Value -> Parser PostedSubredditRule
parseJSON = String
-> (Object -> Parser PostedSubredditRule)
-> Value
-> Parser PostedSubredditRule
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PostedSubredditRule" ((Object -> Parser PostedSubredditRule)
 -> Value -> Parser PostedSubredditRule)
-> (Object -> Parser PostedSubredditRule)
-> Value
-> Parser PostedSubredditRule
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        (Object
o Object -> Title -> Parser Object
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"json" Parser Object -> (Object -> Parser Object) -> Parser Object
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Title -> Parser Object
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"data") Parser Object -> (Object -> Parser Title) -> Parser Title
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Title -> Parser Title
forall a. FromJSON a => Object -> Title -> Parser a
.: Title
"rules"))
        Parser Title -> (Title -> Maybe [Value]) -> Parser (Maybe [Value])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ByteString -> Maybe [Value]
forall a. FromJSON a => ByteString -> Maybe a
decodeStrict (ByteString -> Maybe [Value])
-> (Title -> ByteString) -> Title -> Maybe [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Title -> ByteString
T.encodeUtf8
        Parser (Maybe [Value])
-> (Maybe [Value] -> Parser PostedSubredditRule)
-> Parser PostedSubredditRule
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just [ r :: Value
r@(Object Object
_) ] -> SubredditRule -> PostedSubredditRule
PostedSubredditRule (SubredditRule -> PostedSubredditRule)
-> Parser SubredditRule -> Parser PostedSubredditRule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser SubredditRule
forall a. FromJSON a => Value -> Parser a
parseJSON Value
r
            Maybe [Value]
_ -> Parser PostedSubredditRule
forall a. Monoid a => a
mempty

-- | The type of item that a 'SubredditRule' applies to
data RuleType
    = CommentRule
    | LinkRule
    | AllRule
    deriving stock ( Int -> RuleType -> ShowS
[RuleType] -> ShowS
RuleType -> String
(Int -> RuleType -> ShowS)
-> (RuleType -> String) -> ([RuleType] -> ShowS) -> Show RuleType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuleType] -> ShowS
$cshowList :: [RuleType] -> ShowS
show :: RuleType -> String
$cshow :: RuleType -> String
showsPrec :: Int -> RuleType -> ShowS
$cshowsPrec :: Int -> RuleType -> ShowS
Show, RuleType -> RuleType -> Bool
(RuleType -> RuleType -> Bool)
-> (RuleType -> RuleType -> Bool) -> Eq RuleType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuleType -> RuleType -> Bool
$c/= :: RuleType -> RuleType -> Bool
== :: RuleType -> RuleType -> Bool
$c== :: RuleType -> RuleType -> Bool
Eq, (forall x. RuleType -> Rep RuleType x)
-> (forall x. Rep RuleType x -> RuleType) -> Generic RuleType
forall x. Rep RuleType x -> RuleType
forall x. RuleType -> Rep RuleType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RuleType x -> RuleType
$cfrom :: forall x. RuleType -> Rep RuleType x
Generic, Eq RuleType
Eq RuleType
-> (RuleType -> RuleType -> Ordering)
-> (RuleType -> RuleType -> Bool)
-> (RuleType -> RuleType -> Bool)
-> (RuleType -> RuleType -> Bool)
-> (RuleType -> RuleType -> Bool)
-> (RuleType -> RuleType -> RuleType)
-> (RuleType -> RuleType -> RuleType)
-> Ord RuleType
RuleType -> RuleType -> Bool
RuleType -> RuleType -> Ordering
RuleType -> RuleType -> RuleType
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 :: RuleType -> RuleType -> RuleType
$cmin :: RuleType -> RuleType -> RuleType
max :: RuleType -> RuleType -> RuleType
$cmax :: RuleType -> RuleType -> RuleType
>= :: RuleType -> RuleType -> Bool
$c>= :: RuleType -> RuleType -> Bool
> :: RuleType -> RuleType -> Bool
$c> :: RuleType -> RuleType -> Bool
<= :: RuleType -> RuleType -> Bool
$c<= :: RuleType -> RuleType -> Bool
< :: RuleType -> RuleType -> Bool
$c< :: RuleType -> RuleType -> Bool
compare :: RuleType -> RuleType -> Ordering
$ccompare :: RuleType -> RuleType -> Ordering
$cp1Ord :: Eq RuleType
Ord )

instance FromJSON RuleType where
    parseJSON :: Value -> Parser RuleType
parseJSON = Options -> Value -> Parser RuleType
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
"CommentRule" -> String
"comment"
            String
"LinkRule"    -> String
"link"
            String
"AllRule"     -> String
"all"
            String
_             -> String
forall a. Monoid a => a
mempty

instance ToHttpApiData RuleType where
    toQueryParam :: RuleType -> Title
toQueryParam = \case
        RuleType
CommentRule -> Title
"comment"
        RuleType
LinkRule    -> Title
"link"
        RuleType
AllRule     -> Title
"all"

-- | Mod-created requirements for posting in a subreddit
data PostRequirements = PostRequirements
    { PostRequirements -> [Title]
bodyBlacklistedStrings  :: [Text]
    , PostRequirements -> BodyRestriction
bodyRestrictionPolicy   :: BodyRestriction
    , PostRequirements -> [Title]
domainBlacklist         :: [Text]
      -- | If present, submissions must be from one of the listed domains
    , PostRequirements -> [Title]
domainWhitelist         :: [Text]
    , PostRequirements -> Bool
isFlairRequired         :: Bool
    , PostRequirements -> [Title]
titleBlacklistedStrings :: [Text]
      -- |If present, submission titles must contain one of the given strings
    , PostRequirements -> [Title]
titleRequiredStrings    :: [Text]
    , PostRequirements -> Maybe Word
titleTextMaxLength      :: Maybe Word
    , PostRequirements -> Maybe Word
titleTextMinLength      :: Maybe Word
    }
    deriving stock ( Int -> PostRequirements -> ShowS
[PostRequirements] -> ShowS
PostRequirements -> String
(Int -> PostRequirements -> ShowS)
-> (PostRequirements -> String)
-> ([PostRequirements] -> ShowS)
-> Show PostRequirements
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostRequirements] -> ShowS
$cshowList :: [PostRequirements] -> ShowS
show :: PostRequirements -> String
$cshow :: PostRequirements -> String
showsPrec :: Int -> PostRequirements -> ShowS
$cshowsPrec :: Int -> PostRequirements -> ShowS
Show, PostRequirements -> PostRequirements -> Bool
(PostRequirements -> PostRequirements -> Bool)
-> (PostRequirements -> PostRequirements -> Bool)
-> Eq PostRequirements
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostRequirements -> PostRequirements -> Bool
$c/= :: PostRequirements -> PostRequirements -> Bool
== :: PostRequirements -> PostRequirements -> Bool
$c== :: PostRequirements -> PostRequirements -> Bool
Eq, (forall x. PostRequirements -> Rep PostRequirements x)
-> (forall x. Rep PostRequirements x -> PostRequirements)
-> Generic PostRequirements
forall x. Rep PostRequirements x -> PostRequirements
forall x. PostRequirements -> Rep PostRequirements x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PostRequirements x -> PostRequirements
$cfrom :: forall x. PostRequirements -> Rep PostRequirements x
Generic )

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

-- | Rules concerning the presence of self-text bodies in posts
data BodyRestriction
    = BodyRequired
    | BodyNotAllowed
    | NoRestriction
    deriving stock ( Int -> BodyRestriction -> ShowS
[BodyRestriction] -> ShowS
BodyRestriction -> String
(Int -> BodyRestriction -> ShowS)
-> (BodyRestriction -> String)
-> ([BodyRestriction] -> ShowS)
-> Show BodyRestriction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BodyRestriction] -> ShowS
$cshowList :: [BodyRestriction] -> ShowS
show :: BodyRestriction -> String
$cshow :: BodyRestriction -> String
showsPrec :: Int -> BodyRestriction -> ShowS
$cshowsPrec :: Int -> BodyRestriction -> ShowS
Show, BodyRestriction -> BodyRestriction -> Bool
(BodyRestriction -> BodyRestriction -> Bool)
-> (BodyRestriction -> BodyRestriction -> Bool)
-> Eq BodyRestriction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BodyRestriction -> BodyRestriction -> Bool
$c/= :: BodyRestriction -> BodyRestriction -> Bool
== :: BodyRestriction -> BodyRestriction -> Bool
$c== :: BodyRestriction -> BodyRestriction -> Bool
Eq, (forall x. BodyRestriction -> Rep BodyRestriction x)
-> (forall x. Rep BodyRestriction x -> BodyRestriction)
-> Generic BodyRestriction
forall x. Rep BodyRestriction x -> BodyRestriction
forall x. BodyRestriction -> Rep BodyRestriction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BodyRestriction x -> BodyRestriction
$cfrom :: forall x. BodyRestriction -> Rep BodyRestriction x
Generic )

instance FromJSON BodyRestriction where
    parseJSON :: Value -> Parser BodyRestriction
parseJSON = String
-> (Title -> Parser BodyRestriction)
-> Value
-> Parser BodyRestriction
forall a. String -> (Title -> Parser a) -> Value -> Parser a
withText String
"BodyRestriction" ((Title -> Parser BodyRestriction)
 -> Value -> Parser BodyRestriction)
-> (Title -> Parser BodyRestriction)
-> Value
-> Parser BodyRestriction
forall a b. (a -> b) -> a -> b
$ \case
        Title
"required"   -> BodyRestriction -> Parser BodyRestriction
forall (f :: * -> *) a. Applicative f => a -> f a
pure BodyRestriction
BodyRequired
        Title
"notAllowed" -> BodyRestriction -> Parser BodyRestriction
forall (f :: * -> *) a. Applicative f => a -> f a
pure BodyRestriction
BodyNotAllowed
        Title
"none"       -> BodyRestriction -> Parser BodyRestriction
forall (f :: * -> *) a. Applicative f => a -> f a
pure BodyRestriction
NoRestriction
        Title
_            -> Parser BodyRestriction
forall a. Monoid a => a
mempty