heddit-0.2: Reddit API bindings
Copyright(c) 2021 Rory Tyler Hayford
LicenseBSD-3-Clause
Maintainerrory.hayford@protonmail.com
Stabilityexperimental
PortabilityGHC
Safe HaskellNone
LanguageHaskell2010

Network.Reddit.Submission

Description

 
Synopsis

Reading submissions

getSubmissions :: (MonadReddit m, Foldable t) => ItemOpts -> t SubmissionID -> m (Seq Submission) Source #

Get a information on Submissions given a container of SubmissionIDs

getSubmission :: MonadReddit m => SubmissionID -> m Submission Source #

Get information on a single submission. Throws an exception if no such Submission exists

getSubmissionByURL :: MonadReddit m => URL -> m Submission Source #

Get a Submission from a URL pointing to it, in one of the following forms:

  • http{s}://redd.it/<ID>
  • http{s}://{www.}reddit.com/comments/<ID>/
  • http{s}://{www.}reddit.com/r/<SUBREDDIT>/comments/<ID>/{NAME}
  • http{s}://{www.}reddit.com/gallery/<ID>

getSubmissionsByDomain :: MonadReddit m => Domain -> Paginator SubmissionID Submission -> m (Listing SubmissionID Submission) Source #

Get a Listing of submissions based on their domain

getDuplicateSubmissions :: MonadReddit m => SubmissionID -> m (Seq Submission) Source #

Get a Listing of Submissions that are marked as duplicates of the given submission

saveSubmission :: MonadReddit m => SubmissionID -> m () Source #

Save a submission

unsaveSubmission :: MonadReddit m => SubmissionID -> m () Source #

Unsave a submission

hideSubmissions :: (MonadReddit m, Foldable t) => t SubmissionID -> m () Source #

Hide the submissions corresponding to a container of SubmissionIDs. The submissions will no longer appear in your default view of submissions on the subdreddit

hideSubmission :: MonadReddit m => SubmissionID -> m () Source #

Hide a single submission

unhideSubmissions :: (MonadReddit m, Foldable t) => t SubmissionID -> m () Source #

Unhide the submissions corresponding to a container of SubmissionIDs, returning them to your default view

unhideSubmission :: MonadReddit m => SubmissionID -> m () Source #

Unhide a single submission

Creating, editing, and deleting

deleteSubmission :: MonadReddit m => SubmissionID -> m () Source #

Delete a submission that the currently authenticated user has authored

editSubmission :: MonadReddit m => SubmissionID -> Body -> m Submission Source #

Edit a submission, receving an updated Submission in response

replyToSubmission :: MonadReddit m => SubmissionID -> Body -> m Comment Source #

Leave a reply on a submission, returning the new Comment that has been created

submitSelfPost :: MonadReddit m => SubredditName -> Title -> Body -> m Submission Source #

Submit a new self-post (with no inline media)

submitWithInlineMedia Source #

Arguments

:: (MonadReddit m, Traversable t) 
=> Maybe Char

Delimiter for the placeholders in the body, defaults to #

-> Body

Should contain the placeholders, as described above

-> t InlineMedia

The key field in each InlineMedia must correspond to exactly one of the placeholders in the body

-> SubmissionOptions 
-> m Submission 

Submit a new self-post with inline media. The Body must be markdown- formatted text containing placeholders. Each placeholder must correspond to exactly one of the InlineMedias' key field. For example, given the following:

>>> gif = InlineMedia InlineGIF "/path/to/a.gif" "gif" Nothing
>>> vid = InlineMedia InlineVideo "/path/to/a.mp4" "vid" (Just "my video")
>>> body = "Body with an inline gif #gif# and video #vid#"
>>> submitWithInlineMedia Nothing body [gif, vid] myOptions

Will automatically produce (internally) the following markdown body for the submission, after uploading the media to Reddit's servers:

   Body with an inline gif

   ![gif](j2k2xmfl3 "")

    and video

   ![video](ccdoe02xu "my video")

submitLink :: MonadReddit m => SubredditName -> Title -> URL -> m Submission Source #

Submit a new link post

submitImage Source #

Arguments

:: MonadReddit m 
=> FilePath

Must be a valid image file

-> SubmissionOptions 
-> m () 

