{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module      : Network.Reddit.Types.Internal
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Internal
    ( Thing(..)
    , RedditKind(..)
    , Paginable(..)
    , Paginator(..)
    , Listing(..)
    , CIText(CIText)
    , HKD
    , ItemOpts(..)
    , defaultItemOpts
    , ItemSort(..)
    , ItemReport(..)
    , Distinction(..)
    , Time(..)
    , ItemType(..)
    , UploadURL
    , Body
    , Title
    , URL
    , Subject
    , RGBText
    , Name
    , Domain
    , Modifier
    , RawBody
      -- * Exceptions
    , RedditException
    , ClientException(..)
    , APIException(..)
    , OAauthError(..)
    , ErrorMessage(..)
    , StatusCode
    , StatusMessage(..)
    , JSONError(..)
      -- * Utilities
    , dropTypePrefix
    , integerToUTC
    , withKind
    , textKind
    , prependType
    , bshow
    , tshow
    , editedP
    , validateName
    , joinParams
    , nothingTxtNull
    , textObject
    , textEncode
    , withKinds
    , breakOnType
    , getVals
    , mkTextForm
    ) where

import           Conduit                      ( ConduitM )

import           Control.Exception            ( Exception(..), SomeException )
import           Control.Monad                ( guard )
import           Control.Monad.Catch          ( MonadThrow(throwM) )

import           Data.Aeson
                 ( (.:)
                 , (.:?)
                 , FromJSON(..)
                 , Options(constructorTagModifier)
                 , ToJSON(toJSON)
                 , Value(..)
                 , defaultOptions
                 , genericParseJSON
                 , genericToJSON
                 , object
                 , withArray
                 , withObject
                 , withText
                 )
import           Data.Aeson.Text              ( encodeToLazyText )
import           Data.Aeson.Types             ( Pair, Parser )
import           Data.Bool                    ( bool )
import           Data.ByteString              ( ByteString )
import qualified Data.ByteString.Char8        as C8
import qualified Data.ByteString.Lazy         as LB
import           Data.Char                    ( toLower )
import           Data.Coerce                  ( coerce )
import           Data.Data                    ( cast )
import           Data.Foldable                ( asum )
import qualified Data.Foldable                as F
import           Data.Function                ( on )
import           Data.Functor.Identity        ( Identity )
import qualified Data.Generics.Product.Fields as GL
import           Data.HashMap.Strict          ( HashMap )
import qualified Data.HashMap.Strict          as HM
import           Data.Ix                      ( Ix(inRange) )
import           Data.Kind                    ( Type )
import           Data.Maybe                   ( catMaybes, fromMaybe )
import           Data.Scientific              ( toBoundedInteger )
import           Data.Sequence                ( Seq )
import           Data.Text                    ( Text )
import qualified Data.Text                    as T
import qualified Data.Text.Lazy               as LT
import           Data.Time                    ( UTCTime )
import           Data.Time.Clock.POSIX        ( posixSecondsToUTCTime )

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

import           Network.HTTP.Conduit         ( Request )

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

-- | A @RedditKind@ represents a textual prefix that Reddit uses to denote types
-- in its API
data RedditKind
    = CommentKind -- @t1_@
    | AccountKind -- @t2_@
    | SubmissionKind -- @t3_@
    | MessageKind -- @t4_@
    | SubredditKind -- @t5_@
    | AwardKind -- @t6_@
    | ListingKind -- @Listing@
    | UserListKind -- @UserList@
    | KarmaListKind -- @KarmaList@
    | TrophyListKind -- @TrophyList@
    | MoreKind -- @more@
    | RelKind -- @rb@
    | SubredditSettingsKind -- @subreddit_settings@
    | StylesheetKind -- @stylesheet@
    | WikiPageKind -- @wikipage@
    | WikiPageListingKind -- @wikipagelisting@
    | WikiPageSettingsKind -- @wikipagesettings@
    | LabeledMultiKind -- @LabeledMulti@
    | ModActionKind -- @modaction@
    | LiveThreadKind -- @LiveUpdateEvent@
    | LiveUpdateKind -- @LiveUpdate@
    deriving stock ( RedditKind -> RedditKind -> Bool
(RedditKind -> RedditKind -> Bool)
-> (RedditKind -> RedditKind -> Bool) -> Eq RedditKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RedditKind -> RedditKind -> Bool
$c/= :: RedditKind -> RedditKind -> Bool
== :: RedditKind -> RedditKind -> Bool
$c== :: RedditKind -> RedditKind -> Bool
Eq )

instance FromJSON RedditKind where
    parseJSON :: Value -> Parser RedditKind
parseJSON = String -> (Text -> Parser RedditKind) -> Value -> Parser RedditKind
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"RedditKind" ((Text -> Parser RedditKind) -> Value -> Parser RedditKind)
-> (Text -> Parser RedditKind) -> Value -> Parser RedditKind
forall a b. (a -> b) -> a -> b
$ \case
        Text
"t1" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
CommentKind
        Text
"t2" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
AccountKind
        Text
"t3" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
SubmissionKind
        Text
"t4" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
MessageKind
        Text
"t5" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
SubredditKind
        Text
"t6" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
AwardKind
        Text
"Listing" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
ListingKind
        Text
"UserList" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
UserListKind
        Text
"KarmaList" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
KarmaListKind
        Text
"TrophyList" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
TrophyListKind
        Text
"more" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
MoreKind
        Text
"rb" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
RelKind
        Text
"subreddit_settings" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
SubredditSettingsKind
        Text
"stylesheet" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
StylesheetKind
        Text
"wikipage" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
WikiPageKind
        Text
"wikipagelisting" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
WikiPageListingKind
        Text
"wikipagesettings" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
WikiPageSettingsKind
        Text
"LabeledMulti" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
LabeledMultiKind
        Text
"modaction" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
ModActionKind
        Text
"LiveUpdateEvent" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
LiveThreadKind
        Text
"LiveUpdate" -> RedditKind -> Parser RedditKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RedditKind
LiveUpdateKind
        Text
_ -> Parser RedditKind
forall a. Monoid a => a
mempty

-- | \"Thing\"s are the base class of Reddit's OOP model. Each thing has several
-- properties, but here we are only interested in one, the \"fullname\". This
-- is a combination of a thing's type (here represented as a 'RedditKind'), and its
-- unique ID
class Thing a where
    -- | A @fullname@ is an identifier with a \"type prefix\" attached. See 'RedditKind'
    -- for possible prefixes. This prefixed form is required in various places by
    -- the Reddit API
    fullname :: a -> Text

instance (Foldable t, Thing a) => Thing (t a) where
    fullname :: t a -> Text
fullname t a
ts = Text -> [Text] -> Text
T.intercalate Text
"," (a -> Text
forall a. Thing a => a -> Text
fullname (a -> Text) -> [a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t a
ts)

-- | Certain API endpoints are @listings@, which can be paginated and filtered
-- using a 'Paginator'
data Listing t a = Listing
    { -- | Anchor of previous slice
      Listing t a -> Maybe t
before   :: Maybe t
      -- | Anchor of next slice
    , Listing t a -> Maybe t
after    :: Maybe t
      -- | The actual items returned in the response
    , Listing t a -> Seq a
children :: Seq a
    }
    deriving stock ( Int -> Listing t a -> ShowS
[Listing t a] -> ShowS
Listing t a -> String
(Int -> Listing t a -> ShowS)
-> (Listing t a -> String)
-> ([Listing t a] -> ShowS)
-> Show (Listing t a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t a. (Show t, Show a) => Int -> Listing t a -> ShowS
forall t a. (Show t, Show a) => [Listing t a] -> ShowS
forall t a. (Show t, Show a) => Listing t a -> String
showList :: [Listing t a] -> ShowS
$cshowList :: forall t a. (Show t, Show a) => [Listing t a] -> ShowS
show :: Listing t a -> String
$cshow :: forall t a. (Show t, Show a) => Listing t a -> String
showsPrec :: Int -> Listing t a -> ShowS
$cshowsPrec :: forall t a. (Show t, Show a) => Int -> Listing t a -> ShowS
Show, Listing t a -> Listing t a -> Bool
(Listing t a -> Listing t a -> Bool)
-> (Listing t a -> Listing t a -> Bool) -> Eq (Listing t a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t a. (Eq t, Eq a) => Listing t a -> Listing t a -> Bool
/= :: Listing t a -> Listing t a -> Bool
$c/= :: forall t a. (Eq t, Eq a) => Listing t a -> Listing t a -> Bool
== :: Listing t a -> Listing t a -> Bool
$c== :: forall t a. (Eq t, Eq a) => Listing t a -> Listing t a -> Bool
Eq, (forall x. Listing t a -> Rep (Listing t a) x)
-> (forall x. Rep (Listing t a) x -> Listing t a)
-> Generic (Listing t a)
forall x. Rep (Listing t a) x -> Listing t a
forall x. Listing t a -> Rep (Listing t a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t a x. Rep (Listing t a) x -> Listing t a
forall t a x. Listing t a -> Rep (Listing t a) x
$cto :: forall t a x. Rep (Listing t a) x -> Listing t a
$cfrom :: forall t a x. Listing t a -> Rep (Listing t a) x
Generic )

instance Ord t => Semigroup (Listing t a) where
    (Listing Maybe t
lb Maybe t
la Seq a
lcs) <> :: Listing t a -> Listing t a -> Listing t a
<> (Listing Maybe t
rb Maybe t
ra Seq a
rcs) =
        Maybe t -> Maybe t -> Seq a -> Listing t a
forall t a. Maybe t -> Maybe t -> Seq a -> Listing t a
Listing (Maybe t -> Maybe t -> Maybe t
forall a. Ord a => a -> a -> a
max Maybe t
lb Maybe t
rb) (Maybe t -> Maybe t -> Maybe t
forall a. Ord a => a -> a -> a
min Maybe t
la Maybe t
ra) (Seq a
lcs Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> Seq a
rcs)

instance Ord t => Monoid (Listing t a) where
    mappend :: Listing t a -> Listing t a -> Listing t a
mappend = Listing t a -> Listing t a -> Listing t a
forall a. Semigroup a => a -> a -> a
(<>)

    mempty :: Listing t a
mempty = Maybe t -> Maybe t -> Seq a -> Listing t a
forall t a. Maybe t -> Maybe t -> Seq a -> Listing t a
Listing Maybe t
forall a. Maybe a
Nothing Maybe t
forall a. Maybe a
Nothing Seq a
forall a. Monoid a => a
mempty

instance (FromJSON a, FromJSON t) => FromJSON (Listing t a) where
    parseJSON :: Value -> Parser (Listing t a)
parseJSON = RedditKind
-> String
-> (Object -> Parser (Listing t a))
-> Value
-> Parser (Listing t a)
forall b a.
FromJSON b =>
RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind RedditKind
ListingKind String
"Listing" ((Object -> Parser (Listing t a)) -> Value -> Parser (Listing t a))
-> (Object -> Parser (Listing t a))
-> Value
-> Parser (Listing t a)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        Maybe t -> Maybe t -> Seq a -> Listing t a
forall t a. Maybe t -> Maybe t -> Seq a -> Listing t a
Listing (Maybe t -> Maybe t -> Seq a -> Listing t a)
-> Parser (Maybe t) -> Parser (Maybe t -> Seq a -> Listing t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe t)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"before" Parser (Maybe t -> Seq a -> Listing t a)
-> Parser (Maybe t) -> Parser (Seq a -> Listing t a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe t)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"after" Parser (Seq a -> Listing t a)
-> Parser (Seq a) -> Parser (Listing t a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Seq a)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"children"

-- | Represents requests that can take additional options in a 'Paginator'. This
-- can be used to filter\/sort 'Listing' endpoints
class Paginable a where
    type PaginateOptions (a :: Type)

    type PaginateThing (a :: Type)

    -- | Default 'PaginateOptions' for this type
    defaultOpts :: PaginateOptions a

    -- | Get the fullname of the 'Thing' type associated with this type, if
    -- any
    getFullname :: a -> PaginateThing a
    default getFullname :: (PaginateThing a ~ Text) => a -> PaginateThing a
    getFullname a
_ = PaginateThing a
forall a. Monoid a => a
mempty

    -- | Convert the 'PaginateOptions' options to a 'Form'
    optsToForm :: PaginateOptions a -> Form
    default optsToForm
        :: ToForm (PaginateOptions a) => PaginateOptions a -> Form
    optsToForm = PaginateOptions a -> Form
forall a. ToForm a => a -> Form
toForm

-- | This represents the protocol that Reddit uses to control paginating and
-- filtering entries. These can be applied to 'Listing' endpoints. The first
-- four fields below are common parameters that are applied to each 'Listing'.
-- The @opts@ field takes extended 'PaginateOptions' based on the second type
-- parameter
data Paginator t a = Paginator
    { -- | The pagination controls. These should be 'Thing' instances, in order
      -- to provide the 'fullname' params that Reddit requires
      Paginator t a -> Maybe t
before   :: Maybe t
    , Paginator t a -> Maybe t
after    :: Maybe t
      -- | The maximum number of items to return in an individual slice. Defaults
      -- to 25, with a maximum of 100
    , Paginator t a -> Word
limit    :: Word
      -- | A control to disable filtering, e.g. hiding links that one has voted
      -- on. At the moment, turning this option on is a no-op
    , Paginator t a -> Bool
showAll  :: Bool
      -- | Whether or not to expand subreddits
    , Paginator t a -> Bool
srDetail :: Bool
      -- | Additional options, depending on the type parameter @a@
    , Paginator t a -> PaginateOptions a
opts     :: PaginateOptions a
    }
    deriving stock ( (forall x. Paginator t a -> Rep (Paginator t a) x)
-> (forall x. Rep (Paginator t a) x -> Paginator t a)
-> Generic (Paginator t a)
forall x. Rep (Paginator t a) x -> Paginator t a
forall x. Paginator t a -> Rep (Paginator t a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t a x. Rep (Paginator t a) x -> Paginator t a
forall t a x. Paginator t a -> Rep (Paginator t a) x
$cto :: forall t a x. Rep (Paginator t a) x -> Paginator t a
$cfrom :: forall t a x. Paginator t a -> Rep (Paginator t a) x
Generic )

type role Paginator nominal nominal

deriving stock instance (Show t, Show (PaginateOptions a))
    => Show (Paginator t a)

deriving stock instance (Eq t, Eq (PaginateOptions a)) => Eq (Paginator t a)

instance (Thing t, Paginable a) => ToForm (Paginator t a) where
    toForm :: Paginator t a -> Form
toForm Paginator { Bool
Maybe t
Word
PaginateOptions a
opts :: PaginateOptions a
srDetail :: Bool
showAll :: Bool
limit :: Word
after :: Maybe t
before :: Maybe t
$sel:opts:Paginator :: forall t a. Paginator t a -> PaginateOptions a
$sel:srDetail:Paginator :: forall t a. Paginator t a -> Bool
$sel:showAll:Paginator :: forall t a. Paginator t a -> Bool
$sel:limit:Paginator :: forall t a. Paginator t a -> Word
$sel:after:Paginator :: forall t a. Paginator t a -> Maybe t
$sel:before:Paginator :: forall t a. Paginator t a -> Maybe t
.. } = Form
commonOpts Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> PaginateOptions a -> Form
forall a. Paginable a => PaginateOptions a -> Form
optsToForm @a PaginateOptions a
opts
      where
        commonOpts :: Form
commonOpts = [(Text, Text)] -> Form
mkTextForm
            ([(Text, Text)] -> Form) -> [(Text, Text)] -> Form
forall a b. (a -> b) -> a -> b
$ [ (Text
"limit", Word -> Text
forall a. Show a => a -> Text
tshow Word
limit) ]
            [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [Maybe (Text, Text)] -> [(Text, Text)]
forall a. [Maybe a] -> [a]
catMaybes [ (Text
"show", ) (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Maybe Text -> Bool -> Maybe Text
forall a. a -> a -> Bool -> a
bool Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"given") Bool
showAll
                         , [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)) -> (t -> Text) -> t -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Text
forall a. Thing a => a -> Text
fullname (t -> (Text, Text)) -> Maybe t -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe t
after
                                , (Text
"before", ) (Text -> (Text, Text)) -> (t -> Text) -> t -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Text
forall a. Thing a => a -> Text
fullname (t -> (Text, Text)) -> Maybe t -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe t
before
                                ]
                         ]

instance {-# OVERLAPPING #-}( GL.HasField' name (Paginator t a) s
                            , a ~ b
                            , s ~ u
                            )
    => GL.HasField name (Paginator t a) (Paginator t b) s u where
    field :: (s -> f u) -> Paginator t a -> f (Paginator t b)
field = forall s a. HasField' name s a => Lens s s a a
forall (field :: Symbol) s a. HasField' field s a => Lens s s a a
GL.field' @name

-- | This exists to derive case-insensitive 'Eq' instances for types that are
-- isomorphic to 'Text'
newtype CIText a = CIText a

instance Coercible a Text => Eq (CIText a) where
    == :: CIText a -> CIText a -> Bool
(==) = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> (CIText a -> Text) -> CIText a -> CIText a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Text
T.toCaseFold (Text -> Text) -> (CIText a -> Text) -> CIText a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIText a -> Text
coerce

type family HKD f a where
    HKD Identity a = a
    HKD f a = f a

-- | Options that can be applied to comments or submissions, as represented by the
-- phantom type parameter
data ItemOpts a = ItemOpts
    { ItemOpts a -> Maybe ItemSort
itemSort :: Maybe ItemSort
    , ItemOpts a -> Maybe ItemType
itemType :: Maybe ItemType
    , ItemOpts a -> Maybe Time
itemTime :: Maybe Time
      -- According to the API docs, the requested context should be between 0 and
      -- 8 or between 2 and 10, depending on the item being requested
    , ItemOpts a -> Maybe Word
context  :: Maybe Word
    }
    deriving stock ( Int -> ItemOpts a -> ShowS
[ItemOpts a] -> ShowS
ItemOpts a -> String
(Int -> ItemOpts a -> ShowS)
-> (ItemOpts a -> String)
-> ([ItemOpts a] -> ShowS)
-> Show (ItemOpts a)
forall a. Int -> ItemOpts a -> ShowS
forall a. [ItemOpts a] -> ShowS
forall a. ItemOpts a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemOpts a] -> ShowS
$cshowList :: forall a. [ItemOpts a] -> ShowS
show :: ItemOpts a -> String
$cshow :: forall a. ItemOpts a -> String
showsPrec :: Int -> ItemOpts a -> ShowS
$cshowsPrec :: forall a. Int -> ItemOpts a -> ShowS
Show, ItemOpts a -> ItemOpts a -> Bool
(ItemOpts a -> ItemOpts a -> Bool)
-> (ItemOpts a -> ItemOpts a -> Bool) -> Eq (ItemOpts a)
forall a. ItemOpts a -> ItemOpts a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemOpts a -> ItemOpts a -> Bool
$c/= :: forall a. ItemOpts a -> ItemOpts a -> Bool
== :: ItemOpts a -> ItemOpts a -> Bool
$c== :: forall a. ItemOpts a -> ItemOpts a -> Bool
Eq, (forall x. ItemOpts a -> Rep (ItemOpts a) x)
-> (forall x. Rep (ItemOpts a) x -> ItemOpts a)
-> Generic (ItemOpts a)
forall x. Rep (ItemOpts a) x -> ItemOpts a
forall x. ItemOpts a -> Rep (ItemOpts a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ItemOpts a) x -> ItemOpts a
forall a x. ItemOpts a -> Rep (ItemOpts a) x
$cto :: forall a x. Rep (ItemOpts a) x -> ItemOpts a
$cfrom :: forall a x. ItemOpts a -> Rep (ItemOpts a) x
Generic )

instance ToForm (ItemOpts a) where
    toForm :: ItemOpts a -> Form
toForm ItemOpts { Maybe Word
Maybe Time
Maybe ItemType
Maybe ItemSort
context :: Maybe Word
itemTime :: Maybe Time
itemType :: Maybe ItemType
itemSort :: Maybe ItemSort
$sel:context:ItemOpts :: forall a. ItemOpts a -> Maybe Word
$sel:itemTime:ItemOpts :: forall a. ItemOpts a -> Maybe Time
$sel:itemType:ItemOpts :: forall a. ItemOpts a -> Maybe ItemType
$sel:itemSort:ItemOpts :: forall a. ItemOpts a -> Maybe ItemSort
.. } = [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
"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
itemSort
                    , (Text
"type", ) (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
itemType
                    , (Text
"t", ) (Text -> (Text, Text)) -> (Time -> Text) -> Time -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (Time -> (Text, Text)) -> Maybe Time -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Time
itemTime
                    , (Text
"context", ) (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
context
                    ]

-- | Defaults for fetching items, like comments or submissions
defaultItemOpts :: ItemOpts a
defaultItemOpts :: ItemOpts a
defaultItemOpts = ItemOpts :: forall a.
Maybe ItemSort
-> Maybe ItemType -> Maybe Time -> Maybe Word -> ItemOpts a
ItemOpts
    { $sel:itemSort:ItemOpts :: Maybe ItemSort
itemSort = Maybe ItemSort
forall a. Maybe a
Nothing
    , $sel:itemType:ItemOpts :: Maybe ItemType
itemType = Maybe ItemType
forall a. Maybe a
Nothing
    , $sel:itemTime:ItemOpts :: Maybe Time
itemTime = Maybe Time
forall a. Maybe a
Nothing
    , $sel:context:ItemOpts :: Maybe Word
context  = Maybe Word
forall a. Maybe a
Nothing
    }

-- | How to sort items in certain 'Listing's. Not every option is guaranteed to
-- be accepted by a given endpoint
data ItemSort
    = Hot
    | New
    | Top
    | Controversial
    | Old
    | Random
    | QA
    | Live
    | Confidence
    deriving stock ( Int -> ItemSort -> ShowS
[ItemSort] -> ShowS
ItemSort -> String
(Int -> ItemSort -> ShowS)
-> (ItemSort -> String) -> ([ItemSort] -> ShowS) -> Show ItemSort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemSort] -> ShowS
$cshowList :: [ItemSort] -> ShowS
show :: ItemSort -> String
$cshow :: ItemSort -> String
showsPrec :: Int -> ItemSort -> ShowS
$cshowsPrec :: Int -> ItemSort -> ShowS
Show, ItemSort -> ItemSort -> Bool
(ItemSort -> ItemSort -> Bool)
-> (ItemSort -> ItemSort -> Bool) -> Eq ItemSort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemSort -> ItemSort -> Bool
$c/= :: ItemSort -> ItemSort -> Bool
== :: ItemSort -> ItemSort -> Bool
$c== :: ItemSort -> ItemSort -> Bool
Eq, (forall x. ItemSort -> Rep ItemSort x)
-> (forall x. Rep ItemSort x -> ItemSort) -> Generic ItemSort
forall x. Rep ItemSort x -> ItemSort
forall x. ItemSort -> Rep ItemSort x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ItemSort x -> ItemSort
$cfrom :: forall x. ItemSort -> Rep ItemSort x
Generic )

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

instance ToJSON ItemSort where
    toJSON :: ItemSort -> Value
toJSON = Options -> ItemSort -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON --
        Options
defaultOptions { constructorTagModifier :: ShowS
constructorTagModifier = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower }

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

-- | Type of comments, for filtering in 'Listing's
data ItemType
    = Comments
    | Submissions
    deriving stock ( Int -> ItemType -> ShowS
[ItemType] -> ShowS
ItemType -> String
(Int -> ItemType -> ShowS)
-> (ItemType -> String) -> ([ItemType] -> ShowS) -> Show ItemType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemType] -> ShowS
$cshowList :: [ItemType] -> ShowS
show :: ItemType -> String
$cshow :: ItemType -> String
showsPrec :: Int -> ItemType -> ShowS
$cshowsPrec :: Int -> ItemType -> ShowS
Show, ItemType -> ItemType -> Bool
(ItemType -> ItemType -> Bool)
-> (ItemType -> ItemType -> Bool) -> Eq ItemType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemType -> ItemType -> Bool
$c/= :: ItemType -> ItemType -> Bool
== :: ItemType -> ItemType -> Bool
$c== :: ItemType -> ItemType -> Bool
Eq, (forall x. ItemType -> Rep ItemType x)
-> (forall x. Rep ItemType x -> ItemType) -> Generic ItemType
forall x. Rep ItemType x -> ItemType
forall x. ItemType -> Rep ItemType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ItemType x -> ItemType
$cfrom :: forall x. ItemType -> Rep ItemType x
Generic )

-- | A user- or moderator-generated report on a submission
data ItemReport = ItemReport
    { -- | The textual report reason\/description
      ItemReport -> Text
reason :: Text
    , ItemReport -> Word
count  :: Word
    }
    deriving stock ( Int -> ItemReport -> ShowS
[ItemReport] -> ShowS
ItemReport -> String
(Int -> ItemReport -> ShowS)
-> (ItemReport -> String)
-> ([ItemReport] -> ShowS)
-> Show ItemReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemReport] -> ShowS
$cshowList :: [ItemReport] -> ShowS
show :: ItemReport -> String
$cshow :: ItemReport -> String
showsPrec :: Int -> ItemReport -> ShowS
$cshowsPrec :: Int -> ItemReport -> ShowS
Show, ItemReport -> ItemReport -> Bool
(ItemReport -> ItemReport -> Bool)
-> (ItemReport -> ItemReport -> Bool) -> Eq ItemReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemReport -> ItemReport -> Bool
$c/= :: ItemReport -> ItemReport -> Bool
== :: ItemReport -> ItemReport -> Bool
$c== :: ItemReport -> ItemReport -> Bool
Eq, (forall x. ItemReport -> Rep ItemReport x)
-> (forall x. Rep ItemReport x -> ItemReport) -> Generic ItemReport
forall x. Rep ItemReport x -> ItemReport
forall x. ItemReport -> Rep ItemReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ItemReport x -> ItemReport
$cfrom :: forall x. ItemReport -> Rep ItemReport x
Generic )

instance FromJSON ItemReport where
    -- Reports are sent as variable-length, heterogeneous arrays
    parseJSON :: Value -> Parser ItemReport
parseJSON = String
-> (Array -> Parser ItemReport) -> Value -> Parser ItemReport
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"ItemReport" ((Array -> Parser ItemReport) -> Value -> Parser ItemReport)
-> (Array -> Parser ItemReport) -> Value -> Parser ItemReport
forall a b. (a -> b) -> a -> b
$ \Array
a -> case Array -> [Item Array]
forall l. IsList l => l -> [Item l]
toList Array
a of
        Item Array
report : Item Array
count : [Item Array]
_ ->
            Text -> Word -> ItemReport
ItemReport (Text -> Word -> ItemReport)
-> Parser Text -> Parser (Word -> ItemReport)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
Item Array
report Parser (Word -> ItemReport) -> Parser Word -> Parser ItemReport
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser Word
forall a. FromJSON a => Value -> Parser a
parseJSON Value
Item Array
count
        [Item Array]
_                  -> Parser ItemReport
forall a. Monoid a => a
mempty

instance ToHttpApiData ItemType where
    toQueryParam :: ItemType -> Text
toQueryParam = \case
        ItemType
Comments    -> Text
"comments"
        ItemType
Submissions -> Text
"links"

-- | Sigils that a moderator can add to distinguish comments or submissions. Note
-- that the 'Admin' and 'Special' distinctions require special privileges to use
data Distinction
    = Moderator -- ^ Adds \"[M]\"
    | Undistinguished -- ^ Removes an existing distinction when sent
    | Admin -- ^ Adds \"[A]\"
    | Special -- ^ User-specific distinction
    deriving stock ( Int -> Distinction -> ShowS
[Distinction] -> ShowS
Distinction -> String
(Int -> Distinction -> ShowS)
-> (Distinction -> String)
-> ([Distinction] -> ShowS)
-> Show Distinction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Distinction] -> ShowS
$cshowList :: [Distinction] -> ShowS
show :: Distinction -> String
$cshow :: Distinction -> String
showsPrec :: Int -> Distinction -> ShowS
$cshowsPrec :: Int -> Distinction -> ShowS
Show, Distinction -> Distinction -> Bool
(Distinction -> Distinction -> Bool)
-> (Distinction -> Distinction -> Bool) -> Eq Distinction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Distinction -> Distinction -> Bool
$c/= :: Distinction -> Distinction -> Bool
== :: Distinction -> Distinction -> Bool
$c== :: Distinction -> Distinction -> Bool
Eq, (forall x. Distinction -> Rep Distinction x)
-> (forall x. Rep Distinction x -> Distinction)
-> Generic Distinction
forall x. Rep Distinction x -> Distinction
forall x. Distinction -> Rep Distinction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Distinction x -> Distinction
$cfrom :: forall x. Distinction -> Rep Distinction x
Generic )

instance FromJSON Distinction where
    parseJSON :: Value -> Parser Distinction
parseJSON = String
-> (Text -> Parser Distinction) -> Value -> Parser Distinction
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Distinction" ((Text -> Parser Distinction) -> Value -> Parser Distinction)
-> (Text -> Parser Distinction) -> Value -> Parser Distinction
forall a b. (a -> b) -> a -> b
$ \case
        Text
"moderator" -> Distinction -> Parser Distinction
forall (f :: * -> *) a. Applicative f => a -> f a
pure Distinction
Moderator
        Text
"admin"     -> Distinction -> Parser Distinction
forall (f :: * -> *) a. Applicative f => a -> f a
pure Distinction
Admin
        Text
"special"   -> Distinction -> Parser Distinction
forall (f :: * -> *) a. Applicative f => a -> f a
pure Distinction
Special
        Text
_           -> Parser Distinction
forall a. Monoid a => a
mempty

instance ToHttpApiData Distinction where
    toQueryParam :: Distinction -> Text
toQueryParam = \case
        Distinction
Moderator       -> Text
"yes"
        Distinction
Undistinguished -> Text
"no"
        Distinction
d               -> Distinction -> Text
forall a. Show a => a -> Text
showTextData Distinction
d

-- | Time range when fetching comments or submissions
data Time
    = Hour
    | Day
    | Week
    | Month
    | Year
    | AllTime
    deriving stock ( Int -> Time -> ShowS
[Time] -> ShowS
Time -> String
(Int -> Time -> ShowS)
-> (Time -> String) -> ([Time] -> ShowS) -> Show Time
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Time] -> ShowS
$cshowList :: [Time] -> ShowS
show :: Time -> String
$cshow :: Time -> String
showsPrec :: Int -> Time -> ShowS
$cshowsPrec :: Int -> Time -> ShowS
Show, Time -> Time -> Bool
(Time -> Time -> Bool) -> (Time -> Time -> Bool) -> Eq Time
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c== :: Time -> Time -> Bool
Eq, (forall x. Time -> Rep Time x)
-> (forall x. Rep Time x -> Time) -> Generic Time
forall x. Rep Time x -> Time
forall x. Time -> Rep Time x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Time x -> Time
$cfrom :: forall x. Time -> Rep Time x
Generic )

instance ToHttpApiData Time where
    toQueryParam :: Time -> Text
toQueryParam = \case
        Time
AllTime -> Text
"all"
        Time
t       -> Time -> Text
forall a. Show a => a -> Text
showTextData Time
t

-- | A URL pointing to a resource hosted by Reddit. These should only be obtained
-- by parsing the JSON of existing resources or through particular actions that
-- perform the upload transaction and return the URL, e.g.
-- 'Network.Reddit.Moderation.uploadWidgetImage'
newtype UploadURL = UploadURL URL
    deriving stock ( Int -> UploadURL -> ShowS
[UploadURL] -> ShowS
UploadURL -> String
(Int -> UploadURL -> ShowS)
-> (UploadURL -> String)
-> ([UploadURL] -> ShowS)
-> Show UploadURL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UploadURL] -> ShowS
$cshowList :: [UploadURL] -> ShowS
show :: UploadURL -> String
$cshow :: UploadURL -> String
showsPrec :: Int -> UploadURL -> ShowS
$cshowsPrec :: Int -> UploadURL -> ShowS
Show, (forall x. UploadURL -> Rep UploadURL x)
-> (forall x. Rep UploadURL x -> UploadURL) -> Generic UploadURL
forall x. Rep UploadURL x -> UploadURL
forall x. UploadURL -> Rep UploadURL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UploadURL x -> UploadURL
$cfrom :: forall x. UploadURL -> Rep UploadURL x
Generic )
    deriving newtype ( UploadURL -> UploadURL -> Bool
(UploadURL -> UploadURL -> Bool)
-> (UploadURL -> UploadURL -> Bool) -> Eq UploadURL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UploadURL -> UploadURL -> Bool
$c/= :: UploadURL -> UploadURL -> Bool
== :: UploadURL -> UploadURL -> Bool
$c== :: UploadURL -> UploadURL -> Bool
Eq, Value -> Parser [UploadURL]
Value -> Parser UploadURL
(Value -> Parser UploadURL)
-> (Value -> Parser [UploadURL]) -> FromJSON UploadURL
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UploadURL]
$cparseJSONList :: Value -> Parser [UploadURL]
parseJSON :: Value -> Parser UploadURL
$cparseJSON :: Value -> Parser UploadURL
FromJSON, [UploadURL] -> Encoding
[UploadURL] -> Value
UploadURL -> Encoding
UploadURL -> Value
(UploadURL -> Value)
-> (UploadURL -> Encoding)
-> ([UploadURL] -> Value)
-> ([UploadURL] -> Encoding)
-> ToJSON UploadURL
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UploadURL] -> Encoding
$ctoEncodingList :: [UploadURL] -> Encoding
toJSONList :: [UploadURL] -> Value
$ctoJSONList :: [UploadURL] -> Value
toEncoding :: UploadURL -> Encoding
$ctoEncoding :: UploadURL -> Encoding
toJSON :: UploadURL -> Value
$ctoJSON :: UploadURL -> Value
ToJSON, UploadURL -> ByteString
UploadURL -> Builder
UploadURL -> Text
(UploadURL -> Text)
-> (UploadURL -> Builder)
-> (UploadURL -> ByteString)
-> (UploadURL -> Text)
-> ToHttpApiData UploadURL
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: UploadURL -> Text
$ctoQueryParam :: UploadURL -> Text
toHeader :: UploadURL -> ByteString
$ctoHeader :: UploadURL -> ByteString
toEncodedUrlPiece :: UploadURL -> Builder
$ctoEncodedUrlPiece :: UploadURL -> Builder
toUrlPiece :: UploadURL -> Text
$ctoUrlPiece :: UploadURL -> Text
ToHttpApiData )

