giphy-api 0.3.0.0 → 0.4.0.0
raw patch · 4 files changed
+92/−82 lines, 4 filesdep +transformersdep ~servantdep ~servant-client
Dependencies added: transformers
Dependency ranges changed: servant, servant-client
Files
- changelog.md +5/−0
- giphy-api.cabal +5/−4
- src/Web/Giphy.hs +77/−43
- stack.yaml +5/−35
changelog.md view
@@ -1,5 +1,10 @@ # Changelog +## v0.4.0.0++- Upgrade to Servant 0.6. When running the Giphy monad it is now possible+ to provide a custom HTTP manager.+ ## v0.3.0.0 - Upgrade to Servant 0.5. No changes in the API, but it's not in Stackage yet
giphy-api.cabal view
@@ -1,9 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.11.0.+-- This file has been generated from package.yaml by hpack version 0.11.2. -- -- see: https://github.com/sol/hpack name: giphy-api-version: 0.3.0.0+version: 0.4.0.0 synopsis: Giphy HTTP API wrapper and CLI search tool. description: Please see README.md category: Web@@ -41,8 +41,9 @@ , microlens , microlens-th , mtl- , servant >= 0.5- , servant-client >= 0.5+ , servant >= 0.6+ , servant-client >= 0.6+ , transformers , http-api-data , http-client , http-client-tls
src/Web/Giphy.hs view
@@ -6,6 +6,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE KindSignatures #-} -- | -- Provides a Giphy monad that can be used to issue selected API calls under a@@ -53,6 +55,7 @@ , GiphyConfig(..) , Giphy() , runGiphy+ , runGiphy' -- * Lenses -- $lenses , gifId@@ -82,29 +85,30 @@ , translate , gif , random+ -- NO+ , liftQuery ) where -import Control.Monad (MonadPlus (), forM, join, mzero)-import Control.Monad.Except (ExceptT, runExceptT)-import qualified Control.Monad.Reader as Reader-import Control.Monad.Trans (MonadIO (), lift, liftIO)-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.HTTP.Client as HTTP-import Network.HTTP.Client.TLS (tlsManagerSettings)-import qualified Network.URI as URI-import Servant.API ((:<|>) (..), (:>))-import qualified Servant.API as Servant-import qualified Servant.Client as Servant-import qualified System.IO.Unsafe as Unsafe-import qualified Text.Read as Read-import qualified Web.HttpApiData as Data+import Control.Monad (MonadPlus (), forM, join, mzero)+import Control.Monad.Except (ExceptT, runExceptT)+import qualified Control.Monad.Reader as Reader+import Control.Monad.Trans (MonadIO (), lift, liftIO)+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.HTTP.Client as HTTP+import Network.HTTP.Client.TLS (tlsManagerSettings)+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+import qualified Web.HttpApiData as Data maybeParse :: (Monad m, MonadPlus m) => (a -> Maybe b) -> m a -> m b maybeParse f = (maybe mzero return . f =<<)@@ -312,37 +316,39 @@ api :: Proxy.Proxy GiphyAPI api = Proxy.Proxy --- From the servant docs:--- (Yes, the usage of unsafePerformIO is very ugly, we know.--- Hopefully soon it’ll be possible to do without.)-{-# NOINLINE __manager #-}-__manager :: HTTP.Manager-__manager = Unsafe.unsafePerformIO $ HTTP.newManager tlsManagerSettings+baseUrl :: Servant.BaseUrl+baseUrl = Servant.BaseUrl Servant.Https "api.giphy.com" 443 "v1/gifs/" search' :: Maybe Key -> Maybe PaginationOffset -> Maybe Query+ -> HTTP.Manager+ -> Servant.BaseUrl -> ExceptT Servant.ServantError IO SearchResponse translate' :: Maybe Key -> Maybe Phrase+ -> HTTP.Manager+ -> Servant.BaseUrl -> ExceptT Servant.ServantError IO TranslateResponse gif' :: GifId -> Maybe Key+ -> HTTP.Manager+ -> Servant.BaseUrl -> ExceptT Servant.ServantError IO SingleGifResponse random' :: Maybe Key -> Maybe Tag+ -> HTTP.Manager+ -> Servant.BaseUrl -> ExceptT Servant.ServantError IO RandomResponse -search' :<|> translate' :<|> gif' :<|> random' = Servant.client api host __manager- where- host = Servant.BaseUrl Servant.Https "api.giphy.com" 443 "v1/gifs/"+search' :<|> translate' :<|> gif' :<|> random' = Servant.client api -- $api --@@ -350,25 +356,36 @@ -- the 'Giphy' monad. -- +-- | Lift a partially applied request function into the Giphy monad.+liftQuery+ :: forall b (t :: (* -> *) -> * -> *) (m :: * -> *).+ (Monad m, Reader.MonadTrans t, Reader.MonadReader GiphyContext (t m))+ => (HTTP.Manager -> Servant.BaseUrl -> m b)+ -> t m b+liftQuery f = do+ manager <- Reader.asks ctxManager+ url <- Reader.asks ctxBaseUrl+ lift $ f manager url+ -- | 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> search :: Query -> Giphy SearchResponse search query = do- key <- Reader.asks configApiKey- lift $ search' (pure key) (pure $ PaginationOffset 0) (pure query)+ key <- Reader.asks (configApiKey . ctxConfig)+ liftQuery $ search' (pure key) (pure $ PaginationOffset 0) (pure query) -- | 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> searchOffset :: Query- -> PaginationOffset+ -> PaginationOffset -- ^ Offset as a number of items you want to skip. -> Giphy SearchResponse searchOffset query offset = do- key <- Reader.asks configApiKey- lift $ search' (pure key) (pure offset) (pure query)+ key <- Reader.asks (configApiKey . ctxConfig)+ liftQuery $ search' (pure key) (pure offset) (pure query) -- | Issue a request for a single GIF identified by its 'GifId'. -- E.g. <https://api.giphy.com/v1/gifs/feqkVgjJpYtjy?api_key=dc6zaTOxFJmzC>@@ -376,8 +393,8 @@ :: GifId -> Giphy SingleGifResponse gif gifid = do- key <- Reader.asks configApiKey- lift $ gif' gifid (pure key)+ key <- Reader.asks (configApiKey . ctxConfig)+ liftQuery $ gif' gifid (pure key) -- | Issue a translate request for a given phrase or term. -- E.g. <https://api.giphy.com/v1/gifs/translate?s=superman&api_key=dc6zaTOxFJmzC>@@ -385,8 +402,8 @@ :: Phrase -> Giphy TranslateResponse translate phrase = do- key <- Reader.asks configApiKey- lift $ translate' (pure key) (pure phrase)+ key <- Reader.asks (configApiKey . ctxConfig)+ liftQuery $ translate' (pure key) (pure phrase) -- | 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>@@ -394,8 +411,8 @@ :: Maybe Tag -> Giphy RandomResponse random tag = do- key <- Reader.asks configApiKey- lift $ random' (pure key) tag+ key <- Reader.asks (configApiKey . ctxConfig)+ liftQuery $ random' (pure key) tag -- $giphy --@@ -406,13 +423,30 @@ data GiphyConfig = GiphyConfig { configApiKey :: Key } deriving (Show, Eq) +-- | Internal data structure holding the base url, http manager and config.+data GiphyContext = GiphyContext { ctxConfig :: GiphyConfig+ , ctxManager :: HTTP.Manager+ , ctxBaseUrl :: Servant.BaseUrl }+ -- | The Giphy monad contains the execution context.-type Giphy = Reader.ReaderT GiphyConfig (ExceptT Servant.ServantError IO)+type Giphy = Reader.ReaderT GiphyContext (ExceptT 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 . runExceptT) .) . Reader.runReaderT+runGiphy g conf = do+ manager <- liftIO $ HTTP.newManager tlsManagerSettings+ runGiphy' manager g conf++-- | Same as 'runGiphy' but accepts an explicit 'HTTP.Manager' instead of+-- implicitly creating one for you.+runGiphy'+ :: MonadIO m+ => HTTP.Manager -- ^ This must be a TLS-enabled Manager+ -> Giphy a+ -> GiphyConfig+ -> m (Either Servant.ServantError a)+runGiphy' manager giphy conf = liftIO . runExceptT . Reader.runReaderT giphy $ GiphyContext conf manager baseUrl -- $lenses --
stack.yaml view
@@ -1,38 +1,8 @@-# This file was automatically generated by stack init-# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/--# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)-resolver: nightly-2016-03-25--# Local packages, usually specified by relative directory name+flags: {}+extra-package-dbs: [] packages: - '.'-# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) extra-deps:-- servant-0.5-- servant-client-0.5-- http-api-data-0.2.2--# Override default flag values for local packages and extra-deps-flags: {}--# Extra package databases containing global packages-extra-package-dbs: []--# Control whether we use the GHC we find on the path-# system-ghc: true--# Require a specific version of stack, using version ranges-# require-stack-version: -any # Default-# require-stack-version: >= 1.0.0--# Override the architecture used by stack, especially useful on Windows-# arch: i386-# arch: x86_64--# Extra directories used by stack for building-# extra-include-dirs: [/path/to/dir]-# extra-lib-dirs: [/path/to/dir]--# Allow a newer minor version of GHC than the snapshot specifies-# compiler-check: newer-minor+- servant-0.6+- servant-client-0.6+resolver: nightly-2016-04-04