Post an image submission to the subreddit, uploading the image file. This action does not currently return the posted submission upon success

submitVideo Source #

Arguments

:: MonadReddit m 
=> Bool

If True, creates a silent "videogif"

-> FilePath

Must be a valid video file

-> Maybe FilePath

Must be a valid image file, for the video thumbnail. If Nothing, a PNG of the Haskell logo will be used

-> SubmissionOptions 
-> m () 

Post an image submission to the subreddit, uploading the image file. This action does not currently return the posted submission upon success

submitPoll :: (MonadReddit m, Foldable t) => Poll t -> SubmissionOptions -> m () Source #

Post a poll to the subreddit. See mkPoll to create a new Poll

submitGallery :: (MonadReddit m, Traversable t) => t GalleryImage -> SubmissionOptions -> m () Source #

Post a gallery to the subreddit, given a container of GalleryImages. See mkGalleryImage to create the images with default values. This action also ensures that the image container has at least two elements

submit :: MonadReddit m => NewSubmission -> m Submission Source #

Submit a new submission, returning the Submission that has been created. This action allows for more fine-grained control over submission options. You can use mkSubmissionOptions for defaults and update it as needed. See also submitImage, submitPoll, and submitGallery, which should be used when submitting anything beyond a self-text or link post

crosspost :: MonadReddit m => SubmissionID -> CrosspostOptions -> m Submission Source #

Crosspost an existing submission. You must be a subscriber of the subreddit you are posting into. See also mkCrosspostOptions

setSubmissionReplies :: MonadReddit m => Bool -> SubmissionID -> m () Source #

Enable/disable inbox replies for a submission

Submission flair

getSubmissionFlairChoices :: MonadReddit m => SubredditName -> SubmissionID -> m (Seq FlairChoice) Source #

Get the available FlairChoices for a particular submission on the given subreddit

selectSubmissionFlair :: MonadReddit m => FlairSelection -> SubmissionID -> m () Source #

Select a FlairChoice for a submission.

Searching

search :: MonadReddit m => Search -> Paginator ResultID Submission -> m (Listing ResultID Submission) Source #

Search through Reddit Submissions, either side-wide or constrained to one subreddit. See mkSearch to create the initial Search

Voting

Note: According to Reddit's API rules:

votes must be cast by humans. That is, API clients proxying a human's action one-for-one are OK, but bots deciding how to vote on content or amplifying a human's vote are not. See the reddit rules for more details on what constitutes vote cheating.

upvoteSubmission :: MonadReddit m => SubmissionID -> m () Source #

Upvote a submission

downvoteSubmission :: MonadReddit m => SubmissionID -> m () Source #

Downvote a submission

unvoteSubmission :: MonadReddit m => SubmissionID -> m () Source #

Remove an existing vote on a submission

Awards

awardSubmission :: MonadReddit m => Award -> SubmissionID -> m AwardingsSummary Source #

Grant an Award to a submission. See mkAward for creating an award with default values, as well as the pattern synonyms for common awards

gildSubmission :: MonadReddit m => SubmissionID -> m AwardingsSummary Source #

Convenience action to anonymously give Gold to the author of a submission, without a message. See awardSubmission if you need more fine-grained control

Misc

reportSubmission :: MonadReddit m => Report -> SubmissionID -> m () Source #

Report a submission to the subreddit's mods

unmarkNSFW :: MonadReddit m => SubmissionID -> m () Source #

Unmark a submission NSFW. The submission author can use this as well as the subreddit moderators

markNSFW :: MonadReddit m => SubmissionID -> m () Source #

Mark a submission NSFW. The submission author can use this as well as the subreddit moderators

setOC :: MonadReddit m => SubredditName -> SubmissionID -> m () Source #

Mark a submission as original content. In order for normal users to use this feature in addition to mods, the beta "Original Content" feature must be enabled in the subreddit settings

unsetOC :: MonadReddit m => SubredditName -> SubmissionID -> m () Source #

Unmark a submission as original content. In order for normal users to use this feature in addition to mods, the beta "Original Content" feature must be enabled in the subreddit settings

setSpoiler :: MonadReddit m => SubmissionID -> m () Source #

Mark the submission as containing spoilers

unsetSpoiler :: MonadReddit m => SubmissionID -> m () Source #