-- | Type synonym for URLs
type URL = Text

-- | Type synonym for bodies of submissions, comments, messages, etc...
type Body = Text

-- | Type synonym for titles of submissions, etc...
type Title = Text

-- | Type synonym for subjects of messages, etc...
type Subject = Text

-- | Type synonym RGB color strings
type RGBText = Text

-- | Type synonym for names of items
type Name = Text

-- | Type synonym for domains
type Domain = Text

-- | Type synonym for @fieldLabelModifier@s in @FromJSON@ instances
type Modifier = [Char] -> [Char]

-- | Type synonym the raw body of an HTTP response
type RawBody m = ConduitM () ByteString m ()

--Exceptions-------------------------------------------------------------------
-- | Base exception type for Reddit API client
data RedditException = forall e. Exception e => RedditException e

instance Show RedditException where
    show :: RedditException -> String
show (RedditException e
e) = e -> String
forall a. Show a => a -> String
show e
e

instance Exception RedditException

-- | Exceptions generated within the Reddit API client
data ClientException
    = InvalidRequest Text
    | InvalidResponse Text
    | MalformedCredentials Text
    | OtherError Text
    | ConfigurationError Text
    deriving stock ( ClientException -> ClientException -> Bool
(ClientException -> ClientException -> Bool)
-> (ClientException -> ClientException -> Bool)
-> Eq ClientException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientException -> ClientException -> Bool
$c/= :: ClientException -> ClientException -> Bool
== :: ClientException -> ClientException -> Bool
$c== :: ClientException -> ClientException -> Bool
Eq, Int -> ClientException -> ShowS
[ClientException] -> ShowS
ClientException -> String
(Int -> ClientException -> ShowS)
-> (ClientException -> String)
-> ([ClientException] -> ShowS)
-> Show ClientException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientException] -> ShowS
$cshowList :: [ClientException] -> ShowS
show :: ClientException -> String
$cshow :: ClientException -> String
showsPrec :: Int -> ClientException -> ShowS
$cshowsPrec :: Int -> ClientException -> ShowS
Show, (forall x. ClientException -> Rep ClientException x)
-> (forall x. Rep ClientException x -> ClientException)
-> Generic ClientException
forall x. Rep ClientException x -> ClientException
forall x. ClientException -> Rep ClientException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientException x -> ClientException
$cfrom :: forall x. ClientException -> Rep ClientException x
Generic )

