servant-namedargs 0.1.0.1 → 0.1.1.0

raw patch · 5 files changed

+37/−4 lines, 5 files

Files

• CHANGELOG.md +4/−0
• README.md +3/−1
• servant-namedargs.cabal +3/−1
• src/Servant/API/NamedArgs.hs +22/−2
• test/LinkEquivalency.hs +5/−0

@@ -7,3 +7,7 @@ ## 0.1.0.1 -- 2019-01-25  * Relaxation of base constraint and some minor documentation fixes; had to be done as a new version to be able to build on Hackage++## 0.1.1.0 -- 2019-02-25++* Introduction of NamedBody' combinator

@@ -1,1 +1,3 @@-This library provides combinators to add named arguments to servant endpoints. These combinators are all isomorphic to existing servant combinators, and so a type family `Transform` is also provided for converting namedargs combinators to and from default servant combinators. Following the pattern of servant itself, this library *only* adds the combinators and instances for link generation: for the instances to actually use them with servant-client and servant-server, look at servant-client-namedargs and servant-server-namedargs.+This library provides combinators to add named arguments to servant endpoints. These combinators are all isomorphic to existing servant combinators\*, and so a type family `Transform` is also provided for converting namedargs combinators to and from default servant combinators. Following the pattern of servant itself, this library *only* adds the combinators and instances for link generation: for the instances to actually use them with servant-client and servant-server, look at servant-client-namedargs and servant-server-namedargs.++\* NamedBody' is NOT isomorphic to ReqBody', because ReqBody' doesn't have a name. Conversions are still provided, but going from a NamedBody' to a ReqBody' will lose the associated name of the NamedBody', and going from a ReqBody' to a NamedBody' requires a default name which will be applied.

@@ -1,7 +1,9 @@ name:                servant-namedargs-version:             0.1.0.1+version:             0.1.1.0 synopsis:            Combinators for servant providing named parameters -- description:+homepage:            https://gitlab.com/sciencei/servant-namedargs+bug-reports:         https://gitlab.com/sciencei/servant-namedargs/issues license:             BSD3 license-file:        LICENSE author:              Cullin Poresky

@@ -10,6 +10,7 @@ {-# LANGUAGE TypeApplications      #-} {-# LANGUAGE AllowAmbiguousTypes   #-} {-# LANGUAGE PatternSynonyms       #-}+{-# LANGUAGE ExistentialQuantification       #-}  -- | This module provides combinators to represent named arguments -- to endpoints. Note that only link generation instances are provided@@ -27,7 +28,7 @@ import Servant.API           ((:>), (:<|>)(..), Capture', If, QueryFlag, QueryParam'                              , QueryParams, SBoolI(..), SBool(..), HasLink(..)                              , ToHttpApiData(..), CaptureAll(..), AddHeader(..), Headers(..)-                             , Header'(..))+                             , Header'(..), ReqBody') import Servant.API.Modifiers (FoldRequired, Optional, Required, Strict, FoldLenient) import Servant.API.Generic   (GenericMode(..), AsApi, ToServant) import Servant.Links         (Param(..), Link(..), linkQueryParams)@@ -125,6 +126,20 @@   type MkLink (NamedHeader' mods name a :> sub) r = MkLink sub r   toLink toA _ = toLink toA (Proxy :: Proxy sub) +-- | Named /equivalent/ but /not isomorphism/ of 'ReqBody''. 'ReqBody'' doesn't +-- have an associated name, so if you convert from a 'NamedBody'' to a 'ReqBody''+-- you will /lose the associated name/. Converting from a 'ReqBody'' to a 'NamedBody''+-- requires a default name be passed in. Like 'ReqBody'', 'NamedBody'' is always+-- 'Required'.+data NamedBody' (mods :: [*]) (sym :: Symbol) (contentTypes :: [*]) (a :: *) deriving Typeable++type NamedBody = NamedBody' '[Required, Strict]++-- | Has no effect on the resulting link+instance (HasLink sub) => HasLink (NamedBody' mods name ct a :> sub) where+  type MkLink (NamedBody' mods name ct a :> sub) r = MkLink sub r+  toLink toA _ = toLink toA (Proxy :: Proxy sub)+ -- | Returns the type name ':!' a if given a list including 'Required' -- and name ':?' a otherwise type RequiredNamedArgument mods name a = If (FoldRequired mods) (name :! a) (name :? a)@@ -200,6 +215,8 @@     = NamedCaptureAll sym a   Transform (NameHeaders:_) (Header' mods sym a)     = NamedHeader' mods sym a+  Transform (NameBodies name:_) (ReqBody' mods ct a)+    = NamedBody' mods name ct a   -- unnaming rules   Transform (UnnameParams:_) (NamedParam mods sym a)     = QueryParam' mods sym a@@ -213,6 +230,8 @@     = CaptureAll sym a   Transform (UnnameHeaders:_) (NamedHeader' mods sym a)     = Header' mods sym a+  Transform (UnnameBodies:_) (NamedBody' mods sym ct a)+    = ReqBody' mods ct a   -- if the current transformation doesn't match, try the next one   Transform (_:ts) a = Transform ts a   -- if none of them match, leave it unchanged@@ -232,10 +251,11 @@                     | NameCaptureAlls -- ^ Replace 'CaptureAll's with 'NamedCaptureAll's                     | NameFlags -- ^ Replace 'QueryFlag's with 'NamedFlag's                     | NameHeaders -- ^ Replace 'Header''s with 'NamedHeader''s+                    | forall name. NameBodies name -- ^ Replace 'ReqBody''s with 'NamedBody''s with the default name @name@                     | UnnameParams -- ^ Replace 'NamedParam's with 'QueryParam''s                     | UnnameMultiParams -- ^ Replace 'NamedParams's with 'QueryParams's                      | UnnameCaptures -- ^ Replace 'NamedCapture''s with 'Capture''s                     | UnnameCaptureAlls -- ^ Replace 'NamedCaptureAll's with 'CaptureAll's                      | UnnameFlags -- ^ Replace 'NamedFlag's with 'QueryFlag's                      | UnnameHeaders -- ^ Replace 'NamedHeader''s with 'Header''s-                    deriving (Show, Read, Eq, Enum)+                    | UnnameBodies -- ^ Replace 'NamedBody''s with 'ReqBody''s -- WILL LOSE THE ASSOCIATED NAME

@@ -23,6 +23,7 @@            , NameFlags            , NameParams            , NameMultiParams+           , NameBodies "reqBody"            ]  type CaptureEndpoint = "capture" :> Capture "x" Int :> Get '[JSON] Int@@ -33,6 +34,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 BodyEndpoint = "reqBody" :> ReqBody '[JSON] Int :> Get '[JSON] Int                      type TestApi =    CaptureEndpoint              :<|> CaptureAllEndpoint@@ -42,6 +44,7 @@              :<|> ParamsEndpoint              :<|> ReqHeaderEndpoint              :<|> OpHeaderEndpoint+             :<|> BodyEndpoint  cmpLinks   :: forall endpoint a n. ( IsElem endpoint TestApi@@ -83,3 +86,5 @@         cmpLinks @ReqHeaderEndpoint Nothing (flip const) (flip const)       it "Optional QueryHeader and NamedHeader are equivalent" $ do         cmpLinks @OpHeaderEndpoint Nothing (flip const) (flip const)+      it "ReqBody and NamedBody are equivalent" $ do+        cmpLinks @BodyEndpoint Nothing (flip const) (flip const)