Unmark the submission as containing spoilers

Types

newtype ResultID Source #

A wrapper around SubmissionIDs that allows Listing ResultID a to be distinguished from Listing SubmissionID a

Constructors

ResultID SubmissionID 

Instances

Instances details
Show ResultID Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic ResultID Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep ResultID :: Type -> Type #

Methods

from :: ResultID -> Rep ResultID x #

to :: Rep ResultID x -> ResultID #

FromJSON ResultID Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Thing ResultID Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep ResultID Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep ResultID = D1 ('MetaData "ResultID" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'True) (C1 ('MetaCons "ResultID" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SubmissionID)))

data SearchSyntax Source #

The syntax to use in the Search

Instances

Instances details
Eq SearchSyntax Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show SearchSyntax Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic SearchSyntax Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep SearchSyntax :: Type -> Type #

ToHttpApiData SearchSyntax Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep SearchSyntax Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep SearchSyntax = D1 ('MetaData "SearchSyntax" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) (C1 ('MetaCons "Lucene" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Cloudsearch" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PlainSyntax" 'PrefixI 'False) (U1 :: Type -> Type)))

data SearchCategory Source #

The category for the Search

Instances

Instances details
Eq SearchCategory Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show SearchCategory Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic SearchCategory Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep SearchCategory :: Type -> Type #

type Rep SearchCategory Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep SearchCategory = D1 ('MetaData "SearchCategory" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'True) (C1 ('MetaCons "SearchCategory" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

data SearchSort Source #

The sort order for Searches

Instances

Instances details
Eq SearchSort Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show SearchSort Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic SearchSort Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep SearchSort :: Type -> Type #

ToHttpApiData SearchSort Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep SearchSort Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep SearchSort = D1 ('MetaData "SearchSort" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) ((C1 ('MetaCons "ByRelevance" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ByNew" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "ByHot" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "ByTop" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ByComments" 'PrefixI 'False) (U1 :: Type -> Type))))

data SearchOpts Source #

Options for paginating and filtering Searches

Instances

Instances details
Eq SearchOpts Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show SearchOpts Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic SearchOpts Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep SearchOpts :: Type -> Type #

ToForm SearchOpts Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Methods

toForm :: SearchOpts -> Form #

type Rep SearchOpts Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep SearchOpts = D1 ('MetaData "SearchOpts" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) (C1 ('MetaCons "SearchOpts" 'PrefixI 'True) (S1 ('MetaSel ('Just "searchSort") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SearchSort) :*: (S1 ('MetaSel ('Just "searchTime") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Time) :*: S1 ('MetaSel ('Just "category") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe SearchCategory)))))

data Search Source #

The text to search, along with an optional SubredditName

Instances

Instances details
Eq Search Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Methods

(==) :: Search -> Search -> Bool #

(/=) :: Search -> Search -> Bool #

Show Search Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic Search Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep Search :: Type -> Type #

Methods

from :: Search -> Rep Search x #

to :: Rep Search x -> Search #

ToForm Search Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Methods

toForm :: Search -> Form #

Paginable Search Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep Search Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep Search = D1 ('MetaData "Search" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) (C1 ('MetaCons "Search" 'PrefixI 'True) (S1 ('MetaSel ('Just "q") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Text) :*: (S1 ('MetaSel ('Just "subreddit") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe SubredditName)) :*: S1 ('MetaSel ('Just "syntax") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe SearchSyntax)))))
type PaginateOptions Search Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type PaginateThing Search Source # 
Instance details

Defined in Network.Reddit.Types.Submission

data PostedSubmission Source #

Wrapper for getting the URL from the JSON object that is returned when posting a new submissions

Instances

Instances details
Show PostedSubmission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic PostedSubmission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep PostedSubmission :: Type -> Type #

