diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Pascal Hartig (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Pascal Hartig nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import qualified Data.Text as T +import qualified Options.Applicative as Opt +import qualified Options.Applicative.Types as Opt +import qualified Web.Giphy as Giphy + +import Control.Applicative (optional, (<**>), (<|>)) +import Control.Lens.At (at) +import Control.Lens.Cons (_head) +import Control.Lens.Operators +import Control.Lens.Prism (_Right) +import Data.Monoid ((<>)) +import Data.Version (Version (), showVersion) +import Paths_giphy_api (version) +import System.Environment (getProgName) + +data Options = OptSearch T.Text | OptTranslate T.Text | OptRandom (Maybe T.Text) + +apiKey :: Giphy.Key +apiKey = Giphy.Key "dc6zaTOxFJmzC" + +options :: Opt.Parser Options +options = ( OptSearch <$> textOption + ( Opt.long "search" + <> Opt.short 's' + <> Opt.help "Use search to find a matching GIF." ) ) + <|> ( OptTranslate <$> textOption + ( Opt.long "translate" + <> Opt.short 't' + <> Opt.help "Use translate to find a matching GIF." ) ) + <|> ( OptRandom <$> optional ( textArgument ( Opt.metavar "RANDOM_TAG" ) ) ) + where + -- TODO: This seems quite useful. Maybe publish as Options.Applicative.Text? + text :: Opt.ReadM T.Text + text = T.pack <$> Opt.readerAsk + + textOption :: Opt.Mod Opt.OptionFields T.Text -> Opt.Parser T.Text + textOption = Opt.option text + + textArgument :: Opt.Mod Opt.ArgumentFields T.Text -> Opt.Parser T.Text + textArgument = Opt.argument text + +cliParser :: String -> Version -> Opt.ParserInfo Options +cliParser progName ver = + Opt.info ( Opt.helper <*> options <**> versionInfo ) + ( Opt.fullDesc + <> Opt.progDesc "Find GIFs on the command line." + <> Opt.header progName ) + where + versionInfo = Opt.infoOption ( unwords [progName, showVersion ver] ) + ( Opt.short 'V' + <> Opt.long "version" + <> Opt.hidden + <> Opt.help "Show version information" ) + +main :: IO () +main = do + progName <- getProgName + Opt.execParser (cliParser progName version) >>= run + where + run :: Options -> IO () + run opts = do + let config = Giphy.GiphyConfig apiKey + let app = getApp opts + resp <- Giphy.runGiphy app config + let fstUrl = resp ^? _Right + . _head + . Giphy.gifImages + . at "original" + . traverse + . Giphy.imageUrl + . traverse + print fstUrl + + getApp :: Options -> Giphy.Giphy [Giphy.Gif] + getApp opts = + case opts of + OptSearch s -> searchApp s + OptTranslate t -> translateApp t + OptRandom r -> randomApp r + +translateApp :: T.Text -> Giphy.Giphy [Giphy.Gif] +translateApp q = do + resp <- Giphy.translate $ Giphy.Phrase q + return . pure $ resp ^. Giphy.translateItem + +searchApp :: T.Text -> Giphy.Giphy [Giphy.Gif] +searchApp q = do + resp <- Giphy.search $ Giphy.Query q + return $ resp ^. Giphy.searchItems + +randomApp :: Maybe T.Text -> Giphy.Giphy [Giphy.Gif] +randomApp q = do + resp <- Giphy.random $ Giphy.Tag <$> q + return . pure $ resp ^. Giphy.randomGifItem diff --git a/app/Sample.hs b/app/Sample.hs new file mode 100644 --- /dev/null +++ b/app/Sample.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Sample where + +import qualified Data.Text as T +import qualified Web.Giphy as Giphy + +apiKey :: Giphy.Key +apiKey = Giphy.Key "dc6zaTOxFJmzC" + +sample :: IO () +sample = do + let config = Giphy.GiphyConfig apiKey + resp <- Giphy.runGiphy (app "puppies") config + print resp + + where + app :: T.Text -> Giphy.Giphy [Giphy.Gif] + app q = do + resp <- Giphy.search $ Giphy.Query q + return $ Giphy._searchItems resp diff --git a/giphy-api.cabal b/giphy-api.cabal new file mode 100644 --- /dev/null +++ b/giphy-api.cabal @@ -0,0 +1,68 @@ +name: giphy-api +version: 0.1.0.0 +cabal-version: >=1.10 +build-type: Simple +license: BSD3 +license-file: LICENSE +maintainer: Pascal Hartig +homepage: http://github.com/passy/giphy-api#readme +synopsis: Giphy HTTP API wrapper and CLI search tool. +description: + Please see README.md +category: Web +author: Pascal Hartig + +library + exposed-modules: + Web.Giphy + build-depends: + base >=4.7 && <5, + text <1.3, + network-uri <2.7, + aeson <0.10, + containers <0.6, + either <4.5, + microlens <0.5, + microlens-th <0.4, + mtl <2.3, + servant <0.5, + servant-client <0.5 + default-language: Haskell2010 + hs-source-dirs: src + other-modules: + Paths_giphy_api + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-unused-do-bind + +executable giphy-search + main-is: Main.hs + build-depends: + base >=4.7 && <5, + text <1.3, + network-uri <2.7, + giphy-api <0.2, + lens <4.14, + optparse-applicative <0.13 + default-language: Haskell2010 + hs-source-dirs: app + other-modules: + Sample + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N + +test-suite spec + type: exitcode-stdio-1.0 + main-is: Spec.hs + build-depends: + base >=4.7 && <5, + text <1.3, + network-uri <2.7, + giphy-api <0.2, + aeson <0.10, + basic-prelude <0.6, + bytestring <0.11, + containers <0.6, + directory <1.3, + hspec <2.3, + lens <4.14 + default-language: Haskell2010 + hs-source-dirs: test + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N diff --git a/src/Web/Giphy.hs b/src/Web/Giphy.hs new file mode 100644 --- /dev/null +++ b/src/Web/Giphy.hs @@ -0,0 +1,414 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} + +-- | +-- 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 +-- @ + +module Web.Giphy + ( + -- * Request Data Types + -- $request + Key(..) + , Query(..) + , Phrase(..) + , Tag(..) + , Pagination(..) + -- * Response Data Types + -- $response + , Gif(..) + , Image(..) + , ImageMap() + , PaginationOffset(..) + , SearchResponse(..) + , SingleGifResponse(..) + , TranslateResponse(..) + -- * Giphy Monad + -- $giphy + , GiphyConfig(..) + , Giphy() + , runGiphy + -- * Lenses + -- $lenses + , gifId + , gifImages + , gifSlug + , gifUrl + , imageHeight + , imageUrl + , imageSize + , imageWidth + , imageMp4Url + , imageMp4Size + , imageWebpUrl + , imageWebpSize + , paginationCount + , paginationOffset + , paginationTotalCount + , searchItems + , searchPagination + , singleGifItem + , translateItem + , randomGifItem + -- * API calls + -- $api + , search + , searchOffset + , translate + , gif + , random + ) where + +import Control.Monad (MonadPlus (), forM, join, mzero) +import qualified Control.Monad.Reader as Reader +import Control.Monad.Trans (MonadIO (), lift, liftIO) +import Control.Monad.Trans.Either (EitherT, runEitherT) +import Data.Aeson ((.:), (.:?)) +import qualified Data.Aeson.Types as Aeson +import qualified Data.Map.Strict as Map +import Data.Monoid ((<>)) +import qualified Data.Proxy as Proxy +import qualified Data.Text as T +import GHC.Generics (Generic ()) +import qualified Lens.Micro.TH as Lens +import qualified Network.URI as URI +import Servant.API ((:<|>) (..), (:>)) +import qualified Servant.API as Servant +import qualified Servant.Client as Servant +import qualified Text.Read as Read + +maybeParse :: (Monad m, MonadPlus m) => (a -> Maybe b) -> m a -> m b +maybeParse f = (maybe mzero return . f =<<) + +fromURI :: (Monad m, MonadPlus m) => m String -> m Servant.URI +fromURI = maybeParse URI.parseURI + +fromInt :: (Monad m, MonadPlus m) => m String -> m Int +fromInt = maybeParse Read.readMaybe + +-- $request +-- +-- These data types are used to encapsulate otherwise weakly +-- typed arguments. + +-- | The API Key. See https://github.com/Giphy/GiphyAPI +newtype Key = Key T.Text + deriving (Servant.ToText, Servant.FromText, Show, Eq) + +-- | A search query. +newtype Query = Query T.Text + deriving (Servant.ToText, Servant.FromText, Show, Eq) + +-- | A phrase or term used for translation. +newtype Phrase = Phrase T.Text + deriving (Servant.ToText, Servant.FromText, Show, Eq) + +-- | A tag to retrieve a random GIF for. +newtype Tag = Tag T.Text + deriving (Servant.ToText, Servant.FromText, Show, Eq) + +-- | A unique gif identifier. +newtype GifId = GifId T.Text + deriving (Servant.ToText, Servant.FromText, Show, Eq) + +-- | Offset for paginated requests. +newtype PaginationOffset = PaginationOffset Int + deriving (Servant.ToText, Servant.FromText, Show, Eq) + +-- $response +-- +-- These data types contain are the parsed JSON responses from +-- the Giphy API. + +-- | An image contained in a Giphy response. +data Image = Image { + _imageUrl :: Maybe URI.URI + , _imageSize :: Maybe Int + , _imageMp4Url :: Maybe URI.URI + , _imageMp4Size :: Maybe Int + , _imageWebpUrl :: Maybe URI.URI + , _imageWebpSize :: Maybe Int + , _imageWidth :: Maybe Int + , _imageHeight :: Maybe Int +} deriving (Show, Eq, Ord, Generic) + +Lens.makeLenses ''Image + +parseImageJSON :: T.Text -> Aeson.Object -> Aeson.Parser Image +parseImageJSON prefix o = + let p = if T.null prefix then "" else prefix <> "_" + in Image <$> (fromURI <$> (o .:? (p <> "url"))) + <*> (fromInt <$> (o .:? (p <> "size"))) + <*> (fromURI <$> (o .:? (p <> "mp4"))) + <*> (fromInt <$> (o .:? (p <> "mp4_size"))) + <*> (fromURI <$> (o .:? (p <> "webp"))) + <*> (fromInt <$> (o .:? (p <> "webp_size"))) + <*> (fromInt <$> (o .:? (p <> "width"))) + <*> (fromInt <$> (o .:? (p <> "height"))) + +instance Aeson.FromJSON Image where + parseJSON (Aeson.Object o) = parseImageJSON "" o + parseJSON _ = error "Invalid image response." + +-- | Mapping from a 'T.Text' identifier to an 'Image'. +type ImageMap = Map.Map T.Text Image + +-- | A search response item. +data Gif = Gif { + _gifId :: T.Text + , _gifSlug :: T.Text + , _gifUrl :: URI.URI + , _gifImages :: ImageMap +} deriving (Show, Eq, Ord, Generic) + +Lens.makeLenses ''Gif + +instance Aeson.FromJSON Gif where + parseJSON (Aeson.Object o) = + Gif <$> o .: "id" + <*> o .: "slug" + <*> fromURI (o .: "url") + <*> o .: "images" + parseJSON _ = error "Invalid GIF response." + +-- | Metadata about pagination in a response. +data Pagination = Pagination { + _paginationTotalCount :: Int + , _paginationCount :: Int + , _paginationOffset :: Int +} deriving (Show, Eq, Ord, Generic) + +Lens.makeLenses ''Pagination + +instance Aeson.FromJSON Pagination where + parseJSON (Aeson.Object o) = + Pagination <$> o .: "total_count" + <*> o .: "count" + <*> o .: "offset" + parseJSON _ = error "Invalid pagination data." + +-- | A collection of GIFs as part of a search response. +data SearchResponse = SearchResponse { + _searchItems :: [Gif] + , _searchPagination :: Pagination +} deriving (Show, Eq, Ord, Generic) + +Lens.makeLenses ''SearchResponse + +instance Aeson.FromJSON SearchResponse where + parseJSON (Aeson.Object o) = + SearchResponse <$> o .: "data" + <*> o .: "pagination" + parseJSON _ = error "Invalid search response." + +-- | A single GIF as part of a translate response. +newtype TranslateResponse = TranslateResponse { + _translateItem :: Gif +} deriving (Show, Eq, Ord, Generic) + +Lens.makeLenses ''TranslateResponse + +instance Aeson.FromJSON TranslateResponse where + parseJSON (Aeson.Object o) = + TranslateResponse <$> o .: "data" + parseJSON _ = error "Invalid translate response." + +-- | A single gif as part of a response. +newtype SingleGifResponse = SingleGifResponse { + _singleGifItem :: Gif +} deriving (Show, Eq, Ord, Generic) + +Lens.makeLenses ''SingleGifResponse + +instance Aeson.FromJSON SingleGifResponse where + parseJSON (Aeson.Object o) = + SingleGifResponse <$> o .: "data" + parseJSON _ = error "Invalid GIF response." + +-- | A single gif as part of a response. +newtype RandomResponse = RandomResponse { + _randomGifItem :: Gif +} deriving (Show, Eq, Ord, Generic) + +Lens.makeLenses ''RandomResponse + +randomImageKeys :: [T.Text] +randomImageKeys = [ "fixed_height_downsampled" + , "fixed_height_small" + , "fixed_width_downsampled" + , "fixed_width_small" + , "fixed_width" + ] + +instance Aeson.FromJSON RandomResponse where + parseJSON (Aeson.Object o) = + RandomResponse <$> (mkGif =<< (o .: "data")) + where + mkGif :: Aeson.Object -> Aeson.Parser Gif + mkGif d = + Gif <$> d .: "id" + <*> pure "" + <*> fromURI (d .: "url") + <*> mkImageMap d + + mkImageMap :: Aeson.Object -> Aeson.Parser ImageMap + mkImageMap = (Map.fromList <$>) . forM keys . uncurry . extractImage + where + dup = join (,) + keys = ("image", "original") : (dup <$> randomImageKeys) + + extractImage :: Aeson.Object -> T.Text -> T.Text -> Aeson.Parser (T.Text, Image) + extractImage d key tag = (,) <$> pure tag <*> parseImageJSON key d + + parseJSON _ = error "Invalid GIF response." + +-- | The Giphy API +type GiphyAPI = "v1" + :> "gifs" + :> "search" + :> Servant.QueryParam "api_key" Key + :> Servant.QueryParam "offset" PaginationOffset + :> Servant.QueryParam "q" Query + :> Servant.Get '[Servant.JSON] SearchResponse + :<|> "v1" + :> "gifs" + :> "translate" + :> Servant.QueryParam "api_key" Key + :> Servant.QueryParam "s" Phrase + :> Servant.Get '[Servant.JSON] TranslateResponse + :<|> "v1" + :> "gifs" + :> Servant.Capture "gif_id" GifId + :> Servant.QueryParam "api_key" Key + :> Servant.Get '[Servant.JSON] SingleGifResponse + :<|> "v1" + :> "gifs" + :> "random" + :> Servant.QueryParam "api_key" Key + :> Servant.QueryParam "tag" Tag + :> Servant.Get '[Servant.JSON] RandomResponse + +api :: Proxy.Proxy GiphyAPI +api = Proxy.Proxy + +search' + :: Maybe Key + -> Maybe PaginationOffset + -> Maybe Query + -> EitherT Servant.ServantError IO SearchResponse + +translate' + :: Maybe Key + -> Maybe Phrase + -> EitherT Servant.ServantError IO TranslateResponse + +gif' + :: GifId + -> Maybe Key + -> EitherT Servant.ServantError IO SingleGifResponse + +random' + :: Maybe Key + -> Maybe Tag + -> EitherT Servant.ServantError IO RandomResponse + +search' :<|> translate' :<|> gif' :<|> random' = Servant.client api host + where host = Servant.BaseUrl Servant.Https "api.giphy.com" 443 + +-- $api +-- +-- Functions that directly access the Giphy API. All these functions run in +-- the 'Giphy' monad. +-- + +-- | Issue a search request for the given query without specifying an offset. +-- E.g. +search + :: Query + -> Giphy SearchResponse +search query = do + key <- Reader.asks configApiKey + lift $ search' (pure key) (pure $ PaginationOffset 0) (pure query) + +-- | Issue a search request for the given query by specifying a +-- pagination offset. +-- E.g. +searchOffset + :: Query + -> PaginationOffset + -> Giphy SearchResponse +searchOffset query offset = do + key <- Reader.asks configApiKey + lift $ search' (pure key) (pure offset) (pure query) + +-- | Issue a request for a single GIF identified by its 'GifId'. +-- E.g. +gif + :: GifId + -> Giphy SingleGifResponse +gif gifid = do + key <- Reader.asks configApiKey + lift $ gif' gifid (pure key) + +-- | Issue a translate request for a given phrase or term. +-- E.g. +translate + :: Phrase + -> Giphy TranslateResponse +translate phrase = do + key <- Reader.asks configApiKey + lift $ translate' (pure key) (pure phrase) + +-- | Issue a request for a random GIF for the given (optional) tag. +-- E.g. +random + :: Maybe Tag + -> Giphy RandomResponse +random tag = do + key <- Reader.asks configApiKey + lift $ random' (pure key) tag + +-- $giphy +-- +-- Use 'runGiphy' to lift the 'Giphy' monad into IO. +-- + +-- | Contains the key to access the API. +data GiphyConfig = GiphyConfig { configApiKey :: Key } + deriving (Show, Eq) + +-- | The Giphy monad contains the execution context. +type Giphy = Reader.ReaderT GiphyConfig (EitherT Servant.ServantError IO) + +-- | You need to provide a 'GiphyConfig' to lift a 'Giphy' computation +-- into 'MonadIO'. +runGiphy :: MonadIO m => Giphy a -> GiphyConfig -> m (Either Servant.ServantError a) +runGiphy = ((liftIO . runEitherT) .) . Reader.runReaderT + +-- $lenses +-- +-- You can use these lenses if you prefer them to manually accessing +-- record fields. diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +import BasicPrelude +import Data.Maybe (fromJust) +import System.Directory (getCurrentDirectory) + +import Control.Lens.At (at) +import Control.Lens.Cons (_head) +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy as BS +import qualified Data.Map.Strict as Map +import qualified Data.Text.Encoding as TE +import qualified Data.Text.IO as TIO +import Network.URI (parseURI) + +import Control.Lens.Operators +import Test.Hspec + +import qualified Web.Giphy as Giphy + +readFixture :: FilePath -> IO BS.ByteString +readFixture path = do + dir <- getCurrentDirectory + BS.fromStrict . TE.encodeUtf8 <$> TIO.readFile (dir "test" "fixtures" path) + +main :: IO () +main = hspec $ do + describe "Giphy" $ do + describe "JSON Parsing" $ do + + it "parses a search response" $ do + resp <- readFixture "search_response.json" + let res = either error id (Aeson.eitherDecode resp) + let item = res ^?! Giphy.searchItems . _head + + item ^. Giphy.gifId `shouldBe` "QgcQLZa6glP2w" + item ^. Giphy.gifSlug `shouldBe` "cat-funny-QgcQLZa6glP2w" + item ^. Giphy.gifUrl `shouldBe` fromJust (parseURI "https://giphy.com/gifs/cat-funny-QgcQLZa6glP2w") + res ^. Giphy.searchPagination . Giphy.paginationCount `shouldBe` 25 + res ^. Giphy.searchPagination . Giphy.paginationTotalCount `shouldBe` 2161 + + let images = item ^. Giphy.gifImages + + Map.keys images `shouldBe` [ + "downsized" + , "downsized_large" + , "downsized_medium" + , "downsized_still" + , "fixed_height" + , "fixed_height_downsampled" + , "fixed_height_small" + , "fixed_height_small_still" + , "fixed_height_still" + , "fixed_width" + , "fixed_width_downsampled" + , "fixed_width_small" + , "fixed_width_small_still" + , "fixed_width_still" + , "looping" + , "original" + , "original_still" + ] + + images ^? at "fixed_height" . traverse . Giphy.imageUrl . traverse `shouldBe` + parseURI "https://media0.giphy.com/media/QgcQLZa6glP2w/200.gif" + + images ^? at "looping" . traverse . Giphy.imageMp4Url . traverse `shouldBe` + parseURI "https://media.giphy.com/media/QgcQLZa6glP2w/giphy-loop.mp4" + + images ^? at "fixed_width_small" . traverse . Giphy.imageMp4Size . traverse `shouldBe` Just 39646 + + it "parses a translate response" $ do + resp <- readFixture "translate_response.json" + let item = case Aeson.eitherDecode resp of + Left err -> error err + Right i -> i ^?! Giphy.translateItem + + item ^. Giphy.gifId `shouldBe` "Zlkbqhurvg4Zq" + item ^. Giphy.gifSlug `shouldBe` "superman-Zlkbqhurvg4Zq" + item ^. Giphy.gifUrl `shouldBe` fromJust (parseURI "https://giphy.com/gifs/superman-Zlkbqhurvg4Zq") + + let images = item ^. Giphy.gifImages + + Map.keys images `shouldBe` [ + "downsized" + , "downsized_large" + , "downsized_medium" + , "downsized_still" + , "fixed_height" + , "fixed_height_downsampled" + , "fixed_height_small" + , "fixed_height_small_still" + , "fixed_height_still" + , "fixed_width" + , "fixed_width_downsampled" + , "fixed_width_small" + , "fixed_width_small_still" + , "fixed_width_still" + , "looping" + , "original" + , "original_still" + ] + + images ^? at "fixed_height" . traverse . Giphy.imageUrl . traverse `shouldBe` + parseURI "https://media0.giphy.com/media/Zlkbqhurvg4Zq/200.gif" + + it "parses a 'random' response" $ do + resp <- readFixture "random_response.json" + let item = case Aeson.eitherDecode resp of + Left err -> error err + Right i -> i ^?! Giphy.randomGifItem + + item ^. Giphy.gifId `shouldBe` "13bGOCL29Loy5O" + item ^. Giphy.gifSlug `shouldBe` "" + item ^. Giphy.gifUrl `shouldBe` fromJust (parseURI "http://giphy.com/gifs/american-psycho-quote-text-13bGOCL29Loy5O") + + let images = item ^. Giphy.gifImages + + Map.keys images `shouldMatchList` [ + "fixed_height_downsampled" + , "fixed_height_small" + , "fixed_width_downsampled" + , "fixed_width_small" + , "fixed_width" + , "original" + ] + + images ^? at "original" . traverse . Giphy.imageUrl . traverse `shouldBe` + parseURI "http://media0.giphy.com/media/13bGOCL29Loy5O/giphy.gif" + + images ^? at "fixed_height_small" . traverse . Giphy.imageUrl . traverse `shouldBe` + parseURI "http://media0.giphy.com/media/13bGOCL29Loy5O/100.gif" + + images ^? at "fixed_width_downsampled" . traverse . Giphy.imageHeight . traverse `shouldBe` + pure 82