| Copyright | (c) 2021 Rory Tyler Hayford |
|---|---|
| License | BSD-3-Clause |
| Maintainer | rory.hayford@protonmail.com |
| Stability | experimental |
| Portability | GHC |
| Safe Haskell | None |
| Language | Haskell2010 |
Network.Reddit.Types.Submission
Description
Synopsis
- 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
- newtype SubmissionID = SubmissionID Text
- data SubmissionContent
- submissionP :: Object -> Parser Submission
- data PollData = PollData {}
- data PollOption = PollOption {
- pollOptionID :: PollOptionID
- text :: Body
- voteCount :: Integer
- type PollOptionID = Text
- data Collection = Collection {}
- data CollectionLayout
- type CollectionID = Text
- data NewCollection = NewCollection {}
- data SubmissionOptions = SubmissionOptions {}
- mkSubmissionOptions :: SubredditName -> Title -> SubmissionOptions
- data NewSubmission
- data S3UploadLease = S3UploadLease {}
- data UploadType
- data UploadResult = UploadResult {
- resultType :: Text
- redirectURL :: URL
- data CrosspostOptions = CrosspostOptions {}
- mkCrosspostOptions :: SubredditName -> Title -> CrosspostOptions
- data PostedCrosspost
- data Poll t = Poll {}
- data PollSubmission t = PollSubmission (Poll t) SubmissionOptions
- mkPoll :: (Foldable t, MonadThrow m) => t Text -> Word -> m (Poll t)
- data GalleryImage = GalleryImage {}
- mkGalleryImage :: FilePath -> GalleryImage
- galleryImageToUpload :: GalleryImage -> UploadURL -> GalleryUploadImage
- data GallerySubmission t = GallerySubmission (t GalleryUploadImage) SubmissionOptions
- data InlineMedia = InlineMedia {}
- data InlineMediaType
- data InlineMediaUpload = InlineMediaUpload {}
- inlineMediaToUpload :: InlineMedia -> UploadURL -> InlineMediaUpload
- writeInlineMedia :: InlineMediaUpload -> Body
- data Fancypants
- data PostedSubmission
- data Search = Search {
- q :: Text
- subreddit :: Maybe SubredditName
- syntax :: Maybe SearchSyntax
- data SearchSort
- = ByRelevance
- | ByNew
- | ByHot
- | ByTop
- | ByComments
- data SearchCategory
- mkSearchCategory :: MonadThrow m => Text -> m SearchCategory
- data SearchOpts = SearchOpts {}
- newtype ResultID = ResultID SubmissionID
- data SearchSyntax
- mkSearch :: Text -> Search
Documentation
data Submission Source #
A submitted self-text post or link
Constructors
| Submission | |
Fields
| |
Instances
newtype SubmissionID Source #
Unique, site-wide ID for a Submission
Constructors
| SubmissionID Text |
Instances
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
Constructors
| SelfText Body Body | |
| ExternalLink URL | |
| EmptySubmission |
Instances
submissionP :: Object -> Parser Submission Source #
Parse a Submission
Data from an existing submission containing a poll. See Poll for
submitting a new post with a poll
Constructors
| PollData | |
Fields
| |
Instances
| Eq PollData Source # | |
| Show PollData Source # | |
| Generic PollData Source # | |
| FromJSON PollData Source # | |
| type Rep PollData Source # | |
Defined in Network.Reddit.Types.Submission type Rep PollData = D1 ('MetaData "PollData" "Network.Reddit.Types.Submission" "heddit-0.0.1-76ROQ5tOAm3CpLSaFw8ccb" '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 PollOption Source #
Single option in existing PollData
Constructors
| PollOption | |
Fields
| |
Instances
type PollOptionID = Text Source #
Identifier for a PollOption
Collections
data Collection Source #
Represents a Reddit collection
Constructors
| Collection | |
Fields
| |
Instances
data CollectionLayout Source #
The layout of the Collection on the redesigned site
Instances
type CollectionID = Text Source #
A UUID identifier for a Collection
data NewCollection Source #
Data to create a new Collection as a moderator action
Constructors
| NewCollection | |
Fields
| |
Instances
Creating submissions
data SubmissionOptions Source #
Components to create a new submission
Constructors
| SubmissionOptions | |
Fields
| |
Instances
mkSubmissionOptions :: SubredditName -> Title -> SubmissionOptions Source #
Create a SubmissionOptions with default values for most fields
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 |
| Link URL SubmissionOptions | |
| ImagePost UploadURL SubmissionOptions | Please see |
| VideoPost UploadURL UploadURL Bool SubmissionOptions | See the note for |
Instances
data S3UploadLease Source #
Used to upload style assets and images to Reddit's servers when submitting content
Constructors
| S3UploadLease | |
Instances
data UploadType Source #
Used to distinguish upload types when creating submissions with media
Constructors
| SelfPostUpload | |
| LinkUpload | |
| GalleryUpload |
Instances
| Eq UploadType Source # | |
Defined in Network.Reddit.Types.Submission | |
| Show UploadType Source # | |
Defined in Network.Reddit.Types.Submission Methods showsPrec :: Int -> UploadType -> ShowS # show :: UploadType -> String # showList :: [UploadType] -> ShowS # | |
| Generic UploadType Source # | |
Defined in Network.Reddit.Types.Submission Associated Types type Rep UploadType :: Type -> Type # | |
| type Rep UploadType Source # | |
Defined in Network.Reddit.Types.Submission type Rep UploadType = D1 ('MetaData "UploadType" "Network.Reddit.Types.Submission" "heddit-0.0.1-76ROQ5tOAm3CpLSaFw8ccb" 'False) (C1 ('MetaCons "SelfPostUpload" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "LinkUpload" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GalleryUpload" 'PrefixI 'False) (U1 :: Type -> Type))) | |
data UploadResult Source #
Result issued from a websocket connection after uploading media
Constructors
| UploadResult | |
Fields
| |
Instances
| Eq UploadResult Source # | |
Defined in Network.Reddit.Types.Submission | |
| Show UploadResult Source # | |
Defined in Network.Reddit.Types.Submission Methods showsPrec :: Int -> UploadResult -> ShowS # show :: UploadResult -> String # showList :: [UploadResult] -> ShowS # | |
| Generic UploadResult Source # | |
Defined in Network.Reddit.Types.Submission Associated Types type Rep UploadResult :: Type -> Type # | |
| FromJSON UploadResult Source # | |
Defined in Network.Reddit.Types.Submission | |
| type Rep UploadResult Source # | |
Defined in Network.Reddit.Types.Submission type Rep UploadResult = D1 ('MetaData "UploadResult" "Network.Reddit.Types.Submission" "heddit-0.0.1-76ROQ5tOAm3CpLSaFw8ccb" 'False) (C1 ('MetaCons "UploadResult" 'PrefixI 'True) (S1 ('MetaSel ('Just "resultType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Text) :*: S1 ('MetaSel ('Just "redirectURL") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 URL))) | |
data CrosspostOptions Source #
Options for crossposting a submission
Constructors
| CrosspostOptions | |
Fields
| |
Instances
mkCrosspostOptions :: SubredditName -> Title -> CrosspostOptions Source #
CrosspostOptions with default values for most fields
data PostedCrosspost Source #
Wrapper for getting the submission ID after completing a crosspost
Instances
A Reddit poll. See mkPoll to create a new one satisfying Reddit
constraints on poll options and duration
Constructors
| Poll | |
Instances
| Eq (t Text) => Eq (Poll t) Source # | |
| Show (t Text) => Show (Poll t) Source # | |
| Generic (Poll t) Source # | |
| type Rep (Poll t) Source # | |
Defined in Network.Reddit.Types.Submission type Rep (Poll t) = D1 ('MetaData "Poll" "Network.Reddit.Types.Submission" "heddit-0.0.1-76ROQ5tOAm3CpLSaFw8ccb" '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 PollSubmission t Source #
Wrapper providing a single ToJSON instance for Polls and
SubmissionOptionss together
Constructors
| PollSubmission (Poll t) SubmissionOptions |
Instances
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
data GalleryImage Source #
A single image in a gallery submission
Constructors
| GalleryImage | |
Instances
| Eq GalleryImage Source # | |
Defined in Network.Reddit.Types.Submission | |
| Show GalleryImage Source # | |
Defined in Network.Reddit.Types.Submission Methods showsPrec :: Int -> GalleryImage -> ShowS # show :: GalleryImage -> String # showList :: [GalleryImage] -> ShowS # | |
| Generic GalleryImage Source # | |
Defined in Network.Reddit.Types.Submission Associated Types type Rep GalleryImage :: Type -> Type # | |
| type Rep GalleryImage Source # | |
Defined in Network.Reddit.Types.Submission type Rep GalleryImage = D1 ('MetaData "GalleryImage" "Network.Reddit.Types.Submission" "heddit-0.0.1-76ROQ5tOAm3CpLSaFw8ccb" '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))))) | |
mkGalleryImage :: FilePath -> GalleryImage Source #
Create a GalleryImage with default values for the caption and
outboundURL fields
galleryImageToUpload :: GalleryImage -> UploadURL -> GalleryUploadImage Source #
Convert a GalleryImage to to GalleryUploadImage after obtaining the
UploadURL
data GallerySubmission t Source #
Wrapper providing a single ToJSON instance for a container of
GalleryUploadImages and SubmissionOptionss together
Constructors
| GallerySubmission (t GalleryUploadImage) SubmissionOptions |
Instances
| Generic (GallerySubmission t) Source # | |
Defined in Network.Reddit.Types.Submission Associated Types type Rep (GallerySubmission t) :: Type -> Type # Methods from :: GallerySubmission t -> Rep (GallerySubmission t) x # to :: Rep (GallerySubmission t) x -> GallerySubmission t # | |
| Foldable t => ToJSON (GallerySubmission t) Source # | |
Defined in Network.Reddit.Types.Submission Methods toJSON :: GallerySubmission t -> Value # toEncoding :: GallerySubmission t -> Encoding # toJSONList :: [GallerySubmission t] -> Value # toEncodingList :: [GallerySubmission t] -> Encoding # | |
| type Rep (GallerySubmission t) Source # | |
Defined in Network.Reddit.Types.Submission | |
data InlineMedia Source #
A piece of inline media that can be added to a self-text post
Constructors
| InlineMedia | |
Fields
| |
Instances
data InlineMediaType Source #
The type of inline media
Constructors
| InlineImage | |
| InlineGIF | |
| InlineVideo |
Instances
data InlineMediaUpload Source #
As an InlineMedia, but after obtaining the URL for the Reddit-hosted
image
Constructors
| InlineMediaUpload | |
Instances
inlineMediaToUpload :: InlineMedia -> UploadURL -> InlineMediaUpload Source #
Convert an InlineMedia to InlineMediaUpload after obtaining the
UploadURL
writeInlineMedia :: InlineMediaUpload -> Body Source #
Write an InlineMediaUpload in markdown format
data Fancypants Source #
Represents richtext JSON object. This should be generated through an API endpoint
Instances
data PostedSubmission Source #
Wrapper for getting the URL from the JSON object that is returned when posting a new submissions
Instances
Search
The text to search, along with an optional SubredditName
Constructors
| Search | |
Fields
| |
Instances
data SearchSort Source #
The sort order for Searches
Constructors
| ByRelevance | |
| ByNew | |
| ByHot | |
| ByTop | |
| ByComments |
Instances
data SearchCategory Source #
The category for the Search
Instances
| Eq SearchCategory Source # | |
Defined in Network.Reddit.Types.Submission Methods (==) :: SearchCategory -> SearchCategory -> Bool # (/=) :: SearchCategory -> SearchCategory -> Bool # | |
| Show SearchCategory Source # | |
Defined in Network.Reddit.Types.Submission Methods showsPrec :: Int -> SearchCategory -> ShowS # show :: SearchCategory -> String # showList :: [SearchCategory] -> ShowS # | |
| Generic SearchCategory Source # | |
Defined in Network.Reddit.Types.Submission Associated Types type Rep SearchCategory :: Type -> Type # Methods from :: SearchCategory -> Rep SearchCategory x # to :: Rep SearchCategory x -> SearchCategory # | |
| type Rep SearchCategory Source # | |
Defined in Network.Reddit.Types.Submission type Rep SearchCategory = D1 ('MetaData "SearchCategory" "Network.Reddit.Types.Submission" "heddit-0.0.1-76ROQ5tOAm3CpLSaFw8ccb" 'True) (C1 ('MetaCons "SearchCategory" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text))) | |
mkSearchCategory :: MonadThrow m => Text -> m SearchCategory Source #
Create a SearchCategory from Text, the length of which must not exceed
5 characters
data SearchOpts Source #
Options for paginating and filtering Searches
Constructors
| SearchOpts | |
Fields | |
Instances
A wrapper around SubmissionIDs that allows Listing ResultID a to be
distinguished from Listing SubmissionID a
Constructors
| ResultID SubmissionID |
Instances
| Show ResultID Source # | |
| Generic ResultID Source # | |
| FromJSON ResultID Source # | |
| Thing ResultID Source # | |
| type Rep ResultID Source # | |
Defined in Network.Reddit.Types.Submission type Rep ResultID = D1 ('MetaData "ResultID" "Network.Reddit.Types.Submission" "heddit-0.0.1-76ROQ5tOAm3CpLSaFw8ccb" '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
Constructors
| Lucene | |
| Cloudsearch | |
| PlainSyntax |