instance Exception ClientException where
    toException :: ClientException -> SomeException
toException = ClientException -> SomeException
forall e. Exception e => e -> SomeException
redditExToException

    fromException :: SomeException -> Maybe ClientException
fromException = SomeException -> Maybe ClientException
forall e. Exception e => SomeException -> Maybe e
redditExFromException

-- | Exceptions returned from API endpoints
data APIException
    = ErrorWithStatus StatusMessage
    | ErrorWithMessage ErrorMessage
    | InvalidCredentials OAauthError
    | InvalidJSON JSONError
      -- ^ Sent if errors occur when posting JSON
    | JSONParseError Text LB.ByteString
      -- ^ With the response body, for further debugging
    | Redirected (Maybe Request)
      -- ^ If the API action should not allow automatic redirects,
      -- this error returns the possible redirected request
    | WebsocketError Text SomeException
      -- ^ Thrown when exceptions occur during websocket handling
    | UploadFailed
      -- ^ When an error occurs uploading media to Reddit\'s servers
    deriving stock ( Int -> APIException -> ShowS
[APIException] -> ShowS
APIException -> String
(Int -> APIException -> ShowS)
-> (APIException -> String)
-> ([APIException] -> ShowS)
-> Show APIException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [APIException] -> ShowS
$cshowList :: [APIException] -> ShowS
show :: APIException -> String
$cshow :: APIException -> String
showsPrec :: Int -> APIException -> ShowS
$cshowsPrec :: Int -> APIException -> ShowS
Show, (forall x. APIException -> Rep APIException x)
-> (forall x. Rep APIException x -> APIException)
-> Generic APIException
forall x. Rep APIException x -> APIException
forall x. APIException -> Rep APIException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep APIException x -> APIException
$cfrom :: forall x. APIException -> Rep APIException x
Generic )

