Safe Haskell | None |
---|---|
Language | Haskell2010 |
Provides a Giphy monad that can be used to issue selected API calls under a selected API key.
import qualified Web.Giphy as Giphy let apiKey = Giphy.Key
"dc6zaTOxFJmzC" let config = Giphy.GiphyConfig
apiKey resp <- Giphy.runGiphy
(Giphy.search
$ Giphy.query
"puppies") config let fstUrl = resp ^? _Right . Giphy.searchItems
. _head . Giphy.gifImages
. at "original" . traverse . Giphy.imageUrl
. traverse print fstUrl
Synopsis
- newtype Key = Key Text
- newtype Query = Query Text
- newtype Phrase = Phrase Text
- newtype Tag = Tag Text
- data Pagination = Pagination {}
- newtype GifId = GifId Text
- data Gif = Gif {}
- data Image = Image {
- _imageUrl :: Maybe URI
- _imageSize :: Maybe Int
- _imageMp4Url :: Maybe URI
- _imageMp4Size :: Maybe Int
- _imageWebpUrl :: Maybe URI
- _imageWebpSize :: Maybe Int
- _imageWidth :: Maybe Int
- _imageHeight :: Maybe Int
- type ImageMap = Map Text Image
- newtype PaginationOffset = PaginationOffset Int
- data SearchResponse = SearchResponse {}
- newtype SingleGifResponse = SingleGifResponse {}
- newtype TranslateResponse = TranslateResponse {}
- newtype RandomResponse = RandomResponse {}
- newtype GiphyConfig = GiphyConfig {
- configApiKey :: Key
- type Giphy = ReaderT GiphyContext ClientM
- runGiphy :: MonadIO m => Giphy a -> GiphyConfig -> m (Either ClientError a)
- runGiphy' :: MonadIO m => Manager -> Giphy a -> GiphyConfig -> m (Either ClientError a)
- gifId :: Lens' Gif Text
- gifImages :: Lens' Gif ImageMap
- gifSlug :: Lens' Gif Text
- gifUrl :: Lens' Gif URI
- imageHeight :: Lens' Image (Maybe Int)
- imageUrl :: Lens' Image (Maybe URI)
- imageSize :: Lens' Image (Maybe Int)
- imageWidth :: Lens' Image (Maybe Int)
- imageMp4Url :: Lens' Image (Maybe URI)
- imageMp4Size :: Lens' Image (Maybe Int)
- imageWebpUrl :: Lens' Image (Maybe URI)
- imageWebpSize :: Lens' Image (Maybe Int)
- paginationCount :: Lens' Pagination Int
- paginationOffset :: Lens' Pagination Int
- paginationTotalCount :: Lens' Pagination Int
- searchItems :: Lens' SearchResponse [Gif]
- searchPagination :: Lens' SearchResponse Pagination
- singleGifItem :: Lens' SingleGifResponse Gif
- translateItem :: Lens' TranslateResponse Gif
- randomGifItem :: Lens' RandomResponse Gif
- search :: Query -> Giphy SearchResponse
- searchOffset :: Query -> PaginationOffset -> Giphy SearchResponse
- translate :: Phrase -> Giphy TranslateResponse
- gif :: GifId -> Giphy SingleGifResponse
- random :: Maybe Tag -> Giphy RandomResponse
Request Data Types
These data types are used to encapsulate otherwise weakly typed arguments.
The API Key. See https://github.com/Giphy/GiphyAPI
Instances
Eq Key Source # | |
Show Key Source # | |
ToHttpApiData Key Source # | |
Defined in Web.Giphy toUrlPiece :: Key -> Text # toEncodedUrlPiece :: Key -> Builder # toHeader :: Key -> ByteString # toQueryParam :: Key -> Text # | |
FromHttpApiData Key Source # | |
Defined in Web.Giphy parseUrlPiece :: Text -> Either Text Key # parseHeader :: ByteString -> Either Text Key # |
A search query.
Instances
Eq Query Source # | |
Show Query Source # | |
ToHttpApiData Query Source # | |
Defined in Web.Giphy toUrlPiece :: Query -> Text # toEncodedUrlPiece :: Query -> Builder # toHeader :: Query -> ByteString # toQueryParam :: Query -> Text # | |
FromHttpApiData Query Source # | |
Defined in Web.Giphy parseUrlPiece :: Text -> Either Text Query # parseHeader :: ByteString -> Either Text Query # |
A phrase or term used for translation.
Instances
Eq Phrase Source # | |
Show Phrase Source # | |
ToHttpApiData Phrase Source # | |
Defined in Web.Giphy toUrlPiece :: Phrase -> Text # toEncodedUrlPiece :: Phrase -> Builder # toHeader :: Phrase -> ByteString # toQueryParam :: Phrase -> Text # | |
FromHttpApiData Phrase Source # | |
Defined in Web.Giphy parseUrlPiece :: Text -> Either Text Phrase # parseHeader :: ByteString -> Either Text Phrase # |
A tag to retrieve a random GIF for.
Instances
Eq Tag Source # | |
Show Tag Source # | |
ToHttpApiData Tag Source # | |
Defined in Web.Giphy toUrlPiece :: Tag -> Text # toEncodedUrlPiece :: Tag -> Builder # toHeader :: Tag -> ByteString # toQueryParam :: Tag -> Text # | |
FromHttpApiData Tag Source # | |
Defined in Web.Giphy parseUrlPiece :: Text -> Either Text Tag # parseHeader :: ByteString -> Either Text Tag # |
data Pagination Source #
Metadata about pagination in a response.
Instances
A unique gif identifier.
Instances
Eq GifId Source # | |
Show GifId Source # | |
ToHttpApiData GifId Source # | |
Defined in Web.Giphy toUrlPiece :: GifId -> Text # toEncodedUrlPiece :: GifId -> Builder # toHeader :: GifId -> ByteString # toQueryParam :: GifId -> Text # | |
FromHttpApiData GifId Source # | |
Defined in Web.Giphy parseUrlPiece :: Text -> Either Text GifId # parseHeader :: ByteString -> Either Text GifId # |
Response Data Types
These data types contain are the parsed JSON responses from the Giphy API.
A search response item.
Instances
Eq Gif Source # | |
Ord Gif Source # | |
Show Gif Source # | |
Generic Gif Source # | |
FromJSON Gif Source # | |
type Rep Gif Source # | |
Defined in Web.Giphy type Rep Gif = D1 (MetaData "Gif" "Web.Giphy" "giphy-api-0.7.0.0-GKIHg4B0k0i279jBFZMsh0" False) (C1 (MetaCons "Gif" PrefixI True) ((S1 (MetaSel (Just "_gifId") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text) :*: S1 (MetaSel (Just "_gifSlug") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)) :*: (S1 (MetaSel (Just "_gifUrl") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 URI) :*: S1 (MetaSel (Just "_gifImages") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ImageMap)))) |
An image contained in a Giphy response.
Image | |
|
Instances
newtype PaginationOffset Source #
Offset for paginated requests.
Instances
Eq PaginationOffset Source # | |
Defined in Web.Giphy (==) :: PaginationOffset -> PaginationOffset -> Bool # (/=) :: PaginationOffset -> PaginationOffset -> Bool # | |
Show PaginationOffset Source # | |
Defined in Web.Giphy showsPrec :: Int -> PaginationOffset -> ShowS # show :: PaginationOffset -> String # showList :: [PaginationOffset] -> ShowS # | |
ToHttpApiData PaginationOffset Source # | |
Defined in Web.Giphy toUrlPiece :: PaginationOffset -> Text # toEncodedUrlPiece :: PaginationOffset -> Builder # toHeader :: PaginationOffset -> ByteString # toQueryParam :: PaginationOffset -> Text # | |
FromHttpApiData PaginationOffset Source # | |
Defined in Web.Giphy |
data SearchResponse Source #
A collection of GIFs as part of a search response.
Instances
newtype SingleGifResponse Source #
A single gif as part of a response.
Instances
newtype TranslateResponse Source #
A single GIF as part of a translate response.
Instances
newtype RandomResponse Source #
A single gif as part of a response.
Instances
Giphy Monad
newtype GiphyConfig Source #
Contains the key to access the API.
Instances
Eq GiphyConfig Source # | |
Defined in Web.Giphy (==) :: GiphyConfig -> GiphyConfig -> Bool # (/=) :: GiphyConfig -> GiphyConfig -> Bool # | |
Show GiphyConfig Source # | |
Defined in Web.Giphy showsPrec :: Int -> GiphyConfig -> ShowS # show :: GiphyConfig -> String # showList :: [GiphyConfig] -> ShowS # |
runGiphy :: MonadIO m => Giphy a -> GiphyConfig -> m (Either ClientError a) Source #
You need to provide a GiphyConfig
to lift a Giphy
computation
into MonadIO
.
:: MonadIO m | |
=> Manager | This must be a TLS-enabled Manager |
-> Giphy a | |
-> GiphyConfig | |
-> m (Either ClientError a) |
Lenses
You can use these lenses if you prefer them to manually accessing record fields.
searchItems :: Lens' SearchResponse [Gif] Source #
API calls
Functions that directly access the Giphy API. All these functions run in
the Giphy
monad.
search :: Query -> Giphy SearchResponse Source #
Issue a search request for the given query without specifying an offset. E.g. https://api.giphy.com/v1/gifs/search?q=funny+cat&api_key=dc6zaTOxFJmzC
:: Query | |
-> PaginationOffset | Offset as a number of items you want to skip. |
-> Giphy SearchResponse |
Issue a search request for the given query by specifying a pagination offset. E.g. https://api.giphy.com/v1/gifs/search?q=funny+cat&api_key=dc6zaTOxFJmzC&offset=25
translate :: Phrase -> Giphy TranslateResponse Source #
Issue a translate request for a given phrase or term. E.g. https://api.giphy.com/v1/gifs/translate?s=superman&api_key=dc6zaTOxFJmzC
gif :: GifId -> Giphy SingleGifResponse Source #
Issue a request for a single GIF identified by its GifId
.
E.g. https://api.giphy.com/v1/gifs/feqkVgjJpYtjy?api_key=dc6zaTOxFJmzC
random :: Maybe Tag -> Giphy RandomResponse Source #
Issue a request for a random GIF for the given (optional) tag. E.g. https://api.giphy.com/v1/gifs/random?api_key=dc6zaTOxFJmzC&tag=american+psycho