{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      : Network.Reddit.Types.Submission
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Submission
    ( Submission(..)
    , SubmissionID(SubmissionID)
    , SubmissionContent(..)
    , submissionP
    , PollData(..)
    , PollOption(..)
    , PollOptionID
      -- * Collections
    , Collection(..)
    , CollectionLayout(..)
    , CollectionID
    , NewCollection(..)
      -- * Creating submissions
    , SubmissionOptions(..)
    , mkSubmissionOptions
    , NewSubmission(..)
    , S3UploadLease(..)
    , UploadType(..)
    , UploadResult(..)
    , CrosspostOptions(..)
    , mkCrosspostOptions
    , PostedCrosspost
    , Poll(..)
    , PollSubmission(PollSubmission)
    , mkPoll
    , GalleryImage(..)
    , mkGalleryImage
    , galleryImageToUpload
    , GallerySubmission(GallerySubmission)
    , InlineMedia(..)
    , InlineMediaType(..)
    , InlineMediaUpload(..)
    , inlineMediaToUpload
    , writeInlineMedia
    , Fancypants
    , PostedSubmission
      -- * Search
    , Search(..)
    , SearchSort(..)
    , SearchCategory
    , mkSearchCategory
    , SearchOpts(..)
    , ResultID(ResultID)
    , SearchSyntax(..)
    , mkSearch
    ) where

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

import           Data.Aeson
                 ( (.:)
                 , (.:?)
                 , FromJSON(..)
                 , KeyValue((.=))
                 , Object
                 , Options(..)
                 , ToJSON(toJSON)
                 , defaultOptions
                 , genericParseJSON
                 , genericToJSON
                 , object
                 , withArray
                 , withObject
                 , withText
                 )
import           Data.Aeson.Casing              ( snakeCase )
import           Data.Aeson.Types               ( Parser )
import           Data.Bool                      ( bool )
import           Data.Char                      ( toUpper )
import           Data.Coerce                    ( coerce )
import           Data.Foldable                  ( asum )
import qualified Data.Foldable                  as F
import           Data.Generics.Wrapped          ( wrappedTo )
import qualified Data.HashMap.Strict            as HM
import           Data.HashMap.Strict            ( HashMap )
import           Data.Ix                        ( Ix(inRange) )
import           Data.Maybe
                 ( catMaybes
                 , fromMaybe
                 , isJust
                 )
import           Data.Sequence                  ( Seq )
import           Data.Text                      ( Text )
import qualified Data.Text                      as T
import           Data.Time                      ( UTCTime )

import           GHC.Exts                       ( IsList(..) )
import           GHC.Generics                   ( Generic )

import           Network.Reddit.Types.Award
import           Network.Reddit.Types.Flair
import           Network.Reddit.Types.Internal
import           Network.Reddit.Types.Subreddit

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

-- | Unique, site-wide ID for a 'Submission'
newtype SubmissionID = SubmissionID Text
    deriving stock ( Show, Generic )
    deriving newtype ( Eq, ToHttpApiData )

instance FromJSON SubmissionID where
    parseJSON =
        withText "SubmissionID" (coerce . dropTypePrefix SubmissionKind)

instance Thing SubmissionID where
    fullname (SubmissionID sid) = prependType SubmissionKind sid

-- | A submitted self-text post or link
data Submission = Submission
    { submissionID  :: SubmissionID
    , title         :: Title
    , author        :: Username
    , content       :: SubmissionContent
    , subreddit     :: SubredditName
    , created       :: UTCTime
    , edited        :: Maybe UTCTime
    , permalink     :: URL
    , domain        :: Domain
    , numComments   :: Integer
    , score         :: Integer
    , ups           :: Maybe Integer
    , downs         :: Maybe Integer
    , upvoteRatio   :: Maybe Rational
    , gilded        :: Integer
    , userReports   :: Seq ItemReport
    , modReports    :: Seq ItemReport
    , numReports    :: Maybe Integer
    , distinguished :: Maybe Distinction
    , isOC          :: Bool
    , clicked       :: Bool
    , over18        :: Bool
    , locked        :: Bool
    , spoiler       :: Bool
    , pollData      :: Maybe PollData
    , allAwardings  :: Seq Awarding
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON Submission where
    parseJSON = withKind SubmissionKind "Submission" submissionP

-- | Parse a 'Submission'
submissionP :: Object -> Parser Submission
submissionP o = do
    submissionID <- o .: "id"
    title <- o .: "title"
    author <- o .: "author"
    subreddit <- o .: "subreddit"
    created <- integerToUTC <$> o .: "created_utc"
    edited <- editedP =<< (o .: "edited")
    score <- o .: "score"
    ups <- o .:? "ups"
    downs <- o .:? "downs"
    content <- contentP o
    permalink <- o .: "permalink"
    numComments <- o .: "num_comments"
    gilded <- o .: "gilded"
    upvoteRatio <- o .:? "upvote_ratio"
    isOC <- o .: "is_original_content"
    clicked <- o .: "clicked"
    over18 <- o .: "over_18"
    locked <- o .: "locked"
    spoiler <- o .: "spoiler"
    userReports <- o .: "user_reports"
    modReports <- o .: "mod_reports"
    numReports <- o .:? "num_reports"
    distinguished <- o .:? "distinguished"
    pollData <- o .:? "poll_data"
    domain <- o .: "domain"
    allAwardings <- o .: "all_awardings"
    pure Submission { .. }
  where
    contentP v = (v .: "is_self") >>= \case
        False -> asum [ ExternalLink <$> v .: "url", pure EmptySubmission ]
        True  -> asum [ SelfText <$> v .: "selftext" <*> v .: "selftext_html"
                      , pure EmptySubmission
                      ]

instance Paginable Submission where
    type PaginateOptions Submission = ItemOpts

    type PaginateThing Submission = SubmissionID

    defaultOpts = defaultItemOpts

    getFullname Submission { submissionID } = submissionID

-- | The contents of the 'Submission'. Can be a self-post with a plaintext and
-- HTML body, an external link, or entirely empty
data SubmissionContent
    = SelfText Body Body
    | ExternalLink URL
    | EmptySubmission
    deriving stock ( Show, Eq, Generic )

-- | Data from an existing submission containing a poll. See 'Poll' for
-- submitting a new post with a poll
data PollData = PollData
    { options        :: Seq PollOption
      -- | Total number of votes cast for the poll
    , totalVoteCount :: Integer
      -- | Voting end date for the poll
    , votingEnds     :: UTCTime
      -- | The option selected by the authenticated user, if any
    , userSelection  :: Maybe PollOptionID
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON PollData where
    parseJSON = withObject "PollData" $ \o -> PollData <$> o .: "options"
        <*> o .: "total_vote_count"
        <*> (integerToUTC <$> o .: "voting_end_timestamp")
        <*> o .:? "user_selection"

-- | Single option in existing 'PollData'
data PollOption = PollOption
    { pollOptionID :: PollOptionID
    , text         :: Body
      -- | The total number of votes received thus far
    , voteCount    :: Integer
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON PollOption where
    parseJSON = genericParseJSON defaultOptions { fieldLabelModifier }
      where
        fieldLabelModifier = \case
            "pollOptionID" -> "id"
            s              -> snakeCase s

-- | Identifier for a 'PollOption'
type PollOptionID = Text

-- | Represents a Reddit collection
data Collection = Collection
    { collectionID :: CollectionID
    , author       :: Username
    , title        :: Title
    , subredditID  :: SubredditID
    , description  :: Body
    , permalink    :: URL
    , created      :: UTCTime
    , lastUpdated  :: UTCTime
    , linkIDs      :: Seq SubmissionID
      -- | These are the 'Submission's that correspond to
      -- the IDs in the @linkIDs@ fields. This field may
      -- be empty, depending on how the 'Collection' was
      -- obtained. Fetching all of the collections belonging
      -- to a subreddit will not include it, whereas fetching
      -- an individual collection by ID will
    , sortedLinks  :: Seq Submission
    , layout       :: Maybe CollectionLayout
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON Collection where
    parseJSON = withObject "Collection" $ \o -> Collection
        <$> o .: "collection_id"
        <*> o .: "author_name"
        <*> o .: "title"
        <*> o .: "subreddit_id"
        <*> o .: "description"
        <*> o .: "permalink"
        <*> (doubleToUTC <$> o .: "created_at_utc")
        <*> (doubleToUTC <$> o .: "last_update_utc")
        <*> o .: "link_ids"
        <*> (linksP =<< o .:? "sorted_links")
        <*> o .:? "display_layout"
      where
        linksP      = \case
            Nothing -> pure mempty
            Just (Listing { children } :: Listing () Submission) ->
                pure children

        doubleToUTC = integerToUTC . round @Double

-- | The layout of the 'Collection' on the redesigned site
data CollectionLayout
    = Gallery
    | Timeline
    deriving stock ( Show, Eq, Generic )

instance FromJSON CollectionLayout where
    parseJSON = genericParseJSON --
        defaultOptions { constructorTagModifier = fmap toUpper }

instance ToHttpApiData CollectionLayout where
    toQueryParam = T.toUpper . showTextData

-- | A UUID identifier for a 'Collection'
type CollectionID = Text

-- | Data to create a new 'Collection' as a moderator action
data NewCollection = NewCollection
    { title       :: Title
    , description :: Body
    , subredditID :: SubredditID
    , layout      :: Maybe CollectionLayout
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm NewCollection where
    toForm NewCollection { .. } = fromList
        $ [ ("title", title)
          , ("description", description)
          , ("sr_fullname", fullname subredditID)
          ]
        <> foldMap pure (("display_layout", ) . toQueryParam <$> layout)

-- | Components to create a new submission
data SubmissionOptions = SubmissionOptions
    { -- | Should be <= 300 characters in length
      title        :: Title
    , subreddit    :: SubredditName
    , nsfw         :: Bool
    , sendreplies  :: Bool
    , resubmit     :: Bool
    , spoiler      :: Bool
      -- | The UUID of an existing 'Collection' to which to add
      -- the new submission
    , collectionID :: Maybe CollectionID
    , flairID      :: Maybe FlairID
      -- |
      -- If this is chosen, two conditions must be met that are not
      -- currently enforced by this library:
      --    * The @flairID@ field above must also be provided
      --    * The @textEditable@ field of the associated 'FlairTemplate'
      --      must also be @True@
    , flairText    :: Maybe FlairText
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm SubmissionOptions where
    toForm SubmissionOptions { .. } = fromList
        $ [ ("sr", wrappedTo subreddit)
          , ("title", title)
          , ("nsfw", toQueryParam nsfw)
          , ("spoiler", toQueryParam spoiler)
          , ("sendreplies", toQueryParam sendreplies)
          , ("resubmit", toQueryParam resubmit)
          , ("extension", "json")
          , ("api_type", "json")
          ]
        <> catMaybes [ ("collection_id", ) <$> collectionID
                     , ("flair_id", ) <$> flairID
                     , ("flair_text", ) . toQueryParam <$> flairText
                     ]

-- | The type of 'SubmissionOptions' to submit to Reddit. In general, this
-- should not be used directly. See instead the various @submit@ actions
-- in "Network.Reddit.Submission"
data NewSubmission
    = SelfPost Body SubmissionOptions
    | WithInlineMedia Fancypants SubmissionOptions
      -- ^ The body should be generated using 'InlineMedia' and converted to
      -- \"fancypants\" style markdown. Please see
      -- 'Network.Reddit.Actions.Submission.submitWithInlineMedia', which
      -- handles this
    | Link URL SubmissionOptions
    | ImagePost UploadURL SubmissionOptions
      -- ^ Please see 'Network.Reddit.Actions.Submission.submitImage' in order
      -- to create an image submission. The URL must point to a valid image
      -- hosted by Reddit
    | VideoPost UploadURL UploadURL Bool SubmissionOptions
      -- ^ See the note for 'ImagePost' about 'UploadURL's. The @Bool@ argument
      -- specifies if this is \"videogif\" media. The second 'UploadURL' points
      -- to a Reddit-hosted thumbnail image
    deriving stock ( Show, Eq, Generic )

instance ToForm NewSubmission where
    toForm = \case
        SelfPost body os ->
            fromList [ ("kind", "self"), ("text", body) ] <> toForm os
        WithInlineMedia body os ->
            fromList [ ("kind", "self"), ("richtext_json", textEncode body) ]
            <> toForm os
        Link url os ->
            fromList [ ("kind", "link"), ("url", url) ] <> toForm os
        ImagePost url os ->
            fromList [ ("kind", "image"), ("url", toQueryParam url) ]
            <> toForm os
        VideoPost url thmb videogif os ->
            fromList [ ("kind", bool "video" "videogif" videogif)
                     , ("url", toQueryParam url)
                     , ("video_poster_url", toQueryParam thmb)
                     ]
            <> toForm os

-- | Create a 'SubmissionOptions' with default values for most fields
mkSubmissionOptions :: SubredditName -> Title -> SubmissionOptions
mkSubmissionOptions subreddit title = SubmissionOptions
    { nsfw         = False
    , sendreplies  = True
    , resubmit     = True
    , spoiler      = False
    , collectionID = Nothing
    , flairID      = Nothing
    , flairText    = Nothing
    , ..
    }

-- | Used to upload style assets and images to Reddit\'s servers when
-- submitting content
data S3UploadLease = S3UploadLease
    { action       :: URL
      -- | S3 metadata and headers
    , fields       :: HashMap Text Text
      -- | This is required to get the final upload URL
    , key          :: Text
    , websocketURL :: URL
    , assetID      :: UploadURL
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON S3UploadLease where
    parseJSON = withObject "S3UploadLease" $ \o -> do
        lease <- o .: "args"
        -- The protocol isn't included, for some reason
        action <- ("https:" <>) <$> lease .: "action"
        fields <- fieldsP =<< lease .: "fields"
        key <- maybe (fail "Missing key") pure $ HM.lookup "key" fields
        websocketURL <- (.: "websocket_url") =<< o .: "asset"
        assetID <- (.: "asset_id") =<< o .: "asset"
        pure S3UploadLease { .. }
      where
        fieldsP = withArray "S3UploadLease.fields"
            $ fmap HM.fromList . traverse fieldP . toList

        fieldP  = withObject "S3UploadLease.fields.field"
            $ \o -> (,) <$> o .: "name" <*> o .: "value"

-- | Used to distinguish upload types when creating submissions with media
data UploadType
    = SelfPostUpload
    | LinkUpload
    | GalleryUpload
    deriving stock ( Show, Eq, Generic )

-- | Result issued from a websocket connection after uploading media
data UploadResult = UploadResult { resultType :: Text, redirectURL :: URL }
    deriving stock ( Show, Eq, Generic )

instance FromJSON UploadResult where
    parseJSON = withObject "UploadResult" $ \o -> UploadResult <$> o .: "type"
        <*> ((.: "redirect") =<< o .: "payload")

-- | Options for crossposting a submission
data CrosspostOptions = CrosspostOptions
    { subreddit   :: SubredditName
    , title       :: Title
    , nsfw        :: Bool
    , sendreplies :: Bool
    , spoiler     :: Bool
    , flairID     :: Maybe FlairID
      -- |
      -- If this is chosen, two conditions must be met that are not
      -- currently enforced by this library:
      --    * The @flairID@ field above must also be provided
      --    * The @textEditable@ field of the associated 'FlairTemplate'
      --      must also be @True@
    , flairText   :: Maybe FlairText
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm CrosspostOptions where
    toForm CrosspostOptions { .. } = fromList
        $ [ ("sr", wrappedTo subreddit)
          , ("title", title)
          , ("nsfw", toQueryParam nsfw)
          , ("spoiler", toQueryParam spoiler)
          , ("sendreplies", toQueryParam sendreplies)
          , ("kind", "crosspost")
          , ("api_type", "json")
          ]
        <> catMaybes [ ("flair_id", ) <$> flairID
                     , ("flair_text", ) . toQueryParam <$> flairText
                     ]

-- | Wrapper for getting the submission ID after completing a crosspost
newtype PostedCrosspost = PostedCrosspost SubmissionID
    deriving stock ( Show, Generic )

instance FromJSON PostedCrosspost where
    parseJSON = withObject "PostedLiveThread"
        $ fmap PostedCrosspost . ((.: "id") <=< (.: "data") <=< (.: "json"))

-- | 'CrosspostOptions' with default values for most fields
mkCrosspostOptions :: SubredditName -> Title -> CrosspostOptions
mkCrosspostOptions subreddit title = CrosspostOptions
    { nsfw        = False
    , sendreplies = True
    , spoiler     = False
    , flairID     = Nothing
    , flairText   = Nothing
    , ..
    }

-- | A Reddit poll. See 'mkPoll' to create a new one satisfying Reddit
-- constraints on poll options and duration
data Poll t = Poll
    { -- | Between 2 and 6 total options
      options  :: t Text
      -- | The number of days for the poll to run
    , duration :: Word
      -- | Optional self text for the body of the submission
    , selftext :: Maybe Body
    }
    deriving stock ( Generic )

deriving stock instance (Show (t Text)) => Show (Poll t)

deriving stock instance (Eq (t Text)) => Eq (Poll t)

-- | Wrapper providing a single 'ToJSON' instance for 'Poll's and
-- 'SubmissionOptions's together
data PollSubmission t = PollSubmission (Poll t) SubmissionOptions
    deriving stock ( Generic )

instance Foldable t => ToJSON (PollSubmission t) where
    toJSON (PollSubmission Poll { .. } SubmissionOptions { .. }) =
        object [ "sr" .= subreddit
               , "title" .= title
               , "resubmit" .= resubmit
               , "sendreplies" .= sendreplies
               , "nsfw" .= nsfw
               , "spoiler" .= spoiler
               , "options" .= F.toList options
               , "duration" .= duration
               , "text" .= fromMaybe mempty selftext
               ]

-- | Create a new 'Poll', validating the following constraints:
--      * The @duration@ is between 1 and 7
--      * The number of @options@ is between 2 and 6
mkPoll :: (Foldable t, MonadThrow m) => t Text -> Word -> m (Poll t)
mkPoll options duration
    | not $ inRange (1, 7) duration =
        throwM $ OtherError "mkPoll: duration must be between 1 and 7"
    | not . inRange (2, 6) $ length options = throwM
        $ OtherError "mkPoll: number of options must be between 2 and 6"
    | otherwise = pure $ Poll { selftext = Nothing, .. }

-- | A single image in a gallery submission
data GalleryImage = GalleryImage
    { imagePath   :: FilePath
      -- | Optional caption
    , caption     :: Maybe Body
      -- | Optional outbound URL
    , outboundURL :: Maybe URL
    }
    deriving stock ( Show, Eq, Generic )

-- | Create a 'GalleryImage' with default values for the @caption@ and
-- @outboundURL@ fields
mkGalleryImage :: FilePath -> GalleryImage
mkGalleryImage imagePath =
    GalleryImage { caption = Nothing, outboundURL = Nothing, .. }

-- | As a 'GalleryImage', but after obtaining the URL for the Reddit-hosted
-- image
data GalleryUploadImage = GalleryUploadImage
    { caption     :: Body
    , outboundURL :: URL
      -- | Points to Reddit-hosted image
    , mediaID     :: UploadURL
    }
    deriving stock ( Generic )

instance ToJSON GalleryUploadImage where
    toJSON = genericToJSON defaultOptions { fieldLabelModifier }
      where
        fieldLabelModifier = \case
            "mediaID"     -> "media_id"
            "outboundURL" -> "outbound_url"
            s             -> s

-- | Convert a 'GalleryImage' to to 'GalleryUploadImage' after obtaining the
-- 'UploadURL'
galleryImageToUpload :: GalleryImage -> UploadURL -> GalleryUploadImage
galleryImageToUpload GalleryImage { .. } mediaID = GalleryUploadImage
    { caption     = fromMaybe mempty caption
    , outboundURL = fromMaybe mempty outboundURL
    , ..
    }

-- | Wrapper providing a single 'ToJSON' instance for a container of
-- 'GalleryUploadImage's and 'SubmissionOptions's together
data GallerySubmission t =
    GallerySubmission (t GalleryUploadImage) SubmissionOptions
    deriving stock ( Generic )

instance Foldable t => ToJSON (GallerySubmission t) where
    toJSON (GallerySubmission items SubmissionOptions { .. }) =
        object [ "sr" .= subreddit
               , "title" .= title
               , "sendreplies" .= sendreplies
               , "nsfw" .= nsfw
               , "spoiler" .= spoiler
               , "items" .= F.toList items
               , "show_error_list" .= True
               , "api_type" .= ("json" :: Text)
               ]

-- | A piece of inline media that can be added to a self-text post
data InlineMedia = InlineMedia
    { mediaType :: InlineMediaType
      -- | The path must be valid and the file type must correspond
      -- to the provided @mediaType@ field
    , mediaPath :: FilePath
      -- | This corresponds to a placeholder in the self-text of the
      -- submission. This will be filled in with generated markdown.
      -- If the key is absent from the text, the inline media will
      -- not be included in the final body. See
      -- 'Network.Reddit.Actions.Submission.submitWithInlineMedia'
      -- for more details
    , key       :: Text
      -- | Optional caption for the media
    , caption   :: Maybe Body
    }
    deriving stock ( Show, Eq, Generic )

-- | The type of inline media
data InlineMediaType
    = InlineImage
    | InlineGIF
    | InlineVideo
    deriving stock ( Show, Eq, Generic )

instance ToHttpApiData InlineMediaType where
    toQueryParam = \case
        InlineImage -> "img"
        InlineGIF   -> "gif"
        InlineVideo -> "video"

-- | As an 'InlineMedia', but after obtaining the URL for the Reddit-hosted
-- image
data InlineMediaUpload = InlineMediaUpload
    { mediaType :: InlineMediaType
    , mediaID   :: UploadURL --
    , caption   :: Body
    , key       :: Text
    }
    deriving stock ( Show, Eq, Generic )

-- | Convert an 'InlineMedia' to 'InlineMediaUpload' after obtaining the
-- 'UploadURL'
inlineMediaToUpload :: InlineMedia -> UploadURL -> InlineMediaUpload
inlineMediaToUpload InlineMedia { .. } mediaID =
    InlineMediaUpload { caption = fromMaybe mempty caption, .. }

-- | Write an 'InlineMediaUpload' in markdown format
writeInlineMedia :: InlineMediaUpload -> Body
writeInlineMedia InlineMediaUpload { .. } =
    mconcat [ "\n\n"
            , "!["
            , toQueryParam mediaType
            , "]"
            , "("
            , toQueryParam mediaID
            , " "
            , "\""
            , caption
            , "\""
            , ")"
            , "\n\n"
            ]

-- | Represents richtext JSON object. This should be generated through an
-- API endpoint
newtype Fancypants = Fancypants Object
    deriving stock ( Show, Generic )
    deriving newtype ( Eq, ToJSON )

instance FromJSON Fancypants where
    parseJSON = withObject "Fancypants" $ fmap Fancypants . (.: "output")

-- | Wrapper for getting the URL from the JSON object that is returned when
-- posting a new submissions
newtype PostedSubmission = PostedSubmission URL
    deriving stock ( Show, Generic )

instance FromJSON PostedSubmission where
    parseJSON = withObject "PostedSubmission"
        $ fmap PostedSubmission . ((.: "url") <=< (.: "data") <=< (.: "json"))

--Search-----------------------------------------------------------------------
-- | The text to search, along with an optional 'SubredditName'
data Search = Search
    { -- | The text to search
      q         :: Text
      -- | If @Nothing@, will perform search. Should be <= 512 characters in length
    , subreddit :: Maybe SubredditName
      -- | If @Nothing@, defaults to 'Lucene'
    , syntax    :: Maybe SearchSyntax
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm Search where
    toForm Search { .. } =
        fromList [ ("q", q)
                 , ("syntax", toQueryParam $ fromMaybe Lucene syntax)
                 , ("restrict_sr", toQueryParam $ isJust subreddit)
                 ]

instance Paginable Search where
    type PaginateOptions Search = SearchOpts

    type PaginateThing Search = Text

    defaultOpts = SearchOpts
        { searchSort = ByRelevance, searchTime = AllTime, category = Nothing }

-- | Create a new 'Search' by providing the query, with defaults for the other
-- fields
mkSearch :: Text -> Search
mkSearch q = Search { subreddit = Nothing, syntax = Nothing, .. }

-- | Options for paginating and filtering 'Search'es
data SearchOpts = SearchOpts
    { searchSort :: SearchSort
    , searchTime :: Time
    , category   :: Maybe SearchCategory
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm SearchOpts where
    toForm SearchOpts { .. } = fromList
        $ [ ("sort", toQueryParam searchSort)
          , ("t", toQueryParam searchTime)
          ]
        <> foldMap pure (("category", ) . coerce <$> category)

-- | The sort order for 'Search'es
data SearchSort
    = ByRelevance
    | ByNew
    | ByHot
    | ByTop
    | ByComments
    deriving stock ( Show, Eq, Generic )

instance ToHttpApiData SearchSort where
    toQueryParam = T.drop 2 . showTextData

-- | The category for the 'Search'
newtype SearchCategory = SearchCategory Text
    deriving stock ( Show, Generic )
    deriving newtype ( Eq )

-- | Create a 'SearchCategory' from 'Text',  the length of which must not exceed
-- 5 characters
mkSearchCategory :: MonadThrow m => Text -> m SearchCategory
mkSearchCategory txt
    | T.length txt > 5 =
        throwM $ OtherError "mkSearchCategory: length must be <= 5 characters"
    | otherwise = pure $ SearchCategory txt

-- | The syntax to use in the 'Search'
data SearchSyntax
    = Lucene
    | Cloudsearch
    | PlainSyntax
    deriving stock ( Show, Eq, Generic )

instance ToHttpApiData SearchSyntax where
    toQueryParam = \case
        PlainSyntax -> "plain"
        s           -> showTextData s

-- | A wrapper around 'SubmissionID's that allows @Listing ResultID a@ to be
-- distinguished from @Listing SubmissionID a@
newtype ResultID = ResultID SubmissionID
    deriving stock ( Show, Generic )
    deriving newtype ( FromJSON, Thing )