instance Exception APIException where
    toException :: APIException -> SomeException
toException = APIException -> SomeException
forall e. Exception e => e -> SomeException
redditExToException

    fromException :: SomeException -> Maybe APIException
fromException = SomeException -> Maybe APIException
forall e. Exception e => SomeException -> Maybe e
redditExFromException

instance FromJSON APIException where
    parseJSON :: Value -> Parser APIException
parseJSON = String
-> (Object -> Parser APIException) -> Value -> Parser APIException
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"APIException" ((Object -> Parser APIException) -> Value -> Parser APIException)
-> (Object -> Parser APIException) -> Value -> Parser APIException
forall a b. (a -> b) -> a -> b
$ \(Object -> Value
Object -> Value
o) ->
        [Parser APIException] -> Parser APIException
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ StatusMessage -> APIException
ErrorWithStatus (StatusMessage -> APIException)
-> Parser StatusMessage -> Parser APIException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser StatusMessage
forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
             , ErrorMessage -> APIException
ErrorWithMessage (ErrorMessage -> APIException)
-> Parser ErrorMessage -> Parser APIException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ErrorMessage
forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
             , JSONError -> APIException
InvalidJSON (JSONError -> APIException)
-> Parser JSONError -> Parser APIException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser JSONError
forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
             , OAauthError -> APIException