FromJSON PostedSubmission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep PostedSubmission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep PostedSubmission = D1 ('MetaData "PostedSubmission" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'True) (C1 ('MetaCons "PostedSubmission" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 URL)))

data Fancypants Source #

Represents richtext JSON object. This should be generated through an API endpoint

Instances

Instances details
Eq Fancypants Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show Fancypants Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic Fancypants Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep Fancypants :: Type -> Type #

ToJSON Fancypants Source # 
Instance details

Defined in Network.Reddit.Types.Submission

FromJSON Fancypants Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep Fancypants Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep Fancypants = D1 ('MetaData "Fancypants" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'True) (C1 ('MetaCons "Fancypants" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Object)))

data InlineMediaType Source #

The type of inline media

Instances

Instances details
Eq InlineMediaType Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show InlineMediaType Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic InlineMediaType Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep InlineMediaType :: Type -> Type #

ToHttpApiData InlineMediaType Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep InlineMediaType Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep InlineMediaType = D1 ('MetaData "InlineMediaType" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) (C1 ('MetaCons "InlineImage" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "InlineGIF" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "InlineVideo" 'PrefixI 'False) (U1 :: Type -> Type)))

data InlineMedia Source #

A piece of inline media that can be added to a self-text post

Instances

Instances details
Eq InlineMedia Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show InlineMedia Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic InlineMedia Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep InlineMedia :: Type -> Type #

type Rep InlineMedia Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep InlineMedia = D1 ('MetaData "InlineMedia" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) (C1 ('MetaCons "InlineMedia" 'PrefixI 'True) ((S1 ('MetaSel ('Just "mediaType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 InlineMediaType) :*: S1 ('MetaSel ('Just "mediaPath") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 FilePath)) :*: (S1 ('MetaSel ('Just "key") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Text) :*: S1 ('MetaSel ('Just "caption") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Body)))))

data GalleryImage Source #

A single image in a gallery submission

Instances

Instances details
Eq GalleryImage Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show GalleryImage Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic GalleryImage Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep GalleryImage :: Type -> Type #

type Rep GalleryImage Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep GalleryImage = D1 ('MetaData "GalleryImage" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) (C1 ('MetaCons "GalleryImage" 'PrefixI 'True) (S1 ('MetaSel ('Just "imagePath") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 FilePath) :*: (S1 ('MetaSel ('Just "caption") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Body)) :*: S1 ('MetaSel ('Just "outboundURL") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe URL)))))

data Poll t Source #

A Reddit poll. See mkPoll to create a new one satisfying Reddit constraints on poll options and duration

Constructors

Poll (t Text) Word (Maybe Body) 

Instances

Instances details
Eq (t Text) => Eq (Poll t) Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Methods

(==) :: Poll t -> Poll t -> Bool #

(/=) :: Poll t -> Poll t -> Bool #

Show (t Text) => Show (Poll t) Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Methods

showsPrec :: Int -> Poll t -> ShowS #

show :: Poll t -> String #

showList :: [Poll t] -> ShowS #

Generic (Poll t) Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep (Poll t) :: Type -> Type #

Methods

from :: Poll t -> Rep (Poll t) x #

to :: Rep (Poll t) x -> Poll t #

type Rep (Poll t) Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep (Poll t) = D1 ('MetaData "Poll" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) (C1 ('MetaCons "Poll" 'PrefixI 'True) (S1 ('MetaSel ('Just "options") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (t Text)) :*: (S1 ('MetaSel ('Just "duration") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Word) :*: S1 ('MetaSel ('Just "selftext") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Body)))))

data CrosspostOptions Source #

Options for crossposting a submission

Instances

Instances details
Eq CrosspostOptions Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show CrosspostOptions Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic CrosspostOptions Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep CrosspostOptions :: Type -> Type #

ToForm CrosspostOptions Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep CrosspostOptions Source # 
Instance details

Defined in Network.Reddit.Types.Submission

data S3UploadLease Source #

Used to upload style assets and images to Reddit's servers when submitting content

Instances

Instances details
Eq S3UploadLease Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show S3UploadLease Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic S3UploadLease Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep S3UploadLease :: Type -> Type #

FromJSON S3UploadLease Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep S3UploadLease Source # 
Instance details

Defined in Network.Reddit.Types.Submission

data NewSubmission Source #

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

Constructors

SelfPost Body SubmissionOptions 
WithInlineMedia Fancypants SubmissionOptions

The body should be generated using InlineMedia and converted to "fancypants" style markdown. Please see submitWithInlineMedia, which handles this

Link URL SubmissionOptions 
ImagePost UploadURL SubmissionOptions

Please see 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 UploadURLs. The Bool argument specifies if this is "videogif" media. The second UploadURL points to a Reddit-hosted thumbnail image

