{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# 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(..)
    , Username
    , pattern DeletedUser
    , mkUsername
    , usernameToDisplayName
    , isUserDeleted
    , CIText(CIText)
    , HKD
    , ItemOpts(..)
    , defaultItemOpts
    , ItemSort(..)
    , ItemReport(..)
    , Distinction(..)
    , Time(..)
    , ItemType(..)
    , UploadURL
    , SubredditType(..)
    , Body
    , Title
    , URL
    , Subject
    , RGBText
    , Name
    , Domain
    , Modifier
    , RawBody
      -- * Exceptions
    , RedditException
    , ClientException(..)
    , APIException(..)
    , OAauthError(..)
    , ErrorMessage(..)
    , StatusCode
    , StatusMessage(..)
    , POSTError(..)
    , BannedUser(..)
      -- * Utilities
    , dropTypePrefix
    , integerToUTC
    , withKind
    , textKind
    , prependType
    , bshow
    , tshow
    , editedP
    , validateName
    , joinParams
    , nothingTxtNull
    , textObject
    , textEncode
    , withKinds
    , breakOnType
    , breakOnTypeLenient
    , getVals
    , mkTextForm
    , fromOptional
    ) where

import           Conduit                      ( ConduitM )

import           Control.Applicative          ( Alternative((<|>)), optional )
import           Control.Exception            ( Exception(..), SomeException )
import           Control.Monad                ( guard )
import           Control.Monad.Catch          ( MonadThrow(throwM) )

import           Data.Aeson
                 ( (.:)
                 , (.:?)
                 , FromJSON(..)
                 , Object
                 , Options(constructorTagModifier)
                 , ToJSON(toJSON)
                 , Value(..)
                 , defaultOptions
                 , genericParseJSON
                 , genericToJSON
                 , object
                 , withArray
                 , withObject
                 , withText
                 )
import           Data.Aeson.Casing            ( snakeCase )
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, Item)
                                              )
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@
    | ModeratedListKind -- @ModeratedList@
    deriving stock ( Eq )

instance FromJSON RedditKind where
    parseJSON = withText "RedditKind" $ \case
        "t1" -> pure CommentKind
        "t2" -> pure AccountKind
        "t3" -> pure SubmissionKind
        "t4" -> pure MessageKind
        "t5" -> pure SubredditKind
        "t6" -> pure AwardKind
        "Listing" -> pure ListingKind
        "UserList" -> pure UserListKind
        "KarmaList" -> pure KarmaListKind
        "TrophyList" -> pure TrophyListKind
        "more" -> pure MoreKind
        "rb" -> pure RelKind
        "subreddit_settings" -> pure SubredditSettingsKind
        "stylesheet" -> pure StylesheetKind
        "wikipage" -> pure WikiPageKind
        "wikipagelisting" -> pure WikiPageListingKind
        "wikipagesettings" -> pure WikiPageSettingsKind
        "LabeledMulti" -> pure LabeledMultiKind
        "modaction" -> pure ModActionKind
        "LiveUpdateEvent" -> pure LiveThreadKind
        "LiveUpdate" -> pure LiveUpdateKind
        "ModeratedList" -> pure ModeratedListKind
        _ -> 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 ts = T.intercalate "," (fullname <$> F.toList ts)

-- | Certain API endpoints are @listings@, which can be paginated and filtered
-- using a 'Paginator'
data Listing t a = Listing
    { -- | Anchor of previous slice
      before   :: Maybe t
      -- | Anchor of next slice
    , after    :: Maybe t
      -- | The actual items returned in the response
    , children :: Seq a
    }
    deriving stock ( Show, Eq, Generic )

instance Ord t => Semigroup (Listing t a) where
    (Listing lb la lcs) <> (Listing rb ra rcs) =
        Listing (max lb rb) (min la ra) (lcs <> rcs)

instance Ord t => Monoid (Listing t a) where
    mappend = (<>)

    mempty = Listing Nothing Nothing mempty