InvalidCredentials (OAauthError -> APIException)
-> Parser OAauthError -> Parser APIException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser OAauthError
forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
             ]

-- | An error which occurs when attempting to authenticate via OAuth
data OAauthError = OAauthError
    { -- | The type of the error, e.g. \"invalid_grant\"
      OAauthError -> Text
errorType   :: Text
      -- | This field may be absent. If it exists, it describes
      -- the error
    , OAauthError -> Maybe Text
description :: Maybe Text
    }
    deriving stock ( Int -> OAauthError -> ShowS
[OAauthError] -> ShowS
OAauthError -> String
(Int -> OAauthError -> ShowS)
-> (OAauthError -> String)
-> ([OAauthError] -> ShowS)
-> Show OAauthError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAauthError] -> ShowS
$cshowList :: [OAauthError] -> ShowS
show :: OAauthError -> String
$cshow :: OAauthError -> String
showsPrec :: Int -> OAauthError -> ShowS
$cshowsPrec :: Int -> OAauthError -> ShowS
Show, OAauthError -> OAauthError -> Bool
(OAauthError -> OAauthError -> Bool)
-> (OAauthError -> OAauthError -> Bool) -> Eq OAauthError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAauthError -> OAauthError -> Bool
$c/= :: OAauthError -> OAauthError -> Bool
== :: OAauthError -> OAauthError -> Bool
$c== :: OAauthError -> OAauthError -> Bool
Eq, (forall x. OAauthError -> Rep OAauthError x)
-> (forall x. Rep OAauthError x -> OAauthError)
-> Generic OAauthError
forall x. Rep OAauthError x -> OAauthError
forall x. OAauthError -> Rep OAauthError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OAauthError x -> OAauthError
$cfrom :: forall x. OAauthError -> Rep OAauthError x
Generic )

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