Instances

Instances details
Eq NewSubmission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show NewSubmission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic NewSubmission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep NewSubmission :: Type -> Type #

ToForm NewSubmission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Methods

toForm :: NewSubmission -> Form #

type Rep NewSubmission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep NewSubmission = D1 ('MetaData "NewSubmission" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) ((C1 ('MetaCons "SelfPost" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Body) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SubmissionOptions)) :+: C1 ('MetaCons "WithInlineMedia" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Fancypants) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SubmissionOptions))) :+: (C1 ('MetaCons "Link" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 URL) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SubmissionOptions)) :+: (C1 ('MetaCons "ImagePost" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 UploadURL) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SubmissionOptions)) :+: C1 ('MetaCons "VideoPost" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 UploadURL) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 UploadURL)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SubmissionOptions))))))

data SubmissionOptions Source #

Components to create a new submission

Instances

Instances details
Eq SubmissionOptions Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show SubmissionOptions Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic SubmissionOptions Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep SubmissionOptions :: Type -> Type #

ToForm SubmissionOptions Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep SubmissionOptions Source # 
Instance details

Defined in Network.Reddit.Types.Submission

data NewCollection Source #

Data to create a new Collection as a moderator action

Instances

Instances details
Eq NewCollection Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show NewCollection Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic NewCollection Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep NewCollection :: Type -> Type #

ToForm NewCollection Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Methods

toForm :: NewCollection -> Form #

type Rep NewCollection Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep NewCollection = D1 ('MetaData "NewCollection" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) (C1 ('MetaCons "NewCollection" 'PrefixI 'True) ((S1 ('MetaSel ('Just "title") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Title) :*: S1 ('MetaSel ('Just "description") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Body)) :*: (S1 ('MetaSel ('Just "subredditID") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SubredditID) :*: S1 ('MetaSel ('Just "layout") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe CollectionLayout)))))

type CollectionID = Text Source #

A UUID identifier for a Collection

data CollectionLayout Source #

The layout of the Collection on the redesigned site

Constructors

Gallery 
Timeline 

Instances

Instances details
Eq CollectionLayout Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show CollectionLayout Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic CollectionLayout Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep CollectionLayout :: Type -> Type #

FromJSON CollectionLayout Source # 
Instance details

Defined in Network.Reddit.Types.Submission

ToHttpApiData CollectionLayout Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep CollectionLayout Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep CollectionLayout = D1 ('MetaData "CollectionLayout" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) (C1 ('MetaCons "Gallery" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Timeline" 'PrefixI 'False) (U1 :: Type -> Type))

data Collection Source #

Represents a Reddit collection

Instances

Instances details
Eq Collection Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show Collection Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic Collection Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep Collection :: Type -> Type #

FromJSON Collection Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep Collection Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type PollOptionID = Text Source #

Identifier for a PollOption

data PollOption Source #

Single option in existing PollData

Instances

Instances details
Eq PollOption Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show PollOption Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic PollOption Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep PollOption :: Type -> Type #

FromJSON PollOption Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep PollOption Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep PollOption = D1 ('MetaData "PollOption" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) (C1 ('MetaCons "PollOption" 'PrefixI 'True) (S1 ('MetaSel ('Just "pollOptionID") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 PollOptionID) :*: (S1 ('MetaSel ('Just "text") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Body) :*: S1 ('MetaSel ('Just "voteCount") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Integer))))

data PollData Source #

Data from an existing submission containing a poll. See Poll for submitting a new post with a poll

Instances

Instances details
Eq PollData Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show PollData Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic PollData Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep PollData :: Type -> Type #

Methods

from :: PollData -> Rep PollData x #

to :: Rep PollData x -> PollData #

FromJSON PollData Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep PollData Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep PollData = D1 ('MetaData "PollData" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) (C1 ('MetaCons "PollData" 'PrefixI 'True) ((S1 ('MetaSel ('Just "options") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Seq PollOption)) :*: S1 ('MetaSel ('Just "totalVoteCount") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Integer)) :*: (S1 ('MetaSel ('Just "votingEnds") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 UTCTime) :*: S1 ('MetaSel ('Just "userSelection") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe PollOptionID)))))

data SubmissionContent Source #