instance (FromJSON a, FromJSON t) => FromJSON (Listing t a) where
    parseJSON = withKind ListingKind "Listing" $ \o ->
        Listing <$> o .:? "before" <*> o .:? "after" <*> o .: "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 _ = mempty

    -- | Convert the 'PaginateOptions' options to a 'Form'
    optsToForm :: PaginateOptions a -> Form
    default optsToForm
        :: ToForm (PaginateOptions a) => PaginateOptions a -> Form
    optsToForm = 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
      before   :: Maybe t
    , after    :: Maybe t
      -- | The maximum number of items to return in an individual slice. Defaults
      -- to 25, with a maximum of 100
    , 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
    , showAll  :: Bool
      -- | Whether or not to expand subreddits
    , srDetail :: Bool
      -- | Additional options, depending on the type parameter @a@
    , opts     :: PaginateOptions a
    }
    deriving stock ( 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 { .. } = commonOpts <> optsToForm @a opts
      where
        commonOpts = mkTextForm
            $ [ ("limit", tshow limit) ]
            <> catMaybes [ ("show", ) <$> bool Nothing (Just "given") showAll
                         , (("after", ) . fullname <$> after)
                           <|> (("before", ) . fullname <$> 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 = 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
    (==) = (==) `on` T.toCaseFold . 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
data ItemOpts = ItemOpts
    { itemSort :: Maybe ItemSort
    , itemType :: Maybe ItemType
    , 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
    , context  :: Maybe Word
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm ItemOpts where
    toForm ItemOpts { .. } = fromList
        $ catMaybes [ ("sort", ) . toQueryParam <$> itemSort
                    , ("type", ) . toQueryParam <$> itemType
                    , ("t", ) . toQueryParam <$> itemTime
                    , ("context", ) . toQueryParam <$> context
                    ]

-- | Defaults for fetching items, like comments or submissions
defaultItemOpts :: ItemOpts
defaultItemOpts = ItemOpts
    { itemSort = Nothing
    , itemType = Nothing
    , itemTime = Nothing
    , context  = 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 ( Show, Eq, Generic )

instance FromJSON ItemSort where
    parseJSON = genericParseJSON --
        defaultOptions { constructorTagModifier = fmap toLower }

instance ToJSON ItemSort where
    toJSON = genericToJSON --
        defaultOptions { constructorTagModifier = fmap toLower }

instance ToHttpApiData ItemSort where
    toQueryParam = showTextData

-- | Type of comments, for filtering in 'Listing's
data ItemType
    = Comments
    | Submissions
    deriving stock ( Show, Eq, Generic )

-- | A user- or moderator-generated report on a submission
data ItemReport = ItemReport
    { -- | The textual report reason\/description
      reason :: Text
    , count  :: Word
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON ItemReport where
    -- Reports are sent as variable-length, heterogeneous arrays
    parseJSON = withArray "ItemReport" $ \a -> case toList a of
        report : count : _ ->
            ItemReport <$> parseJSON report <*> parseJSON count
        _                  -> mempty

instance ToHttpApiData ItemType where
    toQueryParam = \case
        Comments    -> "comments"
        Submissions -> "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 ( Show, Eq, Generic )

instance FromJSON Distinction where
    parseJSON = withText "Distinction" $ \case
        "moderator" -> pure Moderator
        "admin"     -> pure Admin
        "special"   -> pure Special
        _           -> mempty

instance ToHttpApiData Distinction where
    toQueryParam = \case
        Moderator       -> "yes"
        Undistinguished -> "no"
        d               -> showTextData d

-- | Time range when fetching comments or submissions
data Time
    = Hour
    | Day
    | Week
    | Month
    | Year
    | AllTime
    deriving stock ( Show, Eq, Generic )

instance ToHttpApiData Time where
    toQueryParam = \case
        AllTime -> "all"
        t       -> showTextData 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 ( Show, Generic )
    deriving newtype ( Eq, FromJSON, ToJSON, ToHttpApiData )

-- | The privacy level for the subreddit
data SubredditType
    = Public
    | Restricted
    | Private
    | Archived
    | GoldRestricted
    | EmployeesOnly
    | GoldOnly
    | UserSubreddit
    deriving stock ( Show, Eq, Generic )

instance FromJSON SubredditType where
    parseJSON = genericParseJSON --
        defaultOptions { constructorTagModifier }
      where
        constructorTagModifier = \case
            "UserSubreddit" -> "user"
            s               -> snakeCase s

instance ToHttpApiData SubredditType where
    toQueryParam = showTextData

-- | Reddit username
newtype Username = Username Text
    deriving stock ( Show, Generic )
    deriving newtype ( FromJSON, ToJSON, ToHttpApiData )
    deriving ( Eq ) via CIText Username

-- | Smart constructor for 'Username', which must be between 3 and 20 chars,
-- and may only include upper\/lowercase alphanumeric chars, underscores, or
-- hyphens
mkUsername :: MonadThrow m => Text -> m Username
mkUsername = validateName Nothing Nothing "Username"

-- | Prefix the username with \"u_\"
usernameToDisplayName :: Username -> Text
usernameToDisplayName (Username uname) = "u_" <> uname

-- | Pattern for \"[deleted]\" username
pattern DeletedUser :: Username
pattern DeletedUser = Username "[deleted]"

-- | Test if a user has the \"[deleted]\" username. Also see the 'DeletedUser'
-- pattern synonym
isUserDeleted :: Username -> Bool
isUserDeleted = \case
    DeletedUser -> True
    _           -> False

-- | 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 e) = show 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 ( Eq, Show, Generic )

instance Exception ClientException where
    toException = redditExToException

    fromException = redditExFromException

-- | Exceptions returned from API endpoints
data APIException
    = ErrorWithStatus StatusMessage
    | ErrorWithMessage ErrorMessage
    | InvalidCredentials OAauthError
    | InvalidPOST POSTError
      -- ^ 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
    | UserIsBanned BannedUser
      -- ^ Thrown when attempting to get account information on a banned
      -- user
    | WebsocketError Text SomeException
      -- ^ Thrown when exceptions occur during websocket handling
    | UploadFailed
      -- ^ When an error occurs uploading media to Reddit\'s servers
    deriving stock ( Show, Generic )

instance Exception APIException where
    toException = redditExToException

    fromException = redditExFromException

instance FromJSON APIException where
    parseJSON = withObject "APIException" $ \(Object -> o) ->
        asum [ ErrorWithStatus <$> parseJSON o
             , ErrorWithMessage <$> parseJSON o
             , InvalidPOST <$> parseJSON o
             , InvalidCredentials <$> parseJSON o
             , UserIsBanned <$> parseJSON o
             ]

-- | An error which occurs when attempting to authenticate via OAuth
data OAauthError = OAauthError
    { -- | The type of the error, e.g. \"invalid_grant\"
      errorType   :: Text
      -- | This field may be absent. If it exists, it describes
      -- the error
    , description :: Maybe Text
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON OAauthError where
    parseJSON = withObject "OAauthError"
        $ \o -> OAauthError <$> o .: "error" <*> o .:? "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
    | InsufficientCoins
    deriving stock ( Show, Eq, Generic )

instance FromJSON ErrorMessage where
    parseJSON = withObject "ErrorMessage" $ \o ->
        msgP o =<< (.: "errors") =<< (o .: "json")
      where
        msgP o = withArray "[[Value]]" $ \a -> case toList a of
            v : _ -> msgsP v
            []    -> pure EmptyError
          where
            msgsP = withArray "[Value]" $ \a -> case toList a of
                "RATELIMIT" : String msg : _ -> Ratelimited
                    <$> fmap (round @Double)
                             ((.: "ratelimit") =<< o .: "json")
                    <*> pure msg
                "COMMENT_DELETED" : _ -> pure CommentDeleted
                "BAD_SR_NAME" : _ -> pure BadSRName
                "SUBREDDIT_REQUIRED" : _ -> pure SubredditRequired
                "SUBREDDIT_NOEXIST" : _ -> pure SubredditNotExists
                "ALREADY_SUB" : _ -> pure AlreadySubmitted
                "NO_URL " : _ -> pure NoURL
                "NO_TEXT" : _ -> pure NoText
                "NO_NAME" : _ -> pure NoName
                "BAD_CAPTCHA" : _ -> pure BadCaptcha
                "TOO_SHORT" : _ -> pure TooShort
                "USER_REQUIRED" : _ -> pure UserRequired
                "INSUFFICIENT_COINS_WITH_AMOUNT" : _ -> pure InsufficientCoins
                v -> pure $ OtherErrorMessage v

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

-- | Details about a non-200 HTTP response
data StatusMessage =
    StatusMessage { statusCode :: StatusCode, message :: Text }
    deriving stock ( Eq, Show, Generic )

instance FromJSON StatusMessage where
    parseJSON = withObject "StatusMessage" $ \o ->
        StatusMessage <$> (o .: "error") <*> (o .: "message")

-- | Details about a non-200 response when sending a POST request
data POSTError = POSTError
    { -- | The fields of the JSON object containing errors (only if
      -- JSON was posted)
      fields      :: [Text]
    , explanation :: Text
    , message     :: Text
    , reason      :: Text
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON POSTError where
    parseJSON = withObject "POSTError" $ \o -> POSTError
        <$> fromOptional o "fields"
        <*> o .: "explanation"
        <*> o .: "message"
        <*> o .: "reason"

-- | Information about a banned user
data BannedUser = BannedUser
    { name        :: Username
    , totalKarma  :: Integer
      -- | Presumably, this should always be @True@. Reddit includes
      -- it in the JSON response nonetheless
    , isSuspended :: Bool
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON BannedUser where
    parseJSON = withKind AccountKind "BannedUser" $ \o -> BannedUser
        <$> o .: "name"
        <*> o .: "total_karma"
        <*> o .: "is_suspended"

redditExToException :: Exception e => e -> SomeException
redditExToException = toException . RedditException

redditExFromException :: Exception e => SomeException -> Maybe e
redditExFromException x = do
    RedditException a <- fromException x
    cast a

--Utilities--------------------------------------------------------------------
-- | 'Show' a 'ByteString'
bshow :: Show a => a -> ByteString
bshow = C8.pack . show

-- | 'Show' some 'Text'
tshow :: Show a => a -> Text
tshow = T.pack . 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 ty txt = case T.breakOn "_" txt of
    (prefix, ident)
        | prefix == textKind ty -> maybe mempty (pure . snd) (T.uncons ident)
    (ident, "")     -> pure ident
    _               -> mempty

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

-- | Convert an 'Integer' to 'UTCTime'
integerToUTC :: Integer -> UTCTime
integerToUTC = posixSecondsToUTCTime . 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 ty name f = withObject name $ \o -> do
    guard . (ty ==) =<< o .: "kind"
    f =<< o .: "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 tys name f = withObject name $ \o -> do
    guard . (`elem` tys) =<< o .: "kind"
    f =<< o .: "data"

-- | Convert a 'RedditKind' to its textual representation
textKind :: RedditKind -> Text
textKind = \case
    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"
    ModeratedListKind     -> "ModeratedList"

-- | Parse the @edited@ field in comments or submissions, which can either be
-- @false@ or a Unix timestamp
editedP :: Value -> Parser (Maybe UTCTime)
editedP (Bool _)   = pure Nothing
editedP (Number n) =
    pure $ integerToUTC . toInteger <$> toBoundedInteger @Int n
editedP _          = 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 specialChars range name txt
    | inRange (fromMaybe (3, 20) range) (T.length txt) --
        , T.all (`elem` allowedChars) txt --
        = pure $ coerce txt
    | otherwise = throwM . OtherError
        $ mconcat [ name <> " may only consist of alphanumeric "
                  , "characters, hyphens, and underscores, and must be "
                  , "between 3 and 20 characters long"
                  ]
  where
    allowedChars = mconcat [ [ 'a' .. 'z' ]
                           , [ 'A' .. 'Z' ]
                           , [ '0' .. '9' ]
                           , fromMaybe [ '_', '-' ] specialChars
                           ]

-- | Make a comma-separated sequence of query params
joinParams :: (Foldable t, ToHttpApiData a) => t a -> Text
joinParams = T.intercalate "," . fmap toQueryParam . F.toList

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

-- | Encode a list of 'Pair's to strict 'Text'
textObject :: [Pair] -> Text
textObject = textEncode . object

-- | Encode a 'ToJSON' instance to strict 'Text'
textEncode :: ToJSON a => a -> Text
textEncode = LT.toStrict . 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 ty t = case T.breakOn "_" t of
    (prefix, r)
        | prefix == ty -> maybe mempty (pure . coerce . snd) (T.uncons r)
        | T.null r -> pure $ coerce prefix
        | otherwise -> mempty

-- | Split a JSON identifier on \"_\"; if it matches the given type
-- prefix, returning the remaining text. If there are no matches, return
-- the text whole. This is useful if Reddit does not consistently prefix
-- values with the type identifier
breakOnTypeLenient :: (Coercible a Text) => Text -> Text -> Parser a
breakOnTypeLenient ty t = asum [ breakOnType ty t, pure $ coerce t ]

-- | 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 = fmap fromList . traverse (parseJSON . snd) . HM.toList

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

-- Parses a container of values that may be missing from the JSON, in which case
-- it returns @mempty@ as a default value
fromOptional
    :: (FromJSON (Item b), IsList b, Monoid b) => Object -> Text -> Parser b
fromOptional o fld = maybe mempty fromList <$> optional (o .: fld)