-- | A specific error message
data ErrorMessage
    = EmptyError
    | OtherErrorMessage [Value]
    | Ratelimited Integer Text
    | CommentDeleted
    | BadSRName
    | SubredditNotExists
    | SubredditRequired
    | AlreadySubmitted
    | NoURL
    | NoName
    | NoText
    | TooShort
    | BadCaptcha
    | UserRequired
    deriving stock ( Int -> ErrorMessage -> ShowS
[ErrorMessage] -> ShowS
ErrorMessage -> String
(Int -> ErrorMessage -> ShowS)
-> (ErrorMessage -> String)
-> ([ErrorMessage] -> ShowS)
-> Show ErrorMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorMessage] -> ShowS
$cshowList :: [ErrorMessage] -> ShowS
show :: ErrorMessage -> String
$cshow :: ErrorMessage -> String
showsPrec :: Int -> ErrorMessage -> ShowS
$cshowsPrec :: Int -> ErrorMessage -> ShowS
Show, ErrorMessage -> ErrorMessage -> Bool
(ErrorMessage -> ErrorMessage -> Bool)
-> (ErrorMessage -> ErrorMessage -> Bool) -> Eq ErrorMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorMessage -> ErrorMessage -> Bool
$c/= :: ErrorMessage -> ErrorMessage -> Bool
== :: ErrorMessage -> ErrorMessage -> Bool
$c== :: ErrorMessage -> ErrorMessage -> Bool
Eq, (forall x. ErrorMessage -> Rep ErrorMessage x)
-> (forall x. Rep ErrorMessage x -> ErrorMessage)
-> Generic ErrorMessage
forall x. Rep ErrorMessage x -> ErrorMessage
forall x. ErrorMessage -> Rep ErrorMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorMessage x -> ErrorMessage
$cfrom :: forall x. ErrorMessage -> Rep ErrorMessage x
Generic )

instance FromJSON ErrorMessage where
    parseJSON :: Value -> Parser ErrorMessage
parseJSON = String
-> (Object -> Parser ErrorMessage) -> Value -> Parser ErrorMessage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ErrorMessage" ((Object -> Parser ErrorMessage) -> Value -> Parser ErrorMessage)
-> (Object -> Parser ErrorMessage) -> Value -> Parser ErrorMessage
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        Object -> Value -> Parser ErrorMessage
msgP Object
o (Value -> Parser ErrorMessage)
-> Parser Value -> Parser ErrorMessage
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"errors") (Object -> Parser Value) -> Parser Object -> Parser Value
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
"json")
      where
        msgP :: Object -> Value -> Parser ErrorMessage
msgP Object
o = String
-> (Array -> Parser ErrorMessage) -> Value -> Parser ErrorMessage
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"[[Value]]" ((Array -> Parser ErrorMessage) -> Value -> Parser ErrorMessage)
-> (Array -> Parser ErrorMessage) -> Value -> Parser ErrorMessage
forall a b. (a -> b) -> a -> b
$ \Array
a -> case Array -> [Item Array]
forall l. IsList l => l -> [Item l]
toList Array
a of
            Item Array
v : [Item Array]
_ -> Value -> Parser ErrorMessage
msgsP Value
Item Array
v
            []    -> ErrorMessage -> Parser ErrorMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorMessage
EmptyError
          where
            msgsP :: Value -> Parser ErrorMessage
msgsP = String
-> (Array -> Parser ErrorMessage) -> Value -> Parser ErrorMessage
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"[Value]" ((Array -> Parser ErrorMessage) -> Value -> Parser ErrorMessage)
-> (Array -> Parser ErrorMessage) -> Value -> Parser ErrorMessage
forall a b. (a -> b) -> a -> b
$ \Array
a -> case Array -> [Item Array]
forall l. IsList l => l -> [Item l]
toList Array
a of
                Item Array
"RATELIMIT" : String msg : [Item Array]
_ -> Integer -> Text -> ErrorMessage
Ratelimited
                    (Integer -> Text -> ErrorMessage)
-> Parser Integer -> Parser (Text -> ErrorMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double -> Integer) -> Parser Double -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b. (RealFrac Double, Integral b) => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round @Double)
                             ((Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ratelimit") (Object -> Parser Double) -> Parser Object -> Parser Double
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
"json")
                    Parser (Text -> ErrorMessage) -> Parser Text -> Parser ErrorMessage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
msg
                Item Array
"COMMENT_DELETED" : [Item Array]
_ -> ErrorMessage -> Parser ErrorMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorMessage
CommentDeleted
                Item Array
"BAD_SR_NAME" : [Item Array]
_ -> ErrorMessage -> Parser ErrorMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorMessage
BadSRName
                Item Array
"SUBREDDIT_REQUIRED" : [Item Array]
_ -> ErrorMessage -> Parser ErrorMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorMessage
SubredditRequired
                Item Array
"SUBREDDIT_NOEXIST" : [Item Array]
_ -> ErrorMessage -> Parser ErrorMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorMessage
SubredditNotExists
                Item Array
"ALREADY_SUB" : [Item Array]
_ -> ErrorMessage -> Parser ErrorMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorMessage
AlreadySubmitted
                Item Array
"NO_URL " : [Item Array]
_ -> ErrorMessage -> Parser ErrorMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorMessage
NoURL
                Item Array
"NO_TEXT" : [Item Array]
_ -> ErrorMessage -> Parser ErrorMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorMessage
NoText
                Item Array
"NO_NAME" : [Item Array]
_ -> ErrorMessage -> Parser ErrorMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorMessage
NoName
                Item Array
"BAD_CAPTCHA" : [Item Array]
_ -> ErrorMessage -> Parser ErrorMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorMessage
BadCaptcha
                Item Array
"TOO_SHORT" : [Item Array]
_ -> ErrorMessage -> Parser ErrorMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorMessage
TooShort
                Item Array
"USER_REQUIRED" : [Item Array]
_ -> ErrorMessage -> Parser ErrorMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorMessage
UserRequired
                [Item Array]
v -> ErrorMessage -> Parser ErrorMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrorMessage -> Parser ErrorMessage)
-> ErrorMessage -> Parser ErrorMessage
forall a b. (a -> b) -> a -> b
$ [Value] -> ErrorMessage
OtherErrorMessage [Value]
[Item Array]
v

-- | Type synonym for status codes in responses
type StatusCode = Int

-- | Details about a non-200 HTTP response
data StatusMessage =
    StatusMessage { StatusMessage -> Int
statusCode :: StatusCode, StatusMessage -> Text
message :: Text }
    deriving stock ( StatusMessage -> StatusMessage -> Bool
(StatusMessage -> StatusMessage -> Bool)
-> (StatusMessage -> StatusMessage -> Bool) -> Eq StatusMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusMessage -> StatusMessage -> Bool
$c/= :: StatusMessage -> StatusMessage -> Bool
== :: StatusMessage -> StatusMessage -> Bool
$c== :: StatusMessage -> StatusMessage -> Bool
Eq, Int -> StatusMessage -> ShowS
[StatusMessage] -> ShowS
StatusMessage -> String
(Int -> StatusMessage -> ShowS)
-> (StatusMessage -> String)
-> ([StatusMessage] -> ShowS)
-> Show StatusMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusMessage] -> ShowS
$cshowList :: [StatusMessage] -> ShowS
show :: StatusMessage -> String
$cshow :: StatusMessage -> String
showsPrec :: Int -> StatusMessage -> ShowS
$cshowsPrec :: Int -> StatusMessage -> ShowS
Show, (forall x. StatusMessage -> Rep StatusMessage x)
-> (forall x. Rep StatusMessage x -> StatusMessage)
-> Generic StatusMessage
forall x. Rep StatusMessage x -> StatusMessage
forall x. StatusMessage -> Rep StatusMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StatusMessage x -> StatusMessage
$cfrom :: forall x. StatusMessage -> Rep StatusMessage x
Generic )

instance FromJSON StatusMessage where
    parseJSON :: Value -> Parser StatusMessage
parseJSON = String
-> (Object -> Parser StatusMessage)
-> Value
-> Parser StatusMessage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"StatusMessage" ((Object -> Parser StatusMessage) -> Value -> Parser StatusMessage)
-> (Object -> Parser StatusMessage)
-> Value
-> Parser StatusMessage
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        Int -> Text -> StatusMessage
StatusMessage (Int -> Text -> StatusMessage)
-> Parser Int -> Parser (Text -> StatusMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"error") Parser (Text -> StatusMessage)
-> Parser Text -> Parser StatusMessage
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
"message")

-- | Details about a non-200 response when posting JSON
data JSONError = JSONError
    { -- | The fields of the object containing errors
      JSONError -> [Text]
fields      :: [Text]
    , JSONError -> Text
explanation :: Text
    , JSONError -> Text
message     :: Text
    , JSONError -> Text
reason      :: Text
    }
    deriving stock ( Int -> JSONError -> ShowS
[JSONError] -> ShowS
JSONError -> String
(Int -> JSONError -> ShowS)
-> (JSONError -> String)
-> ([JSONError] -> ShowS)
-> Show JSONError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONError] -> ShowS
$cshowList :: [JSONError] -> ShowS
show :: JSONError -> String
$cshow :: JSONError -> String
showsPrec :: Int -> JSONError -> ShowS
$cshowsPrec :: Int -> JSONError -> ShowS
Show, JSONError -> JSONError -> Bool
(JSONError -> JSONError -> Bool)
-> (JSONError -> JSONError -> Bool) -> Eq JSONError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONError -> JSONError -> Bool
$c/= :: JSONError -> JSONError -> Bool
== :: JSONError -> JSONError -> Bool
$c== :: JSONError -> JSONError -> Bool
Eq, (forall x. JSONError -> Rep JSONError x)
-> (forall x. Rep JSONError x -> JSONError) -> Generic JSONError
forall x. Rep JSONError x -> JSONError
forall x. JSONError -> Rep JSONError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JSONError x -> JSONError
$cfrom :: forall x. JSONError -> Rep JSONError x
Generic )

instance FromJSON JSONError

redditExToException :: Exception e => e -> SomeException
redditExToException :: e -> SomeException
redditExToException = RedditException -> SomeException
forall e. Exception e => e -> SomeException
toException (RedditException -> SomeException)
-> (e -> RedditException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> RedditException
forall e. Exception e => e -> RedditException
RedditException

redditExFromException :: Exception e => SomeException -> Maybe e
redditExFromException :: SomeException -> Maybe e
redditExFromException SomeException
x = do
    RedditException e
a <- SomeException -> Maybe RedditException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
    e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a

--Utilities--------------------------------------------------------------------
-- | 'Show' a 'ByteString'
bshow :: Show a => a -> ByteString
bshow :: a -> ByteString
bshow = String -> ByteString
C8.pack (String -> ByteString) -> (a -> String) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | 'Show' some 'Text'
tshow :: Show a => a -> Text
tshow :: a -> Text
tshow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Drop the leading textual representation of a 'RedditKind' from a Reddit identifier,
-- or return the entire identifier if there is no prefix
dropTypePrefix :: RedditKind -> Text -> Parser Text
dropTypePrefix :: RedditKind -> Text -> Parser Text
dropTypePrefix RedditKind
ty Text
txt = case Text -> Text -> (Text, Text)
T.breakOn Text
"_" Text
txt of
    (Text
prefix, Text
ident)
        | Text
prefix Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== RedditKind -> Text
textKind RedditKind
ty -> Parser Text
-> ((Char, Text) -> Parser Text)
-> Maybe (Char, Text)
-> Parser Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser Text
forall a. Monoid a => a
mempty (Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text)
-> ((Char, Text) -> Text) -> (Char, Text) -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Text) -> Text
forall a b. (a, b) -> b
snd) (Text -> Maybe (Char, Text)
T.uncons Text
ident)
    (Text
ident, Text
"")     -> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
ident
    (Text, Text)
_               -> Parser Text
forall a. Monoid a => a
mempty

-- | Opposite of 'dropTypePrefix': joins the textual representation of a 'RedditKind'
-- to an identifier with an underscore
prependType :: RedditKind -> Text -> Text
prependType :: RedditKind -> Text -> Text
prependType RedditKind
ty Text
txt = RedditKind -> Text
textKind RedditKind
ty Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt

-- | Convert an 'Integer' to 'UTCTime'
integerToUTC :: Integer -> UTCTime
integerToUTC :: Integer -> UTCTime
integerToUTC = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Integer -> POSIXTime) -> Integer -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger

-- | Ensures that the @kind@ field of a JSON object corresponds to the
-- expected 'RedditKind' of the response and runs a parsing function on its
-- @data@ field
withKind :: FromJSON b
         => RedditKind
         -> [Char]
         -> (b -> Parser a)
         -> Value
         -> Parser a
withKind :: RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind RedditKind
ty String
name b -> Parser a
f = String -> (Object -> Parser a) -> Value -> Parser a
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
name ((Object -> Parser a) -> Value -> Parser a)
-> (Object -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ())
-> (RedditKind -> Bool) -> RedditKind -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RedditKind
ty RedditKind -> RedditKind -> Bool
forall a. Eq a => a -> a -> Bool
==) (RedditKind -> Parser ()) -> Parser RedditKind -> Parser ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser RedditKind
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"kind"
    b -> Parser a
f (b -> Parser a) -> Parser b -> Parser a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser b
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"data"

-- | Like 'withKind', but can be used in the exceptional circumstances that a
-- container of values have heterogeneous kinds
withKinds :: FromJSON b
          => [RedditKind]
          -> [Char]
          -> (b -> Parser a)
          -> Value
          -> Parser a
withKinds :: [RedditKind] -> String -> (b -> Parser a) -> Value -> Parser a
withKinds [RedditKind]
tys String
name b -> Parser a
f = String -> (Object -> Parser a) -> Value -> Parser a
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
name ((Object -> Parser a) -> Value -> Parser a)
-> (Object -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ())
-> (RedditKind -> Bool) -> RedditKind -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RedditKind -> [RedditKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RedditKind]
tys) (RedditKind -> Parser ()) -> Parser RedditKind -> Parser ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser RedditKind
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"kind"
    b -> Parser a
f (b -> Parser a) -> Parser b -> Parser a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser b
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"data"

-- | Convert a 'RedditKind' to its textual representation
textKind :: RedditKind -> Text
textKind :: RedditKind -> Text
textKind = \case
    RedditKind
CommentKind           -> Text
"t1"
    RedditKind
AccountKind           -> Text
"t2"
    RedditKind
SubmissionKind        -> Text
"t3"
    RedditKind
MessageKind           -> Text
"t4"
    RedditKind
SubredditKind         -> Text
"t5"
    RedditKind
AwardKind             -> Text
"t6"
    RedditKind
ListingKind           -> Text
"Listing"
    RedditKind
UserListKind          -> Text
"UserList"
    RedditKind
KarmaListKind         -> Text
"KarmaList"
    RedditKind
TrophyListKind        -> Text
"TrophyList"
    RedditKind
MoreKind              -> Text
"more"
    RedditKind
RelKind               -> Text
"rb"
    RedditKind
SubredditSettingsKind -> Text
"subreddit_settings"
    RedditKind
StylesheetKind        -> Text
"stylesheet"
    RedditKind
WikiPageKind          -> Text
"wikipage"
    RedditKind
WikiPageListingKind   -> Text
"wikipagelisting"
    RedditKind
WikiPageSettingsKind  -> Text
"wikipagesettings"
    RedditKind
LabeledMultiKind      -> Text
"LabeledMulti"
    RedditKind
ModActionKind         -> Text
"modaction"
    RedditKind
LiveThreadKind        -> Text
"LiveUpdateEvent"
    RedditKind
LiveUpdateKind        -> Text
"LiveUpdate"

-- | Parse the @edited@ field in comments or submissions, which can either be
-- @false@ or a Unix timestamp
editedP :: Value -> Parser (Maybe UTCTime)
editedP :: Value -> Parser (Maybe UTCTime)
editedP (Bool Bool
_)   = Maybe UTCTime -> Parser (Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UTCTime
forall a. Maybe a
Nothing
editedP (Number Scientific
n) =
    Maybe UTCTime -> Parser (Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UTCTime -> Parser (Maybe UTCTime))
-> Maybe UTCTime -> Parser (Maybe UTCTime)
forall a b. (a -> b) -> a -> b
$ Integer -> UTCTime
integerToUTC (Integer -> UTCTime) -> (Int -> Integer) -> Int -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> UTCTime) -> Maybe Int -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger @Int Scientific
n
editedP Value
_          = Parser (Maybe UTCTime)
forall a. Monoid a => a
mempty

-- | Verify that some name corresponds to specifiable Reddit naming rules
validateName :: (MonadThrow m, Coercible a Text)
             => Maybe [Char]
             -> Maybe (Int, Int)
             -> Text
             -> Text
             -> m a
validateName :: Maybe String -> Maybe (Int, Int) -> Text -> Text -> m a
validateName Maybe String
specialChars Maybe (Int, Int)
range Text
name Text
txt
    | (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange ((Int, Int) -> Maybe (Int, Int) -> (Int, Int)
forall a. a -> Maybe a -> a
fromMaybe (Int
3, Int
20) Maybe (Int, Int)
range) (Text -> Int
T.length Text
txt) --
        , (Char -> Bool) -> Text -> Bool
T.all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
allowedChars) Text
txt --
        = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Text -> a
coerce Text
txt
    | Bool
otherwise = ClientException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> m a)
-> (Text -> ClientException) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ClientException
OtherError
        (Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" may only consist of alphanumeric "
                  , Text
"characters, hyphens, and underscores, and must be "
                  , Text
"between 3 and 20 characters long"
                  ]
  where
    allowedChars :: String
allowedChars = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [ [ Char
'a' .. Char
'z' ]
                           , [ Char
'A' .. Char
'Z' ]
                           , [ Char
'0' .. Char
'9' ]
                           , String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe [ Char
'_', Char
'-' ] Maybe String
specialChars
                           ]

-- | Make a comma-separated sequence of query params
joinParams :: (Foldable t, ToHttpApiData a) => t a -> Text
joinParams :: t a -> Text
joinParams = Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> (t a -> [Text]) -> t a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam ([a] -> [Text]) -> (t a -> [a]) -> t a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

-- | Return @Nothing@ if a text field is empty
nothingTxtNull :: FromJSON a => Text -> Parser (Maybe a)
nothingTxtNull :: Text -> Parser (Maybe a)
nothingTxtNull = \case
    Text
t
        | Text -> Bool
T.null Text
t -> Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
        | Bool
otherwise -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
String Text
t)

-- | Encode a list of 'Pair's to strict 'Text'
textObject :: [Pair] -> Text
textObject :: [Pair] -> Text
textObject = Value -> Text
forall a. ToJSON a => a -> Text
textEncode (Value -> Text) -> ([Pair] -> Value) -> [Pair] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
object

-- | Encode a 'ToJSON' instance to strict 'Text'
textEncode :: ToJSON a => a -> Text
textEncode :: a -> Text
textEncode = Text -> Text
LT.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText

-- | Split a JSON identifier on \"_\"; if it matches the given type
-- prefix, returning the remaining text. Otherwise, return the
-- identifier whole if there is no remaining text
breakOnType :: (Coercible a Text) => Text -> Text -> Parser a
breakOnType :: Text -> Text -> Parser a
breakOnType Text
ty Text
t = case Text -> Text -> (Text, Text)
T.breakOn Text
"_" Text
t of
    (Text
prefix, Text
r)
        | Text
prefix Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ty -> Parser a
-> ((Char, Text) -> Parser a) -> Maybe (Char, Text) -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser a
forall a. Monoid a => a
mempty (a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Parser a) -> ((Char, Text) -> a) -> (Char, Text) -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> a
coerce (Text -> a) -> ((Char, Text) -> Text) -> (Char, Text) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Text) -> Text
forall a b. (a, b) -> b
snd) (Text -> Maybe (Char, Text)
T.uncons Text
r)
        | Text -> Bool
T.null Text
r -> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Parser a) -> a -> Parser a
forall a b. (a -> b) -> a -> b
$ Text -> a
coerce Text
prefix
        | Bool
otherwise -> Parser a
forall a. Monoid a => a
mempty

-- | Get all of the values from a 'HashMap' and place them in a 'Seq', discarding
-- the keys
getVals :: FromJSON b => HashMap Text Value -> Parser (Seq b)
getVals :: Object -> Parser (Seq b)
getVals = ([b] -> Seq b) -> Parser [b] -> Parser (Seq b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [b] -> Seq b
forall l. IsList l => [Item l] -> l
fromList (Parser [b] -> Parser (Seq b))
-> (Object -> Parser [b]) -> Object -> Parser (Seq b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair -> Parser b) -> [Pair] -> Parser [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser b) -> (Pair -> Value) -> Pair -> Parser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair -> Value
forall a b. (a, b) -> b
snd) ([Pair] -> Parser [b])
-> (Object -> [Pair]) -> Object -> Parser [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HM.toList

-- | Make a form from @[(Text, Text)]@ pairs
mkTextForm :: [(Text, Text)] -> Form
mkTextForm :: [(Text, Text)] -> Form
mkTextForm = ToForm [(Text, Text)] => [(Text, Text)] -> Form
forall a. ToForm a => a -> Form
toForm @[(Text, Text)]