The contents of the Submission. Can be a self-post with a plaintext and HTML body, an external link, or entirely empty

data Submission Source #

A submitted self-text post or link

Instances

Instances details
Eq Submission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show Submission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic Submission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep Submission :: Type -> Type #

FromJSON Submission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Paginable Submission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

FromJSON (PostedItem Submission) Source # 
Instance details

Defined in Network.Reddit.Types.Item

type Rep Submission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep Submission = D1 ('MetaData "Submission" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'False) (C1 ('MetaCons "Submission" 'PrefixI 'True) ((((S1 ('MetaSel ('Just "submissionID") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SubmissionID) :*: (S1 ('MetaSel ('Just "title") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Title) :*: S1 ('MetaSel ('Just "author") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Username))) :*: (S1 ('MetaSel ('Just "content") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SubmissionContent) :*: (S1 ('MetaSel ('Just "subreddit") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SubredditName) :*: S1 ('MetaSel ('Just "created") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 UTCTime)))) :*: ((S1 ('MetaSel ('Just "edited") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe UTCTime)) :*: (S1 ('MetaSel ('Just "permalink") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 URL) :*: S1 ('MetaSel ('Just "domain") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Domain))) :*: ((S1 ('MetaSel ('Just "numComments") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Integer) :*: S1 ('MetaSel ('Just "score") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Integer)) :*: (S1 ('MetaSel ('Just "ups") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Integer)) :*: S1 ('MetaSel ('Just "downs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Integer)))))) :*: (((S1 ('MetaSel ('Just "upvoteRatio") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Rational)) :*: (S1 ('MetaSel ('Just "gilded") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Integer) :*: S1 ('MetaSel ('Just "userReports") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Seq ItemReport)))) :*: (S1 ('MetaSel ('Just "modReports") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Seq ItemReport)) :*: (S1 ('MetaSel ('Just "numReports") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Integer)) :*: S1 ('MetaSel ('Just "distinguished") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Distinction))))) :*: ((S1 ('MetaSel ('Just "isOC") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool) :*: (S1 ('MetaSel ('Just "clicked") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Just "over18") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool))) :*: ((S1 ('MetaSel ('Just "locked") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Just "spoiler") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool)) :*: (S1 ('MetaSel ('Just "pollData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe PollData)) :*: S1 ('MetaSel ('Just "allAwardings") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Seq Awarding))))))))
type PaginateOptions Submission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type PaginateThing Submission Source # 
Instance details

Defined in Network.Reddit.Types.Submission

newtype SubmissionID Source #

Unique, site-wide ID for a Submission

Constructors

SubmissionID Text 

Instances

Instances details
Eq SubmissionID Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Show SubmissionID Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Generic SubmissionID Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Associated Types

type Rep SubmissionID :: Type -> Type #

FromJSON SubmissionID Source # 
Instance details

Defined in Network.Reddit.Types.Submission

ToHttpApiData SubmissionID Source # 
Instance details

Defined in Network.Reddit.Types.Submission

Thing SubmissionID Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep SubmissionID Source # 
Instance details

Defined in Network.Reddit.Types.Submission

type Rep SubmissionID = D1 ('MetaData "SubmissionID" "Network.Reddit.Types.Submission" "heddit-0.2-6CPbqZeiNUj1PM6nX368ZU" 'True) (C1 ('MetaCons "SubmissionID" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

mkSubmissionOptions :: SubredditName -> Title -> SubmissionOptions Source #

Create a SubmissionOptions with default values for most fields

mkCrosspostOptions :: SubredditName -> Title -> CrosspostOptions Source #

CrosspostOptions with default values for most fields

mkPoll :: (Foldable t, MonadThrow m) => t Text -> Word -> m (Poll t) Source #

Create a new Poll, validating the following constraints: * The duration is between 1 and 7 * The number of options is between 2 and 6

mkGalleryImage :: FilePath -> GalleryImage Source #

Create a GalleryImage with default values for the caption and outboundURL fields

mkSearch :: Text -> Search Source #

Create a new Search by providing the query, with defaults for the other fields

mkSearchCategory :: MonadThrow m => Text -> m SearchCategory Source #

Create a SearchCategory from Text, the length of which must not exceed 5 characters