servant-client-namedargs 0.1.0.0 → 0.1.1.0
raw patch · 4 files changed
+44/−10 lines, 4 filesdep ~servant-namedargsdep ~servant-server-namedargs
Dependency ranges changed: servant-namedargs, servant-server-namedargs
Files
- CHANGELOG.md +4/−0
- servant-client-namedargs.cabal +6/−5
- src/Servant/Client/NamedArgs.hs +22/−3
- test/ClientServerEquivalency.hs +12/−2
CHANGELOG.md view
@@ -3,3 +3,7 @@ ## 0.1.0.0 -- YYYY-mm-dd * First version. Released on an unsuspecting world.++## 0.1.1.0 -- 2019-02-25++* Introduction of NamedBody' combinator
servant-client-namedargs.cabal view
@@ -1,8 +1,9 @@ name: servant-client-namedargs-version: 0.1.0.0+version: 0.1.1.0 synopsis: Automatically derive API client functions with named and optional parameters -- description:--- homepage: +homepage: https://gitlab.com/sciencei/servant-client-namedargs+bug-reports: https://gitlab.com/sciencei/servant-client-namedargs/issues license: BSD3 license-file: LICENSE author: Cullin Poresky@@ -20,7 +21,7 @@ build-depends: base >= 4.11 && < 4.13 , servant >= 0.14.1 && < 0.16 , servant-client-core >= 0.14.1 && < 0.16- , servant-namedargs >= 0.1 && < 0.2+ , servant-namedargs >= 0.1.1 && < 0.2 , named >= 0.2 && < 0.3 , text >= 1.2 && < 1.3 hs-source-dirs: src@@ -32,8 +33,8 @@ build-depends: base , servant , named- , servant-namedargs == 0.1.0.1- , servant-server-namedargs == 0.1.0.0+ , servant-namedargs == 0.1.1.0+ , servant-server-namedargs == 0.1.1.0 , servant-client-namedargs , servant-server , servant-client
src/Servant/Client/NamedArgs.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DataKinds #-} -- | Provides instances to be able to use combinators from -- "Servant.API.NamedArgs" with "Servant.Client", returning functions@@ -16,14 +17,14 @@ import Data.Text (pack, Text) import Data.Functor.Identity (Identity) import Data.List (foldl')-import Servant.API ((:>), SBoolI, ToHttpApiData, toQueryParam, toUrlPiece)+import Servant.API ((:>), SBoolI, ToHttpApiData, toQueryParam, toUrlPiece, MimeRender(mimeRender), contentType) import Servant.API.Modifiers (FoldRequired) import Servant.API.NamedArgs ( foldRequiredNamedArgument, NamedCapture', NamedFlag , NamedParam, NamedParams, RequiredNamedArgument- , NamedCaptureAll, NamedHeader')+ , NamedCaptureAll, NamedHeader', NamedBody') import Servant.Client.Core.Internal.HasClient (HasClient(..)) import Servant.Client.Core.Internal.Request ( appendToPath, appendToQueryString, Request- , addHeader)+ , addHeader, setRequestBodyLBS) import Data.String (fromString) import GHC.TypeLits (KnownSymbol, symbolVal)@@ -150,3 +151,21 @@ hoistClientMonad pm _ f cl = \as -> hoistClientMonad pm (Proxy @api) f (cl as)++-- | 'NamedBody''s become required named arguments +instance (KnownSymbol name, MimeRender ct a, HasClient m api)+ => HasClient m (NamedBody' mods name (ct ': cts) a :> api) where++ type Client m (NamedBody' mods name (ct ': cts) a :> api) =+ (name :! a) -> Client m api++ clientWithRoute pm _ req (arg (Name @name) -> body) =+ clientWithRoute pm (Proxy @api) $+ setRequestBodyLBS (mimeRender ctProxy body)+ (contentType ctProxy)+ req+ where+ ctProxy = Proxy @ct++ hoistClientMonad pm _ f cl = \a ->+ hoistClientMonad pm (Proxy @api) f (cl a)
test/ClientServerEquivalency.hs view
@@ -32,6 +32,7 @@ , NameParams , NameMultiParams , NameHeaders+ , NameBodies "reqBody" ] type CaptureEndpoint = "capture" :> Capture "x" Int :> Get '[JSON] Int@@ -42,6 +43,7 @@ type ParamsEndpoint = "params" :> QueryParams "ps" Int :> Get '[JSON] [Int] type ReqHeaderEndpoint = "requiredHeader" :> Header' [Required, Strict] "rh" Int :> Get '[JSON] Int type OpHeaderEndpoint = "optionalHeader" :> Header' [Optional, Strict] "oh" Int :> Get '[JSON] Int+type ReqBodyEndpoint = "reqBody" :> ReqBody' '[Required, Strict] '[JSON] Int :> Get '[JSON] Int type TestApi = CaptureEndpoint :<|> CaptureAllEndpoint@@ -51,6 +53,7 @@ :<|> ParamsEndpoint :<|> ReqHeaderEndpoint :<|> OpHeaderEndpoint+ :<|> ReqBodyEndpoint unnamedServer :: Server TestApi unnamedServer = pure@@ -61,6 +64,7 @@ :<|> pure :<|> pure :<|> pure . def 19+ :<|> pure namedServer :: Server (Transform All TestApi) namedServer = pureI@@ -71,6 +75,7 @@ :<|> pureI :<|> pureI :<|> pureM+ :<|> pureI where pureI (Arg v) = pure v pureM (ArgF mv) = maybe (pure 19) pure mv@@ -85,8 +90,10 @@ :<|> uOParam :<|> uParams :<|> uRHeader- :<|> uOHeader = client (Proxy @TestApi)+ :<|> uOHeader + :<|> uBody = client (Proxy @TestApi) + nCapture :<|> nCaptureAll :<|> nFlag@@ -94,7 +101,8 @@ :<|> nOParam :<|> nParams :<|> nRHeader- :<|> nOHeader = client (Proxy @(Transform All TestApi))+ :<|> nOHeader + :<|> nBody = client (Proxy @(Transform All TestApi)) clientServerEq :: (Eq r)@@ -165,5 +173,7 @@ property $ \x -> ioprop $ doComp x (uRHeader . runIdentity) (nRHeader . ArgF) it "Optional QueryHeader and NamedHeader are equivalent" $ do property $ \x -> ioprop $ doComp x (uOHeader) (nOHeader . ArgF)+ it "ReqBody' and NamedBody' are equivalent" $ do+ property $ \x -> ioprop $ doComp x (uBody . runIdentity) (nBody . ArgF) cancel